diff --git a/async/httpaf_async.ml b/async/httpaf_async.ml index bbeb949..a850b64 100644 --- a/async/httpaf_async.ml +++ b/async/httpaf_async.ml @@ -159,11 +159,12 @@ module Server = struct end module Client = struct - let request ?(config=Config.default) socket request ~error_handler ~response_handler = + type t = Client_connection.t + + let create_connection ?(config=Config.default) socket = let fd = Socket.fd socket in let writev = Faraday_async.writev_of_fd fd in - let request_body, conn = - Client_connection.request request ~error_handler ~response_handler in + let conn = Client_connection.create ~config in let read_complete = Ivar.create () in let buffer = Buffer.create config.read_buffer_size in let rec reader_thread () = @@ -216,5 +217,11 @@ module Client = struct >>| fun () -> if not (Fd.is_closed fd) then don't_wait_for (Fd.close fd)); - request_body + conn + + let request = Client_connection.request + + let shutdown = Client_connection.shutdown + + let is_closed = Client_connection.is_closed end diff --git a/async/httpaf_async.mli b/async/httpaf_async.mli index 25e39eb..768ca8f 100644 --- a/async/httpaf_async.mli +++ b/async/httpaf_async.mli @@ -13,11 +13,21 @@ module Server : sig end module Client : sig - val request - : ?config : Config.t + type t + + val create_connection + : ?config:Config.t -> ([`Active], [< Socket.Address.t]) Socket.t + -> t + + val request + : t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler -> [`write] Body.t + + val shutdown : t -> unit + + val is_closed : t -> bool end diff --git a/esy.json b/esy.json index 1f24efa..26e59dc 100644 --- a/esy.json +++ b/esy.json @@ -33,16 +33,7 @@ } } }, - "@opam/ppx_deriving": "ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c", - "@opam/nocrypto": { - "source": "TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d", - "override": { - "dependencies": { - "@opam/bigarray-compat": "*", - "@opam/ppx_sexp_conv": "*" - } - } - }, + "@opam/nocrypto": "TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8", "@opam/mirage-xen-posix": { "source": "no-source:", "override": {} diff --git a/esy.lock/index.json b/esy.lock/index.json index 9922415..85cf787 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "e118ae1df06a9ff496ecbddced5a065d", + "checksum": "edb38735bb1fb86e77ba06ebfdd6c87d", "root": "httpaf@link-dev:./esy.json", "node": { "yarn-pkg-config@github:esy-ocaml/yarn-pkg-config#cca65f99674ed2d954d28788edeb8c57fada5ed0@d41d8cd9": { @@ -97,12 +97,12 @@ ], "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/ocamlfind@opam:1.8.0@f744a0c5", - "@opam/conf-perl@opam:1@3174af0e", "@opam/conf-gmp@opam:1@bee458be", + "@opam/conf-perl@opam:1@7e7ee9c5", "@opam/conf-gmp@opam:1@61c3c230", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/ocamlfind@opam:1.8.0@f744a0c5", - "@opam/conf-gmp@opam:1@bee458be" + "@opam/conf-gmp@opam:1@61c3c230" ] }, "@opam/yojson@opam:1.7.0@2d92307e": { @@ -178,13 +178,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dune@opam:1.10.0@b15ce221", "@opam/cstruct@opam:4.0.0@27f747cf", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/cstruct@opam:4.0.0@27f747cf" ] }, @@ -209,7 +209,7 @@ "ocaml@4.8.0@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/ptime@opam:0.8.5@0051d642", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/dune@opam:1.10.0@b15ce221", "@opam/cstruct-sexp@opam:5.0.0@0808ad17", "@opam/cstruct@opam:4.0.0@27f747cf", @@ -221,7 +221,7 @@ "ocaml@4.8.0@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/ptime@opam:0.8.5@0051d642", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/cstruct-sexp@opam:5.0.0@0808ad17", "@opam/cstruct@opam:4.0.0@27f747cf", "@opam/astring@opam:0.8.3@4e5e17d5", @@ -253,7 +253,7 @@ "@opam/result@opam:1.4@7add0d71", "@opam/ppx_tools@opam:5.2+4.08.0@964f70cb", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/mirage-flow-lwt@opam:1.6.0@4764001e", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/io-page@opam:2.3.0@278f3131", "@opam/dune@opam:1.10.0@b15ce221", @@ -269,7 +269,7 @@ "@opam/result@opam:1.4@7add0d71", "@opam/ppx_tools@opam:5.2+4.08.0@964f70cb", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/mirage-flow-lwt@opam:1.6.0@4764001e", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/io-page@opam:2.3.0@278f3131", "@opam/cstruct@opam:4.0.0@27f747cf", @@ -508,7 +508,7 @@ "@opam/tls@github:dune-universe/ocaml-tls:tls.opam#9761033@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/result@opam:1.4@7add0d71", "@opam/ptime@opam:0.8.5@0051d642", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/mirage-types@opam:3.5.0@1bc274d2", "@opam/mirage-net-xen@no-source:@7514068f", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dune@opam:1.10.0@b15ce221", @@ -520,7 +520,7 @@ "@opam/tls@github:dune-universe/ocaml-tls:tls.opam#9761033@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/result@opam:1.4@7add0d71", "@opam/ptime@opam:0.8.5@0051d642", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/mirage-types@opam:3.5.0@1bc274d2", "@opam/mirage-net-xen@no-source:@7514068f", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/cstruct@opam:4.0.0@27f747cf" @@ -541,7 +541,7 @@ "@opam/tls@github:dune-universe/ocaml-tls:tls.opam#9761033@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/result@opam:1.4@7add0d71", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dune@opam:1.10.0@b15ce221", "@opam/cstruct@opam:4.0.0@27f747cf", "@esy-ocaml/substs@0.0.1@d41d8cd9" @@ -551,7 +551,7 @@ "@opam/tls@github:dune-universe/ocaml-tls:tls.opam#9761033@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/result@opam:1.4@7add0d71", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/cstruct@opam:4.0.0@27f747cf" ] }, @@ -571,11 +571,11 @@ "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/ptime@opam:0.8.5@0051d642", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/ppx_deriving@github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c@d41d8cd9", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_deriving@opam:4.4@35f44479", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/ocamlfind@opam:1.8.0@f744a0c5", "@opam/ocamlbuild@opam:0.14.0@427a2331", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/mirage-kv-lwt@opam:2.0.0@585db097", "@opam/mirage-flow-lwt@opam:1.6.0@4764001e", "@opam/mirage-clock@opam:2.0.0@9977799a", @@ -589,9 +589,9 @@ "@opam/sexplib@opam:v0.12.0@c65643bb", "@opam/ptime@opam:0.8.5@0051d642", "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", - "@opam/ppx_deriving@github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c@d41d8cd9", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/ppx_deriving@opam:4.4@35f44479", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "@opam/mirage-kv-lwt@opam:2.0.0@585db097", "@opam/mirage-flow-lwt@opam:1.6.0@4764001e", "@opam/mirage-clock@opam:2.0.0@9977799a", @@ -1119,20 +1119,20 @@ "@opam/base@opam:v0.12.2@e209c8f2" ] }, - "@opam/ppx_tools_versioned@opam:5.2.2@34409c89": { - "id": "@opam/ppx_tools_versioned@opam:5.2.2@34409c89", + "@opam/ppx_tools_versioned@opam:5.2.3@139dfedf": { + "id": "@opam/ppx_tools_versioned@opam:5.2.3@139dfedf", "name": "@opam/ppx_tools_versioned", - "version": "opam:5.2.2", + "version": "opam:5.2.3", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/f7/f78a3c2b4cc3b92702e1f7096a6125fa#md5:f78a3c2b4cc3b92702e1f7096a6125fa", - "archive:https://github.com/ocaml-ppx/ppx_tools_versioned/archive/5.2.2.tar.gz#md5:f78a3c2b4cc3b92702e1f7096a6125fa" + "archive:https://opam.ocaml.org/cache/md5/b1/b1455e5a4a1bcd9ddbfcf712ccbd4262#md5:b1455e5a4a1bcd9ddbfcf712ccbd4262", + "archive:https://github.com/ocaml-ppx/ppx_tools_versioned/archive/5.2.3.tar.gz#md5:b1455e5a4a1bcd9ddbfcf712ccbd4262" ], "opam": { "name": "ppx_tools_versioned", - "version": "5.2.2", - "path": "esy.lock/opam/ppx_tools_versioned.5.2.2" + "version": "5.2.3", + "path": "esy.lock/opam/ppx_tools_versioned.5.2.3" } }, "overrides": [], @@ -1756,16 +1756,21 @@ "@opam/base@opam:v0.12.2@e209c8f2" ] }, - "@opam/ppx_deriving@github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c@d41d8cd9": { - "id": - "@opam/ppx_deriving@github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c@d41d8cd9", + "@opam/ppx_deriving@opam:4.4@35f44479": { + "id": "@opam/ppx_deriving@opam:4.4@35f44479", "name": "@opam/ppx_deriving", - "version": "github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c", + "version": "opam:4.4", "source": { "type": "install", "source": [ - "github:ocaml-ppx/ppx_deriving:ppx_deriving.opam#745a45c" - ] + "archive:https://opam.ocaml.org/cache/sha256/c2/c2d85af4cb65a1f163f624590fb0395a164bbfd0d05082092526b669e66bcc34#sha256:c2d85af4cb65a1f163f624590fb0395a164bbfd0d05082092526b669e66bcc34", + "archive:https://github.com/ocaml-ppx/ppx_deriving/archive/v4.4.tar.gz#sha256:c2d85af4cb65a1f163f624590fb0395a164bbfd0d05082092526b669e66bcc34" + ], + "opam": { + "name": "ppx_deriving", + "version": "4.4", + "path": "esy.lock/opam/ppx_deriving.4.4" + } }, "overrides": [], "dependencies": [ @@ -1838,8 +1843,8 @@ "@opam/base@opam:v0.12.2@e209c8f2" ] }, - "@opam/ppx_cstruct@opam:5.0.0@cea738b4": { - "id": "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe": { + "id": "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "name": "@opam/ppx_cstruct", "version": "opam:5.0.0", "source": { @@ -1857,7 +1862,7 @@ "overrides": [], "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", - "@opam/ppx_tools_versioned@opam:5.2.2@34409c89", + "@opam/ppx_tools_versioned@opam:5.2.3@139dfedf", "@opam/ocaml-migrate-parsetree@opam:1.4.0@107a1ff4", "@opam/dune@opam:1.10.0@b15ce221", "@opam/cstruct@opam:4.0.0@27f747cf", @@ -1865,7 +1870,7 @@ ], "devDependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/sexplib@opam:v0.12.0@c65643bb", - "@opam/ppx_tools_versioned@opam:5.2.2@34409c89", + "@opam/ppx_tools_versioned@opam:5.2.3@139dfedf", "@opam/ocaml-migrate-parsetree@opam:1.4.0@107a1ff4", "@opam/cstruct@opam:4.0.0@27f747cf" ] @@ -2163,7 +2168,7 @@ } ], "dependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/conf-m4@opam:1@dd7dde42", + "ocaml@4.8.0@d41d8cd9", "@opam/conf-m4@opam:1@da6f4f44", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.8.0@d41d8cd9" ] @@ -2273,23 +2278,16 @@ ], "devDependencies": [ "ocaml@4.8.0@d41d8cd9" ] }, - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71": { + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9": { "id": - "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d@d86b9d71", + "@opam/nocrypto@github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8@d41d8cd9", "name": "@opam/nocrypto", - "version": "github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d", + "version": "github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8", "source": { "type": "install", - "source": [ "github:TheLortex/ocaml-nocrypto:nocrypto.opam#df2348d" ] + "source": [ "github:TheLortex/ocaml-nocrypto:nocrypto.opam#8e389a8" ] }, - "overrides": [ - { - "dependencies": { - "@opam/bigarray-compat": "*", - "@opam/ppx_sexp_conv": "*" - } - } - ], + "overrides": [], "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/zarith@opam:1.7@1709d54c", "@opam/sexplib@opam:v0.12.0@c65643bb", @@ -2306,10 +2304,12 @@ "devDependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/zarith@opam:1.7@1709d54c", "@opam/sexplib@opam:v0.12.0@c65643bb", + "@opam/ppx_sexp_conv@opam:v0.12.0@6aa153b5", "@opam/ocplib-endian@opam:1.0@aa720242", "@opam/mirage-no-xen@opam:1@953da806", "@opam/mirage-no-solo5@opam:1@f4472686", - "@opam/cstruct@opam:4.0.0@27f747cf" + "@opam/cstruct@opam:4.0.0@27f747cf", + "@opam/bigarray-compat@opam:1.0.0@77cde57f" ] }, "@opam/mmap@opam:1.1.0@6f2a1426": { @@ -2356,7 +2356,7 @@ "ocaml@4.8.0@d41d8cd9", "@opam/mirage-time@opam:1.3.0@08f25052", "@opam/mirage-stack@opam:1.4.0@7f4b0a5c", "@opam/mirage-random@opam:1.2.0@a5394e06", - "@opam/mirage-protocols@opam:2.0.0@7ccf2052", + "@opam/mirage-protocols@opam:3.0.0@f7347ea9", "@opam/mirage-net@opam:2.0.0@103e5ff1", "@opam/mirage-kv@opam:2.0.0@981db5b3", "@opam/mirage-fs@opam:2.0.0@2a37a9ef", @@ -2372,7 +2372,7 @@ "ocaml@4.8.0@d41d8cd9", "@opam/mirage-time@opam:1.3.0@08f25052", "@opam/mirage-stack@opam:1.4.0@7f4b0a5c", "@opam/mirage-random@opam:1.2.0@a5394e06", - "@opam/mirage-protocols@opam:2.0.0@7ccf2052", + "@opam/mirage-protocols@opam:3.0.0@f7347ea9", "@opam/mirage-net@opam:2.0.0@103e5ff1", "@opam/mirage-kv@opam:2.0.0@981db5b3", "@opam/mirage-fs@opam:2.0.0@2a37a9ef", @@ -2484,13 +2484,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/mirage-protocols@opam:2.0.0@7ccf2052", + "ocaml@4.8.0@d41d8cd9", "@opam/mirage-protocols@opam:3.0.0@f7347ea9", "@opam/mirage-device@opam:1.2.0@ed0c95c6", "@opam/fmt@opam:0.8.6@a06c130d", "@opam/dune@opam:1.10.0@b15ce221", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/mirage-protocols@opam:2.0.0@7ccf2052", + "ocaml@4.8.0@d41d8cd9", "@opam/mirage-protocols@opam:3.0.0@f7347ea9", "@opam/mirage-device@opam:1.2.0@ed0c95c6", "@opam/fmt@opam:0.8.6@a06c130d" ] @@ -2521,20 +2521,20 @@ "ocaml@4.8.0@d41d8cd9", "@opam/cstruct@opam:4.0.0@27f747cf" ] }, - "@opam/mirage-protocols@opam:2.0.0@7ccf2052": { - "id": "@opam/mirage-protocols@opam:2.0.0@7ccf2052", + "@opam/mirage-protocols@opam:3.0.0@f7347ea9": { + "id": "@opam/mirage-protocols@opam:3.0.0@f7347ea9", "name": "@opam/mirage-protocols", - "version": "opam:2.0.0", + "version": "opam:3.0.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/7f/7f9de3a8a966a2d78f664290cc231649#md5:7f9de3a8a966a2d78f664290cc231649", - "archive:https://github.com/mirage/mirage-protocols/releases/download/v2.0.0/mirage-protocols-v2.0.0.tbz#md5:7f9de3a8a966a2d78f664290cc231649" + "archive:https://opam.ocaml.org/cache/sha256/b8/b83352a91bb7a693ef7a2022539e789b869903946bbe374bac2df078d60b93e2#sha256:b83352a91bb7a693ef7a2022539e789b869903946bbe374bac2df078d60b93e2", + "archive:https://github.com/mirage/mirage-protocols/releases/download/v3.0.0/mirage-protocols-v3.0.0.tbz#sha256:b83352a91bb7a693ef7a2022539e789b869903946bbe374bac2df078d60b93e2" ], "opam": { "name": "mirage-protocols", - "version": "2.0.0", - "path": "esy.lock/opam/mirage-protocols.2.0.0" + "version": "3.0.0", + "path": "esy.lock/opam/mirage-protocols.3.0.0" } }, "overrides": [], @@ -2553,34 +2553,32 @@ "@opam/fmt@opam:0.8.6@a06c130d", "@opam/duration@opam:0.1.2@26859957" ] }, - "@opam/mirage-profile@opam:0.8.2@df7c8f80": { - "id": "@opam/mirage-profile@opam:0.8.2@df7c8f80", + "@opam/mirage-profile@opam:0.9.1@aa57bf25": { + "id": "@opam/mirage-profile@opam:0.9.1@aa57bf25", "name": "@opam/mirage-profile", - "version": "opam:0.8.2", + "version": "opam:0.9.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/7f/7f094bcb0b81746a712326ea583b2e76#md5:7f094bcb0b81746a712326ea583b2e76", - "archive:https://github.com/mirage/mirage-profile/releases/download/v0.8.2/mirage-profile-0.8.2.tbz#md5:7f094bcb0b81746a712326ea583b2e76" + "archive:https://opam.ocaml.org/cache/sha256/2b/2bb6cf03c73c6f45dedc34365c9131b8bdda62390b04d26eb76793a6422a0352#sha256:2bb6cf03c73c6f45dedc34365c9131b8bdda62390b04d26eb76793a6422a0352", + "archive:https://github.com/mirage/mirage-profile/releases/download/v0.9.1/mirage-profile-v0.9.1.tbz#sha256:2bb6cf03c73c6f45dedc34365c9131b8bdda62390b04d26eb76793a6422a0352" ], "opam": { "name": "mirage-profile", - "version": "0.8.2", - "path": "esy.lock/opam/mirage-profile.0.8.2" + "version": "0.9.1", + "path": "esy.lock/opam/mirage-profile.0.9.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/ocplib-endian@opam:1.0@aa720242", - "@opam/lwt@opam:4.2.1@c1888ec9", - "@opam/jbuilder@opam:transition@58bdfe0a", + "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dune@opam:1.10.0@b15ce221", "@opam/cstruct@opam:4.0.0@27f747cf", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/ppx_cstruct@opam:5.0.0@cea738b4", - "@opam/ocplib-endian@opam:1.0@aa720242", + "ocaml@4.8.0@d41d8cd9", "@opam/ocplib-endian@opam:1.0@aa720242", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/cstruct@opam:4.0.0@27f747cf" ] }, @@ -2817,7 +2815,7 @@ "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/mirage-time-lwt@opam:1.3.0@f1a78e79", "@opam/mirage-stack-lwt@opam:1.4.0@ccaf67a9", - "@opam/mirage-profile@opam:0.8.2@df7c8f80", + "@opam/mirage-profile@opam:0.9.1@aa57bf25", "@opam/mirage-kv-lwt@opam:2.0.0@585db097", "@opam/duration@opam:0.1.2@26859957", "@opam/dune@opam:1.10.0@b15ce221", @@ -2827,7 +2825,7 @@ "devDependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/mirage-time-lwt@opam:1.3.0@f1a78e79", "@opam/mirage-stack-lwt@opam:1.4.0@ccaf67a9", - "@opam/mirage-profile@opam:0.8.2@df7c8f80", + "@opam/mirage-profile@opam:0.9.1@aa57bf25", "@opam/mirage-kv-lwt@opam:2.0.0@585db097", "@opam/duration@opam:0.1.2@26859957", "@opam/dns-lwt@opam:1.1.1@4d6de87b" @@ -3292,7 +3290,7 @@ "overrides": [], "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/ocamlfind@opam:1.8.0@f744a0c5", - "@opam/conf-which@opam:1@56319cdb", + "@opam/conf-which@opam:1@576f0c6d", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.8.0@d41d8cd9" ] @@ -3593,12 +3591,12 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/mirage-profile@opam:0.8.2@df7c8f80", + "ocaml@4.8.0@d41d8cd9", "@opam/mirage-profile@opam:0.9.1@aa57bf25", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dune@opam:1.10.0@b15ce221", "@opam/dns@opam:1.1.1@f1b21283", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.8.0@d41d8cd9", "@opam/mirage-profile@opam:0.8.2@df7c8f80", + "ocaml@4.8.0@d41d8cd9", "@opam/mirage-profile@opam:0.9.1@aa57bf25", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/dns@opam:1.1.1@f1b21283" ] }, @@ -3622,7 +3620,7 @@ "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/uri@opam:2.2.1@6bd26f86", "@opam/result@opam:1.4@7add0d71", "@opam/re@opam:1.9.0@7f4a36a5", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/ipaddr@opam:3.1.0@e0ecc70f", "@opam/hashcons@opam:1.0.1@30492c11", "@opam/dune@opam:1.10.0@b15ce221", @@ -3633,7 +3631,7 @@ "devDependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/uri@opam:2.2.1@6bd26f86", "@opam/result@opam:1.4@7add0d71", "@opam/re@opam:1.9.0@7f4a36a5", - "@opam/ppx_cstruct@opam:5.0.0@cea738b4", + "@opam/ppx_cstruct@opam:5.0.0@f6407cfe", "@opam/ipaddr@opam:3.1.0@e0ecc70f", "@opam/hashcons@opam:1.0.1@30492c11", "@opam/cstruct@opam:4.0.0@27f747cf", @@ -3840,8 +3838,8 @@ "@opam/base-threads@opam:base@36803084" ] }, - "@opam/conf-which@opam:1@56319cdb": { - "id": "@opam/conf-which@opam:1@56319cdb", + "@opam/conf-which@opam:1@576f0c6d": { + "id": "@opam/conf-which@opam:1@576f0c6d", "name": "@opam/conf-which", "version": "opam:1", "source": { @@ -3857,8 +3855,8 @@ "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [] }, - "@opam/conf-pkg-config@opam:1.1@da0b7ce6": { - "id": "@opam/conf-pkg-config@opam:1.1@da0b7ce6", + "@opam/conf-pkg-config@opam:1.1@8c52f003": { + "id": "@opam/conf-pkg-config@opam:1.1@8c52f003", "name": "@opam/conf-pkg-config", "version": "opam:1.1", "source": { @@ -3882,8 +3880,8 @@ ], "devDependencies": [] }, - "@opam/conf-perl@opam:1@3174af0e": { - "id": "@opam/conf-perl@opam:1@3174af0e", + "@opam/conf-perl@opam:1@7e7ee9c5": { + "id": "@opam/conf-perl@opam:1@7e7ee9c5", "name": "@opam/conf-perl", "version": "opam:1", "source": { @@ -3913,13 +3911,13 @@ }, "overrides": [ "esy.lock/overrides/ee5c2c6906d87e3ea9a19e8e3dac5ec6" ], "dependencies": [ - "@opam/conf-pkg-config@opam:1.1@da0b7ce6", + "@opam/conf-pkg-config@opam:1.1@8c52f003", "@opam/conf-autoconf@github:esy-packages/esy-autoconf:package.json#71a8836@d41d8cd9" ], "devDependencies": [] }, - "@opam/conf-m4@opam:1@dd7dde42": { - "id": "@opam/conf-m4@opam:1@dd7dde42", + "@opam/conf-m4@opam:1@da6f4f44": { + "id": "@opam/conf-m4@opam:1@da6f4f44", "name": "@opam/conf-m4", "version": "opam:1", "source": { @@ -3935,8 +3933,8 @@ "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [] }, - "@opam/conf-gmp@opam:1@bee458be": { - "id": "@opam/conf-gmp@opam:1@bee458be", + "@opam/conf-gmp@opam:1@61c3c230": { + "id": "@opam/conf-gmp@opam:1@61c3c230", "name": "@opam/conf-gmp", "version": "opam:1", "source": { @@ -4083,7 +4081,7 @@ "dependencies": [ "ocaml@4.8.0@d41d8cd9", "@opam/jbuilder@opam:transition@58bdfe0a", "@opam/easy-format@opam:1.3.1@9abfd4ed", - "@opam/conf-which@opam:1@56319cdb", + "@opam/conf-which@opam:1@576f0c6d", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ diff --git a/esy.lock/opam/conf-gmp.1/opam b/esy.lock/opam/conf-gmp.1/opam index 398c426..d7ea805 100644 --- a/esy.lock/opam/conf-gmp.1/opam +++ b/esy.lock/opam/conf-gmp.1/opam @@ -12,8 +12,7 @@ build: [ ] {os = "macos"} ] depexts: [ - ["libgmp-dev"] {os-distribution = "debian"} - ["libgmp-dev"] {os-distribution = "ubuntu"} + ["libgmp-dev"] {os-family = "debian"} ["gmp"] {os = "macos" & os-distribution = "homebrew"} ["gmp" "gmp-devel"] {os-distribution = "centos"} ["gmp" "gmp-devel"] {os-distribution = "fedora"} diff --git a/esy.lock/opam/conf-m4.1/opam b/esy.lock/opam/conf-m4.1/opam index 981e702..df03511 100644 --- a/esy.lock/opam/conf-m4.1/opam +++ b/esy.lock/opam/conf-m4.1/opam @@ -6,8 +6,7 @@ authors: "GNU Project" license: "GPL-3" build: [["sh" "-exc" "echo | m4"]] depexts: [ - ["m4"] {os-distribution = "debian"} - ["m4"] {os-distribution = "ubuntu"} + ["m4"] {os-family = "debian"} ["m4"] {os-distribution = "fedora"} ["m4"] {os-distribution = "rhel"} ["m4"] {os-distribution = "centos"} diff --git a/esy.lock/opam/conf-perl.1/opam b/esy.lock/opam/conf-perl.1/opam index 999f098..c0dd1c7 100644 --- a/esy.lock/opam/conf-perl.1/opam +++ b/esy.lock/opam/conf-perl.1/opam @@ -6,8 +6,7 @@ license: "GPL-1+" authors: "Larry Wall" build: [["perl" "--version"]] depexts: [ - ["perl"] {os-distribution = "debian"} - ["perl"] {os-distribution = "ubuntu"} + ["perl"] {os-family = "debian"} ["perl"] {os-distribution = "alpine"} ["perl"] {os-distribution = "nixos"} ["perl"] {os-distribution = "arch"} diff --git a/esy.lock/opam/conf-pkg-config.1.1/opam b/esy.lock/opam/conf-pkg-config.1.1/opam index 1fbd0d5..4bd8695 100644 --- a/esy.lock/opam/conf-pkg-config.1.1/opam +++ b/esy.lock/opam/conf-pkg-config.1.1/opam @@ -17,8 +17,7 @@ post-messages: [ "conf-pkg-config: A symlink to /usr/local/bin/pkgconf has been installed in the OPAM bin directory (%{bin}%) on your PATH as 'pkg-config'. This is necessary for correct operation." {os = "openbsd"} ] depexts: [ - ["pkg-config"] {os-distribution = "debian"} - ["pkg-config"] {os-distribution = "ubuntu"} + ["pkg-config"] {os-family = "debian"} ["pkg-config"] {os-distribution = "arch"} ["pkgconfig"] {os-distribution = "fedora"} ["pkgconfig"] {os-distribution = "centos"} diff --git a/esy.lock/opam/conf-which.1/opam b/esy.lock/opam/conf-which.1/opam index 802239a..2180f30 100644 --- a/esy.lock/opam/conf-which.1/opam +++ b/esy.lock/opam/conf-which.1/opam @@ -9,8 +9,7 @@ depexts: [ ["which"] {os-distribution = "centos"} ["which"] {os-distribution = "fedora"} ["which"] {os-family = "suse"} - ["debianutils"] {os-distribution = "debian"} - ["debianutils"] {os-distribution = "ubuntu"} + ["debianutils"] {os-family = "debian"} ["which"] {os-distribution = "nixos"} ["which"] {os-distribution = "arch"} ] diff --git a/esy.lock/opam/mirage-profile.0.8.2/opam b/esy.lock/opam/mirage-profile.0.8.2/opam deleted file mode 100644 index 0184ca8..0000000 --- a/esy.lock/opam/mirage-profile.0.8.2/opam +++ /dev/null @@ -1,35 +0,0 @@ -opam-version: "2.0" -maintainer: "Thomas Leonard " -authors: "Thomas Leonard " -homepage: "https://github.com/mirage/mirage-profile" -dev-repo: "git+https://github.com/mirage/mirage-profile.git" -bug-reports: "https://github.com/mirage/mirage-profile/issues" -doc: "https://mirage.github.io/mirage-profile" -license: "BSD-2-clause" - -build: [ - [ "jbuilder" "subst" "-p" name] {pinned} - [ "jbuilder" "build" "-p" name "-j" jobs ] -] - -depends: [ - "ocaml" {>= "4.03.0"} - "jbuilder" {build & >= "1.0+beta9"} - "cstruct" {>= "3.0.0"} - "ppx_cstruct" - "ocplib-endian" - "lwt" -] -synopsis: "Collect runtime profiling information in CTF format" -description: """ -This library can be used to trace execution of OCaml/Lwt programs (such as Mirage unikernels) at the level of Lwt threads. -The traces can be viewed using JavaScript or GTK viewers provided by [mirage-trace-viewer][] or processed by tools supporting the [Common Trace Format (CTF)][ctf]. -Some example traces can be found in the blog post [Visualising an Asynchronous Monad](http://roscidus.com/blog/blog/2014/10/27/visualising-an-asynchronous-monad/). - -Libraries can use the functions mirage-profile provides to annotate the traces with extra information. -When compiled against a normal version of Lwt, mirage-profile's functions are null-ops (or call the underlying untraced operation, as appropriate) and OCaml's cross-module inlining will optimise these calls away, meaning there should be no overhead in the non-profiling case.""" -url { - src: - "https://github.com/mirage/mirage-profile/releases/download/v0.8.2/mirage-profile-0.8.2.tbz" - checksum: "md5=7f094bcb0b81746a712326ea583b2e76" -} diff --git a/esy.lock/opam/mirage-profile.0.9.1/opam b/esy.lock/opam/mirage-profile.0.9.1/opam new file mode 100644 index 0000000..a6ceed8 --- /dev/null +++ b/esy.lock/opam/mirage-profile.0.9.1/opam @@ -0,0 +1,43 @@ +opam-version: "2.0" +synopsis: "Collect runtime profiling information in CTF format" +maintainer: "Thomas Leonard " +authors: "Thomas Leonard " +license: "BSD-2-clause" +homepage: "https://github.com/mirage/mirage-profile" +doc: "https://mirage.github.io/mirage-profile/" +bug-reports: "https://github.com/mirage/mirage-profile/issues" +depends: [ + "ocaml" {>= "4.03.0"} + "dune" {build & >= "1.0"} + "cstruct" {>= "3.0.0"} + "ppx_cstruct" {build} + "ocplib-endian" + "lwt" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +dev-repo: "git+https://github.com/mirage/mirage-profile.git" +description: """ +This library can be used to trace execution of OCaml/Lwt programs (such as +Mirage unikernels) at the level of Lwt threads. The traces can be viewed using +JavaScript or GTK viewers provided by [mirage-trace-viewer][] or processed by +tools supporting the [Common Trace Format (CTF)][ctf]. Some example traces can +be found in the blog post [Visualising an Asynchronous +Monad](http://roscidus.com/blog/blog/2014/10/27/visualising-an-asynchronous-monad/). + +Libraries can use the functions mirage-profile provides to annotate the traces +with extra information. When compiled against a normal version of Lwt, +mirage-profile's functions are null-ops (or call the underlying untraced +operation, as appropriate) and OCaml's cross-module inlining will optimise +these calls away, meaning there should be no overhead in the non-profiling +case. +""" +url { + src: + "https://github.com/mirage/mirage-profile/releases/download/v0.9.1/mirage-profile-v0.9.1.tbz" + checksum: [ + "sha256=2bb6cf03c73c6f45dedc34365c9131b8bdda62390b04d26eb76793a6422a0352" + "sha512=23cc4a2a62f5cc05b48d626bd6c8171a442fd46490da6810b1c507fcd7661c7fcd901d8328cddf687af4144136bf0d34b63f8484e32550077ab63d23e6eaea2b" + ] +} diff --git a/esy.lock/opam/mirage-protocols.2.0.0/opam b/esy.lock/opam/mirage-protocols.3.0.0/opam similarity index 79% rename from esy.lock/opam/mirage-protocols.2.0.0/opam rename to esy.lock/opam/mirage-protocols.3.0.0/opam index b818d9f..0ea018f 100644 --- a/esy.lock/opam/mirage-protocols.2.0.0/opam +++ b/esy.lock/opam/mirage-protocols.3.0.0/opam @@ -31,6 +31,9 @@ The current signatures are: ETHERNET, ARP, IP, ICMP, UDP, TCP. """ url { src: - "https://github.com/mirage/mirage-protocols/releases/download/v2.0.0/mirage-protocols-v2.0.0.tbz" - checksum: "md5=7f9de3a8a966a2d78f664290cc231649" + "https://github.com/mirage/mirage-protocols/releases/download/v3.0.0/mirage-protocols-v3.0.0.tbz" + checksum: [ + "sha256=b83352a91bb7a693ef7a2022539e789b869903946bbe374bac2df078d60b93e2" + "sha512=041c16ee3749562a3900762ef1c179f3d97efb856ec79346223083399cfb13b0e22d2041fb4208b98a557ae5ddf561d79c14362a8ce32dd08fe006b45e4b1c3e" + ] } diff --git a/esy.lock/opam/ppx_cstruct.5.0.0/opam b/esy.lock/opam/ppx_cstruct.5.0.0/opam index f21571e..15ad87a 100644 --- a/esy.lock/opam/ppx_cstruct.5.0.0/opam +++ b/esy.lock/opam/ppx_cstruct.5.0.0/opam @@ -13,7 +13,7 @@ tags: [ "org:mirage" "org:ocamllabs" ] build: [ ["dune" "subst"] {pinned} ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "runtest" "-p" name "-j" jobs] {with-test & ocaml:version < "4.08.0"} ] depends: [ "ocaml" {>= "4.03.0"} diff --git a/esy.lock/opam/ppx_deriving.4.4/opam b/esy.lock/opam/ppx_deriving.4.4/opam new file mode 100644 index 0000000..e45d258 --- /dev/null +++ b/esy.lock/opam/ppx_deriving.4.4/opam @@ -0,0 +1,35 @@ +opam-version: "2.0" +maintainer: "whitequark " +authors: [ "whitequark " ] +license: "MIT" +homepage: "https://github.com/ocaml-ppx/ppx_deriving" +doc: "https://ocaml-ppx.github.io/ppx_deriving/" +bug-reports: "https://github.com/ocaml-ppx/ppx_deriving/issues" +dev-repo: "git+https://github.com/ocaml-ppx/ppx_deriving.git" +tags: [ "syntax" ] +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test & ocaml:version >= "4.03"} + ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} +] +depends: [ + "dune" {build >= "1.6.3"} + "cppo" {build} + "ppxfind" {build} + "ocaml-migrate-parsetree" + "ppx_derivers" + "ppx_tools" {>= "4.02.3"} + "result" + "ounit" {with-test} + "ocaml" {>= "4.02" & < "4.09.0"} +] +synopsis: "Type-driven code generation for OCaml >=4.02.2" +description: """ +ppx_deriving provides common infrastructure for generating +code based on type definitions, and a set of useful plugins +for common tasks. +""" +url { + src: "https://github.com/ocaml-ppx/ppx_deriving/archive/v4.4.tar.gz" + checksum: "sha256=c2d85af4cb65a1f163f624590fb0395a164bbfd0d05082092526b669e66bcc34"} diff --git a/esy.lock/opam/ppx_tools_versioned.5.2.2/opam b/esy.lock/opam/ppx_tools_versioned.5.2.3/opam similarity index 75% rename from esy.lock/opam/ppx_tools_versioned.5.2.2/opam rename to esy.lock/opam/ppx_tools_versioned.5.2.3/opam index 46aff30..79251f5 100644 --- a/esy.lock/opam/ppx_tools_versioned.5.2.2/opam +++ b/esy.lock/opam/ppx_tools_versioned.5.2.3/opam @@ -17,14 +17,14 @@ build: [ depends: [ "ocaml" {>= "4.02.0"} "dune" {build & >= "1.0"} - "ocaml-migrate-parsetree" {>= "1.0.10"} + "ocaml-migrate-parsetree" {>= "1.4.0"} ] synopsis: "A variant of ppx_tools based on ocaml-migrate-parsetree" url { src: - "https://github.com/ocaml-ppx/ppx_tools_versioned/archive/5.2.2.tar.gz" + "https://github.com/ocaml-ppx/ppx_tools_versioned/archive/5.2.3.tar.gz" checksum: [ - "md5=f78a3c2b4cc3b92702e1f7096a6125fa" - "sha512=68c168ebc01af46fe8766ad7e36cc778caabb97d8eb303db284d106450cb79974c2a640ce459e197630b9e84b02caa24b59c97c9a8d39ddadc7efc7284e42a70" + "md5=b1455e5a4a1bcd9ddbfcf712ccbd4262" + "sha512=af20aa0031b9c638537bcdb52c75de95f316ae8fd455a38672a60da5c7c6895cca9dbecd5d56a88c3c40979c6a673a047d986b5b41e1e84b528b7df5d905b9b1" ] } diff --git a/examples/async/async_get.ml b/examples/async/async_get.ml index da49267..7a0b537 100644 --- a/examples/async/async_get.ml +++ b/examples/async/async_get.ml @@ -13,11 +13,12 @@ let main port host () = let finished = Ivar.create () in let response_handler = Httpaf_examples.Client.print ~on_eof:(Ivar.fill finished) in let headers = Headers.of_list [ "host", host ] in + let connection = Client.create_connection socket in let request_body = Client.request - ~error_handler + connection ~response_handler - socket + ~error_handler (Request.create ~headers `GET "/") in Body.close_writer request_body; diff --git a/examples/async/async_get_pipelined.ml b/examples/async/async_get_pipelined.ml new file mode 100644 index 0000000..5382a58 --- /dev/null +++ b/examples/async/async_get_pipelined.ml @@ -0,0 +1,53 @@ +open! Core +open Async + +open Httpaf +open Httpaf_async + +let error_handler _ = assert false + +let main port host () = + let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in + Tcp.connect_sock where_to_connect + >>= fun socket -> + let finished = Ivar.create () in + let response_handler = Httpaf_examples.Client.print ~on_eof:(Ivar.fill finished) in + let request_headers = + Request.create ~headers:(Headers.of_list [ "host", host ]) `GET "/" + in + let connection = Client.create_connection socket in + let request_body = + Client.request + connection + ~response_handler + ~error_handler + request_headers + in + let finished' = Ivar.create () in + let response_handler' = + Httpaf_examples.Client.print ~on_eof:(Ivar.fill finished') + in + let request_body' = + Client.request + connection + ~response_handler:response_handler' + ~error_handler + request_headers + in + Body.close_writer request_body'; + Body.close_writer request_body; + Async.Deferred.all_unit [Ivar.read finished; Ivar.read finished'] >>| fun () -> + Client.shutdown connection +;; + +let () = + Command.async + ~summary:"Start a hello world Async client" + Command.Param.( + map (both + (flag "-p" (optional_with_default 80 int) + ~doc:"int destination port") + (anon ("host" %: string))) + ~f:(fun (port, host) -> + (fun () -> main port host ()))) + |> Command.run diff --git a/examples/async/async_post.ml b/examples/async/async_post.ml index c2e9702..2f34668 100644 --- a/examples/async/async_post.ml +++ b/examples/async/async_post.ml @@ -19,11 +19,12 @@ let main port host () = ; "host" , host ] in + let connection = Client.create_connection socket in let request_body = Client.request - ~error_handler + connection ~response_handler - socket + ~error_handler (Request.create ~headers `POST "/") in let stdin = Lazy.force Reader.stdin in diff --git a/examples/async/dune b/examples/async/dune index 4008a21..868edbe 100644 --- a/examples/async/dune +++ b/examples/async/dune @@ -1,7 +1,8 @@ (executables (libraries httpaf httpaf-async httpaf_examples async core) - (names async_echo_post async_get async_post)) + (names async_echo_post async_get async_get_pipelined async_post)) (alias (name examples) - (deps (glob_files *.exe))) + (deps + (glob_files *.exe))) diff --git a/examples/lwt/dune b/examples/lwt/dune index 1b84bf1..1118a01 100644 --- a/examples/lwt/dune +++ b/examples/lwt/dune @@ -1,6 +1,7 @@ (executables (libraries httpaf httpaf-lwt-unix httpaf_examples base stdio lwt lwt.unix) - (names lwt_get lwt_post lwt_echo_post lwt_https_get lwt_https_server)) + (names lwt_get lwt_get_pipelined lwt_post lwt_echo_post lwt_https_get + lwt_https_server)) (alias (name examples) diff --git a/examples/lwt/lwt_get.ml b/examples/lwt/lwt_get.ml index c109d51..7671c94 100644 --- a/examples/lwt/lwt_get.ml +++ b/examples/lwt/lwt_get.ml @@ -18,15 +18,31 @@ let main port host = Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished) in let headers = Headers.of_list [ "host", host ] in + Client.create_connection socket >>= fun connection -> let request_body = Client.request + connection + ~response_handler ~error_handler + (Request.create ~headers `GET "/") + in + Body.close_writer request_body; + finished >>= fun () -> + let finished, notify_finished = Lwt.wait () in + let response_handler = + Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished) + in + let headers = Headers.of_list [ "host", host ] in + let request_body = + Client.request + connection ~response_handler - socket + ~error_handler (Request.create ~headers `GET "/") in Body.close_writer request_body; - finished + finished >|= fun () -> + Client.shutdown connection ;; let () = diff --git a/examples/lwt/lwt_get_pipelined.ml b/examples/lwt/lwt_get_pipelined.ml new file mode 100644 index 0000000..d029a1e --- /dev/null +++ b/examples/lwt/lwt_get_pipelined.ml @@ -0,0 +1,61 @@ +open Base +open Lwt.Infix +module Arg = Caml.Arg + +open Httpaf +open Httpaf_lwt_unix + +let error_handler _ = assert false + +let main port host = + Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)] + >>= fun addresses -> + let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr + >>= fun () -> + let finished, notify_finished = Lwt.wait () in + let response_handler = + Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished) + in + let request_headers = + Request.create ~headers:(Headers.of_list [ "host", host ]) `GET "/" + in + Client.create_connection socket >>= fun connection -> + let request_body = + Client.request + connection + ~response_handler + ~error_handler + request_headers + in + let finished', notify_finished' = Lwt.wait () in + let response_handler' = + Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished') + in + let request_body' = + Client.request + connection + ~response_handler:response_handler' + ~error_handler + request_headers + in + Body.close_writer request_body'; + Body.close_writer request_body; + Lwt.join [finished; finished'] >|= fun () -> + Client.shutdown connection +;; + +let () = + let host = ref None in + let port = ref 80 in + Arg.parse + ["-p", Set_int port, " Port number (80 by default)"] + (fun host_argument -> host := Some host_argument) + "lwt_get.exe [-p N] HOST"; + let host = + match !host with + | None -> failwith "No hostname provided" + | Some host -> host + in + Lwt_main.run (main !port host) +;; diff --git a/examples/lwt/lwt_https_get.ml b/examples/lwt/lwt_https_get.ml index 6546f80..da257c9 100644 --- a/examples/lwt/lwt_https_get.ml +++ b/examples/lwt/lwt_https_get.ml @@ -18,12 +18,13 @@ let main port host = Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished) in let headers = Headers.of_list [ "host", host ] in - Client.TLS.request + Client.TLS.create_connection socket >>= fun connection -> + let request_body = Client.TLS.request + connection ~error_handler ~response_handler - socket (Request.create ~headers `GET "/") - >>= fun request_body -> + in Body.close_writer request_body; finished ;; diff --git a/examples/lwt/lwt_post.ml b/examples/lwt/lwt_post.ml index 91451ad..6f1af57 100644 --- a/examples/lwt/lwt_post.ml +++ b/examples/lwt/lwt_post.ml @@ -26,11 +26,12 @@ let main port host = ; "host" , host ] in + Client.create_connection socket >>= fun connection -> let request_body = Client.request - ~error_handler + connection ~response_handler - socket + ~error_handler (Request.create ~headers `POST "/") in Body.write_string request_body body; diff --git a/lib/body.ml b/lib/body.ml index 3a712ac..7e0a0b1 100644 --- a/lib/body.ml +++ b/lib/body.ml @@ -60,6 +60,7 @@ let create buffer = let create_empty () = let t = create Bigstringaf.empty in + t.write_final_if_chunked <- false; Faraday.close t.faraday; t diff --git a/lib/client_connection.ml b/lib/client_connection.ml index 800abb7..d5f215e 100644 --- a/lib/client_connection.ml +++ b/lib/client_connection.ml @@ -1,5 +1,6 @@ (*---------------------------------------------------------------------------- Copyright (c) 2017-2019 Inhabited Type LLC. + Copyright (c) 2019 Antonio Nuno Monteiro. All rights reserved. @@ -34,170 +35,238 @@ module Reader = Parse.Reader module Writer = Serialize.Writer -module Oneshot = struct - type error = - [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ] - - type response_handler = Response.t -> [`read] Body.t -> unit - type error_handler = error -> unit - - type state = - | Awaiting_response - | Received_response of Response.t * [`read] Body.t - | Closed - - type t = - { request : Request.t - ; request_body : [ `write ] Body.t - ; response_handler : (Response.t -> [`read] Body.t -> unit) - ; error_handler : (error -> unit) - ; reader : Reader.response - ; writer : Writer.t - ; state : state ref - ; mutable error_code : [ `Ok | error ] - } - - let request ?(config=Config.default) request ~error_handler ~response_handler = - let state = ref Awaiting_response in - let request_method = request.Request.meth in - let handler response body = - state := Received_response(response, body); - response_handler response body - in - let request_body = Body.create (Bigstringaf.create config.request_body_buffer_size) in - let t = - { request - ; request_body - ; response_handler - ; error_handler - ; error_code = `Ok - ; reader = Reader.response ~request_method handler - ; writer = Writer.create () - ; state } - in - Writer.write_request t.writer request; - request_body, t - ;; - - let flush_request_body t = - if Body.has_pending_output t.request_body - then - let encoding = - match Request.body_length t.request with - | `Fixed _ | `Chunked as encoding -> encoding - | `Error _ -> assert false (* XXX(seliopou): This needs to be handled properly *) - in - Body.transfer_to_writer_with_encoding t.request_body ~encoding t.writer - ;; - - let set_error_and_handle_without_shutdown t error = - t.state := Closed; - t.error_code <- (error :> [`Ok | error]); - t.error_handler error; - ;; - - let unexpected_eof t = - set_error_and_handle_without_shutdown t (`Malformed_response "unexpected eof"); - ;; - - let shutdown_reader t = - Reader.force_close t.reader; - begin match !(t.state) with - | Awaiting_response -> unexpected_eof t; - | Closed -> () - | Received_response(_, response_body) -> - Body.close_reader response_body; - Body.execute_read response_body; - end; - ;; - - let shutdown_writer t = - flush_request_body t; - Writer.close t.writer; - Body.close_writer t.request_body; - ;; - - let shutdown t = - shutdown_reader t; - shutdown_writer t; - ;; - - let set_error_and_handle t error = - shutdown t; - set_error_and_handle_without_shutdown t error; - ;; - - let report_exn t exn = - set_error_and_handle t (`Exn exn) - ;; - - let flush_response_body t = - match !(t.state) with - | Awaiting_response | Closed -> () - | Received_response(_, response_body) -> - try Body.execute_read response_body - with exn -> report_exn t exn - ;; - - let _next_read_operation t = - match !(t.state) with - | Awaiting_response | Closed -> Reader.next t.reader - | Received_response(_, response_body) -> - if not (Body.is_closed response_body) - then Reader.next t.reader - else begin - Reader.force_close t.reader; - Reader.next t.reader - end - ;; - - let next_read_operation t = - match _next_read_operation t with - | `Error (`Parse(marks, message)) -> - let message = String.concat "" [ String.concat ">" marks; ": "; message] in - set_error_and_handle t (`Malformed_response message); - `Close - | `Error (`Invalid_response_body_length _ as error) -> - set_error_and_handle t error; - `Close - | (`Read | `Close) as operation -> operation - ;; - - let read_with_more t bs ~off ~len more = - let consumed = Reader.read_with_more t.reader bs ~off ~len more in - flush_response_body t; - consumed - ;; - - let read t bs ~off ~len = - read_with_more t bs ~off ~len Incomplete - - let read_eof t bs ~off ~len = - let bytes_read = read_with_more t bs ~off ~len Complete in - begin match !(t.state) with +type error = + [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ] + +type response_handler = Response.t -> [`read] Body.t -> unit +type error_handler = error -> unit + +type t = + { config : Config.t + ; reader : Reader.response + ; writer : Writer.t + ; request_queue : Respd.t Queue.t + (* invariant: If [request_queue] is not empty, then the head of the queue + has already written the request headers to the wire. *) + ; wakeup_writer : (unit -> unit) list ref + } + +let is_closed t = + Reader.is_closed t.reader && Writer.is_closed t.writer + +let is_waiting t = + not (is_closed t) && Queue.is_empty t.request_queue + +let is_active t = + not (Queue.is_empty t.request_queue) + +let current_respd_exn t = + Queue.peek t.request_queue + +let on_wakeup_writer t k = + if is_closed t + then failwith "on_wakeup_writer on closed conn" + else t.wakeup_writer := k::!(t.wakeup_writer) + +let _wakeup_writer callbacks = + let fs = !callbacks in + callbacks := []; + List.iter (fun f -> f ()) fs + +let wakeup_writer t = + _wakeup_writer t.wakeup_writer + +let[@ocaml.warning "-16"] create ?(config=Config.default) = + let request_queue = Queue.create () in + { config + ; reader = Reader.response request_queue + ; writer = Writer.create () + ; request_queue + ; wakeup_writer = ref [] + } + +let request t request ~error_handler ~response_handler = + let request_body = + Body.create (Bigstringaf.create t.config.request_body_buffer_size) + in + let respd = + Respd.create error_handler request request_body t.writer response_handler in + let handle_now = Queue.is_empty t.request_queue in + Queue.push respd t.request_queue; + if handle_now then + Respd.write_request respd; + (* Not handling the request now means it may be pipelined. + * `advance_request_queue_if_necessary` will take care of it, but we still + * wanna wake up the writer so that the function gets called. *) + _wakeup_writer t.wakeup_writer; + request_body +;; + +let flush_request_body t = + if is_active t then begin + let respd = current_respd_exn t in + Respd.flush_request_body respd + end + +let set_error_and_handle_without_shutdown t error = + if is_active t then begin + let respd = current_respd_exn t in + Respd.report_error respd error + end + (* TODO: not active?! can be because of a closed FD for example. *) +;; + +let unexpected_eof t = + set_error_and_handle_without_shutdown t (`Malformed_response "unexpected eof"); +;; + +let shutdown_reader t = + Reader.force_close t.reader; + if is_active t + then Respd.close_response_body (current_respd_exn t) + +let shutdown_writer t = + flush_request_body t; + Writer.close t.writer; + if is_active t then begin + let respd = current_respd_exn t in + Body.close_writer respd.request_body; + end +;; + +let shutdown t = + shutdown_reader t; + shutdown_writer t; +;; + +(* TODO: Need to check in the RFC if reporting an error, e.g. in a malformed + * response causes the whole connection to shutdown. *) +let set_error_and_handle t error = + shutdown t; + set_error_and_handle_without_shutdown t error; +;; + +let report_exn t exn = + set_error_and_handle t (`Exn exn) +;; + +exception Local + +let maybe_pipeline_queued_requests t = + (* Don't bother trying to pipeline if there aren't multiple requests in the + * queue. *) + if Queue.length t.request_queue > 1 then begin + match Queue.fold (fun prev respd -> + begin match prev with + | None -> () + | Some prev -> + if respd.Respd.state = Uninitialized && not (Respd.requires_output prev) + then Respd.write_request respd + else + (* bail early. If we can't pipeline this request, we can't write + * next ones either. *) + raise Local + end; + Some respd) + None + t.request_queue + with + | _ -> () + | exception Local -> () + end + +let advance_request_queue_if_necessary t = + if is_active t then begin + let respd = current_respd_exn t in + if Respd.persistent_connection respd then begin + if Respd.is_complete respd then begin + ignore (Queue.take t.request_queue); + if not (Queue.is_empty t.request_queue) then begin + (* write request to the wire *) + let respd = current_respd_exn t in + Respd.write_request respd; + end; + wakeup_writer t; + end else if not (Respd.requires_output respd) then + (* From RFC7230ยง6.3.2: + * A client that supports persistent connections MAY "pipeline" its + * requests (i.e., send multiple requests without waiting for each + * response). *) + maybe_pipeline_queued_requests t + end else begin + ignore (Queue.take t.request_queue); + Queue.iter Respd.close_response_body t.request_queue; + Queue.clear t.request_queue; + Queue.push respd t.request_queue; + wakeup_writer t; + if Respd.is_complete respd + then shutdown t + else if not (Respd.requires_output respd) + then shutdown_writer t + end + end else if Reader.is_closed t.reader + then shutdown t + +let next_read_operation t = + advance_request_queue_if_necessary t; + match Reader.next t.reader with + | `Error (`Parse(marks, message)) -> + let message = String.concat "" [ String.concat ">" marks; ": "; message] in + set_error_and_handle t (`Malformed_response message); + `Close + | `Error (`Invalid_response_body_length _ as error) -> + set_error_and_handle t error; + `Close + | (`Read | `Close) as operation -> operation +;; + +let read_with_more t bs ~off ~len more = + let consumed = Reader.read_with_more t.reader bs ~off ~len more in + if is_active t then + Respd.flush_response_body (current_respd_exn t); + consumed +;; + +let read t bs ~off ~len = + read_with_more t bs ~off ~len Incomplete + +let read_eof t bs ~off ~len = + let bytes_read = read_with_more t bs ~off ~len Complete in + if is_active t then begin + let respd = current_respd_exn t in + (* TODO: could just check for `Respd.requires_input`? *) + match respd.state with + | Uninitialized -> assert false | Received_response _ | Closed -> () - | Awaiting_response -> unexpected_eof t; - end; - bytes_read - ;; - - let next_write_operation t = - flush_request_body t; - if Body.is_closed t.request_body - then Writer.close t.writer; - Writer.next t.writer - ;; - - let yield_writer t k = - if Body.is_closed t.request_body - then begin + | Awaiting_response -> + (* TODO: review this. It makes sense to tear down the connection if an + * unexpected EOF is received. *) + shutdown t; + unexpected_eof t + end; + bytes_read +;; + +let next_write_operation t = + advance_request_queue_if_necessary t; + flush_request_body t; + Writer.next t.writer +;; + +let yield_writer t k = + if is_active t then begin + let respd = current_respd_exn t in + if Respd.requires_output respd then + Respd.on_more_output_available respd k + else if Respd.persistent_connection respd then + on_wakeup_writer t k + else begin + (* TODO: call shutdown? *) Writer.close t.writer; k () - end else - Body.when_ready_to_write t.request_body k - - let report_write_result t result = - Writer.report_result t.writer result + end + end else + on_wakeup_writer t k - let is_closed t = Reader.is_closed t.reader && Writer.is_closed t.writer -end +let report_write_result t result = + Writer.report_result t.writer result diff --git a/lib/httpaf.ml b/lib/httpaf.ml index 2697ed0..13e6d12 100644 --- a/lib/httpaf.ml +++ b/lib/httpaf.ml @@ -10,7 +10,7 @@ module Body = Body module Config = Config module Server_connection = Server_connection -module Client_connection = Client_connection.Oneshot +module Client_connection = Client_connection module Httpaf_private = struct module Serialize = Serialize diff --git a/lib/httpaf.mli b/lib/httpaf.mli index 53f9ac6..9605256 100644 --- a/lib/httpaf.mli +++ b/lib/httpaf.mli @@ -1,5 +1,6 @@ (*---------------------------------------------------------------------------- Copyright (c) 2017 Inhabited Type LLC. + Copyright (c) 2019 Antonio Nuno Monteiro. All rights reserved. @@ -762,12 +763,14 @@ module Client_connection : sig type error_handler = error -> unit + val create : ?config:Config.t -> t + val request - : ?config:Config.t + : t -> Request.t -> error_handler:error_handler -> response_handler:response_handler - -> [`write] Body.t * t + -> [`write] Body.t val next_read_operation : t -> [ `Read | `Close ] (** [next_read_operation t] returns a value describing the next operation @@ -819,10 +822,15 @@ module Client_connection : sig may call its error handler before terminating the connection. *) val is_closed : t -> bool + (** [is_closed t] is [true] if both the read and write processors have been + shutdown. When this is the case {!next_read_operation} will return + [`Close _] and {!next_write_operation} will return [`Write _] until all + buffered output has been flushed, at which point it will also return + `Close. *) - (**/**) val shutdown : t -> unit - (**/**) + (** [shutdown connection] closes the underlying input and output channels of + the connection, rendering it unusable for any further communication. *) end (**/**) diff --git a/lib/parse.ml b/lib/parse.ml index 599e5bf..d96c35c 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -242,19 +242,30 @@ module Reader = struct in create parser - let response ~request_method handler = + let response request_queue = let parser = response <* commit >>= fun response -> + assert (not (Queue.is_empty request_queue)); + let exception Local of Respd.t in + let respd = match + (Queue.iter (fun respd -> + if respd.Respd.state = Awaiting_response then + raise (Local respd)) request_queue) + with + | exception Local respd -> respd + | _ -> assert false + in + let request = Respd.request respd in let proxy = false in - match Response.body_length ~request_method response with + match Response.body_length ~request_method:request.meth response with | `Error `Bad_gateway -> assert (not proxy); assert false | `Error `Internal_server_error -> return (Error (`Invalid_response_body_length response)) | `Fixed 0L -> - handler response Body.empty; + respd.response_handler response Body.empty; ok | `Fixed _ | `Chunked | `Close_delimited as encoding -> let response_body = Body.create Bigstringaf.empty in - handler response response_body; + respd.response_handler response response_body; body ~encoding response_body *> ok in create parser diff --git a/lib/respd.ml b/lib/respd.ml new file mode 100644 index 0000000..43e0f9d --- /dev/null +++ b/lib/respd.ml @@ -0,0 +1,118 @@ +module Writer = Serialize.Writer + +type error = + [ `Malformed_response of string + | `Invalid_response_body_length of Response.t + | `Exn of exn ] + +type state = + | Uninitialized + | Awaiting_response + | Received_response of Response.t * [`read] Body.t + | Closed + +type t = + { request : Request.t + ; request_body : [ `write ] Body.t + ; response_handler : (Response.t -> [`read] Body.t -> unit) + ; error_handler : (error -> unit) + ; mutable error_code : [ `Ok | error ] + ; writer : Writer.t + ; mutable state : state + ; mutable persistent : bool + } + +let create error_handler request request_body writer response_handler = + let rec handler response body = + let t = Lazy.force t in + if t.persistent then + t.persistent <- Response.persistent_connection response; + t.state <- Received_response(response, body); + response_handler response body + and t = + lazy + { request + ; request_body + ; response_handler = handler + ; error_handler + ; error_code = `Ok + ; writer + ; state = Uninitialized + ; persistent = Request.persistent_connection request + } + in + Lazy.force t + +let request { request; _ } = request + +let request_body { request_body; _ } = request_body + +let write_request t = + Writer.write_request t.writer t.request; + t.state <- Awaiting_response + +let on_more_output_available { request_body; _ } f = + Body.when_ready_to_write request_body f + +let report_error t error = + (* t.persistent <- false; *) + (* TODO: drain queue? *) + match t.state, t.error_code with + | (Uninitialized | Awaiting_response | Received_response _), `Ok -> + t.state <- Closed; + t.error_code <- (error :> [`Ok | error]); + t.error_handler error + | Uninitialized, `Exn _ -> + (* TODO(anmonteiro): Not entirely sure this is possible in the client. *) + failwith "httpaf.Reqd.report_exn: NYI" + | (Uninitialized | Awaiting_response | Received_response _ | Closed), _ -> + (* XXX(seliopou): Once additional logging support is added, log the error + * in case it is not spurious. *) + () + +let persistent_connection t = + t.persistent + +let close_response_body t = + match t.state with + | Uninitialized + | Awaiting_response + | Closed -> () + | Received_response (_, response_body) -> + Body.close_reader response_body + +let requires_input t = + match t.state with + | Uninitialized -> true + | Awaiting_response -> true + | Received_response (_, response_body) -> + not (Body.is_closed response_body) + | Closed -> false + +let requires_output { request_body; state; _ } = + state = Uninitialized || + not (Body.is_closed request_body) || + Body.has_pending_output request_body + +let is_complete t = + not (requires_input t || requires_output t) + +let flush_request_body { request; request_body; writer; _ } = + if Body.has_pending_output request_body + then + let encoding = + match Request.body_length request with + | `Fixed _ | `Chunked as encoding -> encoding + | `Error _ -> assert false (* XXX(seliopou): This needs to be handled properly *) + in + Body.transfer_to_writer_with_encoding request_body ~encoding writer + +let flush_response_body t = + match t.state with + | Uninitialized | Awaiting_response | Closed -> () + | Received_response(_, response_body) -> + try Body.execute_read response_body + (* TODO: report_exn *) + with _exn -> + Format.eprintf "EXN@." + (* report_exn t exn *) diff --git a/lib/server_connection.ml b/lib/server_connection.ml index 4a13efc..f9fc540 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -32,17 +32,6 @@ ----------------------------------------------------------------------------*) -module Queue = struct - include Queue - - let peek_exn = peek - - let peek t = - if is_empty t - then None - else Some (peek_exn t) -end - module Reader = Parse.Reader module Writer = Serialize.Writer @@ -82,7 +71,7 @@ let is_active t = not (Queue.is_empty t.request_queue) let current_reqd_exn t = - Queue.peek_exn t.request_queue + Queue.peek t.request_queue let on_wakeup_reader t k = if is_closed t diff --git a/lib_test/test_httpaf.ml b/lib_test/test_httpaf.ml index eadc96e..2a7d996 100644 --- a/lib_test/test_httpaf.ml +++ b/lib_test/test_httpaf.ml @@ -782,30 +782,53 @@ module Client_connection = struct let response = Response.create `OK in (* Single GET *) - let body, t = + let t = create ?config:None in + let body = request + t request' ~response_handler:(default_response_handler response) ~error_handler:no_error_handler in Body.close_writer body; - write_request t request'; - writer_closed t; - read_response t response; + write_request t request'; + read_response t response; + + (* Single GET, request closes the connection. *) + let request_close = + Request.create + ~headers:(Headers.of_list ["connection", "close"]) + `GET "/" + in + let t = create ?config:None in + let body = + request + t + request_close + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body; + write_request t request_close; + writer_closed t; + read_response t response; - (* Single GET, reponse closes connection *) + (* Single GET, response closes connection *) let response = Response.create `OK ~headers:(Headers.of_list [ "connection", "close" ]) in - let body, t = + let t = create ?config:None in + let body = request + t request' ~response_handler:(default_response_handler response) ~error_handler:no_error_handler in Body.close_writer body; - write_request t request'; - read_response t response; + write_request t request'; + read_response t response; + writer_closed t; let c = read_eof t Bigstringaf.empty ~off:0 ~len:0 in Alcotest.(check int) "read_eof with no input returns 0" 0 c; connection_is_shutdown t; @@ -814,16 +837,56 @@ module Client_connection = struct let response = Response.create `OK ~headers:(Headers.of_list [ "transfer-encoding", "chunked" ]) in - let body, t = + let t = create ?config:None in + let body = request + t request' ~response_handler:(default_response_handler response) ~error_handler:no_error_handler in Body.close_writer body; - write_request t request'; - read_response t response; - read_string t "d\r\nHello, world!\r\n0\r\n\r\n"; + write_request t request'; + read_response t response; + read_string t "d\r\nHello, world!\r\n0\r\n\r\n"; + ;; + + let test_get_last_close () = + (* Multiple GET requests, the last one closes the connection *) + let request' = Request.create `GET "/" in + let response = + Response.create ~headers:(Headers.of_list ["content-length", "0"]) `OK + in + let t = create ?config:None in + let body = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body; + write_request t request'; + read_response t response; + + let request'' = + Request.create ~headers:(Headers.of_list ["connection", "close"]) `GET "/" + in + let body' = + request + t + request'' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body'; + write_request t request''; + read_response t response; + + writer_closed t; + let c = read_eof t Bigstringaf.empty ~off:0 ~len:0 in + Alcotest.(check int) "read_eof with no input returns 0" 0 c; + connection_is_shutdown t; ;; let test_response_eof () = @@ -831,8 +894,10 @@ module Client_connection = struct let response = Response.create `OK in (* not actually writen to the channel *) let error_message = ref None in - let body, t = + let t = create ?config:None in + let body = request + t request' ~response_handler:(default_response_handler response) ~error_handler:(function @@ -840,8 +905,7 @@ module Client_connection = struct | _ -> assert false) in Body.close_writer body; - write_request t request'; - writer_closed t; + write_request t request'; reader_ready t; let c = read_eof t Bigstringaf.empty ~off:0 ~len:0 in Alcotest.(check int) "read_eof with no input returns 0" 0 c; @@ -851,9 +915,147 @@ module Client_connection = struct !error_message ;; + let test_persistent_connection_requests () = + let request' = Request.create `GET "/" in + let response = + Response.create ~headers:(Headers.of_list [ "content-length", "0" ]) `OK + in + let t = create ?config:None in + let body = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body; + write_request t request'; + read_response t response; + writer_yielded t; + reader_ready t; + let body' = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body'; + write_request t request'; + read_response t response; + ;; + + let test_persistent_connection_requests_pipelining () = + let request' = Request.create `GET "/" in + let response = + Response.create ~headers:(Headers.of_list [ "content-length", "0" ]) `OK + in + let t = create ?config:None in + let body = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body; + write_request t request'; + (* send the 2nd request without reading the response *) + let response' = + Response.create ~headers:(Headers.of_list [ "content-length", "0" ]) `Not_found + in + let body' = + request + t + request' + ~response_handler:(fun response body -> + (default_response_handler response' response body)) + ~error_handler:no_error_handler + in + Body.close_writer body'; + write_request t request'; + read_response t response; + read_response t response'; + ;; + + let test_persistent_connection_requests_pipelining_send_body () = + let request' = + Request.create ~headers:(Headers.of_list [ "content-length", "8" ]) `GET "/" + in + let response = + Response.create ~headers:(Headers.of_list [ "content-length", "0" ]) `OK + in + let t = create ?config:None in + let body = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + write_request t request'; + (* send the 2nd request without reading the response *) + let request'' = Request.create `GET "/" in + let response' = + Response.create ~headers:(Headers.of_list [ "content-length", "0" ]) `Not_found + in + let body' = + request + t + request'' + ~response_handler:(fun response body -> + (default_response_handler response' response body)) + ~error_handler:no_error_handler + in + Body.close_writer body'; + Body.write_string body "a string"; + Body.close_writer body; + write_string ~msg:"writes the body for the first request" t "a string"; + write_request t request''; + read_response t response; + read_response t response'; + ;; + + let test_persistent_connection_requests_body () = + let request' = Request.create `GET "/" in + let request'' = Request.create `GET "/second" in + let response = + Response.create ~headers:(Headers.of_list [ "content-length", "10" ]) `OK + in + let t = create ?config:None in + let body = + request + t + request' + ~response_handler:(default_response_handler response) + ~error_handler:no_error_handler + in + Body.close_writer body; + write_request t request'; + let response' = Response.create `OK in + read_response t response; + read_string t "ten chars."; + let body' = + request + t + request'' + ~response_handler:(default_response_handler response') + ~error_handler:no_error_handler + in + Body.close_writer body'; + write_request t request''; + read_response t response'; + ;; + let tests = [ "GET" , `Quick, test_get - ; "Response EOF", `Quick, test_response_eof ] + ; "multiple GET, last request closes connection", `Quick, test_get_last_close + ; "Response EOF", `Quick, test_response_eof + ; "Persistent connection, multiple GETs", `Quick, test_persistent_connection_requests + ; "Persistent connection, request pipelining", `Quick, test_persistent_connection_requests_pipelining + ; "Persistent connection, first request includes body", `Quick, test_persistent_connection_requests_pipelining_send_body + ; "Persistent connections, read response body", `Quick, test_persistent_connection_requests_body ] + end let () = @@ -862,5 +1064,11 @@ let () = ; "method" , Method.tests ; "iovec" , IOVec.tests ; "client connection" , Client_connection.tests - ; "server_connection", Server_connection.tests + ; "server connection", Server_connection.tests ] + +(* + * TODO: + * - test client connection error handling + * + *) diff --git a/lwt-unix/httpaf_lwt_unix.ml b/lwt-unix/httpaf_lwt_unix.ml index 28d0547..4b84164 100644 --- a/lwt-unix/httpaf_lwt_unix.ml +++ b/lwt-unix/httpaf_lwt_unix.ml @@ -136,16 +136,22 @@ module Client = struct module TLS = struct include Httpaf_lwt.Client (Tls_io.Io) - let request ?client ?(config=Config.default) socket request_headers ~error_handler ~response_handler = - Tls_io.make_client ?client socket >|= fun tls_client -> - request ~config (socket, tls_client) request_headers ~error_handler ~response_handler + let create_connection ?client ?(config = Config.default) = + let make_tls_client = Tls_io.make_client ?client in + fun socket -> + make_tls_client socket >>= fun tls_client -> + create_connection + ~config + (socket, tls_client) end module SSL = struct include Httpaf_lwt.Client (Ssl_io.Io) - let request ?client ?(config=Config.default) socket request_headers ~error_handler ~response_handler = - Ssl_io.make_client ?client socket >|= fun ssl_client -> - request ~config ssl_client request_headers ~error_handler ~response_handler + let create_connection ?client ?(config = Config.default) = + let make_ssl_client = Ssl_io.make_client ?client in + fun socket -> + make_ssl_client socket >>= fun ssl_client -> + create_connection ~config ssl_client end end diff --git a/lwt-unix/httpaf_lwt_unix.mli b/lwt-unix/httpaf_lwt_unix.mli index e94b92a..cb9db97 100644 --- a/lwt-unix/httpaf_lwt_unix.mli +++ b/lwt-unix/httpaf_lwt_unix.mli @@ -77,33 +77,63 @@ end (* For an example, see [examples/lwt_get.ml]. *) module Client : sig - val request - : ?config : Config.t + type t + + val create_connection + : ?config:Config.t -> Lwt_unix.file_descr + -> t Lwt.t + + val request + : t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler -> [`write] Body.t + val shutdown : t -> unit + + val is_closed : t -> bool + module TLS : sig - val request + type t + + val create_connection : ?client : Tls_io.client -> ?config : Config.t -> Lwt_unix.file_descr + -> t Lwt.t + + val request + : t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler - -> [`write] Body.t Lwt.t + -> [`write] Body.t + + val shutdown : t -> unit + + val is_closed : t -> bool end module SSL : sig - val request + type t + + val create_connection : ?client : Ssl_io.client -> ?config : Config.t -> Lwt_unix.file_descr + -> t Lwt.t + + val request + : t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler - -> [`write] Body.t Lwt.t + -> [`write] Body.t + + val shutdown : t -> unit + + val is_closed : t -> bool end end diff --git a/lwt/httpaf_lwt.ml b/lwt/httpaf_lwt.ml index 4770743..4a229e6 100644 --- a/lwt/httpaf_lwt.ml +++ b/lwt/httpaf_lwt.ml @@ -205,10 +205,13 @@ end module Client (Io: IO) = struct - let request ?(config=Config.default) socket request ~error_handler ~response_handler = - let module Client_connection = Httpaf.Client_connection in - let request_body, connection = - Client_connection.request ~config request ~error_handler ~response_handler in + module Client_connection = Httpaf.Client_connection + + type t = Client_connection.t + + let create_connection ?(config=Config.default) socket = + let connection = + Client_connection.create ~config in let read_buffer = Buffer.create config.read_buffer_size in @@ -282,5 +285,11 @@ module Client (Io: IO) = struct Lwt.join [read_loop_exited; write_loop_exited] >>= fun () -> Io.close socket); - request_body + Lwt.return connection + + let request = Client_connection.request + + let shutdown = Client_connection.shutdown + + let is_closed = Client_connection.is_closed end diff --git a/lwt/httpaf_lwt.mli b/lwt/httpaf_lwt.mli index 4e81258..ac1603e 100644 --- a/lwt/httpaf_lwt.mli +++ b/lwt/httpaf_lwt.mli @@ -74,11 +74,21 @@ end (* For an example, see [examples/lwt_get.ml]. *) module Client (Io: IO) : sig - val request - : ?config : Httpaf.Config.t + type t + + val create_connection + : ?config : Config.t -> Io.socket + -> t Lwt.t + + val request + : t -> Request.t -> error_handler : Client_connection.error_handler -> response_handler : Client_connection.response_handler - -> [`write] Httpaf.Body.t + -> [`write] Body.t + + val shutdown: t -> unit + + val is_closed : t -> bool end diff --git a/mirage/httpaf_mirage.mli b/mirage/httpaf_mirage.mli index 16f4b9b..9567fe9 100644 --- a/mirage/httpaf_mirage.mli +++ b/mirage/httpaf_mirage.mli @@ -32,13 +32,15 @@ POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------*) +open Httpaf + module type Server_intf = sig type flow val create_connection_handler - : ?config : Httpaf.Config.t - -> request_handler : flow Httpaf.Server_connection.request_handler - -> error_handler : Httpaf.Server_connection.error_handler + : ?config : Config.t + -> request_handler : flow Server_connection.request_handler + -> error_handler : Server_connection.error_handler -> (flow -> unit Lwt.t) end @@ -56,11 +58,21 @@ module Server_with_conduit : sig end module Client (Flow : Mirage_flow_lwt.S) : sig - val request - : ?config : Httpaf.Config.t + type t + + val create_connection + : ?config : Config.t -> Flow.flow - -> Httpaf.Request.t - -> error_handler : Httpaf.Client_connection.error_handler - -> response_handler : Httpaf.Client_connection.response_handler - -> [`write] Httpaf.Body.t + -> t Lwt.t + + val request + : t + -> Request.t + -> error_handler : Client_connection.error_handler + -> response_handler : Client_connection.response_handler + -> [`write] Body.t + + val shutdown : t -> unit + + val is_closed : t -> bool end