Skip to content

Commit

Permalink
Merge pull request #958 from bikallem/client-call
Browse files Browse the repository at this point in the history
Further improve Cohttp_eio.Client ergonomics
  • Loading branch information
mseri authored Dec 22, 2022
2 parents 72fe9fc + c683ac9 commit db2abd0
Show file tree
Hide file tree
Showing 7 changed files with 102 additions and 73 deletions.
3 changes: 2 additions & 1 deletion CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,9 @@
- Upgrade dune to v3.0 (bikallem #947)
- cohttp-eio: allow client to optionally configure request pipelining (bikallem #949)
- cohttp-eio: update to Eio 0.7 (talex5 #952)
- cohttp-eio: update examples to use eio 0.7 primitives (bikallem #?)
- cohttp-eio: update examples to use eio 0.7 primitives (bikallem #957)
- cohttp-eio: generate Date header in responses (bikallem #955)
- cohttp-eio: further improve Cohttp_eio.Client ergonomics (bikallem #?)

## v6.0.0~alpha0 (2022-10-24)
- cohttp-eio: ensure "Host" header is the first header in http client requests (bikallem #939)
Expand Down
8 changes: 2 additions & 6 deletions cohttp-eio/examples/client1.ml
Original file line number Diff line number Diff line change
@@ -1,10 +1,6 @@
open Cohttp_eio

let () =
let host, port = ("www.example.org", 80) in
Eio_main.run @@ fun env ->
Eio.Net.with_tcp_connect ~host ~service:(string_of_int port) env#net
(fun conn ->
let host = (host, Some port) in
let res = Client.get ~conn host "/" in
print_string @@ Client.read_fixed res)
let res = Client.get env ~host:"www.example.org" "/" in
print_string @@ Client.read_fixed res
7 changes: 3 additions & 4 deletions cohttp-eio/examples/client_timeout.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,12 +7,11 @@ let () =
(* Increment/decrement this value to see success/failure. *)
let timeout_s = 0.01 in
Eio.Time.with_timeout env#clock timeout_s (fun () ->
let hostname, port = ("www.example.org", 80) in
let he = Unix.gethostbyname hostname in
let host, port = ("www.example.org", 80) in
let he = Unix.gethostbyname host in
let addr = `Tcp (Eio_unix.Ipaddr.of_unix he.h_addr_list.(0), port) in
let conn = Net.connect ~sw env#net addr in
let host = (hostname, Some port) in
let res = Client.get ~conn host "/" in
let res = Client.get ~conn ~port env ~host "/" in
Client.read_fixed res |> Result.ok)
|> function
| Ok s -> print_string s
Expand Down
2 changes: 1 addition & 1 deletion cohttp-eio/examples/docker_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ let () =
Switch.run @@ fun sw ->
let addr = `Unix "/var/run/docker.sock" in
let conn = Net.connect ~sw env#net addr in
let res = Client.get ~conn ("docker", None) "/version" in
let res = Client.get ~conn ~host:"docker" env "/version" in
let code = fst res |> Response.status |> Status.to_int in
Printf.printf "Response code: %d\n" code;
Printf.printf "Headers: %s\n"
Expand Down
86 changes: 47 additions & 39 deletions cohttp-eio/src/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2,27 +2,33 @@ module Buf_read = Eio.Buf_read
module Buf_write = Eio.Buf_write

type response = Http.Response.t * Buf_read.t
type host = string * int option
type host = string
type port = int
type resource_path = string
type 'a env = < net : Eio.Net.t ; .. > as 'a

type 'a body_disallowed_call =
type ('a, 'b) body_disallowed_call =
?pipeline_requests:bool ->
?version:Http.Version.t ->
?headers:Http.Header.t ->
conn:(#Eio.Flow.two_way as 'a) ->
host ->
?conn:(#Eio.Flow.two_way as 'a) ->
?port:port ->
'b env ->
host:host ->
resource_path ->
response
(** [body_disallowed_call] denotes HTTP client calls where a request is not
allowed to have a request body. *)

type 'a body_allowed_call =
type ('a, 'b) body_allowed_call =
?pipeline_requests:bool ->
?version:Http.Version.t ->
?headers:Http.Header.t ->
?body:Body.t ->
conn:(#Eio.Flow.two_way as 'a) ->
host ->
?conn:(#Eio.Flow.two_way as 'a) ->
?port:port ->
'b env ->
host:host ->
resource_path ->
response

Expand Down Expand Up @@ -76,55 +82,57 @@ let response buf_read =
(* Generic HTTP call *)

let call ?(pipeline_requests = false) ?meth ?version
?(headers = Http.Header.init ()) ?(body = Body.Empty) ~conn host
?(headers = Http.Header.init ()) ?(body = Body.Empty) ?conn ?port env ~host
resource_path =
let headers =
if not (Http.Header.mem headers "Host") then
let host =
match host with
| host, Some port -> host ^ ":" ^ string_of_int port
| host, None -> host
match port with
| Some port -> host ^ ":" ^ string_of_int port
| None -> host
in
Http.Header.add headers "Host" host
else headers
in
let headers =
Http.Header.add_unless_exists headers "User-Agent" "cohttp-eio"
in
let initial_size = 0x1000 in
Buf_write.with_flow ~initial_size conn (fun writer ->
let request = Http.Request.make ?meth ?version ~headers resource_path in
let request = Http.Request.add_te_trailers request in
write_request pipeline_requests request writer body;
let reader = Eio.Buf_read.of_flow ~initial_size ~max_size:max_int conn in
let response = response reader in
(response, reader))
let buf_write conn =
let initial_size = 0x1000 in
Buf_write.with_flow ~initial_size:0x1000 conn (fun writer ->
let request = Http.Request.make ?meth ?version ~headers resource_path in
let request = Http.Request.add_te_trailers request in
write_request pipeline_requests request writer body;
let reader =
Eio.Buf_read.of_flow ~initial_size ~max_size:max_int conn
in
let response = response reader in
(response, reader))
in
match conn with
| None ->
let service =
match port with Some p -> string_of_int p | None -> "80"
in
Eio.Net.with_tcp_connect ~host ~service env#net (fun conn ->
buf_write conn)
| Some conn -> buf_write conn

(* HTTP Calls with Body Disallowed *)

let get ?pipeline_requests ?version ?headers ~conn host resource_path =
call ?pipeline_requests ~meth:`GET ?version ?headers ~conn host resource_path

let head ?pipeline_requests ?version ?headers ~conn host resource_path =
call ?pipeline_requests ~meth:`HEAD ?version ?headers ~conn host resource_path

let delete ?pipeline_requests ?version ?headers ~conn host resource_path =
call ?pipeline_requests ~meth:`DELETE ?version ?headers ~conn host
let call_without_body ?pipeline_requests ?meth ?version ?headers ?conn ?port env
~host resource_path =
call ?pipeline_requests ?meth ?version ?headers ?conn ?port env ~host
resource_path

(* HTTP Calls with Body Allowed *)
let get = call_without_body ~meth:`GET
let head = call_without_body ~meth:`HEAD
let delete = call_without_body ~meth:`DELETE

let post ?pipeline_requests ?version ?headers ?body ~conn host resource_path =
call ?pipeline_requests ~meth:`POST ?version ?headers ?body ~conn host
resource_path

let put ?pipeline_requests ?version ?headers ?body ~conn host resource_path =
call ?pipeline_requests ~meth:`PUT ?version ?headers ?body ~conn host
resource_path
(* HTTP Calls with Body Allowed *)

let patch ?pipeline_requests ?version ?headers ?body ~conn host resource_path =
call ?pipeline_requests ~meth:`PATCH ?version ?headers ?body ~conn host
resource_path
let post = call ~meth:`POST
let put = call ~meth:`PUT
let patch = call ~meth:`PATCH

(* Response Body *)

Expand Down
45 changes: 28 additions & 17 deletions cohttp-eio/src/cohttp_eio.mli
Original file line number Diff line number Diff line change
Expand Up @@ -112,20 +112,27 @@ end
module Client : sig
type response = Http.Response.t * Eio.Buf_read.t

type host = string * int option
(** Represents a server host - as ip address or domain name - and an optional
port value, e.g. www.example.org:8080, www.reddit.com *)
type host = string
(** Represents a server host - as ip address or domain name, e.g.
www.example.org:8080, www.reddit.com*)

type port = int
(** Represents a tcp/ip port value *)

type resource_path = string
(** Represents HTTP request resource path, e.g. "/shop/purchase",
"/shop/items", "/shop/categories/" etc. *)

type 'a body_disallowed_call =
type 'a env = < net : Eio.Net.t ; .. > as 'a

type ('a, 'b) body_disallowed_call =
?pipeline_requests:bool ->
?version:Http.Version.t ->
?headers:Http.Header.t ->
conn:(#Eio.Flow.two_way as 'a) ->
host ->
?conn:(#Eio.Flow.two_way as 'a) ->
?port:port ->
'b env ->
host:host ->
resource_path ->
response
(** [body_disallowed_call] denotes HTTP client calls where a request is not
Expand All @@ -136,13 +143,15 @@ module Client : sig
request/reponse throughput. Set this to [false] if you want to improve
latency of individual client request/response. Default is [false]. *)

type 'a body_allowed_call =
type ('a, 'b) body_allowed_call =
?pipeline_requests:bool ->
?version:Http.Version.t ->
?headers:Http.Header.t ->
?body:Body.t ->
conn:(#Eio.Flow.two_way as 'a) ->
host ->
?conn:(#Eio.Flow.two_way as 'a) ->
?port:port ->
'b env ->
host:host ->
resource_path ->
response
(** [body_allowed_call] denotes HTTP client calls where a request can
Expand All @@ -161,22 +170,24 @@ module Client : sig
?version:Http.Version.t ->
?headers:Http.Header.t ->
?body:Body.t ->
conn:#Eio.Flow.two_way ->
host ->
?conn:#Eio.Flow.two_way ->
?port:port ->
'a env ->
host:host ->
resource_path ->
response

(** {1 HTTP Calls with Body Disallowed} *)

val get : 'a body_disallowed_call
val head : 'a body_disallowed_call
val delete : 'a body_disallowed_call
val get : ('a, 'b) body_disallowed_call
val head : ('a, 'b) body_disallowed_call
val delete : ('a, 'b) body_disallowed_call

(** {1 HTTP Calls with Body Allowed} *)

val post : 'a body_allowed_call
val put : 'a body_allowed_call
val patch : 'a body_allowed_call
val post : ('a, 'b) body_allowed_call
val put : ('a, 'b) body_allowed_call
val patch : ('a, 'b) body_allowed_call

(** {1 Response Body} *)

Expand Down
24 changes: 19 additions & 5 deletions cohttp-eio/tests/client.md
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,13 @@ open Cohttp_eio
A mock client socket and host for testing:

```ocaml
let host = ("localhost", None)
let host = "localhost"
let conn = Eio_mock.Flow.make "socket"
let mock_env =
object
method net = (Eio_mock.Net.make "mock net" :> Eio.Net.t)
end
let run ~response ~test =
Eio_mock.Backend.run @@ fun () ->
Fiber.both
Expand All @@ -33,7 +38,8 @@ GET method request:
(Client.get
~headers:(Http.Header.of_list [ ("Accept", "application/json") ])
~conn
host
~host
mock_env
"/")
|> Client.read_fixed
|> print_string);;
Expand Down Expand Up @@ -68,7 +74,11 @@ POST request:
Client.post
~headers:
(Http.Header.of_list [("Accept", "application/json"); ("Content-Length", content_length);])
~body:(Body.Fixed content) ~conn host "/post"
~body:(Body.Fixed content)
~conn
~host
mock_env
"/post"
|> Client.read_fixed
|> print_string);;
+socket: wrote "POST /post HTTP/1.1\r\n"
Expand Down Expand Up @@ -140,7 +150,11 @@ Chunk request:
])
~body:
(Body.Chunked { body_writer = body_writer chan 0; trailer_writer })
~conn host "/handle_chunk")
~conn
~host
mock_env
"/handle_chunk"
)
|> Client.read_fixed
|> print_string);;
+socket: wrote "POST /handle_chunk HTTP/1.1\r\n"
Expand Down Expand Up @@ -188,7 +202,7 @@ Chunk request:
]
~test:(fun () ->
let print_chunk chunk = traceln "chunk body: %a\n" Body.pp_chunk chunk in
let res = Client.get ~conn host "/get_chunk" in
let res = Client.get ~conn ~host mock_env "/get_chunk" in
match Client.read_chunked res print_chunk with
| None -> print_string "FAIL"
| Some _ -> print_string "PASS"
Expand Down

0 comments on commit db2abd0

Please sign in to comment.