http: add Request.make

CHANGES.md

@@ -1,4 +1,5 @@
 ## Unreleased
+- http: add Http.Request.make (bikallem #878)
 - http: add pretty printer functions (bikallem #880) 
 - New eio based client and server on top of the http library (bikallem #857)
 - New curl based clients (rgrinberg #813)

cohttp-async/src/server.ml

@@ -94,7 +94,7 @@ let handle_client handle_request sock rd wr =
 let respond ?(flush = true) ?(headers = Http.Header.init ()) ?(body = `Empty)
     status : response Deferred.t =
   let encoding = Body.transfer_encoding body in
-  let resp = Http.Response.make ~status ~flush ~encoding ~headers () in
+  let resp = Cohttp.Response.make ~status ~flush ~encoding ~headers () in
   return (resp, body)
 
 let respond_with_pipe ?flush ?headers ?(code = `OK) body =

cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml

@@ -229,7 +229,7 @@ module Make_client_async (P : Params) = Make_api (struct
                 let response =
                   Lwt.(
                     Header_io.parse channel >|= fun resp_headers ->
-                    Http.Response.make ~version:`HTTP_1_1
+                    Cohttp.Response.make ~version:`HTTP_1_1
                       ~status:(C.Code.status_of_code xml##.status)
                       ~flush:false (* ??? *)
                       ~encoding:(CLB.transfer_encoding body)

cohttp-lwt-unix/src/server.ml

@@ -50,7 +50,7 @@ let respond_file ?headers ~fname () =
       let headers =
         Http.Header.add_opt_unless_exists headers "content-type" mime_type
       in
-      let res = Http.Response.make ~status:`OK ~encoding ~headers () in
+      let res = Cohttp.Response.make ~status:`OK ~encoding ~headers () in
       Lwt.return (res, body))
     (function
       | Unix.Unix_error (Unix.ENOENT, _, _) | Isnt_a_file ->

cohttp-lwt-unix/test/test_sanity.ml

@@ -48,12 +48,18 @@ let server =
       (fun _ _ ->
         Lwt.return
           (`Expert
-            ( Http.Response.make (),
-              fun _ic oc -> Lwt_io.write oc "8\r\nexpert 1\r\n0\r\n\r\n" )));
+            (let headers =
+               Http.(
+                 Header.add_transfer_encoding (Header.init ()) Transfer.Chunked)
+             in
+             ( Http.Response.make ~headers (),
+               fun _ic oc -> Lwt_io.write oc "8\r\nexpert 1\r\n0\r\n\r\n" ))));
       (fun _ _ ->
         Lwt.return
           (`Expert
-            ( Http.Response.make (),
+            ( (* Alternatively, cohttp.response.make injects the Chunked encoding when no
+                 encoding is already in the headers. *)
+              Cohttp.Response.make (),
               fun ic oc ->
                 Lwt_io.write oc "8\r\nexpert 2\r\n0\r\n\r\n" >>= fun () ->
                 Lwt_io.flush oc >>= fun () ->

cohttp/src/request.ml

@@ -49,15 +49,9 @@ let scheme t = t.scheme
 let resource t = t.resource
 let version t = t.version
 let encoding t = t.encoding
-let fixed_zero = Transfer.Fixed Int64.zero
 
-let guess_encoding ?(encoding = fixed_zero) headers =
-  match Header.get_transfer_encoding headers with
-  | Transfer.(Chunked | Fixed _) as enc -> enc
-  | Unknown -> encoding
-
-let make ?(meth = `GET) ?(version = `HTTP_1_1) ?encoding ?headers uri =
-  let headers = match headers with None -> Header.init () | Some h -> h in
+let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(encoding = Transfer.Unknown)
+    ?(headers = Header.init ()) uri =
   let headers =
     Header.add_unless_exists headers "host"
       (match Uri.scheme uri with
@@ -81,15 +75,14 @@ let make ?(meth = `GET) ?(version = `HTTP_1_1) ?encoding ?headers uri =
         Header.add_authorization headers auth
     | _, _, _ -> headers
   in
-  let encoding = guess_encoding ?encoding headers in
-  {
-    meth;
-    version;
-    headers;
-    scheme = Uri.scheme uri;
-    resource = Uri.path_and_query uri;
-    encoding;
-  }
+  let scheme = Uri.scheme uri in
+  let resource = Uri.path_and_query uri in
+  let encoding =
+    match Header.get_transfer_encoding headers with
+    | Transfer.Unknown -> encoding
+    | encoding -> encoding
+  in
+  { headers; meth; scheme; resource; version; encoding }
 
 let is_keep_alive t = Http.Request.is_keep_alive t
 

cohttp/src/response.ml

@@ -49,8 +49,8 @@ let make ?(version = `HTTP_1_1) ?(status = `OK) ?(flush = false)
     ?(encoding = Transfer.Chunked) ?(headers = Header.init ()) () =
   let encoding =
     match Header.get_transfer_encoding headers with
-    | Transfer.(Chunked | Fixed _) as enc -> enc
-    | Unknown -> encoding
+    | Transfer.Unknown -> encoding
+    | encoding -> encoding
   in
   { encoding; headers; version; flush; status }
 

cohttp/src/s.ml

@@ -108,6 +108,11 @@ module type Request = sig
     ?headers:Header.t ->
     Uri.t ->
     t
+  (** [make ()] is a value of {!type:t}. The default values for the request, if
+      not specified, are: [status] is [`Ok], [version] is [`HTTP_1_1], [flush]
+      is [false] and [headers] is [Header.empty]. The request encoding value is
+      determined via the [Header.get_transfer_encoding] function and, if not
+      found, uses the default value [Transfer.Fixed 0]. *)
 
   val is_keep_alive : t -> bool
   (** Return true whether the connection should be reused *)
@@ -152,11 +157,11 @@ module type Response = sig
     ?headers:Header.t ->
     unit ->
     t
-  (** The response creates by [make ~encoding ~headers ()] has an encoding value
-      determined from the content of [headers] or if no proper header is
-      present, using the value of [encoding]. Checked headers are
-      "content-length", "content-range" and "transfer-encoding". The default
-      value of [encoding] is chunked. *)
+  (** [make ()] is a value of {!type:t}. The default values for the request, if
+      not specified, are: [status] is [`Ok], [version] is [`HTTP_1_1], [flush]
+      is [false] and [headers] is [Header.empty]. The request encoding value is
+      determined via the [Header.get_transfer_encoding] function and, if not
+      found, uses the default value [Transfer.Chunked]. *)
 end
 
 module type Body = sig

http/src/http.ml

@@ -763,6 +763,11 @@ module Request = struct
     | `DELETE | `POST | `PUT | `PATCH | `OPTIONS | `Other _ ->
         Transfer.has_body req.encoding
 
+  let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Header.empty)
+      ?scheme resource =
+    let encoding = Header.get_transfer_encoding headers in
+    { headers; meth; scheme; resource; version; encoding }
+
   let pp fmt t =
     let open Format in
     pp_open_vbox fmt 0;
@@ -800,12 +805,8 @@ module Response = struct
     | i -> i
 
   let make ?(version = `HTTP_1_1) ?(status = `OK) ?(flush = false)
-      ?(encoding = Transfer.Chunked) ?(headers = Header.empty) () =
-    let encoding =
-      match Header.get_transfer_encoding headers with
-      | Transfer.(Chunked | Fixed _) as enc -> enc
-      | Unknown -> encoding
-    in
+      ?(headers = Header.empty) () =
+    let encoding = Header.get_transfer_encoding headers in
     { encoding; headers; version; flush; status }
 
   let headers t = t.headers

http/src/http.mli

@@ -349,7 +349,12 @@ module Header : sig
 
   val get_content_range : t -> Int64.t option
   val get_connection_close : t -> bool
+
   val get_transfer_encoding : t -> Transfer.encoding
+  (** [get_transfer_encoding h] checks the "content-length", "content-range" and
+      "transfer-encoding" headers to infer the transfer encoding. Uses Unknown
+      if nothing is found.*)
+
   val add_transfer_encoding : t -> Transfer.encoding -> t
   val connection : t -> [ `Keep_alive | `Close | `Unknown of string ] option
   val get_location : t -> string option
@@ -387,6 +392,19 @@ module Request : sig
   val is_keep_alive : t -> bool
   (** Return true whether the connection should be reused *)
 
+  val make :
+    ?meth:Method.t ->
+    ?version:Version.t ->
+    ?headers:Header.t ->
+    ?scheme:string ->
+    string ->
+    t
+  (** [make resource] is a value of {!type:t}. The default values for the
+      response, if not specified, are as follows: [meth] is [`GET], [version] is
+      [`HTTP_1_1], [headers] is [Header.empty] and [scheme] is [None]. The
+      request encoding value is determined via the
+      [Header.get_transfer_encoding] function.*)
+
   val pp : Format.formatter -> t -> unit
 end
 
@@ -423,15 +441,13 @@ module Response : sig
     ?version:Version.t ->
     ?status:Status.t ->
     ?flush:bool ->
-    ?encoding:Transfer.encoding ->
     ?headers:Header.t ->
     unit ->
     t
-  (** The response creates by [make ~encoding ~headers ()] has an encoding value
-      determined from the content of [headers] or if no proper header is
-      present, using the value of [encoding]. Checked headers are
-      "content-length", "content-range" and "transfer-encoding". The default
-      value of [encoding] is chunked. *)
+  (** [make ()] is a value of {!type:t}. The default values for the request, if
+      not specified, are: [status] is [`Ok], [version] is [`HTTP_1_1], [flush]
+      is [false] and [headers] is [Header.empty]. The request encoding value is
+      determined via the [Header.get_transfer_encoding] function. *)
 
   val pp : Format.formatter -> t -> unit
 end

test_helpers/cohttp_async_test/src/cohttp_async_test.ml

@@ -18,7 +18,7 @@ type async_test = unit -> unit io
 
 let response rsp = `Response rsp
 
-let expert ?(rsp = Http.Response.make ()) f _req _body =
+let expert ?(rsp = Cohttp.Response.make ()) f _req _body =
   return (`Expert (rsp, f))
 
 let const rsp _req _body = rsp >>| response