Skip to content

Commit

Permalink
fix: get rid of flush
Browse files Browse the repository at this point in the history 
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]>

<!-- ps-id: adbceded-c111-4ce6-8083-96c5a8a7ca26 -->
  • Loading branch information
@rgrinberg
rgrinberg committed Jul 15, 2024
1 parent d214ef0 commit 6101a53
Show file tree
Hide file tree
Showing 11 changed files with 40 additions and 80 deletions.
21 changes: 10 additions & 11 deletions cohttp-async/src/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 ->
Expand All @@ -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
Expand Down
4 changes: 0 additions & 4 deletions cohttp-async/src/server.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 ->
Expand All @@ -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 ->
Expand All @@ -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 ->
Expand Down
12 changes: 6 additions & 6 deletions cohttp-eio/src/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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
Expand Down
1 change: 0 additions & 1 deletion cohttp-eio/src/server.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ include

val respond :
?headers:Http.Header.t ->
?flush:bool ->
status:Http.Status.t ->
body:_ Eio.Flow.source ->
unit ->
Expand Down
2 changes: 0 additions & 2 deletions cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions cohttp-lwt/src/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
17 changes: 6 additions & 11 deletions cohttp/src/response.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 -> (
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
5 changes: 0 additions & 5 deletions cohttp/src/s.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand All @@ -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 ->
Expand Down
16 changes: 6 additions & 10 deletions cohttp/src/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
11 changes: 4 additions & 7 deletions http/src/http.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
23 changes: 4 additions & 19 deletions http/src/http.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 6101a53

Please sign in to comment.