add proper transfer-encoding parsing

This does two main things to bring it in line with the spec:

1. The values are checked case-insensitive
2. If the header is specified multiple times, later values override
   previous ones

Comprehensive test coverage was added.

lib/headers.ml

@@ -72,6 +72,8 @@ module CI = struct
     )
 end
 
+let ci_equal = CI.equal
+
 let rec mem t name =
   match t with
   | (name', _)::t' -> CI.equal name name' || mem t' name

lib/headers.mli

@@ -3,6 +3,9 @@ type t
 type name = string
 type value = string
 
+(** Case-insensitive equality for testing header names or values *)
+val ci_equal : string -> string -> bool
+
 val empty : t
 
 val of_list     : (name * value) list -> t

lib/httpaf.mli

@@ -528,11 +528,17 @@ module Request : sig
     -> string
     -> t
 
-  val body_length : t -> [
-    | `Fixed of Int64.t
-    | `Chunked
-    | `Error of [`Bad_request]
-  ]
+  module Body_length : sig
+    type t = [
+      | `Fixed of Int64.t
+      | `Chunked
+      | `Error of [`Bad_request]
+    ]
+
+    val pp_hum : Format.formatter -> t -> unit
+  end
+
+  val body_length : t -> Body_length.t
   (** [body_length t] is the length of the message body accompanying [t]. It is
       an error to generate a request with a close-delimited message body.
 
@@ -571,12 +577,18 @@ module Response : sig
       the given parameters. For typical use cases, it's sufficient to provide
       values for [headers] and [status]. *)
 
-  val body_length : ?proxy:bool -> request_method:Method.standard -> t -> [
-    | `Fixed of Int64.t
-    | `Chunked
-    | `Close_delimited
-    | `Error of [ `Bad_gateway | `Internal_server_error ]
-  ]
+  module Body_length : sig
+    type t = [
+      | `Fixed of Int64.t
+      | `Chunked
+      | `Close_delimited
+      | `Error of [ `Bad_gateway | `Internal_server_error ]
+    ]
+
+    val pp_hum : Format.formatter -> t -> unit
+  end
+
+  val body_length : ?proxy:bool -> request_method:Method.standard -> t -> Body_length.t
   (** [body_length ?proxy ~request_method t] is the length of the message body
       accompanying [t] assuming it is a response to a request whose method was
       [request_method]. If the calling code is acting as a proxy, it should

lib/request.ml

@@ -41,12 +41,29 @@ let create ?(version=Version.v1_1) ?(headers=Headers.empty) meth target =
   { meth; target; version; headers }
 
 let bad_request = `Error `Bad_request
-let body_length { headers; _ } =
-  (* XXX(seliopou): perform proper transfer-encoding parsing *)
-  match Headers.get_multi headers "transfer-encoding" with
-  | "chunked"::_                             -> `Chunked
-  | _        ::es when List.mem "chunked" es -> `Error `Bad_request
-  | [] | _                                   ->
+
+module Body_length = struct
+  type t = [
+    | `Fixed of Int64.t
+    | `Chunked
+    | `Error of [`Bad_request]
+  ]
+
+  let pp_hum fmt (len : t) =
+    match len with
+    | `Fixed n -> Format.fprintf fmt "Fixed %Li" n
+    | `Chunked -> Format.pp_print_string fmt "Chunked"
+    | `Error `Bad_request -> Format.pp_print_string fmt "Error: Bad request"
+  ;;
+end
+
+let body_length { headers; _ } : Body_length.t =
+  (* The last entry in transfer-encoding is the correct entry. We only accept
+     chunked transfer-encodings. *)
+  match List.rev (Headers.get_multi headers "transfer-encoding") with
+  | value::_ when Headers.ci_equal value "chunked" -> `Chunked
+  | _    ::_ -> bad_request
+  | [] ->
     begin match Message.unique_content_length_values headers with
     | []      -> `Fixed 0L
     | [ len ] ->

lib/response.ml

@@ -54,16 +54,39 @@ let persistent_connection ?proxy { version; headers; _ } =
 
 let proxy_error  = `Error `Bad_gateway
 let server_error = `Error `Internal_server_error
-let body_length ?(proxy=false) ~request_method { status; headers; _ } =
+
+module Body_length = struct
+  type t = [
+    | `Fixed of Int64.t
+    | `Chunked
+    | `Close_delimited
+    | `Error of [ `Bad_gateway | `Internal_server_error ]
+  ]
+
+  let pp_hum fmt (len : t) =
+    match len with
+    | `Fixed n -> Format.fprintf fmt "Fixed %Li" n
+    | `Chunked -> Format.pp_print_string fmt "Chunked"
+    | `Close_delimited -> Format.pp_print_string fmt "Close delimited"
+    | `Error `Bad_gateway -> Format.pp_print_string fmt "Error: Bad gateway"
+    | `Error `Internal_server_error ->
+        Format.pp_print_string fmt "Error: Internal server error"
+  ;;
+end
+
+let body_length ?(proxy=false) ~request_method { status; headers; _ } : Body_length.t =
   match status, request_method with
+  | _, `HEAD                                   -> `Fixed 0L
   | (`No_content | `Not_modified), _           -> `Fixed 0L
   | s, _        when Status.is_informational s -> `Fixed 0L
   | s, `CONNECT when Status.is_successful s    -> `Close_delimited
   | _, _                                       ->
-    begin match Headers.get_multi headers "transfer-encoding" with
-    | "chunked"::_                             -> `Chunked
-    | _        ::es when List.mem "chunked" es -> `Close_delimited
-    | [] | _                                   ->
+    (* The last entry in transfer-encoding is the correct entry. We only handle
+       chunked transfer-encodings. *)
+    begin match List.rev (Headers.get_multi headers "transfer-encoding") with
+    | value::_ when Headers.ci_equal value "chunked" -> `Chunked
+    | _    ::_ -> `Close_delimited
+    | [] ->
       begin match Message.unique_content_length_values headers with
       | []      -> `Close_delimited
       | [ len ] ->

lib_test/test_request.ml

@@ -1,5 +1,8 @@
 open Httpaf
 open Request
+open Helpers
+
+let body_length = Alcotest.of_pp Request.Body_length.pp_hum
 
 let check =
   let alco =
@@ -44,7 +47,58 @@ let test_parse_invalid_errors () =
     "GET / HTTP/1.1\r\nLink : /path/to/some/website\r\n\r\n";
 ;;
 
+let test_body_length () =
+  let check message request ~expect =
+    let actual = Request.body_length request in
+    Alcotest.check body_length message expect actual
+  in
+  let req method_ headers = Request.create method_ ~headers "/" in
+  check
+    "no headers"
+    ~expect:(`Fixed 0L)
+    (req `GET Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    (req `GET Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    (req `GET Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:(`Error `Bad_request)
+    (req `GET encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    (req `GET Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
+
 let tests =
   [ "parse valid"         , `Quick, test_parse_valid
   ; "parse invalid errors", `Quick, test_parse_invalid_errors
+  ; "body length",          `Quick, test_body_length
   ]

lib_test/test_response.ml

@@ -1,5 +1,8 @@
 open Httpaf
 open Response
+open Helpers
+
+let body_length = Alcotest.of_pp Response.Body_length.pp_hum
 
 let check =
   let alco =
@@ -36,7 +39,77 @@ let test_parse_invalid_error () =
     "HTTP/1.1 999999937377999999999200\r\n\r\n";
 ;;
 
+let test_body_length () =
+  let check message request_method response ~expect =
+    let actual = Response.body_length response ~request_method in
+    Alcotest.check body_length message expect actual
+  in
+  let res status headers = Response.create status ~headers in
+  check
+    "requested HEAD"
+    ~expect:(`Fixed 0L)
+    `HEAD (res `OK Headers.empty);
+  check
+    "requested CONNECT"
+    ~expect:(`Close_delimited)
+    `CONNECT (res `OK Headers.empty);
+  check
+    "status: informational"
+    ~expect:(`Fixed 0L)
+    `GET (res `Continue Headers.empty);
+  check
+    "status: no content"
+    ~expect:(`Fixed 0L)
+    `GET (res `No_content Headers.empty);
+  check
+    "status: not modified"
+    ~expect:(`Fixed 0L)
+    `GET (res `Not_modified Headers.empty);
+  check
+    "no header"
+    ~expect:(`Close_delimited)
+    `GET (res `OK Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    `GET (res `OK Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:`Close_delimited
+    `GET (res `OK encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:`Close_delimited
+    `GET (res `OK Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
 let tests =
   [ "parse valid"        , `Quick, test_parse_valid
   ; "parse invalid error", `Quick, test_parse_invalid_error
+  ; "body length"        , `Quick, test_body_length
   ]