Merge pull request #81 from anmonteiro/anmonteiro/make-read-buffer-si…

…ze-configurable

Make read buffer size configurable again

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 ->

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

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

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 }

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

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

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

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 () =

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