eio(client): implement Cohttp_eio.Client module

Add type for call types:

1. body_disallowed_call : HTTP client call where body is not allowed to be
present in the request

2. body_allowed_call : HTTP client call where body is allowed to be present
in the call.

Add functions call, get,head,delete,post,put and patch functions to imitate
HTTP method calls.

cohttp-eio/examples/dune

@@ -1,5 +1,5 @@
-(executable
- (name server1)
+(executables
+ (names server1 client1)
  (libraries cohttp-eio uri eio_main))
 
 (alias

cohttp-eio/src/body.ml

@@ -46,12 +46,11 @@ open Reader
 open Eio.Buf_read
 
 let read_fixed t headers =
-  match Http.Header.get headers "Content-length" with
-  | Some v ->
-      let content_length = int_of_string v in
-      let content = take content_length t in
-      content
-  | None -> raise @@ Invalid_argument "Request is not a fixed content body"
+  let ( let* ) o f = Option.bind o f in
+  let ( let+ ) o f = Option.map f o in
+  let* v = Http.Header.get headers "Content-Length" in
+  let+ content_length = int_of_string_opt v in
+  take content_length t
 
 (* Chunked encoding parser *)
 
@@ -71,7 +70,8 @@ let quoted_char =
 
 (*-- qdtext = HTAB / SP /%x21 / %x23-5B / %x5D-7E / obs-text -- *)
 let qdtext = function
-  | ('\t' | ' ' | '\x21' | '\x23' .. '\x5B' | '\x5D' .. '\x7E') as c -> c
+  | '\t' | ' ' | '\x21' | '\x23' .. '\x5B'
+  | '\x5D' .. '\x7E' as c -> c
   | c -> failwith (Printf.sprintf "Invalid quoted character %C" c)
 
 (*-- quoted-string = DQUOTE *( qdtext / quoted-pair ) DQUOTE --*)
@@ -81,35 +81,31 @@ let quoted_string r =
   let rec aux () =
     match any_char r with
     | '"' -> Buffer.contents buf
-    | '\\' ->
-        Buffer.add_char buf (quoted_char r);
-        aux ()
-    | c ->
-        Buffer.add_char buf (qdtext c);
-        aux ()
+    | '\\' -> Buffer.add_char buf (quoted_char r); aux ()
+    | c -> Buffer.add_char buf (qdtext c); aux ()
   in
   aux ()
 
 let optional c x r =
   let c2 = peek_char r in
-  if Some c = c2 then (
-    consume r 1;
-    Some (x r))
+  if Some c = c2 then (consume r 1; Some (x r))
   else None
 
 (*-- https://datatracker.ietf.org/doc/html/rfc7230#section-4.1 --*)
 let chunk_ext_val =
   let* c = peek_char in
-  match c with Some '"' -> quoted_string | _ -> token
+  match c with
+  | Some '"' -> quoted_string
+  | _ -> token
 
 let rec chunk_exts r =
   let c = peek_char r in
   match c with
   | Some ';' ->
-      consume r 1;
-      let name = token r in
-      let value = optional '=' chunk_ext_val r in
-      { name; value } :: chunk_exts r
+    consume r 1;
+    let name = token r in
+    let value = optional '=' chunk_ext_val r in
+    { name; value } :: chunk_exts r
   | _ -> []
 
 let chunk_size =
@@ -218,45 +214,7 @@ let read_chunked reader headers f =
             (chunk_loop [@tailcall]) f
         | `Last_chunk (extensions, headers) ->
             f (Last_chunk extensions);
-            headers
+            Some headers
       in
       chunk_loop f
-  | _ -> raise @@ Invalid_argument "Request is not a chunked request"
-
-(* Writes *)
-
-let write_headers t headers =
-  Http.Header.iter
-    (fun k v ->
-      Writer.write_string t k;
-      Writer.write_string t ": ";
-      Writer.write_string t v;
-      Writer.write_string t "\r\n")
-    headers
-
-(* https://datatracker.ietf.org/doc/html/rfc7230#section-4.1 *)
-let write_chunked t chunk_writer =
-  let write_extensions exts =
-    List.iter
-      (fun { name; value } ->
-        let v =
-          match value with None -> "" | Some v -> Printf.sprintf "=%s" v
-        in
-        Writer.write_string t (Printf.sprintf ";%s%s" name v))
-      exts
-  in
-  let write_body = function
-    | Chunk { size; data; extensions = exts } ->
-        Writer.write_string t (Printf.sprintf "%X" size);
-        write_extensions exts;
-        Writer.write_string t "\r\n";
-        Writer.write_string t data;
-        Writer.write_string t "\r\n"
-    | Last_chunk exts ->
-        Writer.write_string t "0";
-        write_extensions exts;
-        Writer.write_string t "\r\n"
-  in
-  chunk_writer.body_writer write_body;
-  chunk_writer.trailer_writer (write_headers t);
-  Writer.write_string t "\r\n"
+  | _ -> None

cohttp-eio/src/client.ml

@@ -0,0 +1,108 @@
+module Buf_read = Eio.Buf_read
+
+type response = Http.Response.t * Buf_read.t
+
+type body_disallowed_call =
+  ?version:Http.Version.t ->
+  ?headers:Http.Header.t ->
+  Eio.Stdenv.t ->
+  Eio.Switch.t ->
+  Eio.Net.Sockaddr.stream ->
+  Uri.t ->
+  response
+
+type body_allowed_call =
+  ?version:Http.Version.t ->
+  ?headers:Http.Header.t ->
+  ?body:Body.t ->
+  Eio.Stdenv.t ->
+  Eio.Switch.t ->
+  Eio.Net.Sockaddr.stream ->
+  Uri.t ->
+  response
+
+(* Request line https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.1 *)
+let write_request writer (meth, version, headers, uri, body) =
+  Writer.write_string writer (Http.Method.to_string meth);
+  Writer.write_char writer ' ';
+  Writer.write_string writer (Uri.path_and_query uri);
+  Writer.write_char writer ' ';
+  Writer.write_string writer (Http.Version.to_string version);
+  Writer.write_string writer "\r\n";
+  Writer.write_headers writer headers;
+  Writer.write_string writer "\r\n";
+  Writer.write_body writer body
+
+(* response parser *)
+
+let is_digit = function '0' .. '9' -> true | _ -> false
+
+open Buf_read.Syntax
+
+let status_code =
+  let open Reader in
+  let+ status = take_while1 is_digit in
+  Http.Status.of_int (int_of_string status)
+
+let reason_phrase =
+  Buf_read.take_while (function
+    | '\x21' .. '\x7E' | '\t' | ' ' -> true
+    | _ -> false)
+
+(* https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.2 *)
+let response buf_read =
+  match Buf_read.at_end_of_input buf_read with
+  | true -> Stdlib.raise_notrace End_of_file
+  | false ->
+      let version = Reader.(version <* space) buf_read in
+      let status = Reader.(status_code <* space) buf_read in
+      let () = Reader.(reason_phrase *> crlf *> return ()) buf_read in
+      let headers = Reader.http_headers buf_read in
+      Http.Response.make ~version ~status ~headers ()
+
+(* Generic HTTP call *)
+
+let call ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Http.Header.init ())
+    ?(body = Body.Empty) env sw stream uri =
+  let open Eio in
+  let flow = Net.connect ~sw (Stdenv.net env) stream in
+  let writer = Writer.create (flow :> Flow.sink) in
+  Fiber.fork ~sw (fun () -> Writer.run writer);
+  write_request writer (meth, version, headers, uri, body);
+  Writer.wakeup writer;
+  let reader =
+    Eio.Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int
+      (flow :> Eio.Flow.source)
+  in
+  let response = response reader in
+  (response, reader)
+
+(*  HTTP Calls with Body Disallowed *)
+
+let get ?version ?headers env sw stream uri =
+  call ~meth:`GET ?version ?headers env sw stream uri
+
+let head ?version ?headers env sw stream uri =
+  call ~meth:`HEAD ?version ?headers env sw stream uri
+
+let delete ?version ?headers env sw stream uri =
+  call ~meth:`DELETE ?version ?headers env sw stream uri
+
+(*  HTTP Calls with Body Allowed *)
+
+let post ?version ?headers ?body env sw stream uri =
+  call ~meth:`POST ?version ?headers ?body env sw stream uri
+
+let put ?version ?headers ?body env sw stream uri =
+  call ~meth:`PUT ?version ?headers ?body env sw stream uri
+
+let patch ?version ?headers ?body env sw stream uri =
+  call ~meth:`PATCH ?version ?headers ?body env sw stream uri
+
+(* Response Body *)
+
+let read_fixed ((response, reader) : Http.Response.t * Buf_read.t) =
+  Body.read_fixed reader response.headers
+
+let read_chunked : response -> (Body.chunk -> unit) -> Http.Header.t option =
+ fun (response, reader) f -> Body.read_chunked reader response.headers f

cohttp-eio/src/cohttp_eio.ml

@@ -1,2 +1,3 @@
 module Body = Body
 module Server = Server
+module Client = Client

cohttp-eio/src/cohttp_eio.mli

@@ -33,28 +33,30 @@ module Server : sig
   and request = Http.Request.t * Eio.Buf_read.t
   and response = Http.Response.t * Body.t
 
-  (** {1 Request} *)
+  (** {1 Request Body} *)
 
-  val read_fixed : request -> string
-  (** [read_fixed (request,reader)] is bytes of length [n] if "Content-Length"
-      header is a valid integer value [n] in [request]. [reader] is updated to
-      reflect that [n] bytes was read.
+  val read_fixed : request -> string option
+  (** [read_fixed (request, buf_read)] is [Some content], where [content] is of
+      length [n] if "Content-Length" header is a valid integer value [n] in
+      [request].
 
-      @raise Invalid_argument
-        if ["Content-Length"] header is missing or is an invalid value in
-        [headers] OR if the request http method is not one of [POST], [PUT] or
-        [PATCH]. *)
+      [buf_read] is updated to reflect that [n] bytes was read.
 
-  val read_chunked : request -> (Body.chunk -> unit) -> Http.Header.t
-  (** [read_chunked request chunk_handler] is [updated_headers] if
-      "Transfer-Encoding" header value is "chunked" in [headers] and all chunks
+      If ["Content-Length"] header is missing or is an invalid value in
+      [request] OR if the request http method is not one of [POST], [PUT] or
+      [PATCH], then [None] is returned. *)
+
+  val read_chunked : request -> (Body.chunk -> unit) -> Http.Header.t option
+  (** [read_chunked request chunk_handler] is [Some updated_headers] if
+      "Transfer-Encoding" header value is "chunked" in [request] and all chunks
       in [reader] are read successfully. [updated_headers] is the updated
-      headers as specified by the chunked encoding algorithm in
-      https://datatracker.ietf.org/doc/html/rfc7230#section-4.1.3. Otherwise it
-      is [Error err] where [err] is the error text.
+      headers as specified by the chunked encoding algorithm in https:
+      //datatracker.ietf.org/doc/html/rfc7230#section-4.1.3.
+
+      [reader] is updated to reflect the number of bytes read.
 
-      @raise Invalid_argument
-        if [Transfer-Encoding] header in [headers] is not specified as "chunked" *)
+      Returns [None] if [Transfer-Encoding] header in [headers] is not specified
+      as "chunked" *)
 
   (** {1 Response} *)
 
@@ -90,3 +92,74 @@ module Server : sig
 
   val not_found_handler : handler
 end
+
+module Client : sig
+  type response = Http.Response.t * Eio.Buf_read.t
+
+  type body_disallowed_call =
+    ?version:Http.Version.t ->
+    ?headers:Http.Header.t ->
+    Eio.Stdenv.t ->
+    Eio.Switch.t ->
+    Eio.Net.Sockaddr.stream ->
+    Uri.t ->
+    response
+  (** [body_disallowed_call] denotes HTTP client calls where a request is not
+      allowed to have a request body. *)
+
+  type body_allowed_call =
+    ?version:Http.Version.t ->
+    ?headers:Http.Header.t ->
+    ?body:Body.t ->
+    Eio.Stdenv.t ->
+    Eio.Switch.t ->
+    Eio.Net.Sockaddr.stream ->
+    Uri.t ->
+    response
+  (** [body_allowed_call] denotes HTTP client calls where a request is allowed
+      to have a request body. *)
+
+  (** {1 Generic HTTP call} *)
+
+  val call :
+    ?meth:Http.Method.t ->
+    ?version:Http.Version.t ->
+    ?headers:Http.Header.t ->
+    ?body:Body.t ->
+    Eio.Stdenv.t ->
+    Eio.Switch.t ->
+    Eio.Net.Sockaddr.stream ->
+    Uri.t ->
+    response
+
+  (** {1 HTTP Calls with Body Disallowed} *)
+
+  val get : body_disallowed_call
+  val head : body_disallowed_call
+  val delete : body_disallowed_call
+
+  (** {1 HTTP Calls with Body Allowed} *)
+
+  val post : body_allowed_call
+  val put : body_allowed_call
+  val patch : body_allowed_call
+
+  (** {1 Response Body} *)
+
+  val read_fixed : response -> string option
+  (** [read_fixed (response,reader)] is [Some bytes], where [bytes] is of length
+      [n] if "Content-Length" header is a valid integer value [n] in [response].
+      [reader] is updated to reflect that [n] bytes was read. *)
+
+  val read_chunked : response -> (Body.chunk -> unit) -> Http.Header.t option
+  (** [read_chunked response chunk_handler] is [Some updated_headers] if
+      "Transfer-Encoding" header value is "chunked" in [response] and all chunks
+      in [reader] are read successfully. [updated_headers] is the updated
+      headers as specified by the chunked encoding algorithm in https:
+      //datatracker.ietf.org/doc/html/rfc7230#section-4.1.3.
+
+      [reader] is updated to reflect the number of bytes read.
+
+      Returns [None] if [Transfer-Encoding] header in [headers] is not specified
+      as "chunked" *)
+end

cohttp-eio/src/dune

@@ -1,4 +1,4 @@
 (library
  (name cohttp_eio)
  (public_name cohttp-eio)
- (libraries eio cstruct http bigstringaf fmt))
+ (libraries eio cstruct http bigstringaf fmt uri))