cohttp-eio: Match body encoding with headers.

CHANGES.md

@@ -1,6 +1,7 @@
 ## v6.0.0~beta2
 
 - cohttp-eio: Don't blow up Server on client disconnections. (mefyl #1011)
+- cohttp-eio: Match body encoding with headers. (mefyl #1012)
 
 ## v6.0.0~beta1 (2023-10-27)
 - cohttp-eio: move new Cohttp.{Client,Server} modules under Cohttp.Generic (mseri #1003)

cohttp-eio/src/server.ml

@@ -55,7 +55,7 @@ let read input =
           in
           `Ok (request, body))
 
-let write output response body =
+let write output (response : Cohttp.Response.t) body =
   let response =
     let content_length =
       let (Eio.Resource.T (body, ops)) = body in
@@ -67,19 +67,26 @@ let write output response body =
     in
     (* encoding field might be deprecated but it is still used
        to compute headers and encode the body*)
-    match content_length with
-    | None ->
-        { response with Cohttp.Response.encoding = Chunked }
-        [@ocaml.warning "-3"]
-    | Some size ->
+    match
+      (Cohttp.Header.get_transfer_encoding response.headers, content_length)
+    with
+    | Unknown, None ->
+        { response with encoding = Chunked } [@ocaml.warning "-3"]
+    | Unknown, Some size ->
         { response with encoding = Fixed (Int64.of_int size) }
         [@ocaml.warning "-3"]
+    | from_headers, _ ->
+        { response with encoding = from_headers } [@ocaml.warning "-3"]
   in
   let () = Logs.debug (fun m -> m "send headers") in
   let () =
     Io.Response.write
       (fun writer ->
-        let () = Logs.debug (fun m -> m "send body") in
+        let () =
+          Logs.debug (fun m ->
+              (m "send body (%a)" Cohttp.Transfer.pp_encoding response.encoding
+               [@ocaml.warning "-3"]))
+        in
         flow_to_writer body writer Io.Response.write_body)
       response output
   in

cohttp/src/transfer.ml

@@ -19,6 +19,11 @@ open Sexplib0.Sexp_conv
 type encoding = Http.Transfer.encoding = Chunked | Fixed of int64 | Unknown
 [@@deriving sexp]
 
+let pp_encoding fmt = function
+  | Chunked -> Format.pp_print_string fmt "chunked"
+  | Fixed size -> Format.fprintf fmt "fixed %Ld" size
+  | Unknown -> Format.pp_print_string fmt "unknown"
+
 type chunk = Chunk of string | Final_chunk of string | Done [@@deriving sexp]
 
 let string_of_encoding = function

cohttp/src/transfer.mli

@@ -25,6 +25,9 @@ type encoding = Http.Transfer.encoding =
   | Unknown  (** unknown body size, which leads to best-effort *)
 [@@deriving sexp]
 
+val pp_encoding : Format.formatter -> encoding -> unit
+(** Human-readable output. *)
+
 (** A chunk of body that also signals if there to more to arrive *)
 type chunk =
   | Chunk of string  (** chunk of data and not the end of stream *)