fix: get rid of flush (#1052)

We haven't yet released [Http] so it's ok to change things. It doesn't seem right to release the library with a deprecated feature. It's easy enough to just drop this field in [Http] Signed-off-by: Rudi Grinberg <[email protected]>
mirage · Jul 17, 2024 · abcad4c · abcad4c
1 parent d214ef0
commit abcad4c
Show file tree

Hide file tree

Showing 11 changed files with 40 additions and 80 deletions.
diff --git a/cohttp-async/src/server.ml b/cohttp-async/src/server.ml
@@ -16,7 +16,6 @@ type response_action =
   | `Response of response ]
 
 type 'r respond_t =
-  ?flush:bool ->
   ?headers:Http.Header.t ->
   ?body:Body.t ->
   Http.Status.t ->
@@ -105,30 +104,30 @@ let handle_client handle_request sock rd wr =
       loop rd wr sock handle_request)
   >>| Result.ok_exn
 
-let respond ?(flush = true) ?(headers = Http.Header.init ()) ?(body = `Empty)
-    status : response Deferred.t =
+let respond ?(headers = Http.Header.init ()) ?(body = `Empty) status :
+    response Deferred.t =
   let encoding = Body.transfer_encoding body in
-  let resp = Cohttp.Response.make ~status ~flush ~encoding ~headers () in
+  let resp = Cohttp.Response.make ~status ~encoding ~headers () in
   return (resp, body)
 
-let respond_with_pipe ?flush ?headers ?(code = `OK) body =
-  respond ?flush ?headers ~body:(`Pipe body) code
+let respond_with_pipe ?headers ?(code = `OK) body =
+  respond ?headers ~body:(`Pipe body) code
 
-let respond_string ?flush ?headers ?(status = `OK) body =
-  respond ?flush ?headers ~body:(`String body) status
+let respond_string ?headers ?(status = `OK) body =
+  respond ?headers ~body:(`String body) status
 
 let respond_with_redirect ?headers uri =
   let headers =
     Http.Header.add_opt_unless_exists headers "location" (Uri.to_string uri)
   in
-  respond ~flush:false ~headers `Found
+  respond ~headers `Found
 
 let resolve_local_file ~docroot ~uri =
   Cohttp.Path.resolve_local_file ~docroot ~uri
 
 let error_body_default = "<html><body><h1>404 Not Found</h1></body></html>"
 
-let respond_with_file ?flush ?headers ?(error_body = error_body_default)
+let respond_with_file ?headers ?(error_body = error_body_default)
     filename =
   Monitor.try_with ~run:`Now (fun () ->
       Reader.open_file filename >>= fun rd ->
@@ -137,7 +136,7 @@ let respond_with_file ?flush ?headers ?(error_body = error_body_default)
       let headers =
         Http.Header.add_opt_unless_exists headers "content-type" mime_type
       in
-      respond ?flush ~headers ~body `OK)
+      respond ~headers ~body `OK)
   >>= function
   | Ok res -> return res
   | Error _exn -> respond_string ~status:`Not_found error_body

diff --git a/cohttp-async/src/server.mli b/cohttp-async/src/server.mli
@@ -11,7 +11,6 @@ val num_connections : (_, _) t -> int
 type response = Http.Response.t * Body.t [@@deriving sexp_of]
 
 type 'r respond_t =
-  ?flush:bool ->
   ?headers:Http.Header.t ->
   ?body:Body.t ->
   Http.Status.t ->
@@ -42,7 +41,6 @@ val resolve_local_file : docroot:string -> uri:Uri.t -> string
 (** Resolve a URI and a docroot into a concrete local filename. *)
 
 val respond_with_pipe :
-  ?flush:bool ->
   ?headers:Http.Header.t ->
   ?code:Http.Status.t ->
   string Async_kernel.Pipe.Reader.t ->
@@ -53,7 +51,6 @@ val respond_with_pipe :
     @param code Default is HTTP 200 `OK *)
 
 val respond_string :
