fix: remove transfer encoding from request

it can be set via the header

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: 9ee6bc80-4321-4eea-920d-0c94ec797bdb -->

cohttp/src/request.ml

@@ -22,22 +22,18 @@ type t = Http.Request.t = {
   scheme : string option;
   resource : string;
   version : Code.version;
-  encoding : Transfer.encoding;
 }
 [@@deriving sexp]
 
-let compare { headers; meth; scheme; resource; version; encoding } y =
+let compare { headers; meth; scheme; resource; version } y =
   match Header.compare headers y.headers with
   | 0 -> (
       match Code.compare_method meth y.meth with
       | 0 -> (
           match Option.compare String.compare scheme y.scheme with
           | 0 -> (
               match String.compare resource y.resource with
-              | 0 -> (
-                  match Code.compare_version version y.version with
-                  | 0 -> Stdlib.compare encoding y.encoding
-                  | i -> i)
+              | 0 -> Code.compare_version version y.version
               | i -> i)
           | i -> i)
       | i -> i)
@@ -48,9 +44,9 @@ let meth t = t.meth
 let scheme t = t.scheme
 let resource t = t.resource
 let version t = t.version
-let encoding t = t.encoding
+let encoding t = Header.get_transfer_encoding t.headers
 
-let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(encoding = Transfer.Unknown)
+let make ?(meth = `GET) ?(version = `HTTP_1_1) ?encoding
     ?(headers = Header.init ()) uri =
   let headers =
     Header.add_unless_exists headers "host"
@@ -77,25 +73,27 @@ let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(encoding = Transfer.Unknown)
   in
   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
+  let headers =
+    match encoding with
+    | None -> headers
+    | Some encoding -> Header.add_transfer_encoding headers encoding
   in
-  { headers; meth; scheme; resource; version; encoding }
+  { headers; meth; scheme; resource; version }
 
 let is_keep_alive t = Http.Request.is_keep_alive t
 
 (* Make a client request, which involves guessing encoding and
    adding content headers if appropriate.
    @param chunked Forces chunked encoding
 *)
-let make_for_client ?headers ?(chunked = true) ?(body_length = Int64.zero) meth
-    uri =
+let make_for_client ?headers ?chunked ?body_length meth uri =
   let encoding =
-    match chunked with
-    | true -> Transfer.Chunked
-    | false -> Transfer.Fixed body_length
+    match (chunked, body_length) with
+    | Some true, None -> Transfer.Chunked
+    | (None | Some false), Some fixed -> Transfer.Fixed fixed
+    | (Some false | None), None -> Transfer.Unknown
+    | Some true, Some _ ->
+        invalid_arg "cannot set both ?chunked and ?body_length:"
   in
   make ~meth ~encoding ?headers uri
 
@@ -187,7 +185,9 @@ module Make (IO : S.IO) = struct
         else return (`Invalid "bad request URI")
     | `Invalid msg -> return (`Invalid msg)
 
-  let make_body_reader req ic = Transfer_IO.make_reader req.encoding ic
+  let make_body_reader req ic =
+    Transfer_IO.make_reader (Header.get_transfer_encoding req.headers) ic
+
   let read_body_chunk = Transfer_IO.read
 
   let write_header req oc =
@@ -197,21 +197,15 @@ module Make (IO : S.IO) = struct
         (if req.resource = "" then "/" else req.resource)
         (Http.Version.to_string req.version)
     in
-    let headers = req.headers in
-    let headers =
-      if Http.Method.body_allowed req.meth then
-        Header.add_transfer_encoding headers req.encoding
-      else headers
-    in
-    IO.write oc fst_line >>= fun _ -> Header_IO.write headers oc
+    IO.write oc fst_line >>= fun _ -> Header_IO.write req.headers oc
 
   let make_body_writer ~flush req oc =
-    Transfer_IO.make_writer ~flush req.encoding oc
+    Transfer_IO.make_writer ~flush (Header.get_transfer_encoding req.headers) oc
 
   let write_body = Transfer_IO.write
 
-  let write_footer req oc =
-    match req.encoding with
+  let write_footer headers oc =
+    match Header.get_transfer_encoding headers with
     | Transfer.Chunked ->
         (* TODO Trailer header support *)
         IO.write oc "0\r\n\r\n"
@@ -220,7 +214,7 @@ module Make (IO : S.IO) = struct
   let write ~flush write_body req oc =
     write_header req oc >>= fun () ->
     let writer = make_body_writer ~flush req oc in
-    write_body writer >>= fun () -> write_footer req oc
+    write_body writer >>= fun () -> write_footer req.headers oc
 end
 
 module Private = struct

cohttp/src/s.ml

@@ -88,8 +88,6 @@ module type Request = sig
     scheme : string option;  (** URI scheme (http or https) *)
     resource : string;  (** Request path and query *)
     version : Code.version;  (** HTTP version, usually 1.1 *)
-    encoding : Transfer.encoding;
-        [@deprecated "this field will be removed in the future"]
   }
   [@@deriving sexp]
 

cohttp/test/test_request.ml

@@ -329,8 +329,7 @@ let useless_null_content_length_header () =
   let output = Buffer.create 1024 in
   let () =
     let r =
-      Cohttp.Request.make_for_client ~chunked:false ~body_length:0L `GET
-        (Uri.of_string "http://someuri.com")
+      Cohttp.Request.make_for_client `GET (Uri.of_string "http://someuri.com")
     in
     Request.write_header r output
   in

http/src/http.ml

@@ -742,28 +742,23 @@ module Request = struct
     scheme : string option;  (** URI scheme (http or https) *)
     resource : string;  (** Request path and query *)
     version : Version.t;  (** HTTP version, usually 1.1 *)
-    encoding : Transfer.encoding;
   }
 
   let headers t = t.headers
   let meth t = t.meth
   let scheme t = t.scheme
   let resource t = t.resource
   let version t = t.version
-  let encoding t = t.encoding
 
-  let compare { headers; meth; scheme; resource; version; encoding } y =
+  let compare { headers; meth; scheme; resource; version } y =
     match Header.compare headers y.headers with
     | 0 -> (
         match Method.compare meth y.meth with
         | 0 -> (
             match Option.compare String.compare scheme y.scheme with
             | 0 -> (
                 match String.compare resource y.resource with
-                | 0 -> (
-                    match Version.compare version y.version with
-                    | 0 -> Transfer.compare_encoding encoding y.encoding
-                    | i -> i)
+                | 0 -> Version.compare version y.version
                 | i -> i)
             | i -> i)
         | i -> i)
@@ -786,12 +781,13 @@ module Request = struct
 
   (* Defined for method types in RFC7231 *)
   let has_body req =
-    if Method.body_allowed req.meth then Transfer.has_body req.encoding else `No
+    if Method.body_allowed req.meth then
+      Transfer.has_body (Header.get_transfer_encoding req.headers)
+    else `No
 
   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 }
+    { headers; meth; scheme; resource; version }
 
   let pp fmt t =
     let open Format in
@@ -1146,14 +1142,7 @@ module Parser = struct
     let path = token source in
     let version = version source in
     let headers = headers source in
-    {
-      Request.headers;
-      meth;
-      scheme = None;
-      resource = path;
-      version;
-      encoding = Header.get_transfer_encoding headers;
-    }
+    { Request.headers; meth; scheme = None; resource = path; version }
 
   type error = Partial | Msg of string
 

http/src/http.mli

@@ -388,8 +388,6 @@ module Request : sig
     scheme : string option;  (** URI scheme (http or https) *)
     resource : string;  (** Request path and query *)
     version : Version.t;  (** HTTP version, usually 1.1 *)
-    encoding : Transfer.encoding;
-        [@deprecated "this field will be removed in the future"]
   }
 
   val has_body : t -> [ `No | `Unknown | `Yes ]
@@ -398,7 +396,6 @@ module Request : sig
   val scheme : t -> string option
   val resource : t -> string
   val version : t -> Version.t
-  val encoding : t -> Transfer.encoding
   val compare : t -> t -> int
 
   val is_keep_alive : t -> bool

http/test/test_parser.ml

@@ -37,16 +37,8 @@ let assert_req_success ~here ~expected_req ~expected_consumed ?pos ?len buf =
     (Http.Header.to_list @@ Http.Request.headers req);
   [%test_result: int] ~here ~expect:expected_consumed consumed
 
-let[@warning "-3"] make_req ~headers ?(encoding = Http.Transfer.Fixed 0L) meth
-    resource =
-  {
-    Http.Request.headers;
-    meth;
-    resource;
-    scheme = None;
-    encoding;
-    version = `HTTP_1_1;
-  }
+let[@warning "-3"] make_req ~headers meth resource =
+  { Http.Request.headers; meth; resource; scheme = None; version = `HTTP_1_1 }
 
 let req_expected =
   make_req