From dd16a48e7ad6a570b2b44e1dd80b44bd8b86eae0 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Mon, 6 Jun 2022 22:36:43 +0100 Subject: [PATCH 1/9] 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. --- CHANGES.md | 1 + cohttp-eio/examples/client1.ml | 0 cohttp-eio/examples/dune | 4 +- cohttp-eio/src/body.ml | 44 +++++------ cohttp-eio/src/client.ml | 108 ++++++++++++++++++++++++++ cohttp-eio/src/cohttp_eio.ml | 1 + cohttp-eio/src/cohttp_eio.mli | 107 ++++++++++++++++++++----- cohttp-eio/src/dune | 2 +- cohttp-eio/src/reader.ml | 22 +----- cohttp-eio/src/server.ml | 48 +++++++++--- cohttp-eio/tests/test_chunk_server.ml | 2 +- cohttp-eio/tests/test_get_post.t | 4 +- 12 files changed, 269 insertions(+), 74 deletions(-) create mode 100644 cohttp-eio/examples/client1.ml create mode 100644 cohttp-eio/src/client.ml diff --git a/CHANGES.md b/CHANGES.md index 6827e5ae8c..8121e51522 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,5 @@ ## Unreleased +- cohttp-eio: add cohttp-eio client api - Cohttp_eio.Client (bikallem #879) - cohttp-eio: use Eio.Buf_write and improve server API (talex5 #887) - cohttp-eio: update to Eio 0.3 (talex5 #886) - cohttp-eio: convert to Eio.Buf_read (talex5 #882) diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml new file mode 100644 index 0000000000..e69de29bb2 diff --git a/cohttp-eio/examples/dune b/cohttp-eio/examples/dune index fe4a214e41..4dc99c490c 100644 --- a/cohttp-eio/examples/dune +++ b/cohttp-eio/examples/dune @@ -1,5 +1,5 @@ -(executable - (name server1) +(executables + (names server1 client1) (libraries cohttp-eio uri eio_main)) (alias diff --git a/cohttp-eio/src/body.ml b/cohttp-eio/src/body.ml index ef2f571f69..220f2a87eb 100644 --- a/cohttp-eio/src/body.ml +++ b/cohttp-eio/src/body.ml @@ -48,12 +48,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 *) @@ -73,7 +72,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 --*) @@ -83,35 +83,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 = @@ -220,9 +216,10 @@ 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 +<<<<<<< HEAD | _ -> raise @@ Invalid_argument "Request is not a chunked request" (* Writes *) @@ -262,3 +259,6 @@ let write_chunked t chunk_writer = chunk_writer.body_writer write_body; chunk_writer.trailer_writer (write_headers t); Write.string t "\r\n" +======= + | _ -> None +>>>>>>> 7c4b2a2e (eio(client): implement Cohttp_eio.Client module) diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml new file mode 100644 index 0000000000..5fdd6d7ff9 --- /dev/null +++ b/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 diff --git a/cohttp-eio/src/cohttp_eio.ml b/cohttp-eio/src/cohttp_eio.ml index 8a0f06127d..284353ff92 100644 --- a/cohttp-eio/src/cohttp_eio.ml +++ b/cohttp-eio/src/cohttp_eio.ml @@ -1,2 +1,3 @@ module Body = Body module Server = Server +module Client = Client diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index 737d1b8068..2cd66d6ef3 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -35,28 +35,28 @@ module Server : sig type response = Http.Response.t * Body.t type handler = request -> response - (** {1 Request} *) + (** {1 Request Body} *) - val read_fixed : Http.Request.t -> Eio.Buf_read.t -> string - (** [read_fixed request body] reads a string of length [n] if "Content-Length" - header is a valid integer value [n] in [request]. + 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 : - Http.Request.t -> Eio.Buf_read.t -> (Body.chunk -> unit) -> Http.Header.t - (** [read_chunked request body chunk_handler] is [updated_headers] if - "Transfer-Encoding" header value is "chunked" in [headers] 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. + 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. *) - @raise Invalid_argument - if [Transfer-Encoding] header in [headers] is not specified as "chunked" *) +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. + [reader] is updated to reflect the number of bytes read. + Returns [None] if [Transfer-Encoding] header in [headers] is not specified + as "chunked" *) (** {1 Response} *) @@ -96,3 +96,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 diff --git a/cohttp-eio/src/dune b/cohttp-eio/src/dune index cab99284c3..3d1f0d9120 100644 --- a/cohttp-eio/src/dune +++ b/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)) diff --git a/cohttp-eio/src/reader.ml b/cohttp-eio/src/reader.ml index e7c0809419..31697f1ac4 100644 --- a/cohttp-eio/src/reader.ml +++ b/cohttp-eio/src/reader.ml @@ -23,14 +23,8 @@ let crlf = string "\r\n" let not_cr = function '\r' -> false | _ -> true let space = char '\x20' -let p_meth = - let+ meth = token <* space in - Http.Method.of_string meth - -let p_resource = take_while1 (fun c -> c != ' ') <* space - -let p_version = - let* v = string "HTTP/1." *> any_char <* crlf in +let version = + let* v = string "HTTP/1." *> any_char in match v with | '1' -> return `HTTP_1_1 | '0' -> return `HTTP_1_0 @@ -41,7 +35,7 @@ let header = (key, value) let http_headers r = - let rec aux () = + let[@tail_mod_cons] rec aux () = match peek_char r with | Some '\r' -> crlf r; @@ -51,13 +45,3 @@ let http_headers r = h :: aux () in Http.Header.of_list (aux ()) - -let[@warning "-3"] http_request t = - match at_end_of_input t with - | true -> Stdlib.raise_notrace End_of_file - | false -> - let meth = p_meth t in - let resource = p_resource t in - let version = p_version t in - let headers = http_headers t in - Http.Request.make ~meth ~version ~headers resource diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml index adb971aacd..06fc9e0fb6 100644 --- a/cohttp-eio/src/server.ml +++ b/cohttp-eio/src/server.ml @@ -16,16 +16,10 @@ let domain_count = let read_fixed request reader = match Http.Request.meth request with | `POST | `PUT | `PATCH -> Body.read_fixed reader request.headers - | _ -> - let err = - Printf.sprintf - "Request with HTTP method '%s' doesn't support request body" - (Http.Method.to_string request.meth) - in - raise @@ Invalid_argument err + | _ -> None -let read_chunked request reader f = - Body.read_chunked reader (Http.Request.headers request) f +let read_chunked : request -> (Body.chunk -> unit) -> Http.Header.t option = + fun (request, reader, _) f -> Body.read_chunked reader request.headers f (* Responses *) @@ -84,6 +78,40 @@ let write_response (writer : Write.t) (* main *) let rec handle_request client_addr reader writer flow handler = + match Reader.http_request reader with + Writer.write_string writer version; + Writer.write_char writer ' '; + Writer.write_string writer status; + Writer.write_string writer "\r\n"; + Writer.write_headers writer response.headers; + Writer.write_string writer "\r\n"; + Writer.write_body writer body + +(* request parsers *) + +open Eio.Buf_read.Syntax +module Buf_read = Eio.Buf_read + +let meth = + let+ meth = Reader.(token <* space) in + Http.Method.of_string meth + +let resource = Reader.(take_while1 (fun c -> c != ' ') <* space) + +let[@warning "-3"] http_request t = + match Buf_read.at_end_of_input t with + | true -> Stdlib.raise_notrace End_of_file + | false -> + let meth = meth t in + let resource = resource t in + let version = Reader.(version <* crlf) t in + let headers = Reader.http_headers t in + let encoding = Http.Header.get_transfer_encoding headers in + { Http.Request.meth; resource; version; headers; scheme = None; encoding } + +(* main *) + +let rec handle_request reader writer flow handler = match Reader.http_request reader with | request -> let response, body = handler (request, reader, client_addr) in @@ -104,6 +132,8 @@ let connection_handler (handler : handler) flow client_addr = in Write.with_flow flow (fun writer -> handle_request client_addr reader writer flow handler) + Writer.wakeup writer; + raise ex let run_domain ssock handler = let on_error exn = diff --git a/cohttp-eio/tests/test_chunk_server.ml b/cohttp-eio/tests/test_chunk_server.ml index 72e9c8c7e1..90e8114c11 100644 --- a/cohttp-eio/tests/test_chunk_server.ml +++ b/cohttp-eio/tests/test_chunk_server.ml @@ -15,7 +15,7 @@ let app (req, reader, _client_addr) = Buffer.contents chunk_buf |> Format.asprintf "%a@ %s%!" Http.Request.pp req |> Server.text_response - | exception Invalid_argument _ -> Server.bad_request_response) + | None -> Server.bad_request_response) | _ -> Server.not_found_response let () = diff --git a/cohttp-eio/tests/test_get_post.t b/cohttp-eio/tests/test_get_post.t index 71f0947670..2847f64083 100644 --- a/cohttp-eio/tests/test_get_post.t +++ b/cohttp-eio/tests/test_get_post.t @@ -26,10 +26,10 @@ The test should respond with error message since we are trying to read request b > > EOF HTTP/1.1 200 OK - content-length: 59 + content-length: 4 content-type: text/plain; charset=UTF-8 - Request with HTTP method 'GET' doesn't support request body + PASS $ kill ${running_pid} Test POST From 6243c13c0e32302be04ee0dc06c9ef95457de796 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Fri, 10 Jun 2022 22:57:11 +0100 Subject: [PATCH 2/9] eio(client): fix ci task 'build-test-cohttp-eio' --- cohttp-eio.opam | 1 + cohttp-eio/examples/client1.ml | 16 ++++++++++++++ cohttp-eio/src/body.ml | 29 ++++++++++++++----------- cohttp-eio/src/client.ml | 21 ++++++++++-------- cohttp-eio/src/cohttp_eio.mli | 23 ++++++++++---------- cohttp-eio/src/{reader.ml => parser.ml} | 2 ++ cohttp-eio/src/server.ml | 8 +++---- dune-project | 1 + 8 files changed, 64 insertions(+), 37 deletions(-) rename cohttp-eio/src/{reader.ml => parser.ml} (93%) diff --git a/cohttp-eio.opam b/cohttp-eio.opam index fa6e487aa1..04ce70a729 100644 --- a/cohttp-eio.opam +++ b/cohttp-eio.opam @@ -27,6 +27,7 @@ depends: [ "cstruct" "bigstringaf" "fmt" + "uri" "mdx" {with-test} "eio_main" {with-test} "http" {= version} diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index e69de29bb2..d5f211e915 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -0,0 +1,16 @@ +(* Contributed by @patricoferris *) + +open Eio +open Cohttp_eio + +let () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + let res = + Client.get + ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) + env sw + (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) + (Uri.of_string "/") + in + match Client.read_fixed res with Some b -> print_string b | None -> () diff --git a/cohttp-eio/src/body.ml b/cohttp-eio/src/body.ml index 220f2a87eb..4f1c157826 100644 --- a/cohttp-eio/src/body.ml +++ b/cohttp-eio/src/body.ml @@ -44,7 +44,7 @@ let pp_chunk fmt = function fmt chunk | Last_chunk extensions -> pp_chunk_extension fmt extensions -open Reader +open Parser open Eio.Buf_read let read_fixed t headers = @@ -72,8 +72,7 @@ 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 --*) @@ -83,31 +82,35 @@ 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 = diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index 5fdd6d7ff9..e636cd368b 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -1,21 +1,24 @@ module Buf_read = Eio.Buf_read type response = Http.Response.t * Buf_read.t +type env = < net : Eio.Net.t > -type body_disallowed_call = +type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - Eio.Stdenv.t -> + (< env ; .. > as 'a) -> 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 = +type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - Eio.Stdenv.t -> + (< env ; .. > as 'a) -> Eio.Switch.t -> Eio.Net.Sockaddr.stream -> Uri.t -> @@ -40,7 +43,7 @@ let is_digit = function '0' .. '9' -> true | _ -> false open Buf_read.Syntax let status_code = - let open Reader in + let open Parser in let+ status = take_while1 is_digit in Http.Status.of_int (int_of_string status) @@ -54,10 +57,10 @@ 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 + let version = Parser.(version <* space) buf_read in + let status = Parser.(status_code <* space) buf_read in + let () = Parser.(reason_phrase *> crlf *> return ()) buf_read in + let headers = Parser.http_headers buf_read in Http.Response.make ~version ~status ~headers () (* Generic HTTP call *) diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index 2cd66d6ef3..4cdc751585 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -99,11 +99,12 @@ end module Client : sig type response = Http.Response.t * Eio.Buf_read.t + type env = < net : Eio.Net.t > - type body_disallowed_call = + type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - Eio.Stdenv.t -> + (< env ; .. > as 'a) -> Eio.Switch.t -> Eio.Net.Sockaddr.stream -> Uri.t -> @@ -111,11 +112,11 @@ module Client : sig (** [body_disallowed_call] denotes HTTP client calls where a request is not allowed to have a request body. *) - type body_allowed_call = + type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - Eio.Stdenv.t -> + (< env ; .. > as 'a) -> Eio.Switch.t -> Eio.Net.Sockaddr.stream -> Uri.t -> @@ -130,7 +131,7 @@ module Client : sig ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - Eio.Stdenv.t -> + < env ; .. > -> Eio.Switch.t -> Eio.Net.Sockaddr.stream -> Uri.t -> @@ -138,15 +139,15 @@ module Client : sig (** {1 HTTP Calls with Body Disallowed} *) - val get : body_disallowed_call - val head : body_disallowed_call - val delete : body_disallowed_call + val get : 'a body_disallowed_call + val head : 'a body_disallowed_call + val delete : 'a body_disallowed_call (** {1 HTTP Calls with Body Allowed} *) - val post : body_allowed_call - val put : body_allowed_call - val patch : body_allowed_call + val post : 'a body_allowed_call + val put : 'a body_allowed_call + val patch : 'a body_allowed_call (** {1 Response Body} *) diff --git a/cohttp-eio/src/reader.ml b/cohttp-eio/src/parser.ml similarity index 93% rename from cohttp-eio/src/reader.ml rename to cohttp-eio/src/parser.ml index 31697f1ac4..7d2722fca8 100644 --- a/cohttp-eio/src/reader.ml +++ b/cohttp-eio/src/parser.ml @@ -1,3 +1,5 @@ +(* Encapsulate refactored/common parser between Client and Server module. *) + open Eio.Buf_read open Eio.Buf_read.Syntax diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml index 06fc9e0fb6..49fa31c6ee 100644 --- a/cohttp-eio/src/server.ml +++ b/cohttp-eio/src/server.ml @@ -93,10 +93,10 @@ open Eio.Buf_read.Syntax module Buf_read = Eio.Buf_read let meth = - let+ meth = Reader.(token <* space) in + let+ meth = Parser.(token <* space) in Http.Method.of_string meth -let resource = Reader.(take_while1 (fun c -> c != ' ') <* space) +let resource = Parser.(take_while1 (fun c -> c != ' ') <* space) let[@warning "-3"] http_request t = match Buf_read.at_end_of_input t with @@ -104,8 +104,8 @@ let[@warning "-3"] http_request t = | false -> let meth = meth t in let resource = resource t in - let version = Reader.(version <* crlf) t in - let headers = Reader.http_headers t in + let version = Parser.(version <* crlf) t in + let headers = Parser.http_headers t in let encoding = Http.Header.get_transfer_encoding headers in { Http.Request.meth; resource; version; headers; scheme = None; encoding } diff --git a/dune-project b/dune-project index dff414491c..fd832c5526 100644 --- a/dune-project +++ b/dune-project @@ -345,6 +345,7 @@ should also be fine under Windows too. cstruct bigstringaf fmt + uri (mdx :with-test) (eio_main :with-test) (http From 7f870d149b56fdc92dbb3f8607d24ccd6a2fada2 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Mon, 25 Jul 2022 15:05:14 +0100 Subject: [PATCH 3/9] eio(client): add example cohttp-eio client usage --- .ocamlformat | 2 +- cohttp-eio/examples/client1.ml | 18 ++++++++++++++---- cohttp-eio/examples/dune | 2 +- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index ccb7749a80..1ba7448c15 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.21.0 +version=0.24.1 profile=conventional break-infix=fit-or-vertical parse-docstrings=true diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index d5f211e915..12e753c784 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -1,16 +1,26 @@ -(* Contributed by @patricoferris *) - open Eio open Cohttp_eio +let connect_info url = + let uri = Uri.of_string url in + let host = Uri.host uri |> Option.get in + let port = Uri.port uri |> Option.value ~default:80 in + let path = Uri.of_string (Uri.path uri) in + let addr = + let he = Unix.gethostbyname host in + he.h_addr_list.(0) + in + (Eio_unix.Ipaddr.of_unix addr, port, path) + let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> + let (addr, port, path) = connect_info "http://www.reddit.com/" in let res = Client.get ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) env sw - (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) - (Uri.of_string "/") + (`Tcp (addr, port)) + path in match Client.read_fixed res with Some b -> print_string b | None -> () diff --git a/cohttp-eio/examples/dune b/cohttp-eio/examples/dune index 4dc99c490c..c16132c348 100644 --- a/cohttp-eio/examples/dune +++ b/cohttp-eio/examples/dune @@ -1,6 +1,6 @@ (executables (names server1 client1) - (libraries cohttp-eio uri eio_main)) + (libraries cohttp-eio uri eio_main eio.unix unix)) (alias (name runtest) From bb1f0d3d2b8c572956718ad6fcd6f3a7ce5b9eef Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Mon, 25 Jul 2022 16:14:20 +0100 Subject: [PATCH 4/9] eio(client): add get, post test --- .ocamlformat | 2 +- cohttp-eio/examples/client1.ml | 4 ++-- cohttp-eio/tests/dune | 14 ++++++++++-- cohttp-eio/tests/test_client.ml | 38 +++++++++++++++++++++++++++++++++ cohttp-eio/tests/test_client.t | 25 ++++++++++++++++++++++ cohttp-eio/tests/test_server.ml | 32 ++++++++++++++++----------- 6 files changed, 98 insertions(+), 17 deletions(-) create mode 100644 cohttp-eio/tests/test_client.ml create mode 100644 cohttp-eio/tests/test_client.t diff --git a/.ocamlformat b/.ocamlformat index 1ba7448c15..ccb7749a80 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.24.1 +version=0.21.0 profile=conventional break-infix=fit-or-vertical parse-docstrings=true diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index 12e753c784..2004eaec14 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -2,7 +2,7 @@ open Eio open Cohttp_eio let connect_info url = - let uri = Uri.of_string url in + let uri = Uri.of_string url in let host = Uri.host uri |> Option.get in let port = Uri.port uri |> Option.value ~default:80 in let path = Uri.of_string (Uri.path uri) in @@ -15,7 +15,7 @@ let connect_info url = let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> - let (addr, port, path) = connect_info "http://www.reddit.com/" in + let addr, port, path = connect_info "http://www.reddit.com/" in let res = Client.get ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) diff --git a/cohttp-eio/tests/dune b/cohttp-eio/tests/dune index c7dfde49c0..2425f61bac 100644 --- a/cohttp-eio/tests/dune +++ b/cohttp-eio/tests/dune @@ -17,12 +17,22 @@ (package cohttp-eio) (packages cohttp-eio)) +(executable + (name test_client) + (modules test_client) + (libraries eio_main uri cohttp-eio)) + (env (_ (binaries (test_server.exe as test-server) crlf.exe - (test_chunk_server.exe as test-chunk-server)))) + (test_chunk_server.exe as test-chunk-server) + (test_client.exe as test-client)))) (cram - (deps %{bin:test-server} %{bin:test-chunk-server} %{bin:crlf})) + (deps + %{bin:test-server} + %{bin:test-chunk-server} + %{bin:crlf} + %{bin:test-client})) diff --git a/cohttp-eio/tests/test_client.ml b/cohttp-eio/tests/test_client.ml new file mode 100644 index 0000000000..05f1d81c32 --- /dev/null +++ b/cohttp-eio/tests/test_client.ml @@ -0,0 +1,38 @@ +open Eio +open Cohttp_eio + +let get () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + let res = + Client.get + ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) + env sw + (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) + (Uri.of_string "/get") + in + match Client.read_fixed res with Some s -> print_string s | None -> () + +let post () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + let content = "hello world!" in + let content_length = String.length content |> string_of_int in + let res = + Client.post + ~headers: + (Http.Header.of_list + [ + ("Accept", "application/json"); ("Content-Length", content_length); + ]) + ~body:(Body.Fixed content) env sw + (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) + (Uri.of_string "/post") + in + match Client.read_fixed res with Some s -> print_string s | None -> () + +let () = + match Sys.argv.(1) with + | "get" -> get () + | "post" -> post () + | _ -> print_string "Usage: test-client [get|post]" diff --git a/cohttp-eio/tests/test_client.t b/cohttp-eio/tests/test_client.t new file mode 100644 index 0000000000..460db5c32e --- /dev/null +++ b/cohttp-eio/tests/test_client.t @@ -0,0 +1,25 @@ +Test Client.get + + $ test-server & + $ running_pid=$! + $ test-client get + meth: GET + resource: /get + version: HTTP/1.1 + headers: Header { Accept = "application/json" } + + $ kill ${running_pid} + +Test Client.post + + $ test-server & + $ running_pid=$! + $ test-client post + meth: POST + resource: /post + version: HTTP/1.1 + headers: Header { Accept = "application/json"; Content-Length = "12" } + + hello world! + + $ kill ${running_pid} diff --git a/cohttp-eio/tests/test_server.ml b/cohttp-eio/tests/test_server.ml index 1a35b19848..5e1fa5e194 100644 --- a/cohttp-eio/tests/test_server.ml +++ b/cohttp-eio/tests/test_server.ml @@ -1,18 +1,26 @@ open Cohttp_eio -let read_body req reader = - let body = Server.read_fixed req reader in - Server.text_response @@ Fmt.str "%a\n\n%s" Http.Request.pp req body - -let app (req, reader, _client_addr) = +let app (req, reader,_) = match Http.Request.resource req with - | "/get" -> Server.text_response (Fmt.to_to_string Http.Request.pp req) + | "/get" -> + let buf = Buffer.create 0 in + let fmt = Format.formatter_of_buffer buf in + Http.Request.pp fmt req; + Format.fprintf fmt "%!"; + Server.text_response (Buffer.contents buf) | "/get_error" -> ( - try - let _ = Server.read_fixed req reader in - assert false - with Invalid_argument e -> Server.text_response e) - | "/post" -> read_body req reader + match Server.read_fixed (req, reader) with + | Some _ -> Server.text_response "FAIL" + | None -> Server.text_response "PASS") + | "/post" -> + let body = Server.read_fixed (req, reader) |> Option.get in + let buf = Buffer.create 0 in + let fmt = Format.formatter_of_buffer buf in + Http.Request.pp fmt req; + Format.fprintf fmt "\n\n%s%!" body; + Server.text_response (Buffer.contents buf) | _ -> Server.bad_request_response -let () = Eio_main.run @@ fun env -> Server.run ~port:8080 env app +let () = + Eio_main.run @@ fun env -> + Eio.Switch.run @@ fun sw -> Server.run ~port:8080 env sw app From 749d41856bd8df52a781fdf7e70966e93813f308 Mon Sep 17 00:00:00 2001 From: Bikal Gurung Date: Wed, 3 Aug 2022 16:00:48 +0100 Subject: [PATCH 5/9] eio(client): replace Writer with Eio.Buf_write --- .ocamlformat | 1 - cohttp-eio.opam | 5 -- cohttp-eio/examples/client1.ml | 26 ++---- cohttp-eio/examples/docker_client.ml | 27 ++++++ cohttp-eio/examples/dune | 4 +- cohttp-eio/src/body.ml | 96 ++++++++++------------ cohttp-eio/src/client.ml | 101 +++++++++++------------ cohttp-eio/src/cohttp_eio.mli | 68 ++++++++++------ cohttp-eio/src/dune | 2 +- cohttp-eio/src/parser.ml | 49 ----------- cohttp-eio/src/rwer.ml | 65 +++++++++++++++ cohttp-eio/src/server.ml | 69 ++++++---------- cohttp-eio/tests/dune | 27 +----- cohttp-eio/tests/test_chunk.t | 54 ------------ cohttp-eio/tests/test_chunk_server.ml | 27 ------ cohttp-eio/tests/test_client.ml | 45 ++++++---- cohttp-eio/tests/test_client.t | 16 ++-- cohttp-eio/tests/test_get_post.t | 57 ------------- cohttp-eio/tests/test_server.ml | 27 ++++-- cohttp-eio/tests/test_server.t | 113 ++++++++++++++++++++++++++ dune-project | 5 -- 21 files changed, 445 insertions(+), 439 deletions(-) create mode 100644 cohttp-eio/examples/docker_client.ml delete mode 100644 cohttp-eio/src/parser.ml create mode 100644 cohttp-eio/src/rwer.ml delete mode 100644 cohttp-eio/tests/test_chunk.t delete mode 100644 cohttp-eio/tests/test_chunk_server.ml delete mode 100644 cohttp-eio/tests/test_get_post.t create mode 100644 cohttp-eio/tests/test_server.t diff --git a/.ocamlformat b/.ocamlformat index ccb7749a80..ad45d296ad 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,3 @@ -version=0.21.0 profile=conventional break-infix=fit-or-vertical parse-docstrings=true diff --git a/cohttp-eio.opam b/cohttp-eio.opam index 04ce70a729..83ff59df4e 100644 --- a/cohttp-eio.opam +++ b/cohttp-eio.opam @@ -23,13 +23,8 @@ depends: [ "base-domains" "eio" {>= "0.4"} "eio_main" {with-test} - "uri" {with-test} - "cstruct" - "bigstringaf" "fmt" - "uri" "mdx" {with-test} - "eio_main" {with-test} "http" {= version} "odoc" {with-doc} ] diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index 2004eaec14..074558678b 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -1,26 +1,16 @@ open Eio open Cohttp_eio -let connect_info url = - let uri = Uri.of_string url in - let host = Uri.host uri |> Option.get in - let port = Uri.port uri |> Option.value ~default:80 in - let path = Uri.of_string (Uri.path uri) in - let addr = - let he = Unix.gethostbyname host in - he.h_addr_list.(0) - in - (Eio_unix.Ipaddr.of_unix addr, port, path) +let conn env sw () = + let hostname, port = ("www.example.org", 80) in + let he = Unix.gethostbyname hostname in + let addr = `Tcp (Eio_unix.Ipaddr.of_unix he.h_addr_list.(0), port) in + let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let host = (hostname, Some port) in + (host, flow) let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> - let addr, port, path = connect_info "http://www.reddit.com/" in - let res = - Client.get - ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) - env sw - (`Tcp (addr, port)) - path - in + let res = Client.get (conn env sw) "/" in match Client.read_fixed res with Some b -> print_string b | None -> () diff --git a/cohttp-eio/examples/docker_client.ml b/cohttp-eio/examples/docker_client.ml new file mode 100644 index 0000000000..6d92b05bac --- /dev/null +++ b/cohttp-eio/examples/docker_client.ml @@ -0,0 +1,27 @@ +module Switch = Eio.Switch +module Net = Eio.Net +module Stdenv = Eio.Stdenv +module Client = Cohttp_eio.Client +module Response = Http.Response +module Status = Http.Status + +let conn env sw () = + let hostname = "docker" in + let addr = `Unix "/var/run/docker.sock" in + let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let host = (hostname, None) in + (host, flow) + +let () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + let res = Client.get (conn env sw) "/version" in + let code = fst res |> Response.status |> Status.to_int in + Printf.printf "Response code: %d\n" code; + Printf.printf "Headers: %s\n" + (fst res |> Response.headers |> Http.Header.to_string); + match Client.read_fixed res with + | Some body -> + Printf.printf "Body of length: %d\n" (String.length body); + print_endline ("Received body\n" ^ body) + | None -> () diff --git a/cohttp-eio/examples/dune b/cohttp-eio/examples/dune index c16132c348..864956b4bb 100644 --- a/cohttp-eio/examples/dune +++ b/cohttp-eio/examples/dune @@ -1,6 +1,6 @@ (executables - (names server1 client1) - (libraries cohttp-eio uri eio_main eio.unix unix)) + (names server1 client1 docker_client) + (libraries cohttp-eio eio_main eio.unix unix)) (alias (name runtest) diff --git a/cohttp-eio/src/body.ml b/cohttp-eio/src/body.ml index 4f1c157826..94e51dd398 100644 --- a/cohttp-eio/src/body.ml +++ b/cohttp-eio/src/body.ml @@ -1,9 +1,10 @@ -module Write = Eio.Buf_write +module Buf_read = Eio.Buf_read +module Buf_write = Eio.Buf_write type t = | Fixed of string | Chunked of chunk_writer - | Custom of (Write.t -> unit) + | Custom of (Buf_write.t -> unit) | Empty and chunk_writer = { @@ -44,20 +45,15 @@ let pp_chunk fmt = function fmt chunk | Last_chunk extensions -> pp_chunk_extension fmt extensions -open Parser -open Eio.Buf_read - let read_fixed t headers = 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 + Buf_read.take content_length t (* Chunked encoding parser *) -open Eio.Buf_read.Syntax - let hex_digit = function | '0' .. '9' -> true | 'a' .. 'f' -> true @@ -65,7 +61,8 @@ let hex_digit = function | _ -> false let quoted_char = - let+ c = any_char in + let open Buf_read.Syntax in + let+ c = Buf_read.any_char in match c with | ' ' | '\t' | '\x21' .. '\x7E' -> c | c -> failwith (Printf.sprintf "Invalid escape \\%C" c) @@ -77,10 +74,10 @@ let qdtext = function (*-- quoted-string = DQUOTE *( qdtext / quoted-pair ) DQUOTE --*) let quoted_string r = - char '"' r; + Buf_read.char '"' r; let buf = Buffer.create 100 in let rec aux () = - match any_char r with + match Buf_read.any_char r with | '"' -> Buffer.contents buf | '\\' -> Buffer.add_char buf (quoted_char r); @@ -92,30 +89,32 @@ let quoted_string r = aux () let optional c x r = - let c2 = peek_char r in + let c2 = Buf_read.peek_char r in if Some c = c2 then ( - consume r 1; + Buf_read.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 + let open Buf_read.Syntax in + let* c = Buf_read.peek_char in + match c with Some '"' -> quoted_string | _ -> Rwer.token let rec chunk_exts r = - let c = peek_char r in + let c = Buf_read.peek_char r in match c with | Some ';' -> - consume r 1; - let name = token r in + Buf_read.consume r 1; + let name = Rwer.token r in let value = optional '=' chunk_ext_val r in { name; value } :: chunk_exts r | _ -> [] let chunk_size = - let* sz = take_while1 hex_digit in - try return (Format.sprintf "0x%s" sz |> int_of_string) + let open Buf_read.Syntax in + let* sz = Rwer.take_while1 hex_digit in + try Rwer.return (Format.sprintf "0x%s" sz |> int_of_string) with _ -> failwith (Format.sprintf "Invalid chunk_size: %s" sz) (* Be strict about headers allowed in trailer headers to minimize security @@ -150,21 +149,22 @@ let request_trailer_headers headers = (* Chunk decoding algorithm is explained at https://datatracker.ietf.org/doc/html/rfc7230#section-4.1.3 *) let chunk (total_read : int) (headers : Http.Header.t) = + let open Buf_read.Syntax in let* sz = chunk_size in match sz with | sz when sz > 0 -> - let* extensions = chunk_exts <* crlf in - let* data = take sz <* crlf in - return @@ `Chunk (sz, data, extensions) + let* extensions = chunk_exts <* Rwer.crlf in + let* data = Buf_read.take sz <* Rwer.crlf in + Rwer.return @@ `Chunk (sz, data, extensions) | 0 -> - let* extensions = chunk_exts <* crlf in + let* extensions = chunk_exts <* Rwer.crlf in (* Read trailer headers if any and append those to request headers. Only headers names appearing in 'Trailer' request headers and "allowed" trailer headers are appended to request. The spec at https://datatracker.ietf.org/doc/html/rfc7230#section-4.1.3 specifies that 'Content-Length' and 'Transfer-Encoding' headers must be updated. *) - let* trailer_headers = http_headers in + let* trailer_headers = Rwer.http_headers in let request_trailer_headers = request_trailer_headers headers in let trailer_headers = List.filter @@ -203,7 +203,7 @@ let chunk (total_read : int) (headers : Http.Header.t) = let headers = Http.Header.add headers "Content-Length" (string_of_int total_read) in - return @@ `Last_chunk (extensions, headers) + Rwer.return @@ `Last_chunk (extensions, headers) | sz -> failwith (Format.sprintf "Invalid chunk size: %d" sz) let read_chunked reader headers f = @@ -222,46 +222,38 @@ let read_chunked reader headers f = Some headers in chunk_loop f -<<<<<<< HEAD - | _ -> raise @@ Invalid_argument "Request is not a chunked request" - -(* Writes *) - -let write_headers t headers = - Http.Header.iter - (fun k v -> - Write.string t k; - Write.string t ": "; - Write.string t v; - Write.string t "\r\n") - headers + | _ -> None (* https://datatracker.ietf.org/doc/html/rfc7230#section-4.1 *) -let write_chunked t chunk_writer = +let write_chunked writer chunk_writer = let write_extensions exts = List.iter (fun { name; value } -> let v = match value with None -> "" | Some v -> Printf.sprintf "=%s" v in - Write.string t (Printf.sprintf ";%s%s" name v)) + Buf_write.string writer (Printf.sprintf ";%s%s" name v)) exts in let write_body = function | Chunk { size; data; extensions = exts } -> - Write.string t (Printf.sprintf "%X" size); + Buf_write.string writer (Printf.sprintf "%X" size); write_extensions exts; - Write.string t "\r\n"; - Write.string t data; - Write.string t "\r\n" + Buf_write.string writer "\r\n"; + Buf_write.string writer data; + Buf_write.string writer "\r\n" | Last_chunk exts -> - Write.string t "0"; + Buf_write.string writer "0"; write_extensions exts; - Write.string t "\r\n" + Buf_write.string writer "\r\n" in chunk_writer.body_writer write_body; - chunk_writer.trailer_writer (write_headers t); - Write.string t "\r\n" -======= - | _ -> None ->>>>>>> 7c4b2a2e (eio(client): implement Cohttp_eio.Client module) + chunk_writer.trailer_writer (Rwer.write_headers writer); + Buf_write.string writer "\r\n" + +let write_body writer body = + match body with + | Fixed s -> Buf_write.string writer s + | Chunked chunk_writer -> write_chunked writer chunk_writer + | Custom f -> f writer + | Empty -> () diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index e636cd368b..dc8b1f0164 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -1,15 +1,16 @@ module Buf_read = Eio.Buf_read +module Buf_write = Eio.Buf_write type response = Http.Response.t * Buf_read.t -type env = < net : Eio.Net.t > +type host = string * int option +type resource_path = string +type 'a conn = unit -> (host * Eio.Flow.two_way as 'a) type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - (< env ; .. > as 'a) -> - Eio.Switch.t -> - Eio.Net.Sockaddr.stream -> - Uri.t -> + 'a conn -> + resource_path -> response (** [body_disallowed_call] denotes HTTP client calls where a request is not allowed to have a request body. *) @@ -18,32 +19,29 @@ type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - (< env ; .. > as 'a) -> - Eio.Switch.t -> - Eio.Net.Sockaddr.stream -> - Uri.t -> + 'a conn -> + resource_path -> 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 +let write_request writer (meth, version, headers, resource_path, body) = + Buf_write.string writer (Http.Method.to_string meth); + Buf_write.char writer ' '; + Buf_write.string writer resource_path; + Buf_write.char writer ' '; + Buf_write.string writer (Http.Version.to_string version); + Buf_write.string writer "\r\n"; + Rwer.write_headers writer headers; + Buf_write.string writer "\r\n"; + Body.write_body writer body (* response parser *) let is_digit = function '0' .. '9' -> true | _ -> false -open Buf_read.Syntax - let status_code = - let open Parser in + let open Rwer in + let open Buf_read.Syntax in let+ status = take_while1 is_digit in Http.Status.of_int (int_of_string status) @@ -54,53 +52,56 @@ let reason_phrase = (* https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.2 *) let response buf_read = + let open Buf_read.Syntax in match Buf_read.at_end_of_input buf_read with | true -> Stdlib.raise_notrace End_of_file | false -> - let version = Parser.(version <* space) buf_read in - let status = Parser.(status_code <* space) buf_read in - let () = Parser.(reason_phrase *> crlf *> return ()) buf_read in - let headers = Parser.http_headers buf_read in + let version = Rwer.(version <* space) buf_read in + let status = Rwer.(status_code <* space) buf_read in + let () = Rwer.(reason_phrase *> crlf *> return ()) buf_read in + let headers = Rwer.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) + ?(body = Body.Empty) flow_fn resource_path = + let (host_name, host_port), flow = flow_fn () in + let host = + match host_port with + | Some port -> host_name ^ ":" ^ string_of_int port + | None -> host_name in - let response = response reader in - (response, reader) + Buf_write.with_flow ~initial_size:0x1000 flow (fun writer -> + let headers = Http.Header.add_unless_exists headers "Host" host in + write_request writer (meth, version, headers, resource_path, body); + let reader = + Eio.Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int flow + 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 get ?version ?headers stream uri = + call ~meth:`GET ?version ?headers stream uri -let head ?version ?headers env sw stream uri = - call ~meth:`HEAD ?version ?headers env sw stream uri +let head ?version ?headers stream uri = + call ~meth:`HEAD ?version ?headers stream uri -let delete ?version ?headers env sw stream uri = - call ~meth:`DELETE ?version ?headers env sw stream uri +let delete ?version ?headers stream uri = + call ~meth:`DELETE ?version ?headers 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 post ?version ?headers ?body stream uri = + call ~meth:`POST ?version ?headers ?body stream uri -let put ?version ?headers ?body env sw stream uri = - call ~meth:`PUT ?version ?headers ?body env sw stream uri +let put ?version ?headers ?body stream uri = + call ~meth:`PUT ?version ?headers ?body stream uri -let patch ?version ?headers ?body env sw stream uri = - call ~meth:`PATCH ?version ?headers ?body env sw stream uri +let patch ?version ?headers ?body stream uri = + call ~meth:`PATCH ?version ?headers ?body stream uri (* Response Body *) diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index 4cdc751585..10fdefda6d 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -37,26 +37,29 @@ module Server : sig (** {1 Request Body} *) - val read_fixed : request -> string option + val read_fixed : Http.Request.t -> Eio.Buf_read.t -> 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]. [buf_read] is updated to reflect that [n] bytes was read. - If ["Content-Length"] header is missing or is an invalid value in + 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 + val read_chunked : + Http.Request.t -> + Eio.Buf_read.t -> + (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. - [reader] is updated to reflect the number of bytes read. - Returns [None] if [Transfer-Encoding] header in [headers] is not specified - as "chunked" *) + //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" *) (** {1 Response} *) @@ -99,30 +102,51 @@ end module Client : sig type response = Http.Response.t * Eio.Buf_read.t - type env = < net : Eio.Net.t > + + type host = string * int option + (** Represents a server host domain name and port, e.g. www.example.org:8080, + www.reddit.com *) + + type resource_path = string + (** Represents HTTP request resource path, e.g. "/shop/purchase", + "/shop/items", "/shop/categories/" etc. *) + + type 'a conn = unit -> (host * Eio.Flow.two_way as 'a) + (** [a 'conn] is [(host, flow)] where [host] represents a server host domain name + or address along with the optional tcp/ip port. + + [flow] is the Eio flow value which is connected to the [host]. *) type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - (< env ; .. > as 'a) -> - Eio.Switch.t -> - Eio.Net.Sockaddr.stream -> - Uri.t -> + 'a conn -> + resource_path -> response (** [body_disallowed_call] denotes HTTP client calls where a request is not - allowed to have a request body. *) + allowed to have a request body. + + It is a lambda [fun ?version ?headers conn_fn uri -> .. response)]. The + [uri] represents a valid and full http uri, e.g. + http://www.example.org/hello?q=123 + + @raise invalid_arg If [uri] doesn't containt full and valid HTTP uri *) type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - (< env ; .. > as 'a) -> - Eio.Switch.t -> - Eio.Net.Sockaddr.stream -> - Uri.t -> + 'a conn -> + resource_path -> response - (** [body_allowed_call] denotes HTTP client calls where a request is allowed - to have a request body. *) + (** [body_allowed_call] denotes HTTP client calls where a request can + optionally have a request body. + + It is a lambda [fun ?version ?headers ?body conn_fn uri -> .. response)]. + The [uri] represents a valid and full http uri, e.g. + http://www.example.org/hello?q=123 + + @raise invalid_arg If [uri] doesn't containt full and valid HTTP uri *) (** {1 Generic HTTP call} *) @@ -131,10 +155,8 @@ module Client : sig ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - < env ; .. > -> - Eio.Switch.t -> - Eio.Net.Sockaddr.stream -> - Uri.t -> + 'a conn -> + resource_path -> response (** {1 HTTP Calls with Body Disallowed} *) diff --git a/cohttp-eio/src/dune b/cohttp-eio/src/dune index 3d1f0d9120..e8cea3850e 100644 --- a/cohttp-eio/src/dune +++ b/cohttp-eio/src/dune @@ -1,4 +1,4 @@ (library (name cohttp_eio) (public_name cohttp-eio) - (libraries eio cstruct http bigstringaf fmt uri)) + (libraries eio http fmt)) diff --git a/cohttp-eio/src/parser.ml b/cohttp-eio/src/parser.ml deleted file mode 100644 index 7d2722fca8..0000000000 --- a/cohttp-eio/src/parser.ml +++ /dev/null @@ -1,49 +0,0 @@ -(* Encapsulate refactored/common parser between Client and Server module. *) - -open Eio.Buf_read -open Eio.Buf_read.Syntax - -let return v _ = v - -let take_while1 p r = - match take_while p r with - | "" -> failwith "[take_while1] count is less than 1" - | x -> x - -let token = - take_while1 (function - | '0' .. '9' - | 'a' .. 'z' - | 'A' .. 'Z' - | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '.' | '^' | '_' - | '`' | '|' | '~' -> - true - | _ -> false) - -let ows = skip_while (function ' ' | '\t' -> true | _ -> false) -let crlf = string "\r\n" -let not_cr = function '\r' -> false | _ -> true -let space = char '\x20' - -let version = - let* v = string "HTTP/1." *> any_char in - match v with - | '1' -> return `HTTP_1_1 - | '0' -> return `HTTP_1_0 - | v -> failwith (Format.sprintf "Invalid HTTP version: %C" v) - -let header = - let+ key = token <* char ':' <* ows and+ value = take_while not_cr <* crlf in - (key, value) - -let http_headers r = - let[@tail_mod_cons] rec aux () = - match peek_char r with - | Some '\r' -> - crlf r; - [] - | _ -> - let h = header r in - h :: aux () - in - Http.Header.of_list (aux ()) diff --git a/cohttp-eio/src/rwer.ml b/cohttp-eio/src/rwer.ml new file mode 100644 index 0000000000..d417c436b7 --- /dev/null +++ b/cohttp-eio/src/rwer.ml @@ -0,0 +1,65 @@ +(* This modules encapsulates refactored - common - readers and writers + used by the Client and Server modules. + + rwer.ml => (R)eader (W)riter + er +*) + +module Buf_read = Eio.Buf_read +module Buf_write = Eio.Buf_write + +let return v _ = v + +let take_while1 p r = + match Buf_read.take_while p r with + | "" -> failwith "[take_while1] count is less than 1" + | x -> x + +let token = + take_while1 (function + | '0' .. '9' + | 'a' .. 'z' + | 'A' .. 'Z' + | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '.' | '^' | '_' + | '`' | '|' | '~' -> + true + | _ -> false) + +let ows = Buf_read.skip_while (function ' ' | '\t' -> true | _ -> false) +let crlf = Buf_read.string "\r\n" +let not_cr = function '\r' -> false | _ -> true +let space = Buf_read.char '\x20' + +let version = + let open Eio.Buf_read.Syntax in + let* v = Buf_read.string "HTTP/1." *> Buf_read.any_char in + match v with + | '1' -> return `HTTP_1_1 + | '0' -> return `HTTP_1_0 + | v -> failwith (Format.sprintf "Invalid HTTP version: %C" v) + +let header = + let open Eio.Buf_read.Syntax in + let+ key = token <* Buf_read.char ':' <* ows + and+ value = Buf_read.take_while not_cr <* crlf in + (key, value) + +let http_headers r = + let[@tail_mod_cons] rec aux () = + match Buf_read.peek_char r with + | Some '\r' -> + crlf r; + [] + | _ -> + let h = header r in + h :: aux () + in + Http.Header.of_list (aux ()) + +let write_headers writer headers = + Http.Header.iter + (fun k v -> + Buf_write.string writer k; + Buf_write.string writer ": "; + Buf_write.string writer v; + Buf_write.string writer "\r\n") + headers diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml index 49fa31c6ee..00607c99a7 100644 --- a/cohttp-eio/src/server.ml +++ b/cohttp-eio/src/server.ml @@ -1,5 +1,6 @@ -open Eio.Std -module Write = Eio.Buf_write +module Buf_read = Eio.Buf_read +module Buf_write = Eio.Buf_write +module Switch = Eio.Switch type middleware = handler -> handler and handler = request -> response @@ -18,8 +19,8 @@ let read_fixed request reader = | `POST | `PUT | `PATCH -> Body.read_fixed reader request.headers | _ -> None -let read_chunked : request -> (Body.chunk -> unit) -> Http.Header.t option = - fun (request, reader, _) f -> Body.read_chunked reader request.headers f +let read_chunked request reader f = + Body.read_chunked reader (Http.Request.headers request) f (* Responses *) @@ -59,60 +60,44 @@ let internal_server_error_response = let bad_request_response = (Http.Response.make ~status:`Bad_request (), Body.Empty) -let write_response (writer : Write.t) - ((response, body) : Http.Response.t * Body.t) = +let write_response writer ((response, body) : Http.Response.t * Body.t) = let version = Http.Version.to_string response.version in let status = Http.Status.to_string response.status in - Write.string writer version; - Write.string writer " "; - Write.string writer status; - Write.string writer "\r\n"; - Body.write_headers writer response.headers; - Write.string writer "\r\n"; - match body with - | Fixed s -> Write.string writer s - | Chunked chunk_writer -> Body.write_chunked writer chunk_writer - | Custom f -> f writer - | Empty -> () - -(* main *) - -let rec handle_request client_addr reader writer flow handler = - match Reader.http_request reader with - Writer.write_string writer version; - Writer.write_char writer ' '; - Writer.write_string writer status; - Writer.write_string writer "\r\n"; - Writer.write_headers writer response.headers; - Writer.write_string writer "\r\n"; - Writer.write_body writer body + Buf_write.string writer version; + Buf_write.char writer ' '; + Buf_write.string writer status; + Buf_write.string writer "\r\n"; + Rwer.write_headers writer response.headers; + Buf_write.string writer "\r\n"; + Body.write_body writer body (* request parsers *) -open Eio.Buf_read.Syntax -module Buf_read = Eio.Buf_read - let meth = - let+ meth = Parser.(token <* space) in + let open Eio.Buf_read.Syntax in + let+ meth = Rwer.(token <* space) in Http.Method.of_string meth -let resource = Parser.(take_while1 (fun c -> c != ' ') <* space) +let resource = + let open Eio.Buf_read.Syntax in + Rwer.(take_while1 (fun c -> c != ' ') <* space) let[@warning "-3"] http_request t = + let open Eio.Buf_read.Syntax in match Buf_read.at_end_of_input t with | true -> Stdlib.raise_notrace End_of_file | false -> let meth = meth t in let resource = resource t in - let version = Parser.(version <* crlf) t in - let headers = Parser.http_headers t in + let version = Rwer.(version <* crlf) t in + let headers = Rwer.http_headers t in let encoding = Http.Header.get_transfer_encoding headers in { Http.Request.meth; resource; version; headers; scheme = None; encoding } (* main *) -let rec handle_request reader writer flow handler = - match Reader.http_request reader with +let rec handle_request client_addr reader writer flow handler = + match http_request reader with | request -> let response, body = handler (request, reader, client_addr) in write_response writer (response, body); @@ -127,13 +112,9 @@ let rec handle_request reader writer flow handler = raise ex let connection_handler (handler : handler) flow client_addr = - let reader = - Eio.Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int flow - in - Write.with_flow flow (fun writer -> + let reader = Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int flow in + Buf_write.with_flow flow (fun writer -> handle_request client_addr reader writer flow handler) - Writer.wakeup writer; - raise ex let run_domain ssock handler = let on_error exn = diff --git a/cohttp-eio/tests/dune b/cohttp-eio/tests/dune index 2425f61bac..55556d238c 100644 --- a/cohttp-eio/tests/dune +++ b/cohttp-eio/tests/dune @@ -1,38 +1,17 @@ -(executable - (name test_server) - (modules test_server) +(executables + (names test_server test_client crlf) (libraries cohttp_eio eio_main fmt)) -(executable - (name test_chunk_server) - (modules test_chunk_server) - (libraries cohttp_eio eio_main fmt)) - -(executable - (name crlf) - (modules crlf) - (libraries unix)) - (mdx (package cohttp-eio) (packages cohttp-eio)) -(executable - (name test_client) - (modules test_client) - (libraries eio_main uri cohttp-eio)) - (env (_ (binaries (test_server.exe as test-server) crlf.exe - (test_chunk_server.exe as test-chunk-server) (test_client.exe as test-client)))) (cram - (deps - %{bin:test-server} - %{bin:test-chunk-server} - %{bin:crlf} - %{bin:test-client})) + (deps %{bin:test-server} %{bin:crlf} %{bin:test-client})) diff --git a/cohttp-eio/tests/test_chunk.t b/cohttp-eio/tests/test_chunk.t deleted file mode 100644 index a0bc7c2197..0000000000 --- a/cohttp-eio/tests/test_chunk.t +++ /dev/null @@ -1,54 +0,0 @@ -Test chunk request processing. -1. Test chunks -2. Test chunk extension parsing -3. Test chunk trailer header processing. Specifically, the in the test sample below - - $ port=8081 - $ test-chunk-server -p ${port} & - $ running_pid=$! - $ crlf << EOF | ncat localhost ${port} - > POST / HTTP/1.1 - > Content-Type: text/plain - > Transfer-Encoding: chunked - > Trailer: Expires, Header1 - > - > 7;ext1=ext1_v;ext2=ext2_v;ext3 - > Mozilla - > 9 - > Developer - > 7 - > Network - > 0 - > Expires: Wed, 21 Oct 2015 07:28:00 GMT - > Header1: Header1 value text - > Header2: Header2 value text - > - > EOF - HTTP/1.1 200 OK - content-length: 342 - content-type: text/plain; charset=UTF-8 - - meth: POST - resource: / - version: HTTP/1.1 - headers: Header { - Content-Length = "23"; Header1 = "Header1 value text"; - Content-Type = "text/plain" } - - size: 7 - data: Mozilla - extensions: - name: ext1 - value: ext1_v; - name: ext2 - value: ext2_v; - name: ext3 - value: - size: 9 - data: Developer - extensions: - size: 7 - data: Network - extensions: - - $ kill ${running_pid} diff --git a/cohttp-eio/tests/test_chunk_server.ml b/cohttp-eio/tests/test_chunk_server.ml deleted file mode 100644 index 90e8114c11..0000000000 --- a/cohttp-eio/tests/test_chunk_server.ml +++ /dev/null @@ -1,27 +0,0 @@ -open Cohttp_eio -open Cohttp_eio.Server - -let dump_chunk buf chunk = - let s = Format.asprintf "\n%a" Body.pp_chunk chunk in - Buffer.add_string buf s - -let app (req, reader, _client_addr) = - match Http.Request.resource req with - | "/" -> ( - let chunk_buf = Buffer.create 0 in - match Server.read_chunked req reader (dump_chunk chunk_buf) with - | headers -> - let req = { req with headers } in - Buffer.contents chunk_buf - |> Format.asprintf "%a@ %s%!" Http.Request.pp req - |> Server.text_response - | None -> Server.bad_request_response) - | _ -> Server.not_found_response - -let () = - let port = ref 8080 in - Arg.parse - [ ("-p", Arg.Set_int port, " Listening port number(8080 by default)") ] - ignore "An HTTP/1.1 server"; - - Eio_main.run @@ fun env -> run ~port:!port env app diff --git a/cohttp-eio/tests/test_client.ml b/cohttp-eio/tests/test_client.ml index 05f1d81c32..c10d36b494 100644 --- a/cohttp-eio/tests/test_client.ml +++ b/cohttp-eio/tests/test_client.ml @@ -1,21 +1,23 @@ -open Eio +module Net = Eio.Net +module Stdenv = Eio.Stdenv +module Switch = Eio.Switch open Cohttp_eio -let get () = - Eio_main.run @@ fun env -> - Switch.run @@ fun sw -> +let conn env sw port () = + let addr = `Tcp (Net.Ipaddr.V4.loopback, port) in + let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let host = ("localhost", Some port) in + (host, flow) + +let get env sw port = let res = Client.get ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) - env sw - (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) - (Uri.of_string "/get") + (conn env sw port) "/get" in match Client.read_fixed res with Some s -> print_string s | None -> () -let post () = - Eio_main.run @@ fun env -> - Switch.run @@ fun sw -> +let post env sw port = let content = "hello world!" in let content_length = String.length content |> string_of_int in let res = @@ -25,14 +27,25 @@ let post () = [ ("Accept", "application/json"); ("Content-Length", content_length); ]) - ~body:(Body.Fixed content) env sw - (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8080)) - (Uri.of_string "/post") + ~body:(Body.Fixed content) (conn env sw port) "/post" in match Client.read_fixed res with Some s -> print_string s | None -> () let () = - match Sys.argv.(1) with - | "get" -> get () - | "post" -> post () + let port = ref 8080 in + let t = ref "invalid_uri" in + Arg.parse + [ + ("-p", Arg.Set_int port, " Server listening port number(8080 default)"); + ( "-t", + Arg.Set_string t, + "Specify test case to execute,('invalid_uri' default)" ); + ] + ignore "An HTTP/1.1 server"; + + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + match !t with + | "get" -> get env sw !port + | "post" -> post env sw !port | _ -> print_string "Usage: test-client [get|post]" diff --git a/cohttp-eio/tests/test_client.t b/cohttp-eio/tests/test_client.t index 460db5c32e..965ad51c6b 100644 --- a/cohttp-eio/tests/test_client.t +++ b/cohttp-eio/tests/test_client.t @@ -1,24 +1,28 @@ Test Client.get - $ test-server & + $ port=8082 + $ test-server -p ${port} & $ running_pid=$! - $ test-client get + $ test-client -p ${port} -t get meth: GET resource: /get version: HTTP/1.1 - headers: Header { Accept = "application/json" } + headers: Header { Accept = "application/json"; Host = "localhost:8082" } $ kill ${running_pid} Test Client.post - $ test-server & + $ port=8082 + $ test-server -p ${port} & $ running_pid=$! - $ test-client post + $ test-client -p ${port} -t post meth: POST resource: /post version: HTTP/1.1 - headers: Header { Accept = "application/json"; Content-Length = "12" } + headers: Header { + Accept = "application/json"; Content-Length = "12"; Host = "localhost:8082" + } hello world! diff --git a/cohttp-eio/tests/test_get_post.t b/cohttp-eio/tests/test_get_post.t deleted file mode 100644 index 2847f64083..0000000000 --- a/cohttp-eio/tests/test_get_post.t +++ /dev/null @@ -1,57 +0,0 @@ -Test GET success. - - $ test-server & - $ running_pid=$! - $ crlf << EOF | ncat localhost 8080 - > GET /get HTTP/1.1 - > - > EOF - HTTP/1.1 200 OK - content-length: 63 - content-type: text/plain; charset=UTF-8 - - meth: GET - resource: /get - version: HTTP/1.1 - headers: Header { } - $ kill ${running_pid} - -Test GET error. -The test should respond with error message since we are trying to read request body. HTTP 1.1 doesn't support request bodies in GET. - - $ test-server & - $ running_pid=$! - $ crlf << EOF | ncat localhost 8080 - > GET /get_error HTTP/1.1 - > - > EOF - HTTP/1.1 200 OK - content-length: 4 - content-type: text/plain; charset=UTF-8 - - PASS - $ kill ${running_pid} - -Test POST - - $ test-server & - $ running_pid=$! - $ crlf << EOF | ncat localhost 8080 - > POST /post HTTP/1.0 - > Content-Length:12 - > - > hello world! - > EOF - HTTP/1.1 200 OK - content-length: 100 - content-type: text/plain; charset=UTF-8 - - meth: POST - resource: /post - version: HTTP/1.0 - headers: Header { Content-Length = "12" } - - hello world! - $ kill ${running_pid} - - diff --git a/cohttp-eio/tests/test_server.ml b/cohttp-eio/tests/test_server.ml index 5e1fa5e194..8ef46fed05 100644 --- a/cohttp-eio/tests/test_server.ml +++ b/cohttp-eio/tests/test_server.ml @@ -1,6 +1,6 @@ open Cohttp_eio -let app (req, reader,_) = +let app (req, reader, _) = match Http.Request.resource req with | "/get" -> let buf = Buffer.create 0 in @@ -9,18 +9,35 @@ let app (req, reader,_) = Format.fprintf fmt "%!"; Server.text_response (Buffer.contents buf) | "/get_error" -> ( - match Server.read_fixed (req, reader) with + match Server.read_fixed req reader with | Some _ -> Server.text_response "FAIL" | None -> Server.text_response "PASS") | "/post" -> - let body = Server.read_fixed (req, reader) |> Option.get in + let body = Server.read_fixed req reader |> Option.get in let buf = Buffer.create 0 in let fmt = Format.formatter_of_buffer buf in Http.Request.pp fmt req; Format.fprintf fmt "\n\n%s%!" body; Server.text_response (Buffer.contents buf) + | "/chunk" -> ( + let dump_chunk buf chunk = + let s = Format.asprintf "\n%a" Body.pp_chunk chunk in + Buffer.add_string buf s + in + let chunk_buf = Buffer.create 0 in + match Server.read_chunked req reader (dump_chunk chunk_buf) with + | Some headers -> + let req = { req with headers } in + Buffer.contents chunk_buf + |> Format.asprintf "%a@ %s%!" Http.Request.pp req + |> Server.text_response + | None -> Server.bad_request_response) | _ -> Server.bad_request_response let () = - Eio_main.run @@ fun env -> - Eio.Switch.run @@ fun sw -> Server.run ~port:8080 env sw app + let port = ref 8080 in + Arg.parse + [ ("-p", Arg.Set_int port, " Listening port number(8080 by default)") ] + ignore "An HTTP/1.1 server"; + + Eio_main.run @@ fun env -> Server.run ~port:!port env app diff --git a/cohttp-eio/tests/test_server.t b/cohttp-eio/tests/test_server.t new file mode 100644 index 0000000000..582dc948fd --- /dev/null +++ b/cohttp-eio/tests/test_server.t @@ -0,0 +1,113 @@ +Test GET success. + + $ port=8080 + $ test-server -p ${port} & + $ running_pid=$! + $ crlf << EOF | ncat localhost ${port} + > GET /get HTTP/1.1 + > + > EOF + HTTP/1.1 200 OK + content-length: 63 + content-type: text/plain; charset=UTF-8 + + meth: GET + resource: /get + version: HTTP/1.1 + headers: Header { } + $ kill ${running_pid} + +Test GET error. +The test should respond with error message since we are trying to read request body. HTTP 1.1 doesn't support request bodies in GET. + + $ port=8081 + $ test-server -p ${port} & + $ running_pid=$! + $ crlf << EOF | ncat localhost ${port} + > GET /get_error HTTP/1.1 + > + > EOF + HTTP/1.1 200 OK + content-length: 4 + content-type: text/plain; charset=UTF-8 + + PASS + $ kill ${running_pid} + +Test POST + + $ port=8082 + $ test-server -p ${port} & + $ running_pid=$! + $ crlf << EOF | ncat localhost ${port} + > POST /post HTTP/1.0 + > Content-Length:12 + > + > hello world! + > EOF + HTTP/1.1 200 OK + content-length: 100 + content-type: text/plain; charset=UTF-8 + + meth: POST + resource: /post + version: HTTP/1.0 + headers: Header { Content-Length = "12" } + + hello world! + $ kill ${running_pid} + +Test chunk request processing. +1. Test chunks +2. Test chunk extension parsing +3. Test chunk trailer header processing + + $ port=8083 + $ test-server -p ${port} & + $ running_pid=$! + $ crlf << EOF | ncat localhost ${port} + > POST /chunk HTTP/1.1 + > Content-Type: text/plain + > Transfer-Encoding: chunked + > Trailer: Expires, Header1 + > + > 7;ext1=ext1_v;ext2=ext2_v;ext3 + > Mozilla + > 9 + > Developer + > 7 + > Network + > 0 + > Expires: Wed, 21 Oct 2015 07:28:00 GMT + > Header1: Header1 value text + > Header2: Header2 value text + > + > EOF + HTTP/1.1 200 OK + content-length: 347 + content-type: text/plain; charset=UTF-8 + + meth: POST + resource: /chunk + version: HTTP/1.1 + headers: Header { + Content-Length = "23"; Header1 = "Header1 value text"; + Content-Type = "text/plain" } + + size: 7 + data: Mozilla + extensions: + name: ext1 + value: ext1_v; + name: ext2 + value: ext2_v; + name: ext3 + value: + size: 9 + data: Developer + extensions: + size: 7 + data: Network + extensions: + + $ kill ${running_pid} diff --git a/dune-project b/dune-project index fd832c5526..62ff826235 100644 --- a/dune-project +++ b/dune-project @@ -341,12 +341,7 @@ should also be fine under Windows too. base-domains (eio (>= 0.4)) (eio_main :with-test) - (uri :with-test) - cstruct - bigstringaf fmt - uri (mdx :with-test) - (eio_main :with-test) (http (= :version)))) From 67089da755a2c3f6c4b931d2171c182a7ec15f83 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Mon, 15 Aug 2022 17:27:32 +0100 Subject: [PATCH 6/9] eio(client): add test/demo for chunked encoding Adde tests/demos both writing and reading chunked encoding in both client and and server. --- cohttp-eio.opam | 3 +- cohttp-eio/examples/client1.ml | 6 +-- cohttp-eio/examples/docker_client.ml | 6 +-- cohttp-eio/src/body.ml | 6 +-- cohttp-eio/src/client.ml | 35 ++++++------ cohttp-eio/src/cohttp_eio.mli | 67 ++++++++++------------- cohttp-eio/src/rwer.ml | 10 ++-- cohttp-eio/src/server.ml | 15 +++--- cohttp-eio/tests/chunks.txt | 3 ++ cohttp-eio/tests/dune | 9 +++- cohttp-eio/tests/server_chunks.txt | 3 ++ cohttp-eio/tests/test_client.ml | 79 ++++++++++++++++++++++++++-- cohttp-eio/tests/test_client.t | 63 ++++++++++++++++++++++ cohttp-eio/tests/test_server.ml | 59 ++++++++++++++++++--- cohttp-eio/tests/test_server.t | 8 +-- dune-project | 3 +- 16 files changed, 273 insertions(+), 102 deletions(-) create mode 100644 cohttp-eio/tests/chunks.txt create mode 100644 cohttp-eio/tests/server_chunks.txt diff --git a/cohttp-eio.opam b/cohttp-eio.opam index 83ff59df4e..e50deadfdd 100644 --- a/cohttp-eio.opam +++ b/cohttp-eio.opam @@ -23,8 +23,9 @@ depends: [ "base-domains" "eio" {>= "0.4"} "eio_main" {with-test} - "fmt" "mdx" {with-test} + "uri" {with-test} + "fmt" "http" {= version} "odoc" {with-doc} ] diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index 074558678b..fccc32eabf 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -1,13 +1,13 @@ open Eio open Cohttp_eio -let conn env sw () = +let conn env sw resource_path = let hostname, port = ("www.example.org", 80) in let he = Unix.gethostbyname hostname in let addr = `Tcp (Eio_unix.Ipaddr.of_unix he.h_addr_list.(0), port) in - let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let flow = Net.connect ~sw env#net addr in let host = (hostname, Some port) in - (host, flow) + (resource_path, host, flow) let () = Eio_main.run @@ fun env -> diff --git a/cohttp-eio/examples/docker_client.ml b/cohttp-eio/examples/docker_client.ml index 6d92b05bac..1cac7794f1 100644 --- a/cohttp-eio/examples/docker_client.ml +++ b/cohttp-eio/examples/docker_client.ml @@ -5,12 +5,12 @@ module Client = Cohttp_eio.Client module Response = Http.Response module Status = Http.Status -let conn env sw () = +let conn env sw resource_path = let hostname = "docker" in let addr = `Unix "/var/run/docker.sock" in - let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let flow = Net.connect ~sw env#net addr in let host = (hostname, None) in - (host, flow) + (resource_path, host, flow) let () = Eio_main.run @@ fun env -> diff --git a/cohttp-eio/src/body.ml b/cohttp-eio/src/body.ml index 94e51dd398..9a0bf338a0 100644 --- a/cohttp-eio/src/body.ml +++ b/cohttp-eio/src/body.ml @@ -114,7 +114,7 @@ let rec chunk_exts r = let chunk_size = let open Buf_read.Syntax in let* sz = Rwer.take_while1 hex_digit in - try Rwer.return (Format.sprintf "0x%s" sz |> int_of_string) + try Buf_read.return (Format.sprintf "0x%s" sz |> int_of_string) with _ -> failwith (Format.sprintf "Invalid chunk_size: %s" sz) (* Be strict about headers allowed in trailer headers to minimize security @@ -155,7 +155,7 @@ let chunk (total_read : int) (headers : Http.Header.t) = | sz when sz > 0 -> let* extensions = chunk_exts <* Rwer.crlf in let* data = Buf_read.take sz <* Rwer.crlf in - Rwer.return @@ `Chunk (sz, data, extensions) + Buf_read.return @@ `Chunk (sz, data, extensions) | 0 -> let* extensions = chunk_exts <* Rwer.crlf in (* Read trailer headers if any and append those to request headers. @@ -203,7 +203,7 @@ let chunk (total_read : int) (headers : Http.Header.t) = let headers = Http.Header.add headers "Content-Length" (string_of_int total_read) in - Rwer.return @@ `Last_chunk (extensions, headers) + Buf_read.return @@ `Last_chunk (extensions, headers) | sz -> failwith (Format.sprintf "Invalid chunk size: %d" sz) let read_chunked reader headers f = diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index dc8b1f0164..db32478856 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -4,23 +4,23 @@ module Buf_write = Eio.Buf_write type response = Http.Response.t * Buf_read.t type host = string * int option type resource_path = string -type 'a conn = unit -> (host * Eio.Flow.two_way as 'a) +type ('a, 'b) conn = 'a -> (resource_path * host * #Eio.Flow.two_way as 'b) -type 'a body_disallowed_call = +type ('a, 'b) body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - 'a conn -> - resource_path -> + ('a, 'b) conn -> + 'a -> 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 = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - 'a conn -> - resource_path -> + ('a, 'b) conn -> + 'a -> response (* Request line https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.1 *) @@ -53,20 +53,17 @@ let reason_phrase = (* https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.2 *) let response buf_read = let open Buf_read.Syntax in - match Buf_read.at_end_of_input buf_read with - | true -> Stdlib.raise_notrace End_of_file - | false -> - let version = Rwer.(version <* space) buf_read in - let status = Rwer.(status_code <* space) buf_read in - let () = Rwer.(reason_phrase *> crlf *> return ()) buf_read in - let headers = Rwer.http_headers buf_read in - Http.Response.make ~version ~status ~headers () + let version = Rwer.(version <* space) buf_read in + let status = Rwer.(status_code <* space) buf_read in + let () = Rwer.(reason_phrase *> crlf *> Buf_read.return ()) buf_read in + let headers = Rwer.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) flow_fn resource_path = - let (host_name, host_port), flow = flow_fn () in + ?(body = Body.Empty) conn_fn uri = + let (resource_path, (host_name, host_port), flow) = conn_fn uri in let host = match host_port with | Some port -> host_name ^ ":" ^ string_of_int port @@ -83,8 +80,8 @@ let call ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Http.Header.init ()) (* HTTP Calls with Body Disallowed *) -let get ?version ?headers stream uri = - call ~meth:`GET ?version ?headers stream uri +let get ?version ?headers conn_fn uri = + call ~meth:`GET ?version ?headers conn_fn uri let head ?version ?headers stream uri = call ~meth:`HEAD ?version ?headers stream uri diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index 10fdefda6d..9a61e4e7e8 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -53,13 +53,14 @@ module Server : sig Eio.Buf_read.t -> (Body.chunk -> unit) -> Http.Header.t option - (** [read_chunked request chunk_handler] is [Some updated_headers] if + (** [read_chunked request buf_read 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 + in [buf_read] 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" *) + //datatracker.ietf.org/doc/html/rfc7230#section-4.1.3. + + [buf_read] is updated to reflect the number of bytes read. Returns [None] + if [Transfer-Encoding] header in [headers] is not specified as "chunked" *) (** {1 Response} *) @@ -104,49 +105,35 @@ module Client : sig type response = Http.Response.t * Eio.Buf_read.t type host = string * int option - (** Represents a server host domain name and port, e.g. www.example.org:8080, - www.reddit.com *) + (** 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 resource_path = string (** Represents HTTP request resource path, e.g. "/shop/purchase", "/shop/items", "/shop/categories/" etc. *) - type 'a conn = unit -> (host * Eio.Flow.two_way as 'a) - (** [a 'conn] is [(host, flow)] where [host] represents a server host domain name - or address along with the optional tcp/ip port. - - [flow] is the Eio flow value which is connected to the [host]. *) + type ('a, 'b) conn = 'a -> (resource_path * host * #Eio.Flow.two_way as 'b) + (** [('a, 'b conn)] is [(resource_path, host, flow)]. [flow] is the Eio flow + value which is connected to the [host]. *) - type 'a body_disallowed_call = + type ('a, 'b) body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - 'a conn -> - resource_path -> + ('a, 'b) conn -> + 'a -> response (** [body_disallowed_call] denotes HTTP client calls where a request is not - allowed to have a request body. + allowed to have a request body. *) - It is a lambda [fun ?version ?headers conn_fn uri -> .. response)]. The - [uri] represents a valid and full http uri, e.g. - http://www.example.org/hello?q=123 - - @raise invalid_arg If [uri] doesn't containt full and valid HTTP uri *) - - type 'a body_allowed_call = + type ('a, 'b) body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - 'a conn -> - resource_path -> + ('a, 'b) conn -> + 'a -> response (** [body_allowed_call] denotes HTTP client calls where a request can - optionally have a request body. - - It is a lambda [fun ?version ?headers ?body conn_fn uri -> .. response)]. - The [uri] represents a valid and full http uri, e.g. - http://www.example.org/hello?q=123 - - @raise invalid_arg If [uri] doesn't containt full and valid HTTP uri *) + optionally have a request body. *) (** {1 Generic HTTP call} *) @@ -155,21 +142,21 @@ module Client : sig ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - 'a conn -> - resource_path -> + ('a, 'b) conn -> + 'a -> 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} *) diff --git a/cohttp-eio/src/rwer.ml b/cohttp-eio/src/rwer.ml index d417c436b7..8484282260 100644 --- a/cohttp-eio/src/rwer.ml +++ b/cohttp-eio/src/rwer.ml @@ -7,12 +7,8 @@ module Buf_read = Eio.Buf_read module Buf_write = Eio.Buf_write -let return v _ = v - let take_while1 p r = - match Buf_read.take_while p r with - | "" -> failwith "[take_while1] count is less than 1" - | x -> x + match Buf_read.take_while p r with "" -> raise End_of_file | x -> x let token = take_while1 (function @@ -33,8 +29,8 @@ let version = let open Eio.Buf_read.Syntax in let* v = Buf_read.string "HTTP/1." *> Buf_read.any_char in match v with - | '1' -> return `HTTP_1_1 - | '0' -> return `HTTP_1_0 + | '1' -> Buf_read.return `HTTP_1_1 + | '0' -> Buf_read.return `HTTP_1_0 | v -> failwith (Format.sprintf "Invalid HTTP version: %C" v) let header = diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml index 00607c99a7..20419985f2 100644 --- a/cohttp-eio/src/server.ml +++ b/cohttp-eio/src/server.ml @@ -84,15 +84,12 @@ let resource = let[@warning "-3"] http_request t = let open Eio.Buf_read.Syntax in - match Buf_read.at_end_of_input t with - | true -> Stdlib.raise_notrace End_of_file - | false -> - let meth = meth t in - let resource = resource t in - let version = Rwer.(version <* crlf) t in - let headers = Rwer.http_headers t in - let encoding = Http.Header.get_transfer_encoding headers in - { Http.Request.meth; resource; version; headers; scheme = None; encoding } + let meth = meth t in + let resource = resource t in + let version = Rwer.(version <* crlf) t in + let headers = Rwer.http_headers t in + let encoding = Http.Header.get_transfer_encoding headers in + { Http.Request.meth; resource; version; headers; scheme = None; encoding } (* main *) diff --git a/cohttp-eio/tests/chunks.txt b/cohttp-eio/tests/chunks.txt new file mode 100644 index 0000000000..94edd3e041 --- /dev/null +++ b/cohttp-eio/tests/chunks.txt @@ -0,0 +1,3 @@ +Mozilla +Developer +Network diff --git a/cohttp-eio/tests/dune b/cohttp-eio/tests/dune index 55556d238c..697349fea1 100644 --- a/cohttp-eio/tests/dune +++ b/cohttp-eio/tests/dune @@ -1,6 +1,6 @@ (executables (names test_server test_client crlf) - (libraries cohttp_eio eio_main fmt)) + (libraries cohttp_eio eio_main fmt uri)) (mdx (package cohttp-eio) @@ -14,4 +14,9 @@ (test_client.exe as test-client)))) (cram - (deps %{bin:test-server} %{bin:crlf} %{bin:test-client})) + (deps + %{bin:test-server} + %{bin:crlf} + %{bin:test-client} + chunks.txt + server_chunks.txt)) diff --git a/cohttp-eio/tests/server_chunks.txt b/cohttp-eio/tests/server_chunks.txt new file mode 100644 index 0000000000..94edd3e041 --- /dev/null +++ b/cohttp-eio/tests/server_chunks.txt @@ -0,0 +1,3 @@ +Mozilla +Developer +Network diff --git a/cohttp-eio/tests/test_client.ml b/cohttp-eio/tests/test_client.ml index c10d36b494..f79432a73e 100644 --- a/cohttp-eio/tests/test_client.ml +++ b/cohttp-eio/tests/test_client.ml @@ -3,11 +3,11 @@ module Stdenv = Eio.Stdenv module Switch = Eio.Switch open Cohttp_eio -let conn env sw port () = +let conn env sw port resource_path = let addr = `Tcp (Net.Ipaddr.V4.loopback, port) in - let flow = (Net.connect ~sw (Stdenv.net env) addr :> Eio.Flow.two_way) in + let flow = Net.connect ~sw env#net addr in let host = ("localhost", Some port) in - (host, flow) + (resource_path, host, flow) let get env sw port = let res = @@ -31,6 +31,77 @@ let post env sw port = in match Client.read_fixed res with Some s -> print_string s | None -> () +(** Write chunk test. + + Read from text file "chunks.txt" and write each line as a chunk. We add some + chunk extensions to the first chunk. This is purely for demonstrative effect + and for testing purposes rather than for any such specific requirement. *) +let post_chunk env sw port = + let rec body_writer chan chunks f = + match In_channel.input_line chan with + | Some data -> + let extensions = + if chunks = 0 then + [ + Body.{ name = "ext1"; value = Some "ext1_v" }; + { name = "ext2"; value = Some "ext2_v" }; + { name = "ext3"; value = None }; + ] + else [] + in + let chunk = + Body.Chunk { size = String.length data; data; extensions } + in + f chunk; + body_writer chan (chunks + 1) f + | None -> + let last_chunk = Body.Last_chunk [] in + f last_chunk + in + let trailer_writer f = + let trailer_headers = + Http.Header.of_list + [ + ("Expires", "Wed, 21 Oct 2015 07:28:00 GMT"); + ("Header1", "Header1 value text"); + ("Header2", "Header2 value text"); + ] + in + f trailer_headers + in + In_channel.with_open_text "chunks.txt" (fun chan -> + Client.post + ~headers: + (Http.Header.of_list + [ + ("Transfer-Encoding", "chunked"); + ("Content-Type", "text/plain"); + ("Trailer", "Expires, Header1"); + ]) + ~body: + (Body.Chunked { body_writer = body_writer chan 0; trailer_writer }) + (conn env sw port) "/handle_chunk") + |> Client.read_fixed + |> function + | Some r -> print_string r + | None -> () + +(* Read chunk and dump to a "client_chunks2.txt" *) +let get_chunk env sw port = + let write_chunk_to_file flow chunk = + let data = Format.asprintf "%a\n\n" Body.pp_chunk chunk in + Eio.Flow.copy_string data flow + in + let res = Client.get (conn env sw port) "/get_chunk" in + let path = Eio.Path.(Stdenv.cwd env / "client_chunks2.txt") in + Eio.Path.with_open_out ~append:false ~create:(`Or_truncate 0o666) path + (fun flow -> + Client.read_chunked res (write_chunk_to_file flow) |> function + | Some headers -> + let s = Format.asprintf "%a%!" Http.Header.pp_hum headers in + Eio.Flow.copy_string s flow + | None -> ()) + let () = let port = ref 8080 in let t = ref "invalid_uri" in @@ -48,4 +119,6 @@ let () = match !t with | "get" -> get env sw !port | "post" -> post env sw !port + | "post_chunk" -> post_chunk env sw !port + | "get_chunk" -> get_chunk env sw !port | _ -> print_string "Usage: test-client [get|post]" diff --git a/cohttp-eio/tests/test_client.t b/cohttp-eio/tests/test_client.t index 965ad51c6b..2699a68ef8 100644 --- a/cohttp-eio/tests/test_client.t +++ b/cohttp-eio/tests/test_client.t @@ -27,3 +27,66 @@ Test Client.post hello world! $ kill ${running_pid} + + +Test posting "chunked" data + $ port=8082 + $ test-server -p ${port} & + $ running_pid=$! + $ test-client -p ${port} -t post_chunk + meth: POST + resource: /handle_chunk + version: HTTP/1.1 + headers: Header { + Content-Length = "23"; Header1 = "Header1 value text"; + Content-Type = "text/plain"; Host = "localhost:8082" } + + size: 7 + data: Mozilla + extensions: + name: ext1 + value: ext1_v; + name: ext2 + value: ext2_v; + name: ext3 + value: + size: 9 + data: Developer + extensions: + size: 7 + data: Network + extensions: + + $ kill ${running_pid} + +Test "chunked" response in client and "chunked" response writing in server. + $ port=8082 + $ test-server -p ${port} & + $ running_pid=$! + $ test-client -p ${port} -t get_chunk + $ kill ${running_pid} + $ cat client_chunks2.txt + size: 7 + data: Mozilla + extensions: + name: ext1 + value: ext1_v; + name: ext2 + value: ext2_v; + name: ext3 + value: + + size: 9 + data: Developer + extensions: + + size: 7 + data: Network + extensions: + + + + Header { + Content-Length = "23"; Header1 = "Header1 value text"; + Content-Type = "text/plain" + } diff --git a/cohttp-eio/tests/test_server.ml b/cohttp-eio/tests/test_server.ml index 8ef46fed05..64bbebd520 100644 --- a/cohttp-eio/tests/test_server.ml +++ b/cohttp-eio/tests/test_server.ml @@ -2,12 +2,7 @@ open Cohttp_eio let app (req, reader, _) = match Http.Request.resource req with - | "/get" -> - let buf = Buffer.create 0 in - let fmt = Format.formatter_of_buffer buf in - Http.Request.pp fmt req; - Format.fprintf fmt "%!"; - Server.text_response (Buffer.contents buf) + | "/get" -> Server.text_response (Fmt.to_to_string Http.Request.pp req) | "/get_error" -> ( match Server.read_fixed req reader with | Some _ -> Server.text_response "FAIL" @@ -19,7 +14,7 @@ let app (req, reader, _) = Http.Request.pp fmt req; Format.fprintf fmt "\n\n%s%!" body; Server.text_response (Buffer.contents buf) - | "/chunk" -> ( + | "/handle_chunk" -> ( let dump_chunk buf chunk = let s = Format.asprintf "\n%a" Body.pp_chunk chunk in Buffer.add_string buf s @@ -32,6 +27,56 @@ let app (req, reader, _) = |> Format.asprintf "%a@ %s%!" Http.Request.pp req |> Server.text_response | None -> Server.bad_request_response) + | "/get_chunk" -> + let rec body_writer chan chunks f = + match In_channel.input_line chan with + | Some data -> + let extensions = + if chunks = 0 then + [ + Body.{ name = "ext1"; value = Some "ext1_v" }; + { name = "ext2"; value = Some "ext2_v" }; + { name = "ext3"; value = None }; + ] + else [] + in + let chunk = + Body.Chunk { size = String.length data; data; extensions } + in + f chunk; + body_writer chan (chunks + 1) f + | None -> + let last_chunk = Body.Last_chunk [] in + In_channel.close chan; + f last_chunk + in + let trailer_writer f = + let trailer_headers = + Http.Header.of_list + [ + ("Expires", "Wed, 21 Oct 2015 07:28:00 GMT"); + ("Header1", "Header1 value text"); + ("Header2", "Header2 value text"); + ] + in + f trailer_headers + in + let chan = + In_channel.open_gen [ Open_text; Open_rdonly ] 0 "server_chunks.txt" + in + let headers = + Http.Header.of_list + [ + ("Transfer-Encoding", "chunked"); + ("Content-Type", "text/plain"); + ("Trailer", "Expires, Header1"); + ] + in + let response = Http.Response.make ~status:`OK ~headers () in + let body = + Body.Chunked { body_writer = body_writer chan 0; trailer_writer } + in + (response, body) | _ -> Server.bad_request_response let () = diff --git a/cohttp-eio/tests/test_server.t b/cohttp-eio/tests/test_server.t index 582dc948fd..d993d7ef97 100644 --- a/cohttp-eio/tests/test_server.t +++ b/cohttp-eio/tests/test_server.t @@ -57,7 +57,7 @@ Test POST hello world! $ kill ${running_pid} -Test chunk request processing. +Test chunk request processing: 1. Test chunks 2. Test chunk extension parsing 3. Test chunk trailer header processing @@ -66,7 +66,7 @@ Test chunk request processing. $ test-server -p ${port} & $ running_pid=$! $ crlf << EOF | ncat localhost ${port} - > POST /chunk HTTP/1.1 + > POST /handle_chunk HTTP/1.1 > Content-Type: text/plain > Transfer-Encoding: chunked > Trailer: Expires, Header1 @@ -84,11 +84,11 @@ Test chunk request processing. > > EOF HTTP/1.1 200 OK - content-length: 347 + content-length: 354 content-type: text/plain; charset=UTF-8 meth: POST - resource: /chunk + resource: /handle_chunk version: HTTP/1.1 headers: Header { Content-Length = "23"; Header1 = "Header1 value text"; diff --git a/dune-project b/dune-project index 62ff826235..525a36803a 100644 --- a/dune-project +++ b/dune-project @@ -341,7 +341,8 @@ should also be fine under Windows too. base-domains (eio (>= 0.4)) (eio_main :with-test) - fmt (mdx :with-test) + (uri :with-test) + fmt (http (= :version)))) From 8adf2ae25ae3ec8d7117cebf419ed5dd78516758 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 25 Aug 2022 16:10:16 +0100 Subject: [PATCH 7/9] eio(client): Client.read_fixed take_all RFC https://www.rfc-editor.org/rfc/rfc7230#section-3.3.3 point 7 states that responses with missing Content-Length/Transfer-Encoding headers should read the message body until the end of file. This commit implements the above spec. Since now that read_fixed is different in client and server, we also remove it from the Body module. --- cohttp-eio/examples/client1.ml | 2 +- cohttp-eio/examples/docker_client.ml | 8 +++----- cohttp-eio/src/body.ml | 7 ------- cohttp-eio/src/client.ml | 10 ++++++++-- cohttp-eio/src/cohttp_eio.mli | 9 +++++---- cohttp-eio/src/server.ml | 7 ++++++- cohttp-eio/tests/test_client.ml | 8 +++----- 7 files changed, 26 insertions(+), 25 deletions(-) diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index fccc32eabf..4388cc39b3 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -13,4 +13,4 @@ let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> let res = Client.get (conn env sw) "/" in - match Client.read_fixed res with Some b -> print_string b | None -> () + print_string @@ Client.read_fixed res diff --git a/cohttp-eio/examples/docker_client.ml b/cohttp-eio/examples/docker_client.ml index 1cac7794f1..0508d6f19e 100644 --- a/cohttp-eio/examples/docker_client.ml +++ b/cohttp-eio/examples/docker_client.ml @@ -20,8 +20,6 @@ let () = Printf.printf "Response code: %d\n" code; Printf.printf "Headers: %s\n" (fst res |> Response.headers |> Http.Header.to_string); - match Client.read_fixed res with - | Some body -> - Printf.printf "Body of length: %d\n" (String.length body); - print_endline ("Received body\n" ^ body) - | None -> () + let body = Client.read_fixed res in + Printf.printf "Body of length: %d\n" (String.length body); + print_endline ("Received body\n" ^ body) diff --git a/cohttp-eio/src/body.ml b/cohttp-eio/src/body.ml index 9a0bf338a0..5bf53fc322 100644 --- a/cohttp-eio/src/body.ml +++ b/cohttp-eio/src/body.ml @@ -45,13 +45,6 @@ let pp_chunk fmt = function fmt chunk | Last_chunk extensions -> pp_chunk_extension fmt extensions -let read_fixed t headers = - 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 - Buf_read.take content_length t - (* Chunked encoding parser *) let hex_digit = function diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index db32478856..7bf0616059 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -63,7 +63,7 @@ let response buf_read = let call ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Http.Header.init ()) ?(body = Body.Empty) conn_fn uri = - let (resource_path, (host_name, host_port), flow) = conn_fn uri in + let resource_path, (host_name, host_port), flow = conn_fn uri in let host = match host_port with | Some port -> host_name ^ ":" ^ string_of_int port @@ -103,7 +103,13 @@ let patch ?version ?headers ?body stream uri = (* Response Body *) let read_fixed ((response, reader) : Http.Response.t * Buf_read.t) = - Body.read_fixed reader response.headers + match + Http.Header.get response.headers "Content-Length" + |> Option.get + |> int_of_string + with + | content_length -> Buf_read.take content_length reader + | exception _ -> Buf_read.take_all reader let read_chunked : response -> (Body.chunk -> unit) -> Http.Header.t option = fun (response, reader) f -> Body.read_chunked reader response.headers f diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index 9a61e4e7e8..bef47d8786 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -160,10 +160,11 @@ module Client : sig (** {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_fixed : response -> string + (** [read_fixed (response,reader)] is [body_content], where [body_content] is + of length [n] if "Content-Length" header exists and is a valid integer + value [n] in [response]. Otherwise [body_content] holds all bytes until + eof. *) val read_chunked : response -> (Body.chunk -> unit) -> Http.Header.t option (** [read_chunked response chunk_handler] is [Some updated_headers] if diff --git a/cohttp-eio/src/server.ml b/cohttp-eio/src/server.ml index 20419985f2..f7fa2b011b 100644 --- a/cohttp-eio/src/server.ml +++ b/cohttp-eio/src/server.ml @@ -16,7 +16,12 @@ let domain_count = let read_fixed request reader = match Http.Request.meth request with - | `POST | `PUT | `PATCH -> Body.read_fixed reader request.headers + | `POST | `PUT | `PATCH -> + let ( let* ) o f = Option.bind o f in + let ( let+ ) o f = Option.map f o in + let* v = Http.Header.get request.headers "Content-Length" in + let+ content_length = int_of_string_opt v in + Buf_read.take content_length reader | _ -> None let read_chunked request reader f = diff --git a/cohttp-eio/tests/test_client.ml b/cohttp-eio/tests/test_client.ml index f79432a73e..7951e58385 100644 --- a/cohttp-eio/tests/test_client.ml +++ b/cohttp-eio/tests/test_client.ml @@ -15,7 +15,7 @@ let get env sw port = ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) (conn env sw port) "/get" in - match Client.read_fixed res with Some s -> print_string s | None -> () + print_string @@ Client.read_fixed res let post env sw port = let content = "hello world!" in @@ -29,7 +29,7 @@ let post env sw port = ]) ~body:(Body.Fixed content) (conn env sw port) "/post" in - match Client.read_fixed res with Some s -> print_string s | None -> () + print_string @@ Client.read_fixed res (** Write chunk test. @@ -82,9 +82,7 @@ let post_chunk env sw port = (Body.Chunked { body_writer = body_writer chan 0; trailer_writer }) (conn env sw port) "/handle_chunk") |> Client.read_fixed - |> function - | Some r -> print_string r - | None -> () + |> print_string (* Read chunk and dump to a "client_chunks2.txt" *) let get_chunk env sw port = From 11458b75350f7abfceb933e39a8bae521409d766 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 25 Aug 2022 16:54:27 +0100 Subject: [PATCH 8/9] eio(client): Client.call expects conn, host and resource_path as paramters --- cohttp-eio/examples/client1.ml | 13 +++---- cohttp-eio/examples/docker_client.ml | 11 ++---- cohttp-eio/src/client.ml | 52 ++++++++++++++-------------- cohttp-eio/src/cohttp_eio.mli | 36 +++++++++---------- cohttp-eio/tests/test_client.ml | 33 ++++++++---------- 5 files changed, 67 insertions(+), 78 deletions(-) diff --git a/cohttp-eio/examples/client1.ml b/cohttp-eio/examples/client1.ml index 4388cc39b3..749f0065bc 100644 --- a/cohttp-eio/examples/client1.ml +++ b/cohttp-eio/examples/client1.ml @@ -1,16 +1,13 @@ open Eio open Cohttp_eio -let conn env sw resource_path = +let () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> let hostname, port = ("www.example.org", 80) in let he = Unix.gethostbyname hostname in let addr = `Tcp (Eio_unix.Ipaddr.of_unix he.h_addr_list.(0), port) in - let flow = Net.connect ~sw env#net addr in + let conn = Net.connect ~sw env#net addr in let host = (hostname, Some port) in - (resource_path, host, flow) - -let () = - Eio_main.run @@ fun env -> - Switch.run @@ fun sw -> - let res = Client.get (conn env sw) "/" in + let res = Client.get ~conn host "/" in print_string @@ Client.read_fixed res diff --git a/cohttp-eio/examples/docker_client.ml b/cohttp-eio/examples/docker_client.ml index 0508d6f19e..8dee798eea 100644 --- a/cohttp-eio/examples/docker_client.ml +++ b/cohttp-eio/examples/docker_client.ml @@ -5,17 +5,12 @@ module Client = Cohttp_eio.Client module Response = Http.Response module Status = Http.Status -let conn env sw resource_path = - let hostname = "docker" in - let addr = `Unix "/var/run/docker.sock" in - let flow = Net.connect ~sw env#net addr in - let host = (hostname, None) in - (resource_path, host, flow) - let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> - let res = Client.get (conn env sw) "/version" in + 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 code = fst res |> Response.status |> Status.to_int in Printf.printf "Response code: %d\n" code; Printf.printf "Headers: %s\n" diff --git a/cohttp-eio/src/client.ml b/cohttp-eio/src/client.ml index 7bf0616059..75d2bd8c1f 100644 --- a/cohttp-eio/src/client.ml +++ b/cohttp-eio/src/client.ml @@ -4,23 +4,24 @@ module Buf_write = Eio.Buf_write type response = Http.Response.t * Buf_read.t type host = string * int option type resource_path = string -type ('a, 'b) conn = 'a -> (resource_path * host * #Eio.Flow.two_way as 'b) -type ('a, 'b) body_disallowed_call = +type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - ('a, 'b) conn -> - 'a -> + conn:(#Eio.Flow.two_way as 'a) -> + host -> + resource_path -> response (** [body_disallowed_call] denotes HTTP client calls where a request is not allowed to have a request body. *) -type ('a, 'b) body_allowed_call = +type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - ('a, 'b) conn -> - 'a -> + conn:(#Eio.Flow.two_way as 'a) -> + host -> + resource_path -> response (* Request line https://datatracker.ietf.org/doc/html/rfc7230#section-3.1.1 *) @@ -62,43 +63,42 @@ let response buf_read = (* Generic HTTP call *) let call ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Http.Header.init ()) - ?(body = Body.Empty) conn_fn uri = - let resource_path, (host_name, host_port), flow = conn_fn uri in + ?(body = Body.Empty) ~conn host resource_path = let host = - match host_port with - | Some port -> host_name ^ ":" ^ string_of_int port - | None -> host_name + match host with + | host, Some port -> host ^ ":" ^ string_of_int port + | host, None -> host in - Buf_write.with_flow ~initial_size:0x1000 flow (fun writer -> + Buf_write.with_flow ~initial_size:0x1000 conn (fun writer -> let headers = Http.Header.add_unless_exists headers "Host" host in write_request writer (meth, version, headers, resource_path, body); let reader = - Eio.Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int flow + Eio.Buf_read.of_flow ~initial_size:0x1000 ~max_size:max_int conn in let response = response reader in (response, reader)) (* HTTP Calls with Body Disallowed *) -let get ?version ?headers conn_fn uri = - call ~meth:`GET ?version ?headers conn_fn uri +let get ?version ?headers ~conn host resource_path = + call ~meth:`GET ?version ?headers ~conn host resource_path -let head ?version ?headers stream uri = - call ~meth:`HEAD ?version ?headers stream uri +let head ?version ?headers ~conn host resource_path = + call ~meth:`HEAD ?version ?headers ~conn host resource_path -let delete ?version ?headers stream uri = - call ~meth:`DELETE ?version ?headers stream uri +let delete ?version ?headers ~conn host resource_path = + call ~meth:`DELETE ?version ?headers ~conn host resource_path (* HTTP Calls with Body Allowed *) -let post ?version ?headers ?body stream uri = - call ~meth:`POST ?version ?headers ?body stream uri +let post ?version ?headers ?body ~conn host resource_path = + call ~meth:`POST ?version ?headers ?body ~conn host resource_path -let put ?version ?headers ?body stream uri = - call ~meth:`PUT ?version ?headers ?body stream uri +let put ?version ?headers ?body ~conn host resource_path = + call ~meth:`PUT ?version ?headers ?body ~conn host resource_path -let patch ?version ?headers ?body stream uri = - call ~meth:`PATCH ?version ?headers ?body stream uri +let patch ?version ?headers ?body ~conn host resource_path = + call ~meth:`PATCH ?version ?headers ?body ~conn host resource_path (* Response Body *) diff --git a/cohttp-eio/src/cohttp_eio.mli b/cohttp-eio/src/cohttp_eio.mli index bef47d8786..3dcea73d84 100644 --- a/cohttp-eio/src/cohttp_eio.mli +++ b/cohttp-eio/src/cohttp_eio.mli @@ -101,6 +101,7 @@ module Server : sig val not_found_handler : handler end +(** [Client] is a HTTP/1.1 client. *) module Client : sig type response = Http.Response.t * Eio.Buf_read.t @@ -112,25 +113,23 @@ module Client : sig (** Represents HTTP request resource path, e.g. "/shop/purchase", "/shop/items", "/shop/categories/" etc. *) - type ('a, 'b) conn = 'a -> (resource_path * host * #Eio.Flow.two_way as 'b) - (** [('a, 'b conn)] is [(resource_path, host, flow)]. [flow] is the Eio flow - value which is connected to the [host]. *) - - type ('a, 'b) body_disallowed_call = + type 'a body_disallowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> - ('a, 'b) conn -> - 'a -> + conn:(#Eio.Flow.two_way as 'a) -> + host -> + resource_path -> response (** [body_disallowed_call] denotes HTTP client calls where a request is not allowed to have a request body. *) - type ('a, 'b) body_allowed_call = + type 'a body_allowed_call = ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - ('a, 'b) conn -> - 'a -> + conn:(#Eio.Flow.two_way as 'a) -> + host -> + resource_path -> response (** [body_allowed_call] denotes HTTP client calls where a request can optionally have a request body. *) @@ -142,21 +141,22 @@ module Client : sig ?version:Http.Version.t -> ?headers:Http.Header.t -> ?body:Body.t -> - ('a, 'b) conn -> - 'a -> + conn:#Eio.Flow.two_way -> + host -> + resource_path -> response (** {1 HTTP Calls with Body Disallowed} *) - val get : ('a, 'b) body_disallowed_call - val head : ('a, 'b) body_disallowed_call - val delete : ('a, 'b) body_disallowed_call + val get : 'a body_disallowed_call + val head : 'a body_disallowed_call + val delete : 'a body_disallowed_call (** {1 HTTP Calls with Body Allowed} *) - val post : ('a, 'b) body_allowed_call - val put : ('a, 'b) body_allowed_call - val patch : ('a, 'b) body_allowed_call + val post : 'a body_allowed_call + val put : 'a body_allowed_call + val patch : 'a body_allowed_call (** {1 Response Body} *) diff --git a/cohttp-eio/tests/test_client.ml b/cohttp-eio/tests/test_client.ml index 7951e58385..766e470ddb 100644 --- a/cohttp-eio/tests/test_client.ml +++ b/cohttp-eio/tests/test_client.ml @@ -3,21 +3,15 @@ module Stdenv = Eio.Stdenv module Switch = Eio.Switch open Cohttp_eio -let conn env sw port resource_path = - let addr = `Tcp (Net.Ipaddr.V4.loopback, port) in - let flow = Net.connect ~sw env#net addr in - let host = ("localhost", Some port) in - (resource_path, host, flow) - -let get env sw port = +let get conn host = let res = Client.get ~headers:(Http.Header.of_list [ ("Accept", "application/json") ]) - (conn env sw port) "/get" + ~conn host "/get" in print_string @@ Client.read_fixed res -let post env sw port = +let post conn host = let content = "hello world!" in let content_length = String.length content |> string_of_int in let res = @@ -27,7 +21,7 @@ let post env sw port = [ ("Accept", "application/json"); ("Content-Length", content_length); ]) - ~body:(Body.Fixed content) (conn env sw port) "/post" + ~body:(Body.Fixed content) ~conn host "/post" in print_string @@ Client.read_fixed res @@ -36,7 +30,7 @@ let post env sw port = Read from text file "chunks.txt" and write each line as a chunk. We add some chunk extensions to the first chunk. This is purely for demonstrative effect and for testing purposes rather than for any such specific requirement. *) -let post_chunk env sw port = +let post_chunk conn host = let rec body_writer chan chunks f = match In_channel.input_line chan with | Some data -> @@ -80,17 +74,17 @@ let post_chunk env sw port = ]) ~body: (Body.Chunked { body_writer = body_writer chan 0; trailer_writer }) - (conn env sw port) "/handle_chunk") + ~conn host "/handle_chunk") |> Client.read_fixed |> print_string (* Read chunk and dump to a "client_chunks2.txt" *) -let get_chunk env sw port = +let get_chunk env conn host = let write_chunk_to_file flow chunk = let data = Format.asprintf "%a\n\n" Body.pp_chunk chunk in Eio.Flow.copy_string data flow in - let res = Client.get (conn env sw port) "/get_chunk" in + let res = Client.get ~conn host "/get_chunk" in let path = Eio.Path.(Stdenv.cwd env / "client_chunks2.txt") in Eio.Path.with_open_out ~append:false ~create:(`Or_truncate 0o666) path (fun flow -> @@ -114,9 +108,12 @@ let () = Eio_main.run @@ fun env -> Switch.run @@ fun sw -> + let addr = `Tcp (Net.Ipaddr.V4.loopback, !port) in + let conn = Net.connect ~sw env#net addr in + let host = ("localhost", Some !port) in match !t with - | "get" -> get env sw !port - | "post" -> post env sw !port - | "post_chunk" -> post_chunk env sw !port - | "get_chunk" -> get_chunk env sw !port + | "get" -> get conn host + | "post" -> post conn host + | "post_chunk" -> post_chunk conn host + | "get_chunk" -> get_chunk env conn host | _ -> print_string "Usage: test-client [get|post]" From a4df4aedcdd371c2489f89cf8386788d40609672 Mon Sep 17 00:00:00 2001 From: Bikal Lem Date: Thu, 25 Aug 2022 17:25:39 +0100 Subject: [PATCH 9/9] eio(client): Add timeout example --- cohttp-eio/examples/client_timeout.ml | 19 +++++++++++++++++++ cohttp-eio/examples/dune | 2 +- 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 cohttp-eio/examples/client_timeout.ml diff --git a/cohttp-eio/examples/client_timeout.ml b/cohttp-eio/examples/client_timeout.ml new file mode 100644 index 0000000000..397a04d9d6 --- /dev/null +++ b/cohttp-eio/examples/client_timeout.ml @@ -0,0 +1,19 @@ +open Eio +open Cohttp_eio + +let () = + Eio_main.run @@ fun env -> + Switch.run @@ fun sw -> + (* 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 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 + Client.read_fixed res |> Result.ok) + |> function + | Ok s -> print_string s + | Error `Timeout -> print_string "Connection timed out" diff --git a/cohttp-eio/examples/dune b/cohttp-eio/examples/dune index 864956b4bb..0127c08042 100644 --- a/cohttp-eio/examples/dune +++ b/cohttp-eio/examples/dune @@ -1,5 +1,5 @@ (executables - (names server1 client1 docker_client) + (names server1 client1 docker_client client_timeout) (libraries cohttp-eio eio_main eio.unix unix)) (alias