-  ?flush:bool ->
   ?headers:Http.Header.t ->
   ?status:Http.Status.t ->
   string ->
@@ -66,7 +63,6 @@ val respond_with_redirect :
     @param uri Absolute URI to redirect the client to *)
 
 val respond_with_file :
-  ?flush:bool ->
   ?headers:Http.Header.t ->
   ?error_body:string ->
   string ->

diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml
@@ -96,7 +96,7 @@ let write output (response : Cohttp.Response.t) body =
   in
   Eio.Buf_write.flush output
 
-let respond ?encoding ?(headers = Cohttp.Header.init ()) ?flush ~status ~body ()
+let respond ?encoding ?(headers = Cohttp.Header.init ()) ~status ~body ()
     (request, oc) =
   let keep_alive = Http.Request.is_keep_alive request in
   let headers =
@@ -106,16 +106,16 @@ let respond ?encoding ?(headers = Cohttp.Header.init ()) ?flush ~status ~body ()
         Http.Header.add headers "connection"
           (if keep_alive then "keep-alive" else "close")
   in
-  let response = Cohttp.Response.make ?encoding ~headers ?flush ~status () in
+  let response = Cohttp.Response.make ?encoding ~headers ~status () in
   write oc response body
 
-let respond_string ?headers ?flush ~status ~body () =
+let respond_string ?headers ~status ~body () =
   respond
     ~encoding:(Fixed (String.length body |> Int64.of_int))
-    ?headers ?flush ~status ~body:(Body.of_string body) ()
+    ?headers ~status ~body:(Body.of_string body) ()
 
-let respond ?headers ?flush ~status ~body () response =
-  respond ?encoding:None ?headers ?flush ~status ~body () response
+let respond ?headers ~status ~body () response =
+  respond ?encoding:None ?headers ~status ~body () response
 
 let callback { conn_closed; handler } ((_, peer_address) as conn) input output =
   let id = (Cohttp.Connection.create () [@ocaml.warning "-3"]) in

diff --git a/cohttp-eio/src/server.mli b/cohttp-eio/src/server.mli
@@ -8,7 +8,6 @@ include
 
 val respond :
   ?headers:Http.Header.t ->
-  ?flush:bool ->
   status:Http.Status.t ->
   body:_ Eio.Flow.source ->
   unit ->

diff --git a/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml b/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml
@@ -242,7 +242,6 @@ module Make_client_async (P : Params) = Make_api (struct
                     Header_io.parse channel >|= fun resp_headers ->
                     Cohttp.Response.make ~version:`HTTP_1_1
                       ~status:(C.Code.status_of_code xml##.status)
-                      ~flush:false (* ??? *)
                       ~encoding:(CLB.transfer_encoding body)
                       ~headers:resp_headers ())
                 in
@@ -327,7 +326,6 @@ module Make_client_sync (P : Params) = Make_api (struct
     let response =
       Response.make ~version:`HTTP_1_1
         ~status:(Cohttp.Code.status_of_code xml##.status)
-        ~flush:false
         ~encoding:(CLB.transfer_encoding body)
         ~headers:resp_headers ()
     in

diff --git a/cohttp-lwt/src/server.ml b/cohttp-lwt/src/server.ml
@@ -45,7 +45,7 @@ module Make (IO : S.IO) = struct
   let resolve_local_file ~docroot ~uri =
     Cohttp.Path.resolve_local_file ~docroot ~uri
 
-  let respond ?headers ?(flush = true) ~status ~body () =
+  let respond ?headers ~status ~body () =
     let encoding =
       match headers with
       | None -> Body.transfer_encoding body
@@ -54,12 +54,12 @@ module Make (IO : S.IO) = struct
           | Http.Transfer.Unknown -> Body.transfer_encoding body
           | t -> t)
     in
-    let res = Response.make ~status ~flush ~encoding ?headers () in
+    let res = Response.make ~status ~encoding ?headers () in
     Lwt.return (res, body)
 
-  let respond_string ?headers ?(flush = true) ~status ~body () =
+  let respond_string ?headers ~status ~body () =
     let res =
-      Response.make ~status ~flush
+      Response.make ~status
         ~encoding:(Http.Transfer.Fixed (Int64.of_int (String.length body)))
         ?headers ()
     in

diff --git a/cohttp/src/response.ml b/cohttp/src/response.ml
@@ -14,20 +14,17 @@
  *
   }}}*)
 
