fix: remove transfer encoding from request

it can be set via the header Signed-off-by: Rudi Grinberg <[email protected]>
mirage · Jul 3, 2024 · 9e69f43 · 9e69f43
1 parent 95a83ee
commit 9e69f43
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 57 deletions.
diff --git a/cohttp/src/request.ml b/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,12 +73,15 @@ 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 =
+  let headers =
     match Header.get_transfer_encoding headers with
-    | Transfer.Unknown -> encoding
-    | encoding -> encoding
+    | Transfer.Unknown -> (
+        match encoding with
+        | None -> headers
+        | Some encoding -> Header.add_transfer_encoding headers encoding)
+    | _ -> headers
   in
-  { headers; meth; scheme; resource; version; encoding }
+  { headers; meth; scheme; resource; version }
 
 let is_keep_alive t = Http.Request.is_keep_alive t
 
@@ -187,7 +186,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 +198,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 +215,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

diff --git a/cohttp/src/s.ml b/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]
 

diff --git a/http/src/http.ml b/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
 

diff --git a/http/src/http.mli b/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

diff --git a/http/test/test_parser.ml b/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