diff --git a/async/httpaf_async.ml b/async/httpaf_async.ml index b4935864..0ff9421b 100644 --- a/async/httpaf_async.ml +++ b/async/httpaf_async.ml @@ -90,16 +90,15 @@ let read fd buffer = open Httpaf module Server = struct - let create_connection_handler ?config ~request_handler ~error_handler = + let create_connection_handler ?(config=Config.default) ~request_handler ~error_handler = fun client_addr socket -> let fd = Socket.fd socket in let writev = Faraday_async.writev_of_fd fd in let request_handler = request_handler client_addr in let error_handler = error_handler client_addr in - let conn = Server_connection.create ?config ~error_handler request_handler in + let conn = Server_connection.create ~config ~error_handler request_handler in let read_complete = Ivar.create () in - (* XXX(seliopou): Make this configurable *) - let buffer = Buffer.create 0x1000 in + let buffer = Buffer.create config.read_buffer_size in let rec reader_thread () = match Server_connection.next_read_operation conn with | `Read -> @@ -158,13 +157,13 @@ module Server = struct end module Client = struct - let request socket request ~error_handler ~response_handler = + let request ?(config=Config.default) socket request ~error_handler ~response_handler = let fd = Socket.fd socket in let writev = Faraday_async.writev_of_fd fd in let request_body, conn = Client_connection.request request ~error_handler ~response_handler in let read_complete = Ivar.create () in - let buffer = Buffer.create 0x1000 in + let buffer = Buffer.create config.read_buffer_size in let rec reader_thread () = match Client_connection.next_read_operation conn with | `Read -> diff --git a/async/httpaf_async.mli b/async/httpaf_async.mli index 97ac4fec..93691b53 100644 --- a/async/httpaf_async.mli +++ b/async/httpaf_async.mli @@ -5,7 +5,7 @@ open Httpaf module Server : sig val create_connection_handler - : ?config : Server_connection.Config.t + : ?config : Config.t -> request_handler : ('a -> Fd.t Server_connection.request_handler) -> error_handler : ('a -> Server_connection.error_handler) -> ([< Socket.Address.t] as 'a) @@ -15,7 +15,8 @@ end module Client : sig val request - : ([`Active], [< Socket.Address.t]) Socket.t + : ?config : Config.t + -> ([`Active], [< Socket.Address.t]) Socket.t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler diff --git a/lib/client_connection.ml b/lib/client_connection.ml index 55e76a89..d74b11a5 100644 --- a/lib/client_connection.ml +++ b/lib/client_connection.ml @@ -57,15 +57,14 @@ module Oneshot = struct ; mutable error_code : [ `Ok | error ] } - let request request ~error_handler ~response_handler = + let request ?(config=Config.default) request ~error_handler ~response_handler = let state = ref Awaiting_response in let request_method = request.Request.meth in let handler response body = state := Received_response(response, body); response_handler response body in - (* XXX(seliopou): This buffer size should be configurable *) - let request_body = Body.create (Bigstring.create 0x1000) in + let request_body = Body.create (Bigstring.create config.request_body_buffer_size) in let t = { request ; request_body diff --git a/lib/config.ml b/lib/config.ml new file mode 100644 index 00000000..d4170401 --- /dev/null +++ b/lib/config.ml @@ -0,0 +1,11 @@ +type t = + { read_buffer_size : int + ; request_body_buffer_size : int + ; response_buffer_size : int + ; response_body_buffer_size : int } + +let default = + { read_buffer_size = 0x1000 + ; request_body_buffer_size = 0x1000 + ; response_buffer_size = 0x400 + ; response_body_buffer_size = 0x1000 } diff --git a/lib/httpaf.ml b/lib/httpaf.ml index dd72dc0a..71c930ef 100644 --- a/lib/httpaf.ml +++ b/lib/httpaf.ml @@ -8,6 +8,7 @@ module Response = Response module Status = Status module Version = Version module Body = Body +module Config = Config module Server_connection = Server_connection module Client_connection = Client_connection.Oneshot diff --git a/lib/httpaf.mli b/lib/httpaf.mli index 8c69f1f3..7468d830 100644 --- a/lib/httpaf.mli +++ b/lib/httpaf.mli @@ -689,21 +689,23 @@ module Reqd : sig val try_with : _ t -> (unit -> unit) -> (unit, exn) result end +(** {2 Buffer Size Configuration} *) +module Config : sig + type t = + { read_buffer_size : int (** Default is [4096] *) + ; request_body_buffer_size : int (** Default is [4096] *) + ; response_buffer_size : int (** Default is [1024] *) + ; response_body_buffer_size : int (** Default is [4096] *) + } + + val default : t + (** [default] is a configuration record with all parameters set to their + default values. *) +end (** {2 Server Connection} *) module Server_connection : sig - module Config : sig - type t = - { response_buffer_size : int (** Default is [1024] *) - ; response_body_buffer_size : int (** Default is [4096] *) - } - - val default : t - (** [default] is a configuration record with all parameters set to their - default values. *) - end - type 'handle t type error = @@ -805,7 +807,8 @@ module Client_connection : sig type error_handler = error -> unit val request - : Request.t + : ?config:Config.t + -> Request.t -> error_handler:error_handler -> response_handler:response_handler -> [`write] Body.t * t diff --git a/lib/server_connection.ml b/lib/server_connection.ml index ee3c653c..00ed0b99 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -46,15 +46,6 @@ end module Reader = Parse.Reader module Writer = Serialize.Writer -module Config = struct - type t = - { response_buffer_size : int - ; response_body_buffer_size : int } - - let default = - { response_buffer_size = 0x400 - ; response_body_buffer_size = 0x1000 } -end type 'fd request_handler = 'fd Reqd.t -> unit @@ -128,7 +119,7 @@ let create ?(config=Config.default) ?(error_handler=default_error_handler) reque { Config . response_buffer_size ; response_body_buffer_size - } = config + ; _ } = config in let writer = Writer.create ~buffer_size:response_buffer_size () in let request_queue = Queue.create () in diff --git a/lwt/httpaf_lwt.ml b/lwt/httpaf_lwt.ml index 2da8c102..6a68106f 100644 --- a/lwt/httpaf_lwt.ml +++ b/lwt/httpaf_lwt.ml @@ -72,26 +72,23 @@ let shutdown socket command = try Lwt_unix.shutdown socket command with Unix.Unix_error (Unix.ENOTCONN, _, _) -> () - +module Config = Httpaf.Config module Server = struct type request_handler = Lwt_unix.file_descr Httpaf.Server_connection.request_handler - - - let create_connection_handler ?config ~request_handler ~error_handler = + let create_connection_handler ?(config=Config.default) ~request_handler ~error_handler = fun client_addr socket -> let module Server_connection = Httpaf.Server_connection in let connection = Server_connection.create - ?config + ~config ~error_handler:(error_handler client_addr) (request_handler client_addr) in - - let read_buffer = Buffer.create 0x1000 in + let read_buffer = Buffer.create config.read_buffer_size in let read_loop_exited, notify_read_loop_exited = Lwt.wait () in let rec read_loop () = @@ -179,13 +176,13 @@ end module Client = struct - let request socket request ~error_handler ~response_handler = + let request ?(config=Config.default) socket request ~error_handler ~response_handler = let module Client_connection = Httpaf.Client_connection in let request_body, connection = - Client_connection.request request ~error_handler ~response_handler in + Client_connection.request ~config request ~error_handler ~response_handler in - let read_buffer = Buffer.create 0x1000 in + let read_buffer = Buffer.create config.read_buffer_size in let read_loop_exited, notify_read_loop_exited = Lwt.wait () in let read_loop () = diff --git a/lwt/httpaf_lwt.mli b/lwt/httpaf_lwt.mli index 63fe2a5a..27da8742 100644 --- a/lwt/httpaf_lwt.mli +++ b/lwt/httpaf_lwt.mli @@ -6,7 +6,7 @@ module Server : sig Lwt_unix.file_descr Httpaf.Server_connection.request_handler val create_connection_handler - : ?config : Httpaf.Server_connection.Config.t + : ?config : Httpaf.Config.t -> request_handler : (Unix.sockaddr -> request_handler) -> error_handler : (Unix.sockaddr -> Httpaf.Server_connection.error_handler) -> (Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t) @@ -15,7 +15,8 @@ end (* For an example, see [examples/lwt_get.ml]. *) module Client : sig val request - : Lwt_unix.file_descr + : ?config : Httpaf.Config.t + -> Lwt_unix.file_descr -> Httpaf.Request.t -> error_handler : Httpaf.Client_connection.error_handler -> response_handler : Httpaf.Client_connection.response_handler