Further improve Cohttp_eio.Client ergonomics

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)

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

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

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"

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,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 *)
 

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} *)
 

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"