-open Sexplib0.Sexp_conv
-
 type t = Http.Response.t = {
   headers : Header.t;
   version : Code.version;
   status : Code.status_code;
-  flush : bool;
 }
 [@@deriving sexp]
 
-let compare { headers; flush; version; status } y =
+let compare { headers; version; status } y =
   match Header.compare headers y.headers with
   | 0 -> (
-      match Bool.compare flush y.flush with
+      match Stdlib.compare status y.status with
       | 0 -> (
           match Stdlib.compare status y.status with
           | 0 -> Code.compare_version version y.version
@@ -39,10 +36,9 @@ let headers t = t.headers
 let encoding t = Header.get_transfer_encoding t.headers
 let version t = t.version
 let status t = t.status
-let flush t = t.flush
 
-let make ?(version = `HTTP_1_1) ?(status = `OK) ?(flush = false)
-    ?(encoding = Transfer.Unknown) ?(headers = Header.init ()) () =
+let make ?(version = `HTTP_1_1) ?(status = `OK) ?(encoding = Transfer.Unknown)
+    ?(headers = Header.init ()) () =
   let headers =
     match encoding with
     | Unknown -> (
@@ -51,7 +47,7 @@ let make ?(version = `HTTP_1_1) ?(status = `OK) ?(flush = false)
         | _ -> headers)
     | _ -> Header.add_transfer_encoding headers encoding
   in
-  { headers; version; flush; status }
+  { headers; version; status }
 
 let pp_hum ppf r =
   Format.fprintf ppf "%s" (r |> sexp_of_t |> Sexplib0.Sexp.to_string_hum)
@@ -102,8 +98,7 @@ module Make (IO : S.IO) = struct
     | `Invalid _reason as r -> return r
     | `Ok (version, status) ->
         Header_IO.parse ic >>= fun headers ->
-        let flush = false in
-        return (`Ok { headers; version; status; flush })
+        return (`Ok { headers; version; status })
 
   let make_body_reader t ic = Transfer_IO.make_reader (encoding t) ic
   let read_body_chunk = Transfer_IO.read

diff --git a/cohttp/src/s.ml b/cohttp/src/s.ml
@@ -131,7 +131,6 @@ module type Response = sig
     headers : Header.t;  (** response HTTP headers *)
     version : Code.version;  (** (** HTTP version, usually 1.1 *) *)
     status : Code.status_code;  (** HTTP status code of the response *)
-    flush : bool; [@deprecated "this field will be removed in the future"]
   }
   [@@deriving sexp]
 
@@ -140,15 +139,11 @@ module type Response = sig
   val version : t -> Code.version
   val status : t -> Code.status_code
 
-  val flush : t -> bool
-  [@@deprecated "this field will be removed in the future"]
-
   val compare : t -> t -> int
 
   val make :
     ?version:Code.version ->
     ?status:Code.status_code ->
-    ?flush:bool ->
     ?encoding:Transfer.encoding ->
     ?headers:Header.t ->
     unit ->

diff --git a/cohttp/src/server.ml b/cohttp/src/server.ml
@@ -45,23 +45,19 @@ module type S = sig
 
   val respond :
     ?headers:Http.Header.t ->
-    ?flush:bool ->
     status:Http.Status.t ->
     body:body ->
     unit ->
     response IO.t
-  (** [respond ?headers ?flush ~status ~body] will respond to an HTTP request
-      with the given [status] code and response [body]. If [flush] is true, then
-      every response chunk will be flushed to the network rather than being
-      buffered. [flush] is true by default. The transfer encoding will be
-      detected from the [body] value and set to chunked encoding if it cannot be
-      determined immediately. You can override the encoding by supplying an
-      appropriate [Content-length] or [Transfer-encoding] in the [headers]
-      parameter. *)
+  (** [respond ?headers ~status ~body] will respond to an HTTP request
+      with the given [status] code and response [body]. The transfer encoding
+      will be detected from the [body] value and set to chunked encoding if it
+      cannot be determined immediately. You can override the encoding by
+      supplying an appropriate [Content-length] or [Transfer-encoding] in the
+      [headers] parameter. *)
 
   val respond_string :
     ?headers:Http.Header.t ->
-    ?flush:bool ->
     status:Http.Status.t ->
     body:string ->
     unit ->

diff --git a/http/src/http.ml b/http/src/http.ml
@@ -807,28 +807,25 @@ module Response = struct
     headers : Header.t;  (** response HTTP headers *)
     version : Version.t;  (** (** HTTP version, usually 1.1 *) *)
     status : Status.t;  (** HTTP status code of the response *)
-    flush : bool;
   }
 
-  let compare { headers; flush; version; status } y =
+  let compare { headers; version; status } y =
     match Header.compare headers y.headers with
     | 0 -> (
-        match Bool.compare flush y.flush with
+        match Stdlib.compare status y.status with
         | 0 -> (
             match Stdlib.compare status y.status with
             | 0 -> Version.compare version y.version
             | i -> i)
         | i -> i)
     | i -> i
 
-  let make ?(version = `HTTP_1_1) ?(status = `OK) ?(flush = false)
-      ?(headers = Header.empty) () =
-    { headers; version; flush; status }
+  let make ?(version = `HTTP_1_1) ?(status = `OK) ?(headers = Header.empty) () =
+    { headers; version; status }
 
   let headers t = t.headers
   let version t = t.version
   let status t = t.status
-  let flush t = t.flush
   let is_keep_alive { version; headers; _ } = is_keep_alive version headers
 
   let requires_content_length ?request_meth t =

diff --git a/http/src/http.mli b/http/src/http.mli
@@ -448,21 +448,11 @@ module Response : sig
     headers : Header.t;  (** response HTTP headers *)
     version : Version.t;  (** (** HTTP version, usually 1.1 *) *)
     status : Status.t;  (** HTTP status code of the response *)
-    flush : bool;
-        [@deprecated
-          "this field will be removed in the future. Provide flush in the \
-           [respond_*] function instead."]
   }
 
   val headers : t -> Header.t
   val version : t -> Version.t
   val status : t -> Status.t
-
-  val flush : t -> bool
-  [@@deprecated
-    "this field will be removed in the future. Provide flush in the \
-     [respond_*] function instead."]
-
   val compare : t -> t -> int
 
   val is_keep_alive : t -> bool
@@ -489,16 +479,11 @@ module Response : sig
       See https://www.rfc-editor.org/rfc/rfc7230#section-3.3.2 *)
 
   val make :
-    ?version:Version.t ->
-    ?status:Status.t ->
-    ?flush:bool ->
-    ?headers:Header.t ->
-    unit ->
-    t
+    ?version:Version.t -> ?status:Status.t -> ?headers:Header.t -> unit -> t
   (** [make ()] is a value of {!type:t}. The default values for the request, if
-      not specified, are: [status] is [`Ok], [version] is [`HTTP_1_1], [flush]
-      is [false] and [headers] is [Header.empty]. The request encoding value is
-      determined via the [Header.get_transfer_encoding] function. *)
+      not specified, are: [status] is [`Ok], [version] is [`HTTP_1_1]. The
+      request encoding value is determined via the
+      [Header.get_transfer_encoding] function. *)
 
   val pp : Format.formatter -> t -> unit
 end