diff --git a/cohttp/src/request.ml b/cohttp/src/request.ml index de350503b..6a6e63cfa 100644 --- a/cohttp/src/request.ml +++ b/cohttp/src/request.ml @@ -22,11 +22,10 @@ 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 @@ -34,10 +33,7 @@ let compare { headers; meth; scheme; resource; version; encoding } y = 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,12 @@ 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 @@ -90,12 +86,14 @@ let is_keep_alive t = Http.Request.is_keep_alive t 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 diff --git a/cohttp/src/s.ml b/cohttp/src/s.ml index 565f0bf4b..7187a3bca 100644 --- 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/cohttp/test/test_request.ml b/cohttp/test/test_request.ml index 5e4648737..8fa4d7026 100644 --- a/cohttp/test/test_request.ml +++ b/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 diff --git a/http/src/http.ml b/http/src/http.ml index 85158de65..8d70fe0ef 100644 --- a/http/src/http.ml +++ b/http/src/http.ml @@ -742,7 +742,6 @@ 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 @@ -750,9 +749,8 @@ module Request = struct 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 @@ -760,10 +758,7 @@ module Request = struct 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 index 13a99954c..d73a51741 100644 --- 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 index 3609ea511..8db9159f5 100644 --- 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