From 3c97adab8b6da8c786c6a3cb661ce5a761b427b8 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 22 Dec 2022 10:59:01 +0000 Subject: [PATCH 1/3] cohttp-eio(client): make Client.call/get/post/put more convenient to use --- cohttp-eio/src/client.ml | 86 +++++++++++++++++++---------------- cohttp-eio/src/cohttp_eio.mli | 45 +++++++++++------- 2 files changed, 75 insertions(+), 56 deletions(-) diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index 936c9cc5b7..a9942f1ef6 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -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 @@ -76,14 +82,14 @@ 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 @@ -91,40 +97,42 @@ let call ?(pipeline_requests = false) ?meth ?version 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 *) diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index fd2dd30100..01a66ea2cf 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -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 @@ -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 @@ -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} *) From a2f64e0e31557065f99ad5ae8d6814017ec7da1f Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 22 Dec 2022 11:04:58 +0000 Subject: [PATCH 2/3] cohttp-eio(client): update client.md tests --- cohttp-eio/tests/client.md | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/cohttp-eio/tests/client.md b/cohttp-eio/tests/client.md index ef947941db..98fcd16fbe 100644 --- a/cohttp-eio/tests/client.md +++ b/cohttp-eio/tests/client.md @@ -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 @@ -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);; @@ -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" @@ -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" @@ -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" From c683ac9878f7ddf45e8507a6b4f5a7957107c24c Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 22 Dec 2022 11:05:41 +0000 Subject: [PATCH 3/3] cohttp-eio(client): update examples to use update Client.call --- CHANGES.md | 3 ++- cohttp-eio/examples/client1.ml | 8 ++------ cohttp-eio/examples/client_timeout.ml | 7 +++---- cohttp-eio/examples/docker_client.ml | 2 +- 4 files changed, 8 insertions(+), 12 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index b266ebba35..38f365bba6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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) diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index d571f85d1e..44d41a2133 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -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 diff --git a/cohttp-eio/examples/client_timeout.ml b/cohttp-eio/examples/client_timeout.ml index 397a04d9d6..6072b356b3 100644 --- a/cohttp-eio/examples/client_timeout.ml +++ b/cohttp-eio/examples/client_timeout.ml @@ -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 diff --git a/cohttp-eio/examples/docker_client.ml b/cohttp-eio/examples/docker_client.ml index 8dee798eea..60a6f38f6e 100644 --- a/cohttp-eio/examples/docker_client.ml +++ b/cohttp-eio/examples/docker_client.ml @@ -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"