From 876933e174a44578fe92348f46a5332081d44697 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 6 Oct 2021 14:01:49 +0300 Subject: [PATCH 001/312] CONTRIBUTING.md: a couple notes --- docs/CONTRIBUTING.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/docs/CONTRIBUTING.md b/docs/CONTRIBUTING.md index e06afe31..7ef48d80 100644 --- a/docs/CONTRIBUTING.md +++ b/docs/CONTRIBUTING.md @@ -101,6 +101,12 @@ If you want to work again later, be sure to use `--recurse-submodules` during git pull --recurse-submodules ``` +Please don't force-push into a PR — it makes incremental review very +difficult, and we will squash-merge most PRs anyway! + +Also please don't resolve conversations in PRs. Reviewers use resolving +conversations to keep track of what has been addressed. +
If you need to link to the local version of Dream from a project that lives in From 250d973bfced4ada1dc05a131971539441d694c9 Mon Sep 17 00:00:00 2001 From: Dennis Dang Date: Sat, 16 Oct 2021 20:30:27 -0400 Subject: [PATCH 002/312] Add z-deploy-fly example (#161) --- example/z-fly/.dockerignore | 15 ++++++ example/z-fly/.gitignore | 2 + example/z-fly/Dockerfile | 28 +++++++++++ example/z-fly/README.md | 85 ++++++++++++++++++++++++++++++++ example/z-fly/app.ml | 7 +++ example/z-fly/docker-compose.yml | 10 ++++ example/z-fly/dune | 5 ++ example/z-fly/dune-project | 1 + example/z-fly/esy.json | 22 +++++++++ 9 files changed, 175 insertions(+) create mode 100644 example/z-fly/.dockerignore create mode 100644 example/z-fly/.gitignore create mode 100644 example/z-fly/Dockerfile create mode 100644 example/z-fly/README.md create mode 100644 example/z-fly/app.ml create mode 100644 example/z-fly/docker-compose.yml create mode 100644 example/z-fly/dune create mode 100644 example/z-fly/dune-project create mode 100644 example/z-fly/esy.json diff --git a/example/z-fly/.dockerignore b/example/z-fly/.dockerignore new file mode 100644 index 00000000..e6f12490 --- /dev/null +++ b/example/z-fly/.dockerignore @@ -0,0 +1,15 @@ +# By ignoring _esy and _build, the final docker image size stays compact and uploaded quickly to Fly. + +# esy build environment +_esy/ + +# Dune build environment +_build/ + +# Git +.git/ +.gitignore + +# Development +Dockerfile +docker-compose.yml diff --git a/example/z-fly/.gitignore b/example/z-fly/.gitignore new file mode 100644 index 00000000..55e75253 --- /dev/null +++ b/example/z-fly/.gitignore @@ -0,0 +1,2 @@ +node_modules +_esy \ No newline at end of file diff --git a/example/z-fly/Dockerfile b/example/z-fly/Dockerfile new file mode 100644 index 00000000..f0515764 --- /dev/null +++ b/example/z-fly/Dockerfile @@ -0,0 +1,28 @@ +FROM debian:stable-slim as build + +RUN apt-get update +RUN apt-get install -y curl git libpq-dev m4 npm unzip + +WORKDIR /build + +RUN npm install esy + +# Install dependencies. +ADD esy.* . +RUN [ -f esy.lock ] || node_modules/.bin/esy solve +RUN node_modules/.bin/esy fetch +RUN node_modules/.bin/esy build-dependencies + +# Build project. +ADD . . +RUN node_modules/.bin/esy install +RUN node_modules/.bin/esy build + +FROM debian:stable-slim as run + +RUN apt-get update +RUN apt-get install -y libev4 libpq5 libssl1.1 + +COPY --from=build build/_esy/default/build/default/app.exe /bin/app + +ENTRYPOINT /bin/app diff --git a/example/z-fly/README.md b/example/z-fly/README.md new file mode 100644 index 00000000..9eb3bd4b --- /dev/null +++ b/example/z-fly/README.md @@ -0,0 +1,85 @@ +# `z-fly` + +This example deploys a very simple Dream +[application](https://github.com/aantron/dream/blob/master/example/z-fly/app.ml) +to [Fly](https://www.fly.io/), a hosting platform that scales and smartly moves your servers closer to your users. A low-usage app can be hosted for +[free](https://fly.io/docs/about/pricing/#free-tier). Fly offers [flyctl](https://fly.io/docs/getting-started/installing-flyctl/), their CLI, that makes [deployment](https://fly.io/docs/hands-on/start/) and +[scaling](https://fly.io/docs/reference/scaling/) super simple. + +```ocaml +let () = + Dream.run ~interface:"0.0.0.0" + @@ Dream.logger + @@ Dream.router [ + Dream.get "/" (fun _ -> Dream.html "Dream deployed on Fly!"); + ] + @@ Dream.not_found +``` + +It uses [Docker Compose](https://docs.docker.com/compose/), so that you can +quickly expand it by adding databases and other services. + +```yaml +version: "3" + +services: + web: + build: . + ports: + - "8080:8080" + restart: always + logging: + driver: ${LOGGING_DRIVER:-json-file} +``` + +The setup can be run locally or on any server provider. + +The +[`Dockerfile`](https://github.com/aantron/dream/blob/master/example/z-docker-esy/Dockerfile) +has two stages: one for building our application, and one for the runtime that +only contains the final binary and its run-time dependencies. + +
+ +## Deploy + +Fly has a really simple [setup guide](https://fly.io/docs/hands-on/start/) that we'll follow. + +1. Install `flyctl` with `brew install superfly/tap/flyctl`. +2. Run `fly launch` to initialize and deploy your project. + +That should be it! Assuming no errors, the cli will share a link to your live app. + +
+ +## Development + +For local development you can run your app with or without Docker. Setting up the Docker build for the first time may take at least 4 minutes. Subsequent builds are cached. + +
+ +**With Docker** + +1. [Install Docker](https://www.docker.com/get-started). +2. Ensure Docker is running, then run `docker compose up`. Docker should build, cache, and serve your app at `localhost:8080`. + +**Without Docker** + +1. Make sure you have [esy](https://esy.sh) installed. +2. Run `esy` to install all dependencies. +3. To start your app, run `esy start`. This is an aliased command setup inside `esy.json`. + +
+ +**See also:** + +- [**`z-docker-opam`**](../z-docker-opam#files) is a variant of this example + that uses opam instead of esy. +- [**`z-systemd`**](../z-systemd#files) packages the app as a systemd daemon, + outside of a Docker container. +- [**`z-heroku`**](../z-heroku#files) deploys the app to + [Heroku](https://heroku.com). + +
+ +[Up to the example index](../#deploying) diff --git a/example/z-fly/app.ml b/example/z-fly/app.ml new file mode 100644 index 00000000..2184ee89 --- /dev/null +++ b/example/z-fly/app.ml @@ -0,0 +1,7 @@ +let () = + Dream.run ~interface:"0.0.0.0" + @@ Dream.logger + @@ Dream.router [ + Dream.get "/" (fun _ -> Dream.html "Dream deployed on Fly!"); + ] + @@ Dream.not_found diff --git a/example/z-fly/docker-compose.yml b/example/z-fly/docker-compose.yml new file mode 100644 index 00000000..3003b28b --- /dev/null +++ b/example/z-fly/docker-compose.yml @@ -0,0 +1,10 @@ +version: "3" + +services: + web: + build: . + ports: + - "8080:8080" + restart: always + logging: + driver: ${LOGGING_DRIVER:-json-file} diff --git a/example/z-fly/dune b/example/z-fly/dune new file mode 100644 index 00000000..ef7bdf98 --- /dev/null +++ b/example/z-fly/dune @@ -0,0 +1,5 @@ +(executable + (name app) + (libraries dream)) + +(data_only_dirs _esy esy.lock lib node_modules) diff --git a/example/z-fly/dune-project b/example/z-fly/dune-project new file mode 100644 index 00000000..929c696e --- /dev/null +++ b/example/z-fly/dune-project @@ -0,0 +1 @@ +(lang dune 2.0) diff --git a/example/z-fly/esy.json b/example/z-fly/esy.json new file mode 100644 index 00000000..959f7de2 --- /dev/null +++ b/example/z-fly/esy.json @@ -0,0 +1,22 @@ +{ + "scripts": { + "start": "./_esy/default/build/default/app.exe", + "build": "dune build" + }, + "dependencies": { + "@opam/dream": "1.0.0~alpha2", + "@opam/dune": "^2.0", + "ocaml": "4.12.x" + }, + "devDependencies": { + "@opam/ocaml-lsp-server": "*" + }, + "resolutions": { + "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829" + }, + "esy": { + "build": [ + "dune build --root . ./app.exe" + ] + } +} \ No newline at end of file From d54b466b4a4444129883dcec06b6220c9cc60236 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Eduardo?= <51955049+joseemds@users.noreply.github.com> Date: Sat, 16 Oct 2021 21:45:05 -0300 Subject: [PATCH 003/312] Add csrf option to Dream.form and Dream.multipart (#167) --- src/dream.mli | 4 ++-- src/middleware/form.ml | 5 ++++- src/middleware/upload.ml | 6 +++++- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index feebd85e..fa1a9ed8 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -816,7 +816,7 @@ type 'a form_result = [ activity, or tokens so old that decryption keys have since been rotated on the server. *) -val form : request -> (string * string) list form_result promise +val form : ?csrf:bool -> request -> (string * string) list form_result promise (** Parses the request body as a form. Performs CSRF checks. Use {!Dream.form_tag} in a template to transparently generate forms that will pass these checks. See {!section-templates} and example @@ -907,7 +907,7 @@ type multipart_form = OWASP {i File Upload Cheat Sheet}} for security precautions for upload forms. *) -val multipart : request -> multipart_form form_result promise +val multipart : ?csrf:bool -> request -> multipart_form form_result promise (** Like {!Dream.form}, but also reads files, and [Content-Type:] must be [multipart/form-data]. The [
] tag and CSRF token can be generated in a template with diff --git a/src/middleware/form.ml b/src/middleware/form.ml index fe29c5aa..f1886da2 100644 --- a/src/middleware/form.ml +++ b/src/middleware/form.ml @@ -54,12 +54,15 @@ let sort_and_check_form ~now to_value form request = log.warning (fun log -> log ~request "CSRF token duplicated"); Lwt.return (`Many_tokens form) -let form ~now request = +let form ?(csrf = true) ~now request = match Dream.header "Content-Type" request with | Some "application/x-www-form-urlencoded" -> let%lwt body = Dream.body request in let form = Dream__pure.Formats.from_form_urlencoded body in + if csrf then sort_and_check_form ~now (fun string -> string) form request + else + Lwt.return (`Ok (sort form)) | _ -> log.warning (fun log -> log ~request diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index 4fbca2c1..0ffde2b7 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -87,7 +87,7 @@ type multipart_form = (string * ((string option * string) list)) list module Map = Map.Make (String) -let multipart ~now request = +let multipart ?(csrf=true) ~now request = let content_type = match Dream.header "content-type" request with | Some content_type -> Result.to_option (Multipart_form.Content_type.of_string (content_type ^ "\r\n")) @@ -124,8 +124,12 @@ let multipart ~now request = | [Some "", ""] -> name, [] | _ -> name, List.rev values) in + if csrf then Form.sort_and_check_form ~now (function | [None, value] -> value | _ -> "") parts request + else + let form = Form.sort parts in + Lwt.return (`Ok form) From f584c1a348b588845902682982229a4c021772cc Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 30 Oct 2021 12:01:35 +0300 Subject: [PATCH 004/312] Add .vscode to .gitignore --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index a4114480..9969b6bd 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,6 @@ _coverage/ # Humans scratch/ + +# Editors +.vscode/ From 6225e2d4ab085709291a135b5a1aa32f9485c548 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 1 Nov 2021 18:51:14 +0300 Subject: [PATCH 005/312] Get Formats coverage to 100% Ptime.to_date_time does not return leap seconds. --- src/pure/formats.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pure/formats.ml b/src/pure/formats.ml index f0311284..bf7c83ac 100644 --- a/src/pure/formats.ml +++ b/src/pure/formats.ml @@ -80,11 +80,11 @@ let to_set_cookie See https://tools.ietf.org/html/rfc6265#section-5.1.1. - Even though [Ptime] time does not account for leap seconds, in case I - misunderstand the gmtime API, system differences, or future + Even though [Ptime.to_date_time] time does not return leap seconds, in + case I misunderstood the gmtime API, of system differences, or future refactoring, make sure no leap seconds creep into the output. *) let seconds = - if ss < 60 then ss else 59 + if ss < 60 then ss else 59 [@coverage off] in Printf.sprintf "; Expires=%s, %02i %s %i %02i:%02i:%02i GMT" weekday d month y hh mm seconds From b11f9f83b0bbc89d542f3c82953245f5a5459b80 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 8 Nov 2021 11:50:54 +0300 Subject: [PATCH 006/312] CI: simplify matrix and add 4.13 --- .github/workflows/test.yml | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 11fc1856..35344af3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -8,21 +8,18 @@ jobs: matrix: os: - ubuntu-latest - - macos-latest - # - windows-latest - # Blocked until we no longer require libev; Dream still works on - # Windows, but testing it is awkward at the moment. ocaml: + - 4.13.x - 4.12.x + - 4.11.x + - 4.10.x + - 4.09.x + - 4.08.x include: - - os: ubuntu-latest - ocaml: 4.08.x - - os: ubuntu-latest - ocaml: 4.09.x - - os: ubuntu-latest - ocaml: 4.10.x - - os: ubuntu-latest - ocaml: 4.11.x + - os: macos-latest + ocaml: 4.12.x + # Windows is blocked until we no longer require libev; Dream still works + # on Windows, but testing it is awkward at the moment. runs-on: ${{matrix.os}} steps: From 440fa71d5bee5d8f8e4f5f16b0f5c2b041b9e417 Mon Sep 17 00:00:00 2001 From: Joe Thomas Date: Mon, 8 Nov 2021 04:44:12 -0700 Subject: [PATCH 007/312] Allow log levels to be configured per-source (#171) --- src/dream.mli | 11 +++++++++-- src/middleware/log.ml | 45 ++++++++++++++++++++++++++++++++++--------- 2 files changed, 45 insertions(+), 11 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index fa1a9ed8..79de562d 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1688,7 +1688,7 @@ type sub_log = { } (** Sub-logs. See {!Dream.val-sub_log} right below. *) -val sub_log : string -> sub_log +val sub_log : ?level:[< log_level] -> string -> sub_log (** Creates a new sub-log with the given name. For example, {[ @@ -1702,6 +1702,10 @@ val sub_log : string -> sub_log log.error (fun log -> log ~request "Validation failed") ]} + [?level] sets the log level threshold for this sub-log only. If not + provided, falls back to the global log level set by {!Dream.initialize_log}, + unless {!Dream.set_log_level} is used. + See [README] of example {{:https://github.com/aantron/dream/tree/master/example/a-log#files} [a-log]}. *) @@ -1730,12 +1734,15 @@ val initialize_log : [Lwt.async_exception_hook]} so as to forward all asynchronous exceptions to the logger, and not terminate the process. - - [~level] sets the log level threshould for the entire binary. The default + - [~level] sets the log level threshold for the entire binary. The default is [`Info]. - [~enable:false] disables Dream logging completely. This can help sanitize output during testing. *) +val set_log_level : string -> [< log_level ] -> unit +(** Set the log level threshold of the given sub-log. *) + (** {1 Errors} diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 75cd049e..53be550d 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -197,6 +197,12 @@ let enable = let level = ref Logs.Info +let custom_log_levels : (string * Logs.level) list ref = + ref [] + +let sources : (string * Logs.src) list ref = + ref [] + let set_printexc = ref true @@ -212,6 +218,13 @@ type log_level = [ | `Debug ] +let to_logs_level l = + match l with + | `Error -> Logs.Error + | `Warning -> Logs.Warning + | `Info -> Logs.Info + | `Debug -> Logs.Debug + exception Logs_are_not_initialized let setup_logs = @@ -244,7 +257,7 @@ type sub_log = { debug : 'a. ('a, unit) conditional_log; } -let sub_log name = +let sub_log ?level:level_ name = (* This creates a wrapper, as described above. The wrapper forwards to a logger of the Logs library, but instead of passing the formatter m to the user's callback, it passes a formatter m', which is like m, but lacks a @@ -268,9 +281,21 @@ let sub_log name = log ~tags format_and_arguments)) in + let level = + List.find Option.is_some [ + Option.map to_logs_level level_; + List.assoc_opt name !custom_log_levels; + Some !level + ] in + (* Create the actual Logs source, and then wrap all the interesting functions. *) - let (module Log) = Logs.src_log (Logs.Src.create name) in + let src = Logs.Src.create name in + let (module Log) = Logs.src_log src in + Logs.Src.set_level src level; + custom_log_levels := + (name, Option.get level)::(List.remove_assoc name !custom_log_levels); + sources := (name, src) :: (List.remove_assoc name !sources); { error = (fun k -> forward ~destination_log:Log.err k); @@ -335,19 +360,21 @@ let initialize_log set_async_exception_hook := false; let level_ = - match level_ with - | None -> Logs.Info - | Some `Error -> Logs.Error - | Some `Warning -> Logs.Warning - | Some `Info -> Logs.Info - | Some `Debug -> Logs.Debug - in + Option.map to_logs_level level_ + |> Option.value ~default:Logs.Info in enable := enable_; level := level_; let `Initialized = initialized () in () +let set_log_level name level = + let level = to_logs_level level in + custom_log_levels := + (name, level)::(List.remove_assoc name !custom_log_levels); + let src = List.assoc_opt name !sources in + Option.iter (fun s -> Logs.Src.set_level s (Some level)) src + module Make (Pclock : Mirage_clock.PCLOCK) = struct let now () = From 237acbbbe1f7d549176978c21944006e321a2f51 Mon Sep 17 00:00:00 2001 From: Shawn McGinty Date: Mon, 8 Nov 2021 06:01:28 -0600 Subject: [PATCH 008/312] Add drop_cookie (#169) --- src/dream.mli | 66 ++++++++++++++++++++++++++++++++++++++++++++++ src/pure/inmost.ml | 33 +++++++++++++++++++++++ 2 files changed, 99 insertions(+) diff --git a/src/dream.mli b/src/dream.mli index 79de562d..23d70dc1 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -636,6 +636,72 @@ val set_cookie : *) + val drop_cookie : + ?prefix:[< `Host | `Secure ] option -> + ?domain:string -> + ?path:string option -> + ?secure:bool -> + ?http_only:bool -> + ?same_site:[< `Lax | `None | `Strict > `Strict ] option -> + string -> request -> response -> response +(** Appends an expired [Set-Cookie:] header to the {!type-response}. Infers the + most secure defaults from the {!type-request}. + + {[ + Dream.drop_cookie "my.cookie" request response + ]} + + See example + {{:https://github.com/aantron/dream/tree/master/example/c-cookie#files} + [c-cookie]}. + + Most of the optional arguments are for overriding inferred defaults. + Please use the same arguments provided when the cookie to be dropped was set. + + - [~prefix] sets [__Host-], [__Secure-], or no prefix, from most secure to + least. A conforming client will refuse to accept the cookie if [~domain], + [~path], and [~secure] don't match the constraints implied by the prefix. + By default, {!Dream.set_cookie} chooses the most restrictive prefix based + on the other settings and the {!type-request}. See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.3} + RFC 6265bis §4.1.3} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Cookie_prefixes} + MDN}. + - [~domain] sets the [Domain=] attribute. See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.3} + RFC 6265bis §4.1.2.3} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Domain_attribute} + MDN}. + - [~path] sets the [Path=] attribute. By default, [Path=] set to the site + prefix in the {!type-request}, which is usually [/]. See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.4} + RFC 6265bis §4.1.2.4} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Path_attribute} + MDN}. + - [~secure] sets the [Secure] attribute. By default, [Secure] is set if + {!Dream.https} is [true] for the {!type-request}. See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.5} + RFC 6265bis §4.1.2.5} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#restrict_access_to_cookies} + MDN}. + - [~http_only] sets the [HttpOnly] attribute. [HttpOnly] is set by default. + See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.6} + RFC 6265bis §4.1.2.6} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#restrict_access_to_cookies} + MDN}. + - [~same_site] sets the [SameSite=] attribute. [SameSite] is set to [Strict] + by default. See + {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.7} + RFC 6265bis §4.1.2.7} and + {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#SameSite_attribute} + MDN}. + + {!Dream.to_set_cookie} is a “raw” version of this function that does not do + any inference. + + *) + val cookie : ?prefix:[< `Host | `Secure ] option -> ?decrypt:bool -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 2bbb961a..741ce43f 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -702,3 +702,36 @@ let set_cookie in add_header "Set-Cookie" set_cookie response + +let drop_cookie + ?prefix:cookie_prefix + ?domain + ?path + ?secure + ?(http_only = true) + ?same_site + name + request + response = + + let set_cookie = set_cookie ~http_only:http_only ~expires:0. ~encrypt:false in + + let set_cookie = match cookie_prefix with + | Some p -> set_cookie ~prefix:p + | None -> set_cookie ~prefix:None in + + let set_cookie = match path with + | Some p -> set_cookie ~path:p + | None -> set_cookie ~path:(Some (prefix request)) in + + let set_cookie = match secure with + | Some sec -> set_cookie ~secure:sec + | None -> set_cookie ~secure:false in + + let set_cookie = match same_site with + | Some s -> set_cookie ~same_site:s + | None -> set_cookie ~same_site:(Some `Strict) in + + match domain with + | Some d -> set_cookie ~domain:d name "deleted" request response + | None -> set_cookie name "deleted" request response From 0d7b042214793193f3f053b99ca6d147423c7f3b Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 15:02:01 +0300 Subject: [PATCH 009/312] Upgrade gluten --- src/vendor/gluten | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vendor/gluten b/src/vendor/gluten index e1cd95ae..475c3610 160000 --- a/src/vendor/gluten +++ b/src/vendor/gluten @@ -1 +1 @@ -Subproject commit e1cd95ae9e2270d2b1c80c2894d111bafd961f62 +Subproject commit 475c36109fad6a09cec9d1a1b9b2f9c3818fc854 From c1ca22d2668d32aa413a2cda8d7d2897512b7461 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 16:29:04 +0300 Subject: [PATCH 010/312] Upgrade http/af and websocket/af forks --- src/http/adapt.ml | 10 +++++----- src/http/http.ml | 35 +++++++++++++++++++---------------- src/vendor/httpaf | 2 +- src/vendor/websocketaf | 2 +- 4 files changed, 26 insertions(+), 23 deletions(-) diff --git a/src/http/adapt.ml b/src/http/adapt.ml index c55d9882..d554faed 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -53,14 +53,14 @@ let forward_body_general let forward_body (response : Dream.response) - (body : [ `write ] Httpaf.Body.t) = + (body : Httpaf.Body.Writer.t) = forward_body_general response - (Httpaf.Body.write_string body) - (Httpaf.Body.write_bigstring body) - (Httpaf.Body.flush body) - (fun () -> Httpaf.Body.close_writer body) + (Httpaf.Body.Writer.write_string body) + (Httpaf.Body.Writer.write_bigstring body) + (Httpaf.Body.Writer.flush body) + (fun () -> Httpaf.Body.Writer.close body) let forward_body_h2 (response : Dream.response) diff --git a/src/http/http.ml b/src/http/http.ml index 239960b7..47fcfc0f 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -79,7 +79,7 @@ let websocket_handler user's_websocket_handler socket = (* This function is called on each frame received. In this high-level handler. we automatically respond to all control opcodes. *) - let frame ~opcode ~is_fin buffer ~off ~len = + let frame ~opcode ~is_fin ~len:_ payload = match opcode with | `Connection_close -> Websocketaf.Wsd.close socket; @@ -92,21 +92,24 @@ let websocket_handler user's_websocket_handler socket = () | `Text - | `Binary -> - let fragment = Lwt_bytes.to_string (Lwt_bytes.proxy buffer off len) in - if is_fin then - push_message (Some fragment) - else - message_frames := [fragment] - + | `Binary | `Continuation -> - let fragment = Lwt_bytes.to_string (Lwt_bytes.proxy buffer off len) in - message_frames := fragment::!message_frames; - if is_fin then begin - let message = String.concat "" (List.rev !message_frames) in - message_frames := []; - push_message (Some message) - end + let rec read () = + Websocketaf.Payload.schedule_read + payload + ~on_read:(fun buffer ~off ~len -> + let fragment = + Lwt_bytes.to_string (Lwt_bytes.proxy buffer off len) in + message_frames := fragment::!message_frames; + read ()) + ~on_eof:(fun () -> + if is_fin then begin + let message = String.concat "" (List.rev !message_frames) in + message_frames := []; + push_message (Some message) + end) + in + read () in let eof () = @@ -170,7 +173,7 @@ let wrap_handler let on_eof () = Dream.close_stream request |> ignore in let rec loop () = - Httpaf.Body.schedule_read + Httpaf.Body.Reader.schedule_read body ~on_eof ~on_read:(fun buffer ~off ~len -> diff --git a/src/vendor/httpaf b/src/vendor/httpaf index ee3e7906..3a74fd88 160000 --- a/src/vendor/httpaf +++ b/src/vendor/httpaf @@ -1 +1 @@ -Subproject commit ee3e790669dedfae5210d1431ea7f3e1f346a95e +Subproject commit 3a74fd8851e3019f5889ae1bf9350e90ed40017d diff --git a/src/vendor/websocketaf b/src/vendor/websocketaf index 98d5f952..248a2cb0 160000 --- a/src/vendor/websocketaf +++ b/src/vendor/websocketaf @@ -1 +1 @@ -Subproject commit 98d5f952f5fd25eecc78cd105f1d7a4013f4166a +Subproject commit 248a2cb0dcffa51996c3ad7643577dce75d67454 From 264febe50c54ae85fa3c7e51b7880fd8d4329c43 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 16:35:36 +0300 Subject: [PATCH 011/312] Upgrade h2 --- src/vendor/h2 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vendor/h2 b/src/vendor/h2 index a696a1ce..fa0c8a47 160000 --- a/src/vendor/h2 +++ b/src/vendor/h2 @@ -1 +1 @@ -Subproject commit a696a1ce66f573c23041840322d0e1770d5ebc70 +Subproject commit fa0c8a4746fdc50183e254f8c08239fc5b67717d From 972d3a9ec0d1baad8500c6b513f1221e310fe1dc Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 17:07:18 +0300 Subject: [PATCH 012/312] CI: don't install deps of dream-mirage --- .github/workflows/test.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 35344af3..9f801012 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -33,7 +33,7 @@ jobs: - run: opam depext --yes conf-postgresql - run: opam depext --yes conf-libev - - run: opam install --yes --deps-only --with-test . + - run: opam install --yes --deps-only --with-test ./dream.opam - run: opam exec -- dune runtest - run: | set -e From 3ae5855c0b911d86492ee72566cd04b7ff360227 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 17:17:17 +0300 Subject: [PATCH 013/312] CI: pin Reason Needed until https://github.com/reasonml/reason/pull/2660 is released. --- .github/workflows/test.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 9f801012..c12dfebc 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -33,6 +33,8 @@ jobs: - run: opam depext --yes conf-postgresql - run: opam depext --yes conf-libev + # Needed until https://github.com/reasonml/reason/pull/2660 is in opam. + - run: opam pin add reason --yes --no-action --dev-repo - run: opam install --yes --deps-only --with-test ./dream.opam - run: opam exec -- dune runtest - run: | From f056d0b34daf608944f1950d5e81b107cf5b7063 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 9 Nov 2021 17:56:51 +0300 Subject: [PATCH 014/312] Simplify drop_cookie --- src/dream.mli | 66 +++++----------------------------------------- src/pure/inmost.ml | 35 +++--------------------- 2 files changed, 10 insertions(+), 91 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 23d70dc1..93b2a705 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -632,9 +632,7 @@ val set_cookie : MDN}. {!Dream.to_set_cookie} is a “raw” version of this function that does not do - any inference. - - *) + any inference. *) val drop_cookie : ?prefix:[< `Host | `Secure ] option -> @@ -642,65 +640,13 @@ val set_cookie : ?path:string option -> ?secure:bool -> ?http_only:bool -> - ?same_site:[< `Lax | `None | `Strict > `Strict ] option -> + ?same_site:[< `Strict | `Lax | `None ] option -> string -> request -> response -> response -(** Appends an expired [Set-Cookie:] header to the {!type-response}. Infers the - most secure defaults from the {!type-request}. - - {[ - Dream.drop_cookie "my.cookie" request response - ]} - - See example - {{:https://github.com/aantron/dream/tree/master/example/c-cookie#files} - [c-cookie]}. - - Most of the optional arguments are for overriding inferred defaults. - Please use the same arguments provided when the cookie to be dropped was set. - - - [~prefix] sets [__Host-], [__Secure-], or no prefix, from most secure to - least. A conforming client will refuse to accept the cookie if [~domain], - [~path], and [~secure] don't match the constraints implied by the prefix. - By default, {!Dream.set_cookie} chooses the most restrictive prefix based - on the other settings and the {!type-request}. See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.3} - RFC 6265bis §4.1.3} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Cookie_prefixes} - MDN}. - - [~domain] sets the [Domain=] attribute. See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.3} - RFC 6265bis §4.1.2.3} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Domain_attribute} - MDN}. - - [~path] sets the [Path=] attribute. By default, [Path=] set to the site - prefix in the {!type-request}, which is usually [/]. See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.4} - RFC 6265bis §4.1.2.4} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#Path_attribute} - MDN}. - - [~secure] sets the [Secure] attribute. By default, [Secure] is set if - {!Dream.https} is [true] for the {!type-request}. See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.5} - RFC 6265bis §4.1.2.5} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#restrict_access_to_cookies} - MDN}. - - [~http_only] sets the [HttpOnly] attribute. [HttpOnly] is set by default. - See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.6} - RFC 6265bis §4.1.2.6} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#restrict_access_to_cookies} - MDN}. - - [~same_site] sets the [SameSite=] attribute. [SameSite] is set to [Strict] - by default. See - {{:https://tools.ietf.org/html/draft-ietf-httpbis-rfc6265bis-07#section-4.1.2.7} - RFC 6265bis §4.1.2.7} and - {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#SameSite_attribute} - MDN}. - - {!Dream.to_set_cookie} is a “raw” version of this function that does not do - any inference. +(** Deletes the given cookie. - *) + This function works by calling {!Dream.set_cookie}, and setting the cookie + to expire in the past. Pass all the same optional values that you would pass + to {!Dream.set_cookie}, to make sure that the same cookie is deleted. *) val cookie : ?prefix:[< `Host | `Secure ] option -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 741ce43f..333b2b01 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -704,34 +704,7 @@ let set_cookie add_header "Set-Cookie" set_cookie response let drop_cookie - ?prefix:cookie_prefix - ?domain - ?path - ?secure - ?(http_only = true) - ?same_site - name - request - response = - - let set_cookie = set_cookie ~http_only:http_only ~expires:0. ~encrypt:false in - - let set_cookie = match cookie_prefix with - | Some p -> set_cookie ~prefix:p - | None -> set_cookie ~prefix:None in - - let set_cookie = match path with - | Some p -> set_cookie ~path:p - | None -> set_cookie ~path:(Some (prefix request)) in - - let set_cookie = match secure with - | Some sec -> set_cookie ~secure:sec - | None -> set_cookie ~secure:false in - - let set_cookie = match same_site with - | Some s -> set_cookie ~same_site:s - | None -> set_cookie ~same_site:(Some `Strict) in - - match domain with - | Some d -> set_cookie ~domain:d name "deleted" request response - | None -> set_cookie name "deleted" request response + ?prefix ?domain ?path ?secure ?http_only ?same_site name request response = + set_cookie + ?prefix ~encrypt:false ~expires:0. ?domain ?path ?secure ?http_only + ?same_site name "" request response From 8efb1adaffc957286f9963221522359990c45b30 Mon Sep 17 00:00:00 2001 From: Michael Bacarella Date: Tue, 9 Nov 2021 13:50:47 -0800 Subject: [PATCH 015/312] Mirage: fix up and explain gcloud commands (#172) --- example/m-mirage/README.md | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/example/m-mirage/README.md b/example/m-mirage/README.md index 34f8f41f..3b952b91 100644 --- a/example/m-mirage/README.md +++ b/example/m-mirage/README.md @@ -15,11 +15,14 @@ encrypt challenge. ```sh $ gcloud init +# Your name below must be __globally__ unique, dream-os will be taken by now $ gcloud projects create dream-os --name="dream-os" -# Enable billing on the dream-os project +# Enable billing for project +# Go to https://cloud.google.com, log into Console, select project from +# dropdown, then click billing $ gcloud config set project dream-os -$ gcloud compute address --region europe-west1 -# Set your zone file with the given IP address +$ gcloud compute addresses create --region europe-west1 +# Set your in your DNS zone file the IP address yielded above $ gsutil mb gs://dream-os ``` @@ -37,10 +40,10 @@ address. ```sh $ opam install mirage $ mirage configure -t virtio --dhcp true --hostname --tls true \ - --letsencrypt true --productive false + --letsencrypt true --production false $ make depends $ mirage build -$ solo5-virtio-mkimage gs://dream-os +$ solo5-virtio-mkimage -f tar -- dream.tar.gz dream.virtio ``` #### Deployement From b4402449f13c1ece90d00ca09e8903ec19e4ffe5 Mon Sep 17 00:00:00 2001 From: Joe Thomas Date: Thu, 11 Nov 2021 11:31:26 -0700 Subject: [PATCH 016/312] Add additional instrumentation for flash messages (#173) Resolves #90. --- example/w-flash/README.md | 11 ++++++ example/w-flash/flash.eml.ml | 1 + src/middleware/flash.ml | 69 ++++++++++++++++++++++++------------ src/middleware/log.ml | 3 ++ 4 files changed, 61 insertions(+), 23 deletions(-) diff --git a/example/w-flash/README.md b/example/w-flash/README.md index ffc98d7f..515a547d 100644 --- a/example/w-flash/README.md +++ b/example/w-flash/README.md @@ -48,6 +48,7 @@ into cookies and reads them back out: ```ocaml let () = + Dream.set_log_level "dream.flash" `Debug; Dream.run @@ Dream.logger @@ Dream.memory_sessions @@ -75,6 +76,16 @@ let () = @@ Dream.not_found ``` +The example configures a custom log level for flash messages using +`Dream.set_log_level`. Setting this to "debug" means the server logs +will display a log point summarizing the flash messages on every +request, like this: + +``` +10.11.21 01:48:21.629 dream.log INFO REQ 3 GET /result ::1:39808 Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Firefox/78.0 +10.11.21 01:48:21.629 dream.flash DEBUG REQ 3 Flash messages: Info: Some Message +``` +
$ cd example/w-flash
 $ npm install esy && npx esy
 $ npx esy start
diff --git a/example/w-flash/flash.eml.ml b/example/w-flash/flash.eml.ml index e07ffab8..b1f4fe4b 100644 --- a/example/w-flash/flash.eml.ml +++ b/example/w-flash/flash.eml.ml @@ -18,6 +18,7 @@ let result request = let () = + Dream.set_log_level "dream.flash" `Debug; Dream.run @@ Dream.logger @@ Dream.memory_sessions diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 1ccc9ddf..5fc1ee97 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -19,33 +19,16 @@ let storage = let flash_cookie = "dream.flash" - - -let flash_messages inner_handler request = - let outbox = ref [] in - let request = Dream.with_local storage outbox request in - let%lwt response = inner_handler request in - let entries = List.rev !outbox in - let existing = Dream.cookie flash_cookie request in - let response = - match existing, entries with - | None, [] -> response - | Some _, [] -> - Dream.set_cookie flash_cookie "" request response ~expires:0. - | _, _ -> - let content = - List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] - in - let value = `List content |> Yojson.Basic.to_string in - Dream.set_cookie flash_cookie value request response ~max_age:five_minutes - in - Lwt.return response - - +(* This is a soft limit. Encryption and base64 encoding increase the + original size of the cookie text by ~4/3.*) +let content_byte_size_limit = + 3072 let (|>?) = Option.bind + + let flash request = let rec group x = match x with @@ -76,3 +59,43 @@ let put_flash category message request = failwith message in outbox := (category, message)::!outbox + + + +let flash_messages inner_handler request = + log.debug (fun log -> + let current = + flash request + |> List.map (fun (p,q) -> p ^ ": " ^ q) + |> String.concat ", " in + if String.length current > 0 then + log ~request "Flash messages: %s" current + else + log ~request "%s" "No flash messages."); + let outbox = ref [] in + let request = Dream.with_local storage outbox request in + let existing = Dream.cookie flash_cookie request in + let%lwt response = inner_handler request in + let entries = List.rev !outbox in + let response = + match existing, entries with + | None, [] -> response + | Some _, [] -> + Dream.set_cookie flash_cookie "" request response ~expires:0. + | _, _ -> + let content = + List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] + in + let value = `List content |> Yojson.Basic.to_string in + let () = + if String.length value >= content_byte_size_limit then + log.warning (fun log -> + log ~request + "Flash messages exceed soft size limit (%d bytes)" + content_byte_size_limit) + else + () + in + Dream.set_cookie flash_cookie value request response ~max_age:five_minutes + in + Lwt.return response diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 53be550d..68b6da62 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -369,6 +369,9 @@ let initialize_log () let set_log_level name level = + (* If logging hasn't been initialized, trigger this so that + configuration of log levels can proceed. *) + let `Initialized = initialized () in let level = to_logs_level level in custom_log_levels := (name, level)::(List.remove_assoc name !custom_log_levels); From 5578b901ff3a311ac4f4e7f050461e558005d96e Mon Sep 17 00:00:00 2001 From: Calascibetta Romain Date: Mon, 15 Nov 2021 14:44:24 +0100 Subject: [PATCH 017/312] Mirage: fix make depends command on DreamOS (#175) --- example/m-mirage/config.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example/m-mirage/config.ml b/example/m-mirage/config.ml index 7945bef7..b8be79da 100644 --- a/example/m-mirage/config.ml +++ b/example/m-mirage/config.ml @@ -35,8 +35,8 @@ let letsencrypt = let dream = foreign "Unikernel.Make" ~packages:[ package "ca-certs-nss" - ; package "dns-client.mirage" - ; package "dream-mirage.paf.le" + ; package "dns-client" ~sublibs:[ "mirage" ] + ; package "dream-mirage" ~sublibs:[ "paf.le" ] ; package "dream-mirage" ] ~keys:Key.([ abstract port ; abstract hostname From 2075347172ca520be9dec87eaca9dc5cacc3badf Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 24 Nov 2021 17:12:15 +0300 Subject: [PATCH 018/312] Replace Body by simpler, clearer Stream module --- src/dream.ml | 5 +- src/dream.mli | 18 +- src/http/adapt.ml | 22 +- src/http/http.ml | 65 +++--- src/middleware/content_length.ml | 42 +--- src/pure/body.ml | 332 ------------------------------- src/pure/inmost.ml | 84 ++++---- src/pure/stream.ml | 311 +++++++++++++++++++++++++++++ src/pure/stream.mli | 40 ++++ 9 files changed, 448 insertions(+), 471 deletions(-) delete mode 100644 src/pure/body.ml create mode 100644 src/pure/stream.ml create mode 100644 src/pure/stream.mli diff --git a/src/dream.ml b/src/dream.ml index 9a2c80e4..14058753 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -11,12 +11,9 @@ struct include Dream__pure.Status end +include Dream__pure.Stream include Dream__pure.Inmost -(* Eliminate optional arguments from the public interface for now. *) -let next ~buffer ~close ~exn request = - next ~buffer ~close ~exn request - include Dream__middleware.Log include Dream__middleware.Log.Make (Ptime_clock) (* Initalize logs with the default reporter which uses [Ptime_clock], this diff --git a/src/dream.mli b/src/dream.mli index 93b2a705..1cb989b1 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -676,8 +676,7 @@ val all_cookies : request -> (string * string) list (** {1 Bodies} *) val body : 'a message -> string promise -(** Retrieves the entire body. Retains a reference to the body, so {!Dream.body} - can be used multiple times. See example +(** Retrieves the entire body. See example {{:https://github.com/aantron/dream/tree/master/example/6-echo#files} [6-echo]}. *) @@ -723,13 +722,20 @@ type buffer = - {{:https://github.com/mirage/ocaml-cstruct/blob/9a8b9a79bdfa2a1b8455bc26689e0228cc6fac8e/lib/cstruct.mli#L139} [Cstruct.buffer]} in Cstruct. *) +(* TODO What should the body stream retrieval function be called? *) +(* TODO Remove old functions from signature. *) +type stream + +val body_stream : 'a message -> stream + +(* TODO Probably even close can be made optional. exn can be made optional. *) +(* TODO Argument order? *) val next : - buffer:(buffer -> int -> int -> unit) -> - (* ?string:(string -> int -> int -> unit) -> - ?flush:(unit -> unit) -> *) + stream -> + data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> + flush:(unit -> unit) -> exn:(exn -> unit) -> - request -> unit (** Waits for the next stream event, and calls: diff --git a/src/http/adapt.ml b/src/http/adapt.ml index d554faed..e5a5fe7a 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -6,6 +6,7 @@ module Dream = Dream__pure.Inmost +module Stream = Dream__pure.Stream @@ -19,31 +20,26 @@ let address_to_string : Unix.sockaddr -> string = function (* TODO Write a test simulating client exit during SSE; this was killing the server at some point. *) (* TODO LATER Will also need to monitor buffer accumulation and use flush. *) -(* TODO Rewrite using Dream.next. *) let forward_body_general (response : Dream.response) - (write_string : ?off:int -> ?len:int -> string -> unit) - (write_buffer : ?off:int -> ?len:int -> Dream.buffer -> unit) + (_write_string : ?off:int -> ?len:int -> string -> unit) + (write_buffer : ?off:int -> ?len:int -> Stream.buffer -> unit) http_flush close = let rec send () = - response - |> Dream.next - ~buffer - ~string - ~flush + Dream.body_stream response + |> fun stream -> Stream.next + stream + ~data ~close + ~flush ~exn:ignore - and buffer chunk off len = + and data chunk off len = write_buffer ~off ~len chunk; send () - and string chunk off len = - write_string ~off ~len chunk; - send () - and flush () = http_flush send diff --git a/src/http/http.ml b/src/http/http.ml index 47fcfc0f..bf4432a1 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -6,6 +6,7 @@ module Dream = Dream__pure.Inmost +module Stream = Dream__pure.Stream @@ -158,32 +159,21 @@ let wrap_handler let body = Httpaf.Reqd.request_body conn in - - let request : Dream.request = - Dream.request_from_http ~app ~client ~method_ ~target ~version ~headers in - - (* TODO Could use a private variant of flush that causes no app-observable - side-effects. *) - (* TODO It would still help to have a fully pull-based writing API. *) - (* TODO The whole body-reading model seems to be broken. How does one detect - an exception? *) - (* The request body stream. *) - Lwt.async begin fun () -> - let%lwt () = Dream.flush request in - let on_eof () = Dream.close_stream request |> ignore in - - let rec loop () = + (* TODO Review per-chunk allocations. *) + (* TODO Should the stream be auto-closed? It doesn't even have a closed + state. The whole thing is just a wrapper for whatever the http/af + behavior is. *) + let body = + Stream.read_only (fun ~data ~close ~flush:_ ~exn:_ -> Httpaf.Body.Reader.schedule_read body - ~on_eof - ~on_read:(fun buffer ~off ~len -> - Lwt.on_success - (Dream__pure.Body.write_bigstring buffer off len request.body) - loop) - in - loop (); - Lwt.return_unit - end; + ~on_eof:close + ~on_read:(fun buffer ~off ~len -> data buffer off len)) + in + + let request : Dream.request = + Dream.request_from_http + ~app ~client ~method_ ~target ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -313,26 +303,17 @@ let wrap_handler_h2 let body = H2.Reqd.request_body conn in - - let request : Dream.request = - Dream.request_from_http ~app ~client ~method_ ~target ~version ~headers in - - Lwt.async begin fun () -> - let%lwt () = Dream.flush request in - let on_eof () = Dream.close_stream request |> ignore in - - let rec loop () = + let body = + Stream.read_only (fun ~data ~close ~flush:_ ~exn:_ -> H2.Body.schedule_read body - ~on_eof - ~on_read:(fun buffer ~off ~len -> - Dream__pure.Body.write_bigstring buffer off len request.body - |> ignore; - loop ()) - in - loop (); - Lwt.return_unit - end; + ~on_eof:close + ~on_read:(fun buffer ~off ~len -> data buffer off len)) + in + + let request : Dream.request = + Dream.request_from_http + ~app ~client ~method_ ~target ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This diff --git a/src/middleware/content_length.ml b/src/middleware/content_length.ml index c252a8d9..549f2e56 100644 --- a/src/middleware/content_length.ml +++ b/src/middleware/content_length.ml @@ -9,47 +9,19 @@ module Dream = Dream__pure.Inmost -(* TODO This belongs in the core module. *) -(* let add_header response buffered_body = - let length = - match buffered_body with - | `Empty -> 0 - | `String body -> String.length body - in - Lwt.return - (Dream.add_header "Content-Length" (string_of_int length) response) *) - (* TODO Also mind Connection: close. *) (* TODO Test in integration with HTTP/2. *) +(* TODO This could be renamed transfer_encoding at this point. *) (* Add a Content-Length header to HTTP 1.x responses that have a fixed body but don't yet have the header. *) let content_length next_handler request = - if fst (Dream.version request) <> 1 then next_handler request - else let%lwt (response : Dream.response) = next_handler request in - - let body_length = - match !(response.body) with - | `Empty -> Some 0 - | `String string -> Some (String.length string) - | `Stream _ | `Exn _ -> None - in - - match body_length with - | Some length -> - if Dream.has_header "Content-Length" response then - Lwt.return response - else - response - |> Dream.add_header "Content-Length" (string_of_int length) - |> Lwt.return - | None -> - if Dream.has_header "Transfer-Encoding" response then - Lwt.return response - else - response - |> Dream.add_header "Transfer-Encoding" "chunked" - |> Lwt.return + if Dream.has_header "Transfer-Encoding" response then + Lwt.return response + else + response + |> Dream.add_header "Transfer-Encoding" "chunked" + |> Lwt.return diff --git a/src/pure/body.ml b/src/pure/body.ml deleted file mode 100644 index 818261c3..00000000 --- a/src/pure/body.ml +++ /dev/null @@ -1,332 +0,0 @@ -(* This file is part of Dream, released under the MIT license. See LICENSE.md - for details, or visit https://github.com/aantron/dream. - - Copyright 2021 Anton Bachin *) - - - -type bigstring = Bigstringaf.t - -(* The stream representation can be replaced by a record with mutable fields for - 0-allocation streaming. *) -type writer = - bigstring:(bigstring -> int -> int -> unit) -> - string:(string -> int -> int -> unit) -> - flush:(unit -> unit) -> - close:(unit -> unit) -> - exn:(exn -> unit) -> - unit - -type stream = [ - | `Idle - | `Read of (writer -> unit) - | `Write of writer * (exn -> unit) -] - -let stream_read ~bigstring ~string ~flush ~close ~exn stream = - match !stream with - | `Idle -> - stream := `Read (fun writer -> - stream := `Idle; - writer ~bigstring ~string ~flush ~close ~exn) - | `Read _ -> - exn (Failure ("Concurrent reads of same stream")) - | `Write (writer, _) -> - stream := `Idle; - writer ~bigstring ~string ~flush ~close ~exn - -let bigstring_writer chunk offset length k = - fun ~bigstring ~string:_ ~flush:_ ~close:_ ~exn:_ -> - bigstring chunk offset length; - k () - -let string_writer chunk offset length k = - fun ~bigstring:_ ~string ~flush:_ ~close:_ ~exn:_ -> - string chunk offset length; - k () - -let flush_writer k = - fun ~bigstring:_ ~string:_ ~flush ~close:_ ~exn:_ -> - flush (); - k () - -let close_writer k = - fun ~bigstring:_ ~string:_ ~flush:_ ~close ~exn:_ -> - close (); - k () - -let exn_writer the_exn k = - fun ~bigstring:_ ~string:_ ~flush:_ ~close:_ ~exn -> - exn the_exn; - k () - -let stream_write writer stream k fail = - match !stream with - | `Idle -> - stream := `Write (writer k, fail) - | `Read reader -> - reader (writer k) - | `Write _ -> - failwith "Concurrent writes to same stream" - - - -(* TODO This probably can become a regular variant in the long term. *) -type body = [ - | `Empty - | `Exn of exn - | `String of string - | `Stream of stream ref -] - -type body_cell = - body ref - -let has_body body_cell = - match !body_cell with - | `Empty -> false - | `String "" -> false - | `String _ -> true - | `Stream _ -> true - | `Exn _ -> false -(* The purpose of storing exceptions is to prevent silent emission of false - empty bodies. The exception itself is usually redundant. It would have been - reported when it originally occurred. *) - - - -let body : body_cell -> string Lwt.t = fun body_cell -> - match !body_cell with - | `Empty -> - Lwt.return "" - - | `Exn exn -> - Lwt.fail exn - - | `String body -> - Lwt.return body - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - - let length = ref 0 in - let buffer = ref (Bigstringaf.create 4096) in - - let close () = - let result = Bigstringaf.to_string (Bigstringaf.sub !buffer ~off:0 ~len:!length) in - - if !length = 0 then - body_cell := `Empty - else - body_cell := `String result; - - Lwt.wakeup_later resolver result - in - - let exn the_exn = - body_cell := `Exn the_exn; - Lwt.wakeup_later_exn resolver the_exn - in - - let rec loop () = - stream_read ~bigstring ~string ~flush ~close ~exn stream - - and bigstring chunk offset chunk_length = - let new_length = !length + chunk_length in - - if new_length > Bigstringaf.length !buffer then begin - let new_buffer = Bigstringaf.create (new_length * 2) in - Bigstringaf.blit !buffer ~src_off:0 new_buffer ~dst_off:0 ~len:!length; - buffer := new_buffer - end; - - Bigstringaf.blit chunk ~src_off:offset !buffer ~dst_off:!length ~len:chunk_length; - length := new_length; - - loop () - - and string chunk offset chunk_length = - let new_length = !length + chunk_length in - - if new_length > Bigstringaf.length !buffer then begin - let new_buffer = Bigstringaf.create (new_length * 2) in - Bigstringaf.blit !buffer ~src_off:0 new_buffer ~dst_off:0 ~len:!length; - buffer := new_buffer - end; - - Bigstringaf.blit_from_bytes - (Bytes.unsafe_of_string chunk) ~src_off:offset !buffer ~dst_off:!length ~len:chunk_length; - length := new_length; - - loop () - - and flush () = - loop () - - in - - loop (); - - promise - - - -let read : body_cell -> string option Lwt.t = fun body_cell -> - match !body_cell with - | `Empty -> - Lwt.return_none - - | `Exn exn -> - Lwt.fail exn - - | `String body -> - body_cell := `Empty; - Lwt.return (Some body) - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - - let close () = - body_cell := `Empty; - Lwt.wakeup_later resolver None - in - - let exn the_exn = - body_cell := `Exn the_exn; - Lwt.wakeup_later_exn resolver the_exn - in - - let rec loop () = - stream_read ~bigstring ~string ~flush ~close ~exn stream - - and bigstring chunk offset length = - Lwt.wakeup_later resolver - (Some (Bigstringaf.to_string (Bigstringaf.sub chunk ~off:offset ~len:length))) - - and string chunk offset length = - let chunk = - if offset = 0 && length = String.length chunk then - chunk - else - String.sub chunk offset length - in - Lwt.wakeup_later resolver (Some chunk) - - and flush () = - loop () - - in - - loop (); - - promise - - - -let next - ~bigstring - ?(string = fun _ _ _ -> ()) - ?(flush = ignore) - ~close - ~exn - body_cell = - - match !body_cell with - | `Empty -> - close () - - | `Exn the_exn -> - exn the_exn - - | `String body -> - body_cell := `Empty; - string body 0 (String.length body) - - | `Stream stream -> - stream_read ~bigstring ~string ~flush ~close ~exn stream - - - -let write string body_cell = - match !body_cell with - | `Empty | `String _ -> - failwith "Write into body that is not a stream; see Dream.with_stream" - | `Exn exn -> - Lwt.fail exn - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - stream_write - (string_writer string 0 (String.length string)) - stream - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver); - promise - -let flush body_cell = - match !body_cell with - | `Empty | `String _ -> - failwith "Flush of body that is not a stream; see Dream.with_stream" - - | `Exn exn -> - Lwt.fail exn - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - stream_write - flush_writer - stream - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver); - promise - -let close_stream body_cell = - match !body_cell with - | `Empty | `String _ -> - failwith "Close of body that is not a stream; see Dream.with_stream" - - | `Exn exn -> - Lwt.fail exn - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - stream_write - close_writer - stream - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver); - promise - -let write_bigstring bigstring offset length body_cell = - match !body_cell with - | `Empty | `String _ -> - failwith "Write into body that is not a stream; see Dream.with_stream" - | `Exn exn -> - Lwt.fail exn - - | `Stream stream -> - let promise, resolver = Lwt.wait () in - stream_write - (bigstring_writer bigstring offset length) - stream - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver); - promise - - - -let report exn body_cell = - match !body_cell with - | `Exn _ -> - () - - | `Empty | `String _ -> - body_cell := `Exn exn - - | `Stream stream -> - body_cell := `Exn exn; - match !stream with - | `Write (_, report) -> report exn - | _ -> () - -(* TODO Review GC-friendliness. *) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 333b2b01..1bb1de1e 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -8,8 +8,6 @@ include Method include Status -type buffer = Body.bigstring - (* Used for converting the stream interface of [multipart_form] into the pull interface of Dream. @@ -51,7 +49,7 @@ and response = outgoing message and 'a message = { specific : 'a; headers : (string * string) list; - body : Body.body_cell; + body : Stream.stream; locals : Scope.t; first : 'a message; last : 'a message ref; @@ -291,13 +289,13 @@ let cookie name request = with Not_found -> None *) let body message = - Body.body message.body + Stream.body message.body let read message = - Body.read message.body + Stream.read message.body -let next ~buffer ?string ?flush ~close ~exn message = - Body.next ~bigstring:buffer ?string ?flush ~close ~exn message.body +let body_stream message = + message.body (* Create a fresh ref. The reason this field has a ref is because it might get replaced when a body is forced read. That's not what's happening here - we @@ -307,36 +305,57 @@ let next ~buffer ?string ?flush ~close ~exn message = let with_body body message = let body = if String.length body = 0 then - `Empty + Stream.empty else - `String body + Stream.string body in - update {message with body = ref body} + update {message with body} let with_stream message = - update {message with body = ref (`Stream (ref `Idle))} + update {message with body = Stream.pipe ()} -(* TODO Can also change order of arguments on Body.write, though it's - internal. *) let write message chunk = - Body.write chunk message.body + let promise, resolver = Lwt.wait () in + let length = String.length chunk in + let buffer = Bigstringaf.of_string ~off:0 ~len:length chunk in + (* TODO Better handling of close? But it can't even occur with http/af. *) + Stream.write + buffer 0 length + (Lwt.wakeup_later resolver) + (fun () -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later_exn resolver) + message.body; + promise let write_buffer ?(offset = 0) ?length message chunk = + let promise, resolver = Lwt.wait () in let length = match length with | Some length -> length | None -> Bigstringaf.length chunk - offset in - Body.write_bigstring chunk offset length message.body - + (* TODO Proper handling of close. *) + Stream.write + chunk offset length + (Lwt.wakeup_later resolver) + (Lwt.wakeup_later resolver) + (Lwt.wakeup_later_exn resolver) + message.body; + promise + +(* TODO How are remote closes actually handled? There is no way for http/af to + report them to the user application through the writer. *) let flush message = - Body.flush message.body + let promise, resolver = Lwt.wait () in + Stream.flush + (Lwt.wakeup_later resolver) + (fun () -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later_exn resolver) + message.body; + promise let close_stream message = - Body.close_stream message.body - -let has_body message = - Body.has_body message.body + Stream.close message.body (* TODO Rename. *) let is_websocket response = @@ -395,7 +414,8 @@ let request_from_http ~method_ ~target ~version - ~headers = + ~headers + body = let path, query = Formats.split_target target in @@ -412,7 +432,7 @@ let request_from_http upload = initial_multipart_state (); }; headers; - body = ref (`Stream (ref `Idle)); + body; locals = Scope.empty; first = request; (* TODO LATER What OCaml version is required for this? *) last = ref request; @@ -438,13 +458,6 @@ let request and then immediately replace it. *) let path, query = Formats.split_target target in - let body = - if String.length body = 0 then - `Empty - else - `String body - in - let rec request = { specific = { (* TODO Is there a better fake error handler? Maybe this function should @@ -460,7 +473,7 @@ let request upload = initial_multipart_state (); }; headers; - body = ref body; + body = Stream.string body; locals = Scope.empty; first = request; last = ref request; @@ -481,20 +494,13 @@ let response | None, Some code -> int_to_status code in - let body = - if String.length body = 0 then - `Empty - else - `String body - in - let rec response = { specific = { status; websocket = None; }; headers; - body = ref body; + body = Stream.string body; locals = Scope.empty; first = response; last = ref response; diff --git a/src/pure/stream.ml b/src/pure/stream.ml new file mode 100644 index 00000000..3c77aea0 --- /dev/null +++ b/src/pure/stream.ml @@ -0,0 +1,311 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +type buffer = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type 'a promise = + 'a Lwt.t + +type reader = + data:(buffer -> int -> int -> unit) -> + close:(unit -> unit) -> + flush:(unit -> unit) -> + exn:(exn -> unit) -> + unit + +type stream = { + next : + data:(buffer -> int -> int -> unit) -> + close:(unit -> unit) -> + flush:(unit -> unit) -> + exn:(exn -> unit) -> + unit; + + (* TODO Needs continuation arguments. Writer feedback is ok, exception, + closed. Ok should probably carry an int. *) + (* TODO Continuation labels? *) + (* TODO Really review these continuations. *) + write : + buffer -> int -> int -> + (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> + unit; + flush : (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> unit; + + close : (unit -> unit) -> unit; +} + +(* TODO Probably rename next throughout. *) +(* TODO Raise some exception when writes are attempted. *) +let read_only next = + { + next; + write = (fun _buffer _offset _length _done _close _exn -> ()); + flush = (fun _done _close _exn -> ()); + close = (fun _done -> ()); + } + +let empty = + read_only (fun ~data:_ ~close ~flush:_ ~exn:_ -> close ()) + +(* TODO This shows the awkwardness in string-to-string body reading. *) +let string s = + if String.length s = 0 then + empty + + else begin + let already_read = ref false in + read_only begin fun ~data ~close ~flush:_ ~exn:_ -> + if not !already_read then begin + already_read := true; + let length = String.length s in + data (Bigstringaf.of_string ~off:0 ~len:length s) 0 length + end + else + close () + end + end + +let next stream ~data ~close ~flush ~exn = + stream.next ~data ~close ~flush ~exn + +(* TODO Can probably save promise allocation if create a separate looping + function. *) +let rec read stream = + let promise, resolver = Lwt.wait () in + + begin + stream.next + ~data:(fun buffer offset length -> + Bigstringaf.sub buffer ~off:offset ~len:length + |> Bigstringaf.to_string + |> Option.some + |> Lwt.wakeup_later resolver) + + ~close:(fun () -> + Lwt.wakeup_later resolver None) + + ~flush:(fun () -> + let next_promise = read stream in + Lwt.on_any + next_promise + (Lwt.wakeup_later resolver) + (Lwt.wakeup_later_exn resolver)) + + ~exn:(Lwt.wakeup_later_exn resolver) + end; + + promise + +let body stream = + let promise, resolver = Lwt.wait () in + let length = ref 0 in + let buffer = ref (Bigstringaf.create 4096) in + + let rec loop () = + stream.next + ~data:(fun chunk offset chunk_length -> + let new_length = !length + chunk_length in + + if new_length > Bigstringaf.length !buffer then begin + let new_buffer = Bigstringaf.create (new_length * 2) in + Bigstringaf.blit + !buffer ~src_off:0 new_buffer ~dst_off:0 ~len:!length; + buffer := new_buffer + end; + + Bigstringaf.blit + chunk ~src_off:offset !buffer ~dst_off:!length ~len:chunk_length; + length := new_length; + + loop ()) + + ~close:(fun () -> + Bigstringaf.sub !buffer ~off:0 ~len:!length + |> Bigstringaf.to_string + |> Lwt.wakeup_later resolver) + + ~flush:loop + + (* TODO Make an effort to eagerly release the buffer? *) + ~exn:(Lwt.wakeup_later_exn resolver) + in + loop (); + + promise + +(* TODO Fix. This shouldn't return a promise. *) +let close stream = + stream.close ignore; + Lwt.return_unit + +let write buffer offset length done_ close exn stream = + stream.write buffer offset length done_ close exn + +let flush done_ close exn stream = + stream.flush done_ close exn + +type pipe = { + mutable state : [ + | `Idle + | `Reader_waiting + | `Writer_waiting + | `Closed + ]; + + mutable read_data_callback : buffer -> int -> int -> unit; + mutable read_close_callback : unit -> unit; + mutable read_flush_callback : unit -> unit; + mutable read_exn_callback : exn -> unit; + + mutable write_kind : [ + | `Data + | `Flush + | `Exn + ]; + mutable write_buffer : buffer; + mutable write_offset : int; + mutable write_length : int; + mutable write_done_callback : unit -> unit; + mutable write_close_callback : unit -> unit; + mutable write_exn_callback : exn -> unit; +} + +let dummy_buffer = + Bigstringaf.create 0 + +let dummy_read_data_callback _buffer _offset _length = + () + +let clean_up_reader_fields pipe = + pipe.read_data_callback <- dummy_read_data_callback; + pipe.read_close_callback <- ignore; + pipe.read_flush_callback <- ignore; + pipe.read_exn_callback <- ignore + +let clean_up_writer_fields pipe = + pipe.write_buffer <- dummy_buffer; + pipe.write_done_callback <- ignore; + pipe.write_close_callback <- ignore; + pipe.write_exn_callback <- ignore + +let pipe () = + let internal = { + state = `Idle; + + read_data_callback = dummy_read_data_callback; + read_close_callback = ignore; + read_flush_callback = ignore; + read_exn_callback = ignore; + + write_kind = `Data; + write_buffer = dummy_buffer; + write_offset = 0; + write_length = 0; + write_done_callback = ignore; + write_close_callback = ignore; + write_exn_callback = ignore; + } in + + let next ~data ~close ~flush ~exn = + match internal.state with + | `Idle -> + internal.state <- `Reader_waiting; + internal.read_data_callback <- data; + internal.read_close_callback <- close; + internal.read_flush_callback <- flush; + internal.read_exn_callback <- exn + | `Reader_waiting -> + raise (Failure "Stream read: the previous read has not completed") + | `Writer_waiting -> + internal.state <- `Idle; + let write_done_callback = internal.write_done_callback in + clean_up_writer_fields internal; + begin match internal.write_kind with + | `Data -> + let buffer = internal.write_buffer in + internal.write_buffer <- dummy_buffer; + data buffer internal.write_offset internal.write_length; + write_done_callback (); + | `Flush -> + flush (); + write_done_callback (); + | `Exn -> + (* TODO Real exception. *) + exn Exit; + write_done_callback (); + end + | `Closed -> + close () + in + + (* TODO Callbacks could definitely use labels, based on usage. *) + let write buffer offset length done_ close exn = + match internal.state with + | `Idle -> + internal.state <- `Writer_waiting; + internal.write_kind <- `Data; + internal.write_buffer <- buffer; + internal.write_offset <- offset; + internal.write_length <- length; + internal.write_done_callback <- done_; + internal.write_close_callback <- close; + internal.write_exn_callback <- exn + | `Reader_waiting -> + internal.state <- `Idle; + let read_data_callback = internal.read_data_callback in + clean_up_reader_fields internal; + read_data_callback buffer offset length; + done_ () + | `Writer_waiting -> + raise (Failure "Stream write: the previous write has not completed") + | `Closed -> + close () + in + + let close done_ = + match internal.state with + | `Idle -> + internal.state <- `Closed; + done_ () + | `Reader_waiting -> + internal.state <- `Closed; + let read_close_callback = internal.read_close_callback in + clean_up_reader_fields internal; + read_close_callback (); + done_ () + | `Writer_waiting -> + internal.state <- `Closed; + let write_close_callback = internal.write_close_callback in + clean_up_writer_fields internal; + write_close_callback (); + done_ () + | `Closed -> + done_ () + in + + let flush done_ close exn = + match internal.state with + | `Idle -> + internal.state <- `Writer_waiting; + internal.write_kind <- `Flush; + internal.write_done_callback <- done_; + internal.write_close_callback <- close; + internal.write_exn_callback <- exn + | `Reader_waiting -> + internal.state <- `Idle; + let read_flush_callback = internal.read_flush_callback in + clean_up_reader_fields internal; + read_flush_callback (); + done_ () + | `Writer_waiting -> + raise (Failure "Stream flush: the previous write has not completed") + | `Closed -> + close () + in + + {next; write; flush; close} diff --git a/src/pure/stream.mli b/src/pure/stream.mli new file mode 100644 index 00000000..73a0793c --- /dev/null +++ b/src/pure/stream.mli @@ -0,0 +1,40 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +type buffer = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +type 'a promise = + 'a Lwt.t + +type stream + +type reader = + data:(buffer -> int -> int -> unit) -> + close:(unit -> unit) -> + flush:(unit -> unit) -> + exn:(exn -> unit) -> + unit + +val read_only : reader -> stream +val empty : stream +val string : string -> stream +val pipe : unit -> stream + +(* TODO Rename. *) +val next : stream -> reader +val read : stream -> string option promise +val body : stream -> string promise + +(* TODO Wrong signature. *) +val close : stream -> unit promise +(* TODO Clarify these signatures. *) +val write : + buffer -> int -> int -> + (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> stream -> + unit +val flush : (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> stream -> unit From 4f5f3c4dcf445a2985f08921979754c6c806156d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 24 Nov 2021 18:37:17 +0300 Subject: [PATCH 019/312] Ability to run separate expect test suites --- Makefile | 6 ++++-- docs/CONTRIBUTING.md | 5 ++++- test/expect/pure/{ => cipher}/cipher.ml | 0 test/expect/pure/cipher/dune | 5 +++++ test/expect/pure/dune | 5 +---- test/expect/pure/{ => formats/base64}/base64.ml | 0 test/expect/pure/formats/base64/dune | 5 +++++ test/expect/pure/{ => formats/cookie}/cookie.ml | 0 test/expect/pure/formats/cookie/dune | 5 +++++ test/expect/pure/formats/escape/dune | 5 +++++ test/expect/pure/{ => formats/escape}/escape.ml | 0 test/expect/pure/formats/form_urlencoded/dune | 5 +++++ .../pure/{ => formats/form_urlencoded}/form_urlencoded.ml | 0 test/expect/pure/formats/path/dune | 5 +++++ test/expect/pure/{ => formats/path}/path.ml | 0 test/expect/pure/formats/percent/dune | 5 +++++ test/expect/pure/{ => formats/percent}/percent.ml | 0 test/expect/pure/formats/query/dune | 5 +++++ test/expect/pure/{ => formats/query}/query.ml | 0 test/expect/pure/formats/target/dune | 5 +++++ test/expect/pure/{ => formats/target}/target.ml | 0 test/expect/pure/method/dune | 5 +++++ test/expect/pure/{ => method}/method.ml | 0 test/expect/pure/status/dune | 5 +++++ test/expect/pure/{ => status}/status.ml | 0 test/expect/pure/{body.ml => stream/stream.ml} | 0 26 files changed, 64 insertions(+), 7 deletions(-) rename test/expect/pure/{ => cipher}/cipher.ml (100%) create mode 100644 test/expect/pure/cipher/dune rename test/expect/pure/{ => formats/base64}/base64.ml (100%) create mode 100644 test/expect/pure/formats/base64/dune rename test/expect/pure/{ => formats/cookie}/cookie.ml (100%) create mode 100644 test/expect/pure/formats/cookie/dune create mode 100644 test/expect/pure/formats/escape/dune rename test/expect/pure/{ => formats/escape}/escape.ml (100%) create mode 100644 test/expect/pure/formats/form_urlencoded/dune rename test/expect/pure/{ => formats/form_urlencoded}/form_urlencoded.ml (100%) create mode 100644 test/expect/pure/formats/path/dune rename test/expect/pure/{ => formats/path}/path.ml (100%) create mode 100644 test/expect/pure/formats/percent/dune rename test/expect/pure/{ => formats/percent}/percent.ml (100%) create mode 100644 test/expect/pure/formats/query/dune rename test/expect/pure/{ => formats/query}/query.ml (100%) create mode 100644 test/expect/pure/formats/target/dune rename test/expect/pure/{ => formats/target}/target.ml (100%) create mode 100644 test/expect/pure/method/dune rename test/expect/pure/{ => method}/method.ml (100%) create mode 100644 test/expect/pure/status/dune rename test/expect/pure/{ => status}/status.ml (100%) rename test/expect/pure/{body.ml => stream/stream.ml} (100%) diff --git a/Makefile b/Makefile index fcd759a3..2dde57d5 100644 --- a/Makefile +++ b/Makefile @@ -6,18 +6,20 @@ build : watch : @dune build -p dream --no-print-directory -w +TEST ?= test + .PHONY : test test : @find . -name '*.coverage' | xargs rm -f @dune build --no-print-directory \ - --instrument-with bisect_ppx --force @test/runtest + --instrument-with bisect_ppx --force @$(TEST)/runtest @bisect-ppx-report html @bisect-ppx-report summary @echo See _coverage/index.html .PHONY : test-watch test-watch : - @dune build --no-print-directory -w --root . @test/runtest + @dune build --no-print-directory -w --root . @$(TEST)/runtest .PHONY : coverage-serve coverage-serve : diff --git a/docs/CONTRIBUTING.md b/docs/CONTRIBUTING.md index 7ef48d80..7f344da2 100644 --- a/docs/CONTRIBUTING.md +++ b/docs/CONTRIBUTING.md @@ -65,9 +65,12 @@ You can now add some code that will exercise your change, so you can test it as you work. There are two main places for this: 1. The tests in `test/`. They can be run with `make test`. View the generated - coverage report in `_coverage/index.html` to see how much the tests exercies + coverage report in `_coverage/index.html` to see how much the tests exercise your changes. + To run tests from a single directory, for example `test/expect/pure`, run + `make test TEST=test/expect/pure`. + 2. The examples in `example/`. I often test changes by modifying an example that is almost on topic for the code I'm changing, and then not committing the example. In some cases, though, it's easiest to fork or write a new example diff --git a/test/expect/pure/cipher.ml b/test/expect/pure/cipher/cipher.ml similarity index 100% rename from test/expect/pure/cipher.ml rename to test/expect/pure/cipher/cipher.ml diff --git a/test/expect/pure/cipher/dune b/test/expect/pure/cipher/dune new file mode 100644 index 00000000..f6cf5ed5 --- /dev/null +++ b/test/expect/pure/cipher/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_cipher) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/dune b/test/expect/pure/dune index 9a9ac159..f0bbebdc 100644 --- a/test/expect/pure/dune +++ b/test/expect/pure/dune @@ -10,7 +10,4 @@ lwt.unix ppx_expect.common ppx_inline_test.config - ppx_expect.config_types - ) - (inline_tests) - (preprocess (pps lwt_ppx ppx_expect))) + ppx_expect.config_types)) diff --git a/test/expect/pure/base64.ml b/test/expect/pure/formats/base64/base64.ml similarity index 100% rename from test/expect/pure/base64.ml rename to test/expect/pure/formats/base64/base64.ml diff --git a/test/expect/pure/formats/base64/dune b/test/expect/pure/formats/base64/dune new file mode 100644 index 00000000..a582ff76 --- /dev/null +++ b/test/expect/pure/formats/base64/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_base64) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/cookie.ml b/test/expect/pure/formats/cookie/cookie.ml similarity index 100% rename from test/expect/pure/cookie.ml rename to test/expect/pure/formats/cookie/cookie.ml diff --git a/test/expect/pure/formats/cookie/dune b/test/expect/pure/formats/cookie/dune new file mode 100644 index 00000000..b7bde4cc --- /dev/null +++ b/test/expect/pure/formats/cookie/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_cookie) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/formats/escape/dune b/test/expect/pure/formats/escape/dune new file mode 100644 index 00000000..869fce07 --- /dev/null +++ b/test/expect/pure/formats/escape/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_escape) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/escape.ml b/test/expect/pure/formats/escape/escape.ml similarity index 100% rename from test/expect/pure/escape.ml rename to test/expect/pure/formats/escape/escape.ml diff --git a/test/expect/pure/formats/form_urlencoded/dune b/test/expect/pure/formats/form_urlencoded/dune new file mode 100644 index 00000000..1f738583 --- /dev/null +++ b/test/expect/pure/formats/form_urlencoded/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_form_urlencoded) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/form_urlencoded.ml b/test/expect/pure/formats/form_urlencoded/form_urlencoded.ml similarity index 100% rename from test/expect/pure/form_urlencoded.ml rename to test/expect/pure/formats/form_urlencoded/form_urlencoded.ml diff --git a/test/expect/pure/formats/path/dune b/test/expect/pure/formats/path/dune new file mode 100644 index 00000000..4ddcd519 --- /dev/null +++ b/test/expect/pure/formats/path/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_path) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/path.ml b/test/expect/pure/formats/path/path.ml similarity index 100% rename from test/expect/pure/path.ml rename to test/expect/pure/formats/path/path.ml diff --git a/test/expect/pure/formats/percent/dune b/test/expect/pure/formats/percent/dune new file mode 100644 index 00000000..dfe1ec6d --- /dev/null +++ b/test/expect/pure/formats/percent/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_percent) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/percent.ml b/test/expect/pure/formats/percent/percent.ml similarity index 100% rename from test/expect/pure/percent.ml rename to test/expect/pure/formats/percent/percent.ml diff --git a/test/expect/pure/formats/query/dune b/test/expect/pure/formats/query/dune new file mode 100644 index 00000000..985a864d --- /dev/null +++ b/test/expect/pure/formats/query/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_query) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/query.ml b/test/expect/pure/formats/query/query.ml similarity index 100% rename from test/expect/pure/query.ml rename to test/expect/pure/formats/query/query.ml diff --git a/test/expect/pure/formats/target/dune b/test/expect/pure/formats/target/dune new file mode 100644 index 00000000..11356a55 --- /dev/null +++ b/test/expect/pure/formats/target/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_target) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/target.ml b/test/expect/pure/formats/target/target.ml similarity index 100% rename from test/expect/pure/target.ml rename to test/expect/pure/formats/target/target.ml diff --git a/test/expect/pure/method/dune b/test/expect/pure/method/dune new file mode 100644 index 00000000..2a6ab6c2 --- /dev/null +++ b/test/expect/pure/method/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_method) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/method.ml b/test/expect/pure/method/method.ml similarity index 100% rename from test/expect/pure/method.ml rename to test/expect/pure/method/method.ml diff --git a/test/expect/pure/status/dune b/test/expect/pure/status/dune new file mode 100644 index 00000000..3b64cd2e --- /dev/null +++ b/test/expect/pure/status/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_status) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/status.ml b/test/expect/pure/status/status.ml similarity index 100% rename from test/expect/pure/status.ml rename to test/expect/pure/status/status.ml diff --git a/test/expect/pure/body.ml b/test/expect/pure/stream/stream.ml similarity index 100% rename from test/expect/pure/body.ml rename to test/expect/pure/stream/stream.ml From f58b8b5cda3dc27cb239d8d65f1dc8ca37ef1a0e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 24 Nov 2021 22:15:11 +0300 Subject: [PATCH 020/312] Begin testing streams --- src/pure/stream.ml | 11 +- test/expect/pure/stream/dune | 5 + test/expect/pure/stream/stream.ml | 341 +++++++++++------------------- 3 files changed, 141 insertions(+), 216 deletions(-) create mode 100644 test/expect/pure/stream/dune diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 3c77aea0..461d3871 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -224,18 +224,21 @@ let pipe () = | `Writer_waiting -> internal.state <- `Idle; let write_done_callback = internal.write_done_callback in - clean_up_writer_fields internal; begin match internal.write_kind with | `Data -> - let buffer = internal.write_buffer in - internal.write_buffer <- dummy_buffer; - data buffer internal.write_offset internal.write_length; + let buffer = internal.write_buffer + and offset = internal.write_offset + and length = internal.write_length in + clean_up_writer_fields internal; + data buffer offset length; write_done_callback (); | `Flush -> + clean_up_writer_fields internal; flush (); write_done_callback (); | `Exn -> (* TODO Real exception. *) + clean_up_writer_fields internal; exn Exit; write_done_callback (); end diff --git a/test/expect/pure/stream/dune b/test/expect/pure/stream/dune new file mode 100644 index 00000000..b012b025 --- /dev/null +++ b/test/expect/pure/stream/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_pure_stream) + (libraries test_expect_pure) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 48ab63b1..c1a869c0 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -5,241 +5,158 @@ -(* let has_body message = - Printf.printf "%B\n" (Dream.has_body message) +module Stream = Dream__pure.Stream -let%expect_test _ = - has_body (Dream.response ""); - has_body (Dream.response "foo"); - Dream.response "" - |> Dream.with_body "foo" - |> has_body; - Dream.response "foo" - |> Dream.with_body "" - |> has_body; +let read_and_dump stream = + Stream.next stream + ~data:(fun buffer offset length -> + print_string "data: "; + Bigstringaf.substring buffer ~off:offset ~len:length + |> print_endline) - Dream.response "" - |> Dream.with_stream - |> has_body; - [%expect {| - false - true - true - false - true |}] *) - - - -let string_stream chunks = - let chunks = ref chunks in - let response = Dream.response "" |> Dream.with_stream in - let rec push () = - match !chunks with - | [] -> - Dream.close_stream response - | chunk::more -> - chunks := more; - let%lwt () = Dream.write response chunk in - push () - in - Lwt.async push; - response - -let bigstring_stream chunks = - let chunks = ref chunks in - let response = Dream.response "" |> Dream.with_stream in - let rec push () = - match !chunks with - | [] -> - Dream.close_stream response - | chunk::more -> - chunks := more; - let%lwt () = Dream.write_buffer response (Lwt_bytes.of_string chunk) in - push () - in - Lwt.async push; - response - - - -let body message = - Printf.printf "%S\n" (Lwt_main.run (Dream.body message)) + ~close:(fun () -> + print_endline "close") -let%expect_test _ = - body (Dream.response ""); - body (Dream.response "foo"); + ~flush:(fun () -> + print_endline "flush") - body (Dream.with_body "foo" (Dream.response "")); - body (Dream.with_body "" (Dream.response "foo")); + ~exn:(fun _ -> + print_endline "exn") - body (string_stream []); - body (string_stream ["foo"]); - body (string_stream ["foo"; "bar"]); - body (bigstring_stream []); - body (bigstring_stream ["foo"]); - body (bigstring_stream ["foo"; "bar"]); - body (bigstring_stream [String.make 4097 'a'; "foo"]); - body (bigstring_stream ["foo"; String.make 4097 'a']); + +(* Read-only streams. *) + +let%expect_test _ = + let stream = Stream.empty in + read_and_dump stream; + read_and_dump stream; [%expect {| - "" - "foo" - "foo" - "" - "" - "foo" - "foobar" - "" - "foo" - "foobar" - "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafoo" - "fooaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" |}] - - - -let read message = - let message : Dream.request = Obj.magic message in - let rec read accumulator = - match%lwt Dream.read message with - | None -> Lwt.return (List.rev accumulator) - | Some chunk -> read (chunk::accumulator) - in - Lwt_main.run (read []) - |> List.map (Printf.sprintf "%S") - |> String.concat "; " - |> Printf.printf "[%s]\n" + close + close |}] let%expect_test _ = - read (Dream.response ""); - read (Dream.response "foo"); - - read (Dream.with_body "foo" (Dream.response "")); - read (Dream.with_body "" (Dream.response "foo")); - - read (string_stream []); - read (string_stream [""]); - read (string_stream ["foo"]); - read (string_stream ["foo"; "bar"]); - - read (bigstring_stream []); - read (bigstring_stream [""]); - read (bigstring_stream ["foo"]); - read (bigstring_stream ["foo"; "bar"]); - read (bigstring_stream [String.make 4097 'a'; "foo"]); - read (bigstring_stream ["foo"; String.make 4097 'a']); + let stream = Stream.string "foo" in + read_and_dump stream; + read_and_dump stream; + read_and_dump stream; [%expect {| - [] - ["foo"] - ["foo"] - [] - [] - [""] - ["foo"] - ["foo"; "bar"] - [] - [""] - ["foo"] - ["foo"; "bar"] - ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"; "foo"] - ["foo"; "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"] |}] - - - -let next message = - let until_done, signal_done = Lwt.wait () in - let rec next accumulator = - Dream__pure.Inmost.next - ~buffer:(fun data start length -> - next - ((Lwt_bytes.to_string - (Lwt_bytes.proxy data start length))::accumulator)) - ~string:(fun data start length -> - next - ((String.sub data start length)::accumulator)) - ~close:(fun () -> Lwt.wakeup_later signal_done (List.rev accumulator)) - ~exn:ignore - (Obj.magic message) - in - next []; - Lwt_main.run until_done - |> List.map (Printf.sprintf "%S") - |> String.concat "; " - |> Printf.printf "[%s]\n" + data: foo + close + close |}] let%expect_test _ = - next (Dream.response ""); - next (Dream.response "foo"); - - next (Dream.with_body "foo" (Dream.response "")); - next (Dream.with_body "" (Dream.response "foo")); - - next (string_stream []); - next (string_stream [""]); - next (string_stream ["foo"]); - next (string_stream ["foo"; "bar"]); - - next (bigstring_stream []); - next (bigstring_stream [""]); - next (bigstring_stream ["foo"]); - next (bigstring_stream ["foo"; "bar"]); - next (bigstring_stream [String.make 4097 'a'; "foo"]); - next (bigstring_stream ["foo"; String.make 4097 'a']); + let stream = Stream.string "" in + read_and_dump stream; + read_and_dump stream; [%expect {| - [] - ["foo"] - ["foo"] - [] - [] - [""] - ["foo"] - ["foo"; "bar"] - [] - [""] - ["foo"] - ["foo"; "bar"] - ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"; "foo"] - ["foo"; "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"] |}] + close + close |}] +(* Pipe: double read. *) + let%expect_test _ = - let message = Dream.response "foo" in - read message; - read message; + let stream = Stream.pipe () in + read_and_dump stream; + try read_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn); + [%expect {| (Failure "Stream read: the previous read has not completed") |}] + + - let message = string_stream ["foo"] in - read message; - read message; +(* Pipe: interactions between read and close. *) + +let%expect_test _ = + let stream = Stream.pipe () in + read_and_dump stream; + print_endline "checkpoint 1"; + (* TODO Check that the callback is called. *) + Stream.close stream |> ignore; + print_endline "checkpoint 2"; + read_and_dump stream; + print_endline "checkpoint 3"; + Stream.close stream |> ignore; + [%expect {| + checkpoint 1 + close + checkpoint 2 + close + checkpoint 3 |}] - let message = bigstring_stream ["foo"] in - read message; - read message; +let%expect_test _ = + let stream = Stream.pipe () in + Stream.close stream |> ignore; + read_and_dump stream; + read_and_dump stream; [%expect {| - ["foo"] - [] - ["foo"] - [] - ["foo"] - [] |}] + close + close |}] + + + +(* Pipe: interactions between read and flush. *) let%expect_test _ = - let message = Dream.response "foo" in - next message; - next message; - - (* TODO This is broken at the moment! *) - (* let message = string_stream ["foo"] in - next message; - next message; - - let message = bigstring_stream ["foo"] in - next message; - next message; *) + let stream = Stream.pipe () in + read_and_dump stream; + print_endline "checkpoint 1"; + (* TODO Check the callbacks are called. *) + Stream.flush ignore ignore ignore stream; + Stream.flush ignore ignore ignore stream; + print_endline "checkpoint 2"; + read_and_dump stream; + Stream.flush ignore ignore ignore stream; + try Stream.flush ignore ignore ignore stream + with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| - ["foo"] - [] |}] + checkpoint 1 + flush + checkpoint 2 + flush + (Failure "Stream flush: the previous write has not completed") |}] + -(* TODO Test flush, exception passing, report. *) -(* TODO Test concurrent readers, writers. *) + +(* Pipe: interactions between read and write. *) + +let buffer = + Bigstringaf.of_string ~off:0 ~len:3 "foo" + +let%expect_test _ = + let stream = Stream.pipe () in + read_and_dump stream; + print_endline "checkpoint 1"; + (* TODO Check the callbacks are called. *) + Stream.write buffer 0 3 ignore ignore ignore stream; + Stream.write buffer 1 1 ignore ignore ignore stream; + print_endline "checkpoint 2"; + read_and_dump stream; + Stream.write buffer 0 3 ignore ignore ignore stream; + try Stream.write buffer 0 3 ignore ignore ignore stream; + with Failure _ as exn -> print_endline (Printexc.to_string exn); + [%expect {| + checkpoint 1 + data: foo + checkpoint 2 + data: o + (Failure "Stream write: the previous write has not completed") |}] + + + +(* TODO: Test: + +- Writing to a read-only stream. Flushing, etc. +- Early close of read-only streams or any other streams by the reader. +- The generic read_only needs to take a close callback in addition to the + reader. +- Stream.string needs to be able to abort the string by providing an appropriate + such callback. +- Have the string stream release the string eagerly after it is read. +- Interactions between writers (including flush) and close. This will benefit + from clarifying the writers' callbacks. +- The higher-level reading helpers. +*) From 6ece622f97d6afecfad51981a7b8e603d5a1b155 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 15:03:48 +0300 Subject: [PATCH 021/312] Stream: rename reader functions --- src/http/adapt.ml | 2 +- src/pure/inmost.ml | 9 +++++++-- src/pure/stream.ml | 27 +++++++++++++-------------- src/pure/stream.mli | 11 +++++------ test/expect/pure/stream/stream.ml | 2 +- 5 files changed, 27 insertions(+), 24 deletions(-) diff --git a/src/http/adapt.ml b/src/http/adapt.ml index e5a5fe7a..29414103 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -29,7 +29,7 @@ let forward_body_general let rec send () = Dream.body_stream response - |> fun stream -> Stream.next + |> fun stream -> Stream.read stream ~data ~close diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 1bb1de1e..1f1cdde7 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -289,14 +289,19 @@ let cookie name request = with Not_found -> None *) let body message = - Stream.body message.body + Stream.read_until_close message.body let read message = - Stream.read message.body + Stream.read_convenience message.body let body_stream message = message.body +(* TODO Pending the dream.mli interface reorganization for the new stream + API. *) +let next = + Stream.read + (* Create a fresh ref. The reason this field has a ref is because it might get replaced when a body is forced read. That's not what's happening here - we are setting a new body. Indeed, there might be a concurrent read going on. diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 461d3871..2f84e7aa 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -11,7 +11,7 @@ type buffer = type 'a promise = 'a Lwt.t -type reader = +type read = data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> @@ -19,7 +19,7 @@ type reader = unit type stream = { - next : + read : data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> @@ -39,11 +39,10 @@ type stream = { close : (unit -> unit) -> unit; } -(* TODO Probably rename next throughout. *) (* TODO Raise some exception when writes are attempted. *) -let read_only next = +let read_only read = { - next; + read; write = (fun _buffer _offset _length _done _close _exn -> ()); flush = (fun _done _close _exn -> ()); close = (fun _done -> ()); @@ -70,16 +69,16 @@ let string s = end end -let next stream ~data ~close ~flush ~exn = - stream.next ~data ~close ~flush ~exn +let read stream ~data ~close ~flush ~exn = + stream.read ~data ~close ~flush ~exn (* TODO Can probably save promise allocation if create a separate looping function. *) -let rec read stream = +let rec read_convenience stream = let promise, resolver = Lwt.wait () in begin - stream.next + stream.read ~data:(fun buffer offset length -> Bigstringaf.sub buffer ~off:offset ~len:length |> Bigstringaf.to_string @@ -90,7 +89,7 @@ let rec read stream = Lwt.wakeup_later resolver None) ~flush:(fun () -> - let next_promise = read stream in + let next_promise = read_convenience stream in Lwt.on_any next_promise (Lwt.wakeup_later resolver) @@ -101,13 +100,13 @@ let rec read stream = promise -let body stream = +let read_until_close stream = let promise, resolver = Lwt.wait () in let length = ref 0 in let buffer = ref (Bigstringaf.create 4096) in let rec loop () = - stream.next + stream.read ~data:(fun chunk offset chunk_length -> let new_length = !length + chunk_length in @@ -211,7 +210,7 @@ let pipe () = write_exn_callback = ignore; } in - let next ~data ~close ~flush ~exn = + let read ~data ~close ~flush ~exn = match internal.state with | `Idle -> internal.state <- `Reader_waiting; @@ -311,4 +310,4 @@ let pipe () = close () in - {next; write; flush; close} + {read; write; flush; close} diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 73a0793c..0ef86008 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -13,22 +13,21 @@ type 'a promise = type stream -type reader = +type read = data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> exn:(exn -> unit) -> unit -val read_only : reader -> stream +val read_only : read -> stream val empty : stream val string : string -> stream val pipe : unit -> stream -(* TODO Rename. *) -val next : stream -> reader -val read : stream -> string option promise -val body : stream -> string promise +val read : stream -> read +val read_convenience : stream -> string option promise +val read_until_close : stream -> string promise (* TODO Wrong signature. *) val close : stream -> unit promise diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index c1a869c0..f9de5873 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -10,7 +10,7 @@ module Stream = Dream__pure.Stream let read_and_dump stream = - Stream.next stream + Stream.read stream ~data:(fun buffer offset length -> print_string "data: "; Bigstringaf.substring buffer ~off:offset ~len:length From df4f4b630089d920dcbf9f6c05f0e8064b0966fa Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 15:25:14 +0300 Subject: [PATCH 022/312] Equip read-only streams with a close callback --- src/http/http.ml | 30 +++++++++------- src/pure/stream.ml | 57 +++++++++++++++++-------------- src/pure/stream.mli | 2 +- test/expect/pure/stream/stream.ml | 18 ++++++++++ 4 files changed, 69 insertions(+), 38 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index bf4432a1..467d1801 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -163,13 +163,16 @@ let wrap_handler (* TODO Should the stream be auto-closed? It doesn't even have a closed state. The whole thing is just a wrapper for whatever the http/af behavior is. *) - let body = - Stream.read_only (fun ~data ~close ~flush:_ ~exn:_ -> - Httpaf.Body.Reader.schedule_read - body - ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len)) + let read ~data ~close ~flush:_ ~exn:_ = + Httpaf.Body.Reader.schedule_read + body + ~on_eof:close + ~on_read:(fun buffer ~off ~len -> data buffer off len) in + let close () = + Httpaf.Body.Reader.close body in + let body = + Stream.read_only ~read ~close in let request : Dream.request = Dream.request_from_http @@ -303,13 +306,16 @@ let wrap_handler_h2 let body = H2.Reqd.request_body conn in - let body = - Stream.read_only (fun ~data ~close ~flush:_ ~exn:_ -> - H2.Body.schedule_read - body - ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len)) + let read ~data ~close ~flush:_ ~exn:_ = + H2.Body.schedule_read + body + ~on_eof:close + ~on_read:(fun buffer ~off ~len -> data buffer off len) in + let close () = + H2.Body.close_reader body in + let body = + Stream.read_only ~read ~close in let request : Dream.request = Dream.request_from_http diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 2f84e7aa..8f10ff13 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -36,37 +36,47 @@ type stream = { unit; flush : (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> unit; - close : (unit -> unit) -> unit; + close : unit -> unit; } (* TODO Raise some exception when writes are attempted. *) -let read_only read = +let read_only ~read ~close = { read; write = (fun _buffer _offset _length _done _close _exn -> ()); flush = (fun _done _close _exn -> ()); - close = (fun _done -> ()); + close; } let empty = - read_only (fun ~data:_ ~close ~flush:_ ~exn:_ -> close ()) + read_only + ~read:(fun ~data:_ ~close ~flush:_ ~exn:_ -> close ()) + ~close:ignore (* TODO This shows the awkwardness in string-to-string body reading. *) -let string s = - if String.length s = 0 then +let string the_string = + if String.length the_string = 0 then empty - else begin - let already_read = ref false in - read_only begin fun ~data ~close ~flush:_ ~exn:_ -> - if not !already_read then begin - already_read := true; - let length = String.length s in - data (Bigstringaf.of_string ~off:0 ~len:length s) 0 length - end - else + (* Storing the string in a ref here so that we can "lose" it eagerly once + the stream is closed, making the memory available to the GC. *) + let string_ref = ref (Some the_string) in + + let read ~data ~close ~flush:_ ~exn:_ = + match !string_ref with + | Some stored_string -> + string_ref := None; + let length = String.length stored_string in + data (Bigstringaf.of_string ~off:0 ~len:length stored_string) 0 length + | None -> close () - end + in + + let close () = + string_ref := None; + in + + read_only ~read ~close end let read stream ~data ~close ~flush ~exn = @@ -139,7 +149,7 @@ let read_until_close stream = (* TODO Fix. This shouldn't return a promise. *) let close stream = - stream.close ignore; + stream.close (); Lwt.return_unit let write buffer offset length done_ close exn stream = @@ -269,25 +279,22 @@ let pipe () = close () in - let close done_ = + let close () = match internal.state with | `Idle -> - internal.state <- `Closed; - done_ () + internal.state <- `Closed | `Reader_waiting -> internal.state <- `Closed; let read_close_callback = internal.read_close_callback in clean_up_reader_fields internal; - read_close_callback (); - done_ () + read_close_callback () | `Writer_waiting -> internal.state <- `Closed; let write_close_callback = internal.write_close_callback in clean_up_writer_fields internal; - write_close_callback (); - done_ () + write_close_callback () | `Closed -> - done_ () + () in let flush done_ close exn = diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 0ef86008..cd0526d1 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -20,7 +20,7 @@ type read = exn:(exn -> unit) -> unit -val read_only : read -> stream +val read_only : read:read -> close:(unit -> unit) -> stream val empty : stream val string : string -> stream val pipe : unit -> stream diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index f9de5873..76723111 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -33,18 +33,30 @@ let%expect_test _ = let stream = Stream.empty in read_and_dump stream; read_and_dump stream; + Stream.close stream |> ignore; + read_and_dump stream; [%expect {| + close close close |}] +let%expect_test _ = + let stream = Stream.empty in + Stream.close stream |> ignore; + read_and_dump stream; + [%expect {| close |}] + let%expect_test _ = let stream = Stream.string "foo" in read_and_dump stream; read_and_dump stream; read_and_dump stream; + Stream.close stream |> ignore; + read_and_dump stream; [%expect {| data: foo close + close close |}] let%expect_test _ = @@ -55,6 +67,12 @@ let%expect_test _ = close close |}] +let%expect_test _ = + let stream = Stream.string "foo" in + Stream.close stream |> ignore; + read_and_dump stream; + [%expect {| close |}] + (* Pipe: double read. *) From 6ab46c32264a765a5ef3087026f58db9697336db Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 15:28:56 +0300 Subject: [PATCH 023/312] Stream.close shouldn't evaluate to a promise --- src/pure/inmost.ml | 3 ++- src/pure/stream.ml | 4 +--- src/pure/stream.mli | 4 ++-- test/expect/pure/stream/stream.ml | 14 +++++++------- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 1f1cdde7..ce88567f 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -360,7 +360,8 @@ let flush message = promise let close_stream message = - Stream.close message.body + Stream.close message.body; + Lwt.return_unit (* TODO Rename. *) let is_websocket response = diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 8f10ff13..09f33a27 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -147,10 +147,8 @@ let read_until_close stream = promise -(* TODO Fix. This shouldn't return a promise. *) let close stream = - stream.close (); - Lwt.return_unit + stream.close () let write buffer offset length done_ close exn stream = stream.write buffer offset length done_ close exn diff --git a/src/pure/stream.mli b/src/pure/stream.mli index cd0526d1..55c810a5 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -25,12 +25,12 @@ val empty : stream val string : string -> stream val pipe : unit -> stream +val close : stream -> unit + val read : stream -> read val read_convenience : stream -> string option promise val read_until_close : stream -> string promise -(* TODO Wrong signature. *) -val close : stream -> unit promise (* TODO Clarify these signatures. *) val write : buffer -> int -> int -> diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 76723111..6de69a55 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -33,7 +33,7 @@ let%expect_test _ = let stream = Stream.empty in read_and_dump stream; read_and_dump stream; - Stream.close stream |> ignore; + Stream.close stream; read_and_dump stream; [%expect {| close @@ -42,7 +42,7 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.empty in - Stream.close stream |> ignore; + Stream.close stream; read_and_dump stream; [%expect {| close |}] @@ -51,7 +51,7 @@ let%expect_test _ = read_and_dump stream; read_and_dump stream; read_and_dump stream; - Stream.close stream |> ignore; + Stream.close stream; read_and_dump stream; [%expect {| data: foo @@ -69,7 +69,7 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.string "foo" in - Stream.close stream |> ignore; + Stream.close stream; read_and_dump stream; [%expect {| close |}] @@ -93,11 +93,11 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; (* TODO Check that the callback is called. *) - Stream.close stream |> ignore; + Stream.close stream; print_endline "checkpoint 2"; read_and_dump stream; print_endline "checkpoint 3"; - Stream.close stream |> ignore; + Stream.close stream; [%expect {| checkpoint 1 close @@ -107,7 +107,7 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in - Stream.close stream |> ignore; + Stream.close stream; read_and_dump stream; read_and_dump stream; [%expect {| From 2b57a463c62f50366877ba4402fdd69cdbbd9c73 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 19:15:27 +0300 Subject: [PATCH 024/312] Don't pass exceptions through streams for now --- src/dream.mli | 1 - src/http/adapt.ml | 1 - src/http/http.ml | 4 +- src/pure/inmost.ml | 3 -- src/pure/stream.ml | 69 ++++++++++--------------------- src/pure/stream.mli | 7 +--- test/expect/pure/stream/stream.ml | 19 ++++----- 7 files changed, 34 insertions(+), 70 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 1cb989b1..a8d3ba38 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -735,7 +735,6 @@ val next : data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> - exn:(exn -> unit) -> unit (** Waits for the next stream event, and calls: diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 29414103..c98ffbaa 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -34,7 +34,6 @@ let forward_body_general ~data ~close ~flush - ~exn:ignore and data chunk off len = write_buffer ~off ~len chunk; diff --git a/src/http/http.ml b/src/http/http.ml index 467d1801..90ac64c1 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -163,7 +163,7 @@ let wrap_handler (* TODO Should the stream be auto-closed? It doesn't even have a closed state. The whole thing is just a wrapper for whatever the http/af behavior is. *) - let read ~data ~close ~flush:_ ~exn:_ = + let read ~data ~close ~flush:_ = Httpaf.Body.Reader.schedule_read body ~on_eof:close @@ -306,7 +306,7 @@ let wrap_handler_h2 let body = H2.Reqd.request_body conn in - let read ~data ~close ~flush:_ ~exn:_ = + let read ~data ~close ~flush:_ = H2.Body.schedule_read body ~on_eof:close diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index ce88567f..4a97c2ea 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -328,7 +328,6 @@ let write message chunk = buffer 0 length (Lwt.wakeup_later resolver) (fun () -> Lwt.wakeup_later_exn resolver End_of_file) - (Lwt.wakeup_later_exn resolver) message.body; promise @@ -344,7 +343,6 @@ let write_buffer ?(offset = 0) ?length message chunk = chunk offset length (Lwt.wakeup_later resolver) (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver) message.body; promise @@ -355,7 +353,6 @@ let flush message = Stream.flush (Lwt.wakeup_later resolver) (fun () -> Lwt.wakeup_later_exn resolver End_of_file) - (Lwt.wakeup_later_exn resolver) message.body; promise diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 09f33a27..fd0a7836 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -15,7 +15,6 @@ type read = data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> - exn:(exn -> unit) -> unit type stream = { @@ -23,18 +22,14 @@ type stream = { data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> - exn:(exn -> unit) -> unit; (* TODO Needs continuation arguments. Writer feedback is ok, exception, closed. Ok should probably carry an int. *) (* TODO Continuation labels? *) (* TODO Really review these continuations. *) - write : - buffer -> int -> int -> - (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> - unit; - flush : (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> unit; + write : buffer -> int -> int -> (unit -> unit) -> (unit -> unit) -> unit; + flush : (unit -> unit) -> (unit -> unit) -> unit; close : unit -> unit; } @@ -43,14 +38,14 @@ type stream = { let read_only ~read ~close = { read; - write = (fun _buffer _offset _length _done _close _exn -> ()); - flush = (fun _done _close _exn -> ()); + write = (fun _buffer _offset _length _done _close -> ()); + flush = (fun _done _close -> ()); close; } let empty = read_only - ~read:(fun ~data:_ ~close ~flush:_ ~exn:_ -> close ()) + ~read:(fun ~data:_ ~close ~flush:_ -> close ()) ~close:ignore (* TODO This shows the awkwardness in string-to-string body reading. *) @@ -62,7 +57,7 @@ let string the_string = the stream is closed, making the memory available to the GC. *) let string_ref = ref (Some the_string) in - let read ~data ~close ~flush:_ ~exn:_ = + let read ~data ~close ~flush:_ = match !string_ref with | Some stored_string -> string_ref := None; @@ -79,8 +74,8 @@ let string the_string = read_only ~read ~close end -let read stream ~data ~close ~flush ~exn = - stream.read ~data ~close ~flush ~exn +let read stream ~data ~close ~flush = + stream.read ~data ~close ~flush (* TODO Can probably save promise allocation if create a separate looping function. *) @@ -104,8 +99,6 @@ let rec read_convenience stream = next_promise (Lwt.wakeup_later resolver) (Lwt.wakeup_later_exn resolver)) - - ~exn:(Lwt.wakeup_later_exn resolver) end; promise @@ -139,9 +132,6 @@ let read_until_close stream = |> Lwt.wakeup_later resolver) ~flush:loop - - (* TODO Make an effort to eagerly release the buffer? *) - ~exn:(Lwt.wakeup_later_exn resolver) in loop (); @@ -150,11 +140,11 @@ let read_until_close stream = let close stream = stream.close () -let write buffer offset length done_ close exn stream = - stream.write buffer offset length done_ close exn +let write buffer offset length done_ close stream = + stream.write buffer offset length done_ close -let flush done_ close exn stream = - stream.flush done_ close exn +let flush done_ close stream = + stream.flush done_ close type pipe = { mutable state : [ @@ -167,19 +157,16 @@ type pipe = { mutable read_data_callback : buffer -> int -> int -> unit; mutable read_close_callback : unit -> unit; mutable read_flush_callback : unit -> unit; - mutable read_exn_callback : exn -> unit; mutable write_kind : [ | `Data | `Flush - | `Exn ]; mutable write_buffer : buffer; mutable write_offset : int; mutable write_length : int; mutable write_done_callback : unit -> unit; mutable write_close_callback : unit -> unit; - mutable write_exn_callback : exn -> unit; } let dummy_buffer = @@ -191,14 +178,12 @@ let dummy_read_data_callback _buffer _offset _length = let clean_up_reader_fields pipe = pipe.read_data_callback <- dummy_read_data_callback; pipe.read_close_callback <- ignore; - pipe.read_flush_callback <- ignore; - pipe.read_exn_callback <- ignore + pipe.read_flush_callback <- ignore let clean_up_writer_fields pipe = pipe.write_buffer <- dummy_buffer; pipe.write_done_callback <- ignore; - pipe.write_close_callback <- ignore; - pipe.write_exn_callback <- ignore + pipe.write_close_callback <- ignore let pipe () = let internal = { @@ -207,7 +192,6 @@ let pipe () = read_data_callback = dummy_read_data_callback; read_close_callback = ignore; read_flush_callback = ignore; - read_exn_callback = ignore; write_kind = `Data; write_buffer = dummy_buffer; @@ -215,17 +199,15 @@ let pipe () = write_length = 0; write_done_callback = ignore; write_close_callback = ignore; - write_exn_callback = ignore; } in - let read ~data ~close ~flush ~exn = + let read ~data ~close ~flush = match internal.state with | `Idle -> internal.state <- `Reader_waiting; internal.read_data_callback <- data; internal.read_close_callback <- close; - internal.read_flush_callback <- flush; - internal.read_exn_callback <- exn + internal.read_flush_callback <- flush | `Reader_waiting -> raise (Failure "Stream read: the previous read has not completed") | `Writer_waiting -> @@ -238,23 +220,18 @@ let pipe () = and length = internal.write_length in clean_up_writer_fields internal; data buffer offset length; - write_done_callback (); + write_done_callback () | `Flush -> clean_up_writer_fields internal; flush (); - write_done_callback (); - | `Exn -> - (* TODO Real exception. *) - clean_up_writer_fields internal; - exn Exit; - write_done_callback (); + write_done_callback () end | `Closed -> close () in (* TODO Callbacks could definitely use labels, based on usage. *) - let write buffer offset length done_ close exn = + let write buffer offset length done_ close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; @@ -263,8 +240,7 @@ let pipe () = internal.write_offset <- offset; internal.write_length <- length; internal.write_done_callback <- done_; - internal.write_close_callback <- close; - internal.write_exn_callback <- exn + internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_data_callback = internal.read_data_callback in @@ -295,14 +271,13 @@ let pipe () = () in - let flush done_ close exn = + let flush done_ close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; internal.write_kind <- `Flush; internal.write_done_callback <- done_; - internal.write_close_callback <- close; - internal.write_exn_callback <- exn + internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_flush_callback = internal.read_flush_callback in diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 55c810a5..83430389 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -17,7 +17,6 @@ type read = data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> - exn:(exn -> unit) -> unit val read_only : read:read -> close:(unit -> unit) -> stream @@ -33,7 +32,5 @@ val read_until_close : stream -> string promise (* TODO Clarify these signatures. *) val write : - buffer -> int -> int -> - (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> stream -> - unit -val flush : (unit -> unit) -> (unit -> unit) -> (exn -> unit) -> stream -> unit + buffer -> int -> int -> (unit -> unit) -> (unit -> unit) -> stream -> unit +val flush : (unit -> unit) -> (unit -> unit) -> stream -> unit diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 6de69a55..fddacae1 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -22,9 +22,6 @@ let read_and_dump stream = ~flush:(fun () -> print_endline "flush") - ~exn:(fun _ -> - print_endline "exn") - (* Read-only streams. *) @@ -123,12 +120,12 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; (* TODO Check the callbacks are called. *) - Stream.flush ignore ignore ignore stream; - Stream.flush ignore ignore ignore stream; + Stream.flush ignore ignore stream; + Stream.flush ignore ignore stream; print_endline "checkpoint 2"; read_and_dump stream; - Stream.flush ignore ignore ignore stream; - try Stream.flush ignore ignore ignore stream + Stream.flush ignore ignore stream; + try Stream.flush ignore ignore stream with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 @@ -149,12 +146,12 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; (* TODO Check the callbacks are called. *) - Stream.write buffer 0 3 ignore ignore ignore stream; - Stream.write buffer 1 1 ignore ignore ignore stream; + Stream.write buffer 0 3 ignore ignore stream; + Stream.write buffer 1 1 ignore ignore stream; print_endline "checkpoint 2"; read_and_dump stream; - Stream.write buffer 0 3 ignore ignore ignore stream; - try Stream.write buffer 0 3 ignore ignore ignore stream; + Stream.write buffer 0 3 ignore ignore stream; + try Stream.write buffer 0 3 ignore ignore stream; with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 From abeba7b4b835d2babf6a93387497dc1781197fa9 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 19:34:20 +0300 Subject: [PATCH 025/312] Streams: clarify writer callbacks --- src/pure/inmost.ml | 18 +++---- src/pure/stream.ml | 55 ++++++++++--------- src/pure/stream.mli | 11 ++-- test/expect/pure/stream/stream.ml | 87 +++++++++++++++++-------------- 4 files changed, 91 insertions(+), 80 deletions(-) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 4a97c2ea..1666b42e 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -325,10 +325,10 @@ let write message chunk = let buffer = Bigstringaf.of_string ~off:0 ~len:length chunk in (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write + message.body buffer 0 length - (Lwt.wakeup_later resolver) - (fun () -> Lwt.wakeup_later_exn resolver End_of_file) - message.body; + ~ok:(Lwt.wakeup_later resolver) + ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); promise let write_buffer ?(offset = 0) ?length message chunk = @@ -340,10 +340,10 @@ let write_buffer ?(offset = 0) ?length message chunk = in (* TODO Proper handling of close. *) Stream.write + message.body chunk offset length - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later resolver) - message.body; + ~ok:(Lwt.wakeup_later resolver) + ~close:(Lwt.wakeup_later resolver); promise (* TODO How are remote closes actually handled? There is no way for http/af to @@ -351,9 +351,9 @@ let write_buffer ?(offset = 0) ?length message chunk = let flush message = let promise, resolver = Lwt.wait () in Stream.flush - (Lwt.wakeup_later resolver) - (fun () -> Lwt.wakeup_later_exn resolver End_of_file) - message.body; + message.body + ~ok:(Lwt.wakeup_later resolver) + ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); promise let close_stream message = diff --git a/src/pure/stream.ml b/src/pure/stream.ml index fd0a7836..8329e582 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -18,18 +18,18 @@ type read = unit type stream = { - read : - data:(buffer -> int -> int -> unit) -> + read : read; + + write : + buffer -> int -> int -> + ok:(unit -> unit) -> close:(unit -> unit) -> - flush:(unit -> unit) -> unit; - (* TODO Needs continuation arguments. Writer feedback is ok, exception, - closed. Ok should probably carry an int. *) - (* TODO Continuation labels? *) - (* TODO Really review these continuations. *) - write : buffer -> int -> int -> (unit -> unit) -> (unit -> unit) -> unit; - flush : (unit -> unit) -> (unit -> unit) -> unit; + flush : + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit; close : unit -> unit; } @@ -38,8 +38,8 @@ type stream = { let read_only ~read ~close = { read; - write = (fun _buffer _offset _length _done _close -> ()); - flush = (fun _done _close -> ()); + write = (fun _buffer _offset _length ~ok:_ ~close:_ -> ()); + flush = (fun ~ok:_ ~close:_ -> ()); close; } @@ -140,11 +140,11 @@ let read_until_close stream = let close stream = stream.close () -let write buffer offset length done_ close stream = - stream.write buffer offset length done_ close +let write stream buffer offset length ~ok ~close = + stream.write buffer offset length ~ok ~close -let flush done_ close stream = - stream.flush done_ close +let flush stream ~ok ~close = + stream.flush ~ok ~close type pipe = { mutable state : [ @@ -165,7 +165,7 @@ type pipe = { mutable write_buffer : buffer; mutable write_offset : int; mutable write_length : int; - mutable write_done_callback : unit -> unit; + mutable write_ok_callback : unit -> unit; mutable write_close_callback : unit -> unit; } @@ -182,7 +182,7 @@ let clean_up_reader_fields pipe = let clean_up_writer_fields pipe = pipe.write_buffer <- dummy_buffer; - pipe.write_done_callback <- ignore; + pipe.write_ok_callback <- ignore; pipe.write_close_callback <- ignore let pipe () = @@ -197,7 +197,7 @@ let pipe () = write_buffer = dummy_buffer; write_offset = 0; write_length = 0; - write_done_callback = ignore; + write_ok_callback = ignore; write_close_callback = ignore; } in @@ -212,7 +212,7 @@ let pipe () = raise (Failure "Stream read: the previous read has not completed") | `Writer_waiting -> internal.state <- `Idle; - let write_done_callback = internal.write_done_callback in + let write_ok_callback = internal.write_ok_callback in begin match internal.write_kind with | `Data -> let buffer = internal.write_buffer @@ -220,18 +220,17 @@ let pipe () = and length = internal.write_length in clean_up_writer_fields internal; data buffer offset length; - write_done_callback () + write_ok_callback () | `Flush -> clean_up_writer_fields internal; flush (); - write_done_callback () + write_ok_callback () end | `Closed -> close () in - (* TODO Callbacks could definitely use labels, based on usage. *) - let write buffer offset length done_ close = + let write buffer offset length ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; @@ -239,14 +238,14 @@ let pipe () = internal.write_buffer <- buffer; internal.write_offset <- offset; internal.write_length <- length; - internal.write_done_callback <- done_; + internal.write_ok_callback <- ok; internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_data_callback = internal.read_data_callback in clean_up_reader_fields internal; read_data_callback buffer offset length; - done_ () + ok () | `Writer_waiting -> raise (Failure "Stream write: the previous write has not completed") | `Closed -> @@ -271,19 +270,19 @@ let pipe () = () in - let flush done_ close = + let flush ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; internal.write_kind <- `Flush; - internal.write_done_callback <- done_; + internal.write_ok_callback <- ok; internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_flush_callback = internal.read_flush_callback in clean_up_reader_fields internal; read_flush_callback (); - done_ () + ok () | `Writer_waiting -> raise (Failure "Stream flush: the previous write has not completed") | `Closed -> diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 83430389..cc3491d5 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -30,7 +30,12 @@ val read : stream -> read val read_convenience : stream -> string option promise val read_until_close : stream -> string promise -(* TODO Clarify these signatures. *) val write : - buffer -> int -> int -> (unit -> unit) -> (unit -> unit) -> stream -> unit -val flush : (unit -> unit) -> (unit -> unit) -> stream -> unit + stream -> + buffer -> int -> int -> + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit + +val flush : + stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index fddacae1..03a7995b 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -12,15 +12,27 @@ module Stream = Dream__pure.Stream let read_and_dump stream = Stream.read stream ~data:(fun buffer offset length -> - print_string "data: "; + print_string "read: data: "; Bigstringaf.substring buffer ~off:offset ~len:length |> print_endline) + ~close:(fun () -> + print_endline "read: close") + ~flush:(fun () -> + print_endline "read: flush") +let flush_and_dump stream = + Stream.flush stream + ~ok:(fun () -> + print_endline "flush: ok") ~close:(fun () -> - print_endline "close") + print_endline "flush: close") - ~flush:(fun () -> - print_endline "flush") +let write_and_dump stream buffer offset length = + Stream.write stream buffer offset length + ~ok:(fun () -> + print_endline "write: ok") + ~close:(fun () -> + print_endline "write: close") @@ -33,15 +45,15 @@ let%expect_test _ = Stream.close stream; read_and_dump stream; [%expect {| - close - close - close |}] + read: close + read: close + read: close |}] let%expect_test _ = let stream = Stream.empty in Stream.close stream; read_and_dump stream; - [%expect {| close |}] + [%expect {| read: close |}] let%expect_test _ = let stream = Stream.string "foo" in @@ -51,24 +63,24 @@ let%expect_test _ = Stream.close stream; read_and_dump stream; [%expect {| - data: foo - close - close - close |}] + read: data: foo + read: close + read: close + read: close |}] let%expect_test _ = let stream = Stream.string "" in read_and_dump stream; read_and_dump stream; [%expect {| - close - close |}] + read: close + read: close |}] let%expect_test _ = let stream = Stream.string "foo" in Stream.close stream; read_and_dump stream; - [%expect {| close |}] + [%expect {| read: close |}] @@ -89,7 +101,6 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - (* TODO Check that the callback is called. *) Stream.close stream; print_endline "checkpoint 2"; read_and_dump stream; @@ -97,9 +108,9 @@ let%expect_test _ = Stream.close stream; [%expect {| checkpoint 1 - close + read: close checkpoint 2 - close + read: close checkpoint 3 |}] let%expect_test _ = @@ -108,8 +119,8 @@ let%expect_test _ = read_and_dump stream; read_and_dump stream; [%expect {| - close - close |}] + read: close + read: close |}] @@ -119,19 +130,20 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - (* TODO Check the callbacks are called. *) - Stream.flush ignore ignore stream; - Stream.flush ignore ignore stream; + flush_and_dump stream; + flush_and_dump stream; print_endline "checkpoint 2"; read_and_dump stream; - Stream.flush ignore ignore stream; - try Stream.flush ignore ignore stream + flush_and_dump stream; + try flush_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - flush + read: flush + flush: ok checkpoint 2 - flush + read: flush + flush: ok (Failure "Stream flush: the previous write has not completed") |}] @@ -145,19 +157,20 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - (* TODO Check the callbacks are called. *) - Stream.write buffer 0 3 ignore ignore stream; - Stream.write buffer 1 1 ignore ignore stream; + write_and_dump stream buffer 0 3; + write_and_dump stream buffer 1 1; print_endline "checkpoint 2"; read_and_dump stream; - Stream.write buffer 0 3 ignore ignore stream; - try Stream.write buffer 0 3 ignore ignore stream; + write_and_dump stream buffer 0 3; + try write_and_dump stream buffer 0 3 with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - data: foo + read: data: foo + write: ok checkpoint 2 - data: o + read: data: o + write: ok (Failure "Stream write: the previous write has not completed") |}] @@ -165,12 +178,6 @@ let%expect_test _ = (* TODO: Test: - Writing to a read-only stream. Flushing, etc. -- Early close of read-only streams or any other streams by the reader. -- The generic read_only needs to take a close callback in addition to the - reader. -- Stream.string needs to be able to abort the string by providing an appropriate - such callback. -- Have the string stream release the string eagerly after it is read. - Interactions between writers (including flush) and close. This will benefit from clarifying the writers' callbacks. - The higher-level reading helpers. From bde5fc82850bf6d1ca22bb91b59ca53cb72b4e01 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 20:16:59 +0300 Subject: [PATCH 026/312] Fail on writes to read-only streams --- src/pure/stream.ml | 15 +++++++++------ test/expect/pure/stream/stream.ml | 17 +++++++++++++---- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 8329e582..576d8e2e 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -34,12 +34,15 @@ type stream = { close : unit -> unit; } -(* TODO Raise some exception when writes are attempted. *) let read_only ~read ~close = { read; - write = (fun _buffer _offset _length ~ok:_ ~close:_ -> ()); - flush = (fun ~ok:_ ~close:_ -> ()); + write = + (fun _buffer _offset _length ~ok:_ ~close:_ -> + raise (Failure "write to a read-only stream")); + flush = + (fun ~ok:_ ~close:_ -> + raise (Failure "flush of a read-only stream")); close; } @@ -209,7 +212,7 @@ let pipe () = internal.read_close_callback <- close; internal.read_flush_callback <- flush | `Reader_waiting -> - raise (Failure "Stream read: the previous read has not completed") + raise (Failure "stream read: the previous read has not completed") | `Writer_waiting -> internal.state <- `Idle; let write_ok_callback = internal.write_ok_callback in @@ -247,7 +250,7 @@ let pipe () = read_data_callback buffer offset length; ok () | `Writer_waiting -> - raise (Failure "Stream write: the previous write has not completed") + raise (Failure "stream write: the previous write has not completed") | `Closed -> close () in @@ -284,7 +287,7 @@ let pipe () = read_flush_callback (); ok () | `Writer_waiting -> - raise (Failure "Stream flush: the previous write has not completed") + raise (Failure "stream flush: the previous write has not completed") | `Closed -> close () in diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 03a7995b..ea89335f 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -82,6 +82,16 @@ let%expect_test _ = read_and_dump stream; [%expect {| read: close |}] +let%expect_test _ = + let stream = Stream.empty in + (try write_and_dump stream Bigstringaf.empty 0 0 + with Failure _ as exn -> print_endline (Printexc.to_string exn)); + (try flush_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); + [%expect {| + (Failure "write to a read-only stream") + (Failure "flush of a read-only stream") |}] + (* Pipe: double read. *) @@ -91,7 +101,7 @@ let%expect_test _ = read_and_dump stream; try read_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn); - [%expect {| (Failure "Stream read: the previous read has not completed") |}] + [%expect {| (Failure "stream read: the previous read has not completed") |}] @@ -144,7 +154,7 @@ let%expect_test _ = checkpoint 2 read: flush flush: ok - (Failure "Stream flush: the previous write has not completed") |}] + (Failure "stream flush: the previous write has not completed") |}] @@ -171,13 +181,12 @@ let%expect_test _ = checkpoint 2 read: data: o write: ok - (Failure "Stream write: the previous write has not completed") |}] + (Failure "stream write: the previous write has not completed") |}] (* TODO: Test: -- Writing to a read-only stream. Flushing, etc. - Interactions between writers (including flush) and close. This will benefit from clarifying the writers' callbacks. - The higher-level reading helpers. From 9a426fa5e5a8063552096552786533cfc8d34b2d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 20:25:45 +0300 Subject: [PATCH 027/312] Test interactions between stream writers and close --- src/pure/stream.ml | 2 +- test/expect/pure/stream/stream.ml | 27 ++++++++++++++++++++++----- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 576d8e2e..6b4ae562 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -176,7 +176,7 @@ let dummy_buffer = Bigstringaf.create 0 let dummy_read_data_callback _buffer _offset _length = - () + () [@coverage off] let clean_up_reader_fields pipe = pipe.read_data_callback <- dummy_read_data_callback; diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index ea89335f..5af47c61 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -185,9 +185,26 @@ let%expect_test _ = -(* TODO: Test: +(* Pipe: interactions between flush and close. *) -- Interactions between writers (including flush) and close. This will benefit - from clarifying the writers' callbacks. -- The higher-level reading helpers. -*) +let%expect_test _ = + let stream = Stream.pipe () in + flush_and_dump stream; + Stream.close stream; + flush_and_dump stream; + [%expect {| + flush: close + flush: close |}] + + + +(* Pipe: interactions between write and close. *) + +let%expect_test _ = + let stream = Stream.pipe () in + write_and_dump stream buffer 0 3; + Stream.close stream; + write_and_dump stream buffer 0 3; + [%expect {| + write: close + write: close |}] From 586f93bfc6e837a9d86747f506e2cd09a6bebc33 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 25 Nov 2021 20:52:52 +0300 Subject: [PATCH 028/312] Stream: initial internal docs --- src/pure/stream.mli | 65 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/src/pure/stream.mli b/src/pure/stream.mli index cc3491d5..e521845a 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -7,28 +7,87 @@ type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t +(** Type abbreviation for byte buffers in the C heap. *) type 'a promise = 'a Lwt.t +(** Type abbreviation for promises. *) type stream +(** This module's principal type, the {e stream}. + + Streams are basically just tuples of a reading function and several writing + functions. In C++ terms, they are vtables. Different stream objects can have + completely different implementations of these functions. Concrete stream + constructors, such as {!Stream.empty} and {!Stream.pipe} implement those + functions in interesting ways. + + There are three main kinds of streams used in Dream: + + - {e Read-only streams} have the reading function implemented, and the + writers raise exceptions when called. These are typically created by the + HTTP layer as facades for the underlying HTTP server's request body + reader. + - {e Pipes} have their reading function connected to their writing + functions. Pipes are essentially a synchronization primitive that allows + one reader to be satisfied by one writer. These are created for responses, + because responses are created deep in the user's Web application, and the + HTTP layer reads them later to process the application's writes. Pipes can + also be created by middlewares that transform messages bodies, such as for + compression. + - {e Duplex streams} have the reading function and writing functions + implemented, but connected to different streams. This is used primarily + for WebSockets, where writing to the stream causes data to be sent to the + client, and reading from the stream awaits data to be received from the + client. + + Streams are asynchronous. Readers and writers expect callbacks, and call + them when underlying operations complete. + + The entire interface is pull-based for flow control. *) type read = data:(buffer -> int -> int -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> unit +(** A reading function. Awaits the next event on the stream. For each call of a + reading function, one of the callbacks will eventually be called, according + to which event occurs next on the stream. *) val read_only : read:read -> close:(unit -> unit) -> stream +(** Creates a read-only stream from the given reader. [~close] is called in + response to {!Stream.close}. It doesn't need to call {!Stream.close} again + on the stream. It should be used to free any underlying resources. *) + val empty : stream +(** A read-only stream whose reading function always calls its [~close] + callback. *) + val string : string -> stream +(** A read-only stream which calls its [~data] callback once with the contents + of the given string, and then always calls [~close]. *) + val pipe : unit -> stream +(** A stream which matches each call of the reading function to one call of its + writing functions. For example, calling {!Stream.flush} on a pipe will cause + the reader to call its [~flush] callback. *) val close : stream -> unit +(** Closes the given stream. Causes a pending reader or writer to call its + [~close] callback. *) val read : stream -> read +(** Awaits the next stream event. See {!Stream.type-read}. *) + val read_convenience : stream -> string option promise +(** A wrapper around {!Stream.read} that converts [~data] with content [s] into + [Some s], and [~close] into [None], and uses them to resolve a promise. + [~flush] is ignored. *) + val read_until_close : stream -> string promise +(** Reads a stream completely until [~close], and accumulates the data into a + string. *) val write : stream -> @@ -36,6 +95,12 @@ val write : ok:(unit -> unit) -> close:(unit -> unit) -> unit +(** A writing function that sends a data buffer on the given stream. No more + writing functions should be called on the stream until this function calls + [~ok]. *) val flush : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +(** A writing function that asks for the given stream to be flushed. The meaning + of flushing depends on the implementation of the stream. No more writing + functions should be called on the stream until this function calls [~ok]. *) From 40bc9946805f4b0b8b422cc69ac89968195cecca Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 26 Nov 2021 00:09:08 +0300 Subject: [PATCH 029/312] Streams: support FIN, ping, and pong --- src/dream.mli | 4 +- src/http/adapt.ml | 23 +++-- src/http/http.ml | 8 +- src/pure/inmost.ml | 8 +- src/pure/stream.ml | 163 ++++++++++++++++++++++-------- src/pure/stream.mli | 20 +++- test/expect/pure/stream/stream.ml | 131 ++++++++++++++++++++---- 7 files changed, 281 insertions(+), 76 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index a8d3ba38..cee3272e 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -732,9 +732,11 @@ val body_stream : 'a message -> stream (* TODO Argument order? *) val next : stream -> - data:(buffer -> int -> int -> unit) -> + data:(buffer -> int -> int -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> + ping:(unit -> unit) -> + pong:(unit -> unit) -> unit (** Waits for the next stream event, and calls: diff --git a/src/http/adapt.ml b/src/http/adapt.ml index c98ffbaa..f1927fe4 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -29,19 +29,28 @@ let forward_body_general let rec send () = Dream.body_stream response - |> fun stream -> Stream.read - stream - ~data - ~close - ~flush - - and data chunk off len = + |> fun stream -> + Stream.read + stream + ~data + ~close + ~flush + ~ping + ~pong + + and data chunk off len _fin = write_buffer ~off ~len chunk; send () and flush () = http_flush send + and ping () = + send () + + and pong () = + send () + in send () diff --git a/src/http/http.ml b/src/http/http.ml index 90ac64c1..c40028b8 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -163,11 +163,11 @@ let wrap_handler (* TODO Should the stream be auto-closed? It doesn't even have a closed state. The whole thing is just a wrapper for whatever the http/af behavior is. *) - let read ~data ~close ~flush:_ = + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = Httpaf.Body.Reader.schedule_read body ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len) + ~on_read:(fun buffer ~off ~len -> data buffer off len false) in let close () = Httpaf.Body.Reader.close body in @@ -306,11 +306,11 @@ let wrap_handler_h2 let body = H2.Reqd.request_body conn in - let read ~data ~close ~flush:_ = + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = H2.Body.schedule_read body ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len) + ~on_read:(fun buffer ~off ~len -> data buffer off len false) in let close () = H2.Body.close_reader body in diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 1666b42e..f8173af8 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -319,6 +319,9 @@ let with_body body message = let with_stream message = update {message with body = Stream.pipe ()} +(* TODO Need to expose FIN. However, it can't have any effect even on + WebSockets, because websocket/af does not offer the ability to pass FIN. It + is hardcoded to true. *) let write message chunk = let promise, resolver = Lwt.wait () in let length = String.length chunk in @@ -326,7 +329,7 @@ let write message chunk = (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write message.body - buffer 0 length + buffer 0 length false ~ok:(Lwt.wakeup_later resolver) ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); promise @@ -339,9 +342,10 @@ let write_buffer ?(offset = 0) ?length message chunk = | None -> Bigstringaf.length chunk - offset in (* TODO Proper handling of close. *) + (* TODO As above, properly expose FIN. *) Stream.write message.body - chunk offset length + chunk offset length false ~ok:(Lwt.wakeup_later resolver) ~close:(Lwt.wakeup_later resolver); promise diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 6b4ae562..ce34d32b 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -12,16 +12,18 @@ type 'a promise = 'a Lwt.t type read = - data:(buffer -> int -> int -> unit) -> + data:(buffer -> int -> int -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> + ping:(unit -> unit) -> + pong:(unit -> unit) -> unit type stream = { read : read; write : - buffer -> int -> int -> + buffer -> int -> int -> bool -> ok:(unit -> unit) -> close:(unit -> unit) -> unit; @@ -31,6 +33,16 @@ type stream = { close:(unit -> unit) -> unit; + ping : + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit; + + pong : + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit; + close : unit -> unit; } @@ -38,17 +50,23 @@ let read_only ~read ~close = { read; write = - (fun _buffer _offset _length ~ok:_ ~close:_ -> + (fun _buffer _offset _length _fin ~ok:_ ~close:_ -> raise (Failure "write to a read-only stream")); flush = (fun ~ok:_ ~close:_ -> raise (Failure "flush of a read-only stream")); + ping = + (fun ~ok:_ ~close:_ -> + raise (Failure "ping on a read-only stream")); + pong = + (fun ~ok:_ ~close:_ -> + raise (Failure "pong on a read-only stream")); close; } let empty = read_only - ~read:(fun ~data:_ ~close ~flush:_ -> close ()) + ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close ()) ~close:ignore (* TODO This shows the awkwardness in string-to-string body reading. *) @@ -60,12 +78,14 @@ let string the_string = the stream is closed, making the memory available to the GC. *) let string_ref = ref (Some the_string) in - let read ~data ~close ~flush:_ = + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = match !string_ref with | Some stored_string -> string_ref := None; let length = String.length stored_string in - data (Bigstringaf.of_string ~off:0 ~len:length stored_string) 0 length + data + (Bigstringaf.of_string ~off:0 ~len:length stored_string) + 0 length true | None -> close () in @@ -80,14 +100,12 @@ let string the_string = let read stream ~data ~close ~flush = stream.read ~data ~close ~flush -(* TODO Can probably save promise allocation if create a separate looping - function. *) -let rec read_convenience stream = +let read_convenience stream = let promise, resolver = Lwt.wait () in - begin + let rec loop () = stream.read - ~data:(fun buffer offset length -> + ~data:(fun buffer offset length _fin -> Bigstringaf.sub buffer ~off:offset ~len:length |> Bigstringaf.to_string |> Option.some @@ -96,13 +114,17 @@ let rec read_convenience stream = ~close:(fun () -> Lwt.wakeup_later resolver None) - ~flush:(fun () -> - let next_promise = read_convenience stream in - Lwt.on_any - next_promise - (Lwt.wakeup_later resolver) - (Lwt.wakeup_later_exn resolver)) - end; + ~flush:loop + + (* TODO This requires reordering the implementations and taking a harder + look at all these functions. + Upon a ping event, assume that we are on a read-write, duplex WebSocket + stream, and send a pong. *) + ~ping:loop + + ~pong:loop + in + loop (); promise @@ -113,7 +135,7 @@ let read_until_close stream = let rec loop () = stream.read - ~data:(fun chunk offset chunk_length -> + ~data:(fun chunk offset chunk_length _fin -> let new_length = !length + chunk_length in if new_length > Bigstringaf.length !buffer then begin @@ -135,6 +157,12 @@ let read_until_close stream = |> Lwt.wakeup_later resolver) ~flush:loop + + (* TODO As with the previous function, should respond to a ping with a + pong. *) + ~ping:loop + + ~pong:loop in loop (); @@ -143,12 +171,18 @@ let read_until_close stream = let close stream = stream.close () -let write stream buffer offset length ~ok ~close = - stream.write buffer offset length ~ok ~close +let write stream buffer offset length fin ~ok ~close = + stream.write buffer offset length fin ~ok ~close let flush stream ~ok ~close = stream.flush ~ok ~close +let ping stream ~ok ~close = + stream.ping ~ok ~close + +let pong stream ~ok ~close = + stream.pong ~ok ~close + type pipe = { mutable state : [ | `Idle @@ -157,17 +191,22 @@ type pipe = { | `Closed ]; - mutable read_data_callback : buffer -> int -> int -> unit; + mutable read_data_callback : buffer -> int -> int -> bool -> unit; mutable read_close_callback : unit -> unit; mutable read_flush_callback : unit -> unit; + mutable read_ping_callback : unit -> unit; + mutable read_pong_callback : unit -> unit; mutable write_kind : [ | `Data | `Flush + | `Ping + | `Pong ]; mutable write_buffer : buffer; mutable write_offset : int; mutable write_length : int; + mutable write_fin : bool; mutable write_ok_callback : unit -> unit; mutable write_close_callback : unit -> unit; } @@ -175,13 +214,15 @@ type pipe = { let dummy_buffer = Bigstringaf.create 0 -let dummy_read_data_callback _buffer _offset _length = +let dummy_read_data_callback _buffer _offset _length _fin = () [@coverage off] let clean_up_reader_fields pipe = pipe.read_data_callback <- dummy_read_data_callback; pipe.read_close_callback <- ignore; - pipe.read_flush_callback <- ignore + pipe.read_flush_callback <- ignore; + pipe.read_ping_callback <- ignore; + pipe.read_pong_callback <- ignore let clean_up_writer_fields pipe = pipe.write_buffer <- dummy_buffer; @@ -195,45 +236,48 @@ let pipe () = read_data_callback = dummy_read_data_callback; read_close_callback = ignore; read_flush_callback = ignore; + read_ping_callback = ignore; + read_pong_callback = ignore; write_kind = `Data; write_buffer = dummy_buffer; write_offset = 0; write_length = 0; + write_fin = false; write_ok_callback = ignore; write_close_callback = ignore; } in - let read ~data ~close ~flush = + let read ~data ~close ~flush ~ping ~pong = match internal.state with | `Idle -> internal.state <- `Reader_waiting; internal.read_data_callback <- data; internal.read_close_callback <- close; - internal.read_flush_callback <- flush + internal.read_flush_callback <- flush; + internal.read_ping_callback <- ping; + internal.read_pong_callback <- pong; | `Reader_waiting -> raise (Failure "stream read: the previous read has not completed") | `Writer_waiting -> internal.state <- `Idle; let write_ok_callback = internal.write_ok_callback in + let buffer = internal.write_buffer in + clean_up_writer_fields internal; begin match internal.write_kind with | `Data -> - let buffer = internal.write_buffer - and offset = internal.write_offset - and length = internal.write_length in - clean_up_writer_fields internal; - data buffer offset length; - write_ok_callback () - | `Flush -> - clean_up_writer_fields internal; - flush (); - write_ok_callback () - end + data + buffer internal.write_offset internal.write_length internal.write_fin + | `Flush -> flush () + | `Ping -> ping () + | `Pong -> pong () + end; + write_ok_callback () | `Closed -> close () in - let write buffer offset length ~ok ~close = + let write buffer offset length fin ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; @@ -241,13 +285,14 @@ let pipe () = internal.write_buffer <- buffer; internal.write_offset <- offset; internal.write_length <- length; + internal.write_fin <- fin; internal.write_ok_callback <- ok; internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_data_callback = internal.read_data_callback in clean_up_reader_fields internal; - read_data_callback buffer offset length; + read_data_callback buffer offset length fin; ok () | `Writer_waiting -> raise (Failure "stream write: the previous write has not completed") @@ -292,4 +337,42 @@ let pipe () = close () in - {read; write; flush; close} + let ping ~ok ~close = + match internal.state with + | `Idle -> + internal.state <- `Writer_waiting; + internal.write_kind <- `Ping; + internal.write_ok_callback <- ok; + internal.write_close_callback <- close + | `Reader_waiting -> + internal.state <- `Idle; + let read_ping_callback = internal.read_ping_callback in + clean_up_reader_fields internal; + read_ping_callback (); + ok () + | `Writer_waiting -> + raise (Failure "stream ping: the previous write has not completed") + | `Closed -> + close () + in + + let pong ~ok ~close = + match internal.state with + | `Idle -> + internal.state <- `Writer_waiting; + internal.write_kind <- `Pong; + internal.write_ok_callback <- ok; + internal.write_close_callback <- close + | `Reader_waiting -> + internal.state <- `Idle; + let read_pong_callback = internal.read_pong_callback in + clean_up_reader_fields internal; + read_pong_callback (); + ok () + | `Writer_waiting -> + raise (Failure "stream pong: the previous write has not completed") + | `Closed -> + close () + in + + {read; write; flush; close; ping; pong} diff --git a/src/pure/stream.mli b/src/pure/stream.mli index e521845a..cd1ce7ce 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -47,9 +47,11 @@ type stream The entire interface is pull-based for flow control. *) type read = - data:(buffer -> int -> int -> unit) -> + data:(buffer -> int -> int -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> + ping:(unit -> unit) -> + pong:(unit -> unit) -> unit (** A reading function. Awaits the next event on the stream. For each call of a reading function, one of the callbacks will eventually be called, according @@ -91,16 +93,24 @@ val read_until_close : stream -> string promise val write : stream -> - buffer -> int -> int -> + buffer -> int -> int -> bool -> ok:(unit -> unit) -> close:(unit -> unit) -> unit (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls - [~ok]. *) + [~ok]. The [bool] argument is the [FIN] flag that indicates the end of a + WebSocket message. It is ignored by non-WebSocket streams. *) -val flush : - stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +val flush : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit (** A writing function that asks for the given stream to be flushed. The meaning of flushing depends on the implementation of the stream. No more writing functions should be called on the stream until this function calls [~ok]. *) + +val ping : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +(** A writing function that sends a ping event on the given stream. This is only + meaningful for WebSockets. *) + +val pong : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +(** A writing function that sends a pong event on the given stream. This is only + meaningful for WebSockets. *) diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 5af47c61..c64e47d5 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -11,14 +11,17 @@ module Stream = Dream__pure.Stream let read_and_dump stream = Stream.read stream - ~data:(fun buffer offset length -> - print_string "read: data: "; - Bigstringaf.substring buffer ~off:offset ~len:length - |> print_endline) + ~data:(fun buffer offset length fin -> + Printf.printf "read: data: FIN=%b %s\n" + fin (Bigstringaf.substring buffer ~off:offset ~len:length)) ~close:(fun () -> print_endline "read: close") ~flush:(fun () -> print_endline "read: flush") + ~ping:(fun () -> + print_endline "read: ping") + ~pong:(fun () -> + print_endline "read: pong") let flush_and_dump stream = Stream.flush stream @@ -27,13 +30,27 @@ let flush_and_dump stream = ~close:(fun () -> print_endline "flush: close") -let write_and_dump stream buffer offset length = - Stream.write stream buffer offset length +let write_and_dump stream buffer offset length fin = + Stream.write stream buffer offset length fin ~ok:(fun () -> print_endline "write: ok") ~close:(fun () -> print_endline "write: close") +let ping_and_dump stream = + Stream.ping stream + ~ok:(fun () -> + print_endline "ping: ok") + ~close:(fun () -> + print_endline "ping: close") + +let pong_and_dump stream = + Stream.pong stream + ~ok:(fun () -> + print_endline "pong: ok") + ~close:(fun () -> + print_endline "pong: close") + (* Read-only streams. *) @@ -63,7 +80,7 @@ let%expect_test _ = Stream.close stream; read_and_dump stream; [%expect {| - read: data: foo + read: data: FIN=true foo read: close read: close read: close |}] @@ -84,13 +101,19 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.empty in - (try write_and_dump stream Bigstringaf.empty 0 0 + (try write_and_dump stream Bigstringaf.empty 0 0 false with Failure _ as exn -> print_endline (Printexc.to_string exn)); (try flush_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn)); + (try ping_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); + (try pong_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); [%expect {| (Failure "write to a read-only stream") - (Failure "flush of a read-only stream") |}] + (Failure "flush of a read-only stream") + (Failure "ping on a read-only stream") + (Failure "pong on a read-only stream") |}] @@ -167,24 +190,72 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - write_and_dump stream buffer 0 3; - write_and_dump stream buffer 1 1; + write_and_dump stream buffer 0 3 true; + write_and_dump stream buffer 1 1 false; print_endline "checkpoint 2"; read_and_dump stream; - write_and_dump stream buffer 0 3; - try write_and_dump stream buffer 0 3 + write_and_dump stream buffer 0 3 true; + try write_and_dump stream buffer 0 3 false with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - read: data: foo + read: data: FIN=true foo write: ok checkpoint 2 - read: data: o + read: data: FIN=false o write: ok (Failure "stream write: the previous write has not completed") |}] +(* Pipe: interactions between read and ping. *) + +let%expect_test _ = + let stream = Stream.pipe () in + read_and_dump stream; + print_endline "checkpoint 1"; + ping_and_dump stream; + ping_and_dump stream; + print_endline "checkpoint 2"; + read_and_dump stream; + ping_and_dump stream; + try ping_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn); + [%expect {| + checkpoint 1 + read: ping + ping: ok + checkpoint 2 + read: ping + ping: ok + (Failure "stream ping: the previous write has not completed") |}] + + + +(* Pipe: interactions between read and pong. *) + +let%expect_test _ = + let stream = Stream.pipe () in + read_and_dump stream; + print_endline "checkpoint 1"; + pong_and_dump stream; + pong_and_dump stream; + print_endline "checkpoint 2"; + read_and_dump stream; + pong_and_dump stream; + try pong_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn); + [%expect {| + checkpoint 1 + read: pong + pong: ok + checkpoint 2 + read: pong + pong: ok + (Failure "stream pong: the previous write has not completed") |}] + + + (* Pipe: interactions between flush and close. *) let%expect_test _ = @@ -202,9 +273,35 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in - write_and_dump stream buffer 0 3; + write_and_dump stream buffer 0 3 true; Stream.close stream; - write_and_dump stream buffer 0 3; + write_and_dump stream buffer 0 3 false; [%expect {| write: close write: close |}] + + + +(* Pipe: interactions between ping and close. *) + +let%expect_test _ = + let stream = Stream.pipe () in + ping_and_dump stream; + Stream.close stream; + ping_and_dump stream; + [%expect {| + ping: close + ping: close |}] + + + +(* Pipe: interactions between pong and close. *) + +let%expect_test _ = + let stream = Stream.pipe () in + pong_and_dump stream; + Stream.close stream; + pong_and_dump stream; + [%expect {| + pong: close + pong: close |}] From 4813c0791492ce7221f22c506b9a1b75608ab3f9 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 13:58:39 +0300 Subject: [PATCH 030/312] Implement WebSockets as streams --- src/http/http.ml | 55 ++++++++++++++++++++++++++++----------------- src/pure/inmost.ml | 28 +++++++++++++---------- src/pure/stream.ml | 20 +++++++++++++++++ src/pure/stream.mli | 15 +++++++++++++ 4 files changed, 85 insertions(+), 33 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index c40028b8..9bf1523a 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -44,31 +44,44 @@ let websocket_handler user's_websocket_handler socket = higher-level reader. *) let messages, push_message = Lwt_stream.create () in - let send kind message = - let kind = (kind :> [ `Text | `Binary | `Continuation ]) in - Websocketaf.Wsd.send_bytes - socket - ~kind - (Bytes.unsafe_of_string message) - ~off:0 - ~len:(String.length message); - Lwt.return_unit + (* TODO Approximate pull behavior by delaying the payload reader, and + implement passing of ping and pong to the caller. *) + (* TODO Currently, there is a double conversion from bigstring to string and + then back (and then probably again), but this should go away once there is + a lower-level pull reader, and messages are assembled elsewhere in the + stack. *) + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + Lwt.on_success (Lwt_stream.get messages) @@ function + | Some message -> + let length = String.length message in + data (Bigstringaf.of_string ~off:0 ~len:length message) 0 length true + | None -> + close () in - let receive () = - Lwt_stream.get messages in - - let close code = - let code = Option.map (fun code -> `Other code) code in - Websocketaf.Wsd.close ?code socket; - Lwt.return_unit + (* TODO Re-expose kind. *) + let write buffer offset length _fin ~ok ~close:_ = + Websocketaf.Wsd.schedule + socket ~kind:`Text buffer ~off:offset ~len:length; + ok () in - let websocket = { - Dream.send; - receive; - close; - } in + (* TODO Implement (for the first time). *) + let flush ~ok ~close:_ = + ok () in + + let ping ~ok ~close:_ = + ok () in + + let pong ~ok ~close:_ = + ok () in + + (* TODO Re-expose close code. *) + let close () = + Websocketaf.Wsd.close socket in + + let websocket = + Stream.stream ~read ~write ~flush ~ping ~pong ~close in (* TODO Needs error handling like the top-level app has! *) Lwt.async (fun () -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index f8173af8..c5e97f68 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -37,11 +37,7 @@ struct end module Scope = Hmap.Make (Scope_variable_metadata) -type websocket = { - send : [ `Text | `Binary ] -> string -> unit Lwt.t; - receive : unit -> string option Lwt.t; - close : int option -> unit Lwt.t; -} +type websocket = Stream.stream type request = incoming message and response = outgoing message @@ -564,19 +560,27 @@ let websocket ?headers handler = in Lwt.return response -let send ?kind websocket message = - let kind = +let send ?kind:_ websocket message = + (* let kind = match kind with | None | Some `Text -> `Text | Some `Binary -> `Binary - in - websocket.send kind message + in *) + let promise, resolver = Lwt.wait () in + let length = String.length message in + Stream.write + websocket (Bigstringaf.of_string ~off:0 ~len:length message) 0 length true + ~ok:(Lwt.wakeup_later resolver) + ~close:(Lwt.wakeup_later resolver); + (* TODO The API will likely have to change to report closing. *) + promise let receive websocket = - websocket.receive () + Stream.read_convenience websocket -let close_websocket ?code websocket = - websocket.close code +let close_websocket ?code:_ websocket = + Stream.close websocket; + Lwt.return_unit let no_middleware handler request = handler request diff --git a/src/pure/stream.ml b/src/pure/stream.ml index ce34d32b..61cb1ec8 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -376,3 +376,23 @@ let pipe () = in {read; write; flush; close; ping; pong} + +let duplex ~read ~write ~close = + { + read = read.read; + write = write.write; + flush = write.flush; + ping = write.ping; + pong = write.pong; + close; + } + +let stream ~read ~write ~flush ~ping ~pong ~close = + { + read; + write; + flush; + ping; + pong; + close; + } diff --git a/src/pure/stream.mli b/src/pure/stream.mli index cd1ce7ce..398a1263 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -75,6 +75,21 @@ val pipe : unit -> stream writing functions. For example, calling {!Stream.flush} on a pipe will cause the reader to call its [~flush] callback. *) +val duplex : read:stream -> write:stream -> close:(unit -> unit) -> stream +(** A stream whose reading functions behave like [~read], and whose writing + functions behave like [~write]. *) + +(* TODO Seriously fix this signature. *) +val stream : + read:read -> + write:(buffer -> int -> int -> bool -> ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> + flush:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> + ping:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> + pong:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> + close:(unit -> unit) -> + stream +(** A general stream. *) + val close : stream -> unit (** Closes the given stream. Causes a pending reader or writer to call its [~close] callback. *) From 706810a95d0ec27a91f6809040c40ada6e69a74c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 15:53:07 +0300 Subject: [PATCH 031/312] WebSocket: pull style; expose ping, pong, flush --- src/http/http.ml | 178 ++++++++++++++++++++++++++--------------------- 1 file changed, 100 insertions(+), 78 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 9bf1523a..9cf24891 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -34,51 +34,117 @@ let sha1 s = implementation... *) let websocket_handler user's_websocket_handler socket = - (* Frames of the current partial message, in reverse order. *) - let message_frames = ref [] in - - (* Queue of received messages. There doesn't appear to be a nice way to - achieve backpressure with the current API of websocketaf, so that will have - to be added later. The user-facing API of Dream does support backpressure. - It's just that this code here reads no matter whether there is a - higher-level reader. *) - let messages, push_message = Lwt_stream.create () in - - (* TODO Approximate pull behavior by delaying the payload reader, and - implement passing of ping and pong to the caller. *) - (* TODO Currently, there is a double conversion from bigstring to string and - then back (and then probably again), but this should go away once there is - a lower-level pull reader, and messages are assembled elsewhere in the - stack. *) - let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = - Lwt.on_success (Lwt_stream.get messages) @@ function - | Some message -> - let length = String.length message in - data (Bigstringaf.of_string ~off:0 ~len:length message) 0 length true - | None -> + (* Queue of received frames. There doesn't appear to be a nice way to achieve + backpressure with the current API of websocket/af, so that will have to be + added later. The user-facing API of Dream does support backpressure. *) + let frames, push_frame = Lwt_stream.create () in + + (* Frame reader called by websocket/af on each frame received. There is no + good way to truly throttle this, hence this frame reader pushes frame + objects into the above frame queue for the reader to take from later. *) + let frame ~opcode ~is_fin:_ ~len:_ payload = + match opcode with + | `Connection_close -> + Websocketaf.Wsd.close socket; + push_frame None; + | `Ping -> + push_frame (Some `Ping) + | `Pong -> + push_frame (Some `Pong) + | `Other _ -> + () (* TODO Log? *) + | `Text + | `Binary + | `Continuation -> + push_frame (Some (`Data payload)) + in + + let eof () = + Websocketaf.Wsd.close socket; + push_frame None + in + + (* The reader retrieves the next frame. If it is a data frame, it keeps a + reference to the payload across multiple reader calls, until the payload is + exhausted. *) + (* TODO What's the best way to signal FIN? As a property of the last chunk, or + after the last chunk? WebSockets use the former, but the current + websocket/af API suggests the latter. *) + let closed = ref false in + let current_payload = ref None in + + (* TODO Can this be canceled by a user's close? i.e. will that eventually + cause a call to eof above? *) + let rec read ~data ~close ~flush ~ping ~pong = + if !closed then close () + else + match !current_payload with + | None -> + Lwt.on_success (Lwt_stream.get frames) begin function + | None -> + closed := true; + close () + | Some `Ping -> + ping () + | Some `Pong -> + pong () + | Some (`Data payload) -> + current_payload := Some payload; + read ~data ~close ~flush ~ping ~pong + end + | Some payload -> + Websocketaf.Payload.schedule_read + payload + ~on_read:(fun buffer ~off ~len -> + (* TODO Implement FIN. *) + data buffer off len true) + ~on_eof:(fun () -> + current_payload := None; + read ~data ~close ~flush ~ping ~pong) in (* TODO Re-expose kind. *) - let write buffer offset length _fin ~ok ~close:_ = - Websocketaf.Wsd.schedule - socket ~kind:`Text buffer ~off:offset ~len:length; - ok () + let write buffer offset length _fin ~ok ~close = + if !closed then + close () + else begin + Websocketaf.Wsd.schedule + socket ~kind:`Text buffer ~off:offset ~len:length; + ok () + end in - (* TODO Implement (for the first time). *) - let flush ~ok ~close:_ = - ok () in + let flush ~ok ~close = + if !closed then + close () + else + Websocketaf.Wsd.flushed socket ok + in - let ping ~ok ~close:_ = - ok () in + let ping ~ok ~close = + if !closed then + close () + else begin + Websocketaf.Wsd.send_ping socket; + ok () + end + in - let pong ~ok ~close:_ = - ok () in + let pong ~ok ~close = + if !closed then + close () + else begin + Websocketaf.Wsd.send_pong socket; + ok () + end + in (* TODO Re-expose close code. *) let close () = - Websocketaf.Wsd.close socket in + closed := true; + Websocketaf.Wsd.close socket + in let websocket = Stream.stream ~read ~write ~flush ~ping ~pong ~close in @@ -87,50 +153,6 @@ let websocket_handler user's_websocket_handler socket = Lwt.async (fun () -> user's_websocket_handler websocket); - (* The code isn't very efficient at the moment, doing multiple copies while - assembling a message. However, multi-fragment messages should be relatively - rare. *) - - (* This function is called on each frame received. In this high-level handler. - we automatically respond to all control opcodes. *) - let frame ~opcode ~is_fin ~len:_ payload = - match opcode with - | `Connection_close -> - Websocketaf.Wsd.close socket; - push_message None; - | `Ping -> - Websocketaf.Wsd.send_pong socket - | `Pong -> - () - | `Other _ -> - () - - | `Text - | `Binary - | `Continuation -> - let rec read () = - Websocketaf.Payload.schedule_read - payload - ~on_read:(fun buffer ~off ~len -> - let fragment = - Lwt_bytes.to_string (Lwt_bytes.proxy buffer off len) in - message_frames := fragment::!message_frames; - read ()) - ~on_eof:(fun () -> - if is_fin then begin - let message = String.concat "" (List.rev !message_frames) in - message_frames := []; - push_message (Some message) - end) - in - read () - in - - let eof () = - push_message None; - Websocketaf.Wsd.close socket - in - Websocketaf.Server_connection.{frame; eof} From fd0ba1fa599fe3442d9a17d7d206119b1cc8e94a Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 15:56:37 +0300 Subject: [PATCH 032/312] Reorder stream.ml In particular, the convenience readers need to be last, so that they can respond to ping with pong automatically. --- src/pure/stream.ml | 172 ++++++++++++++++++++++----------------------- 1 file changed, 86 insertions(+), 86 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 61cb1ec8..191a4bb1 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -46,6 +46,16 @@ type stream = { close : unit -> unit; } +let stream ~read ~write ~flush ~ping ~pong ~close = + { + read; + write; + flush; + ping; + pong; + close; + } + let read_only ~read ~close = { read; @@ -97,77 +107,19 @@ let string the_string = read_only ~read ~close end +let duplex ~read ~write ~close = + { + read = read.read; + write = write.write; + flush = write.flush; + ping = write.ping; + pong = write.pong; + close; + } + let read stream ~data ~close ~flush = stream.read ~data ~close ~flush -let read_convenience stream = - let promise, resolver = Lwt.wait () in - - let rec loop () = - stream.read - ~data:(fun buffer offset length _fin -> - Bigstringaf.sub buffer ~off:offset ~len:length - |> Bigstringaf.to_string - |> Option.some - |> Lwt.wakeup_later resolver) - - ~close:(fun () -> - Lwt.wakeup_later resolver None) - - ~flush:loop - - (* TODO This requires reordering the implementations and taking a harder - look at all these functions. - Upon a ping event, assume that we are on a read-write, duplex WebSocket - stream, and send a pong. *) - ~ping:loop - - ~pong:loop - in - loop (); - - promise - -let read_until_close stream = - let promise, resolver = Lwt.wait () in - let length = ref 0 in - let buffer = ref (Bigstringaf.create 4096) in - - let rec loop () = - stream.read - ~data:(fun chunk offset chunk_length _fin -> - let new_length = !length + chunk_length in - - if new_length > Bigstringaf.length !buffer then begin - let new_buffer = Bigstringaf.create (new_length * 2) in - Bigstringaf.blit - !buffer ~src_off:0 new_buffer ~dst_off:0 ~len:!length; - buffer := new_buffer - end; - - Bigstringaf.blit - chunk ~src_off:offset !buffer ~dst_off:!length ~len:chunk_length; - length := new_length; - - loop ()) - - ~close:(fun () -> - Bigstringaf.sub !buffer ~off:0 ~len:!length - |> Bigstringaf.to_string - |> Lwt.wakeup_later resolver) - - ~flush:loop - - (* TODO As with the previous function, should respond to a ping with a - pong. *) - ~ping:loop - - ~pong:loop - in - loop (); - - promise - let close stream = stream.close () @@ -377,22 +329,70 @@ let pipe () = {read; write; flush; close; ping; pong} -let duplex ~read ~write ~close = - { - read = read.read; - write = write.write; - flush = write.flush; - ping = write.ping; - pong = write.pong; - close; - } +let read_convenience stream = + let promise, resolver = Lwt.wait () in -let stream ~read ~write ~flush ~ping ~pong ~close = - { - read; - write; - flush; - ping; - pong; - close; - } + let rec loop () = + stream.read + ~data:(fun buffer offset length _fin -> + Bigstringaf.sub buffer ~off:offset ~len:length + |> Bigstringaf.to_string + |> Option.some + |> Lwt.wakeup_later resolver) + + ~close:(fun () -> + Lwt.wakeup_later resolver None) + + ~flush:loop + + (* TODO This requires reordering the implementations and taking a harder + look at all these functions. + Upon a ping event, assume that we are on a read-write, duplex WebSocket + stream, and send a pong. *) + ~ping:loop + + ~pong:loop + in + loop (); + + promise + +let read_until_close stream = + let promise, resolver = Lwt.wait () in + let length = ref 0 in + let buffer = ref (Bigstringaf.create 4096) in + + let rec loop () = + stream.read + ~data:(fun chunk offset chunk_length _fin -> + let new_length = !length + chunk_length in + + if new_length > Bigstringaf.length !buffer then begin + let new_buffer = Bigstringaf.create (new_length * 2) in + Bigstringaf.blit + !buffer ~src_off:0 new_buffer ~dst_off:0 ~len:!length; + buffer := new_buffer + end; + + Bigstringaf.blit + chunk ~src_off:offset !buffer ~dst_off:!length ~len:chunk_length; + length := new_length; + + loop ()) + + ~close:(fun () -> + Bigstringaf.sub !buffer ~off:0 ~len:!length + |> Bigstringaf.to_string + |> Lwt.wakeup_later resolver) + + ~flush:loop + + (* TODO As with the previous function, should respond to a ping with a + pong. *) + ~ping:loop + + ~pong:loop + in + loop (); + + promise From 1f0ef738451db5bc143b6f96d58ba769c95bfa70 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 16:00:37 +0300 Subject: [PATCH 033/312] Stream convenience readers: auto-reply to ping --- src/pure/stream.ml | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 191a4bb1..a304f226 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -345,11 +345,11 @@ let read_convenience stream = ~flush:loop - (* TODO This requires reordering the implementations and taking a harder - look at all these functions. - Upon a ping event, assume that we are on a read-write, duplex WebSocket - stream, and send a pong. *) - ~ping:loop + ~ping:(fun () -> + stream.pong + ~ok:loop + ~close:(fun () -> + Lwt.wakeup_later resolver None)) ~pong:loop in @@ -361,6 +361,11 @@ let read_until_close stream = let promise, resolver = Lwt.wait () in let length = ref 0 in let buffer = ref (Bigstringaf.create 4096) in + let close () = + Bigstringaf.sub !buffer ~off:0 ~len:!length + |> Bigstringaf.to_string + |> Lwt.wakeup_later resolver + in let rec loop () = stream.read @@ -380,16 +385,12 @@ let read_until_close stream = loop ()) - ~close:(fun () -> - Bigstringaf.sub !buffer ~off:0 ~len:!length - |> Bigstringaf.to_string - |> Lwt.wakeup_later resolver) + ~close ~flush:loop - (* TODO As with the previous function, should respond to a ping with a - pong. *) - ~ping:loop + ~ping:(fun () -> + stream.pong ~ok:loop ~close) ~pong:loop in From 018b459658fda5e741cb05036e08ef621fbd4661 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 16:24:12 +0300 Subject: [PATCH 034/312] Introduce Stream.write type abbreviation --- src/http/http.ml | 1 + src/pure/stream.ml | 5 +++++ src/pure/stream.mli | 29 +++++++++++++++-------------- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 9cf24891..9efefcca 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -156,6 +156,7 @@ let websocket_handler user's_websocket_handler socket = Websocketaf.Server_connection.{frame; eof} + (* Wraps the user's Dream handler in the kind of handler expected by http/af. The scheme is simple: wait for http/af "Reqd.t"s (partially parsed connections), convert their fields to Dream.request, call the user's handler, diff --git a/src/pure/stream.ml b/src/pure/stream.ml index a304f226..cbf536c3 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -19,6 +19,11 @@ type read = pong:(unit -> unit) -> unit +type write = + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit + type stream = { read : read; diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 398a1263..e037dbb9 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -57,6 +57,13 @@ type read = reading function, one of the callbacks will eventually be called, according to which event occurs next on the stream. *) +type write = + ok:(unit -> unit) -> + close:(unit -> unit) -> + unit +(** A writing function. Pushes an event into a stream. May take additional + arguments before [~ok]. *) + val read_only : read:read -> close:(unit -> unit) -> stream (** Creates a read-only stream from the given reader. [~close] is called in response to {!Stream.close}. It doesn't need to call {!Stream.close} again @@ -79,13 +86,12 @@ val duplex : read:stream -> write:stream -> close:(unit -> unit) -> stream (** A stream whose reading functions behave like [~read], and whose writing functions behave like [~write]. *) -(* TODO Seriously fix this signature. *) val stream : read:read -> - write:(buffer -> int -> int -> bool -> ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> - flush:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> - ping:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> - pong:(ok:(unit -> unit) -> close:(unit -> unit) -> unit) -> + write:(buffer -> int -> int -> bool -> write) -> + flush:write -> + ping:write -> + pong:write -> close:(unit -> unit) -> stream (** A general stream. *) @@ -106,26 +112,21 @@ val read_until_close : stream -> string promise (** Reads a stream completely until [~close], and accumulates the data into a string. *) -val write : - stream -> - buffer -> int -> int -> bool -> - ok:(unit -> unit) -> - close:(unit -> unit) -> - unit +val write : stream -> buffer -> int -> int -> bool -> write (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls [~ok]. The [bool] argument is the [FIN] flag that indicates the end of a WebSocket message. It is ignored by non-WebSocket streams. *) -val flush : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +val flush : stream -> write (** A writing function that asks for the given stream to be flushed. The meaning of flushing depends on the implementation of the stream. No more writing functions should be called on the stream until this function calls [~ok]. *) -val ping : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +val ping : stream -> write (** A writing function that sends a ping event on the given stream. This is only meaningful for WebSockets. *) -val pong : stream -> ok:(unit -> unit) -> close:(unit -> unit) -> unit +val pong : stream -> write (** A writing function that sends a pong event on the given stream. This is only meaningful for WebSockets. *) From 4e66f78a29426bc741f8445a592755593580bf73 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 16:39:52 +0300 Subject: [PATCH 035/312] WebSockets: restore FIN handling --- src/http/http.ml | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 9efefcca..062a8075 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -42,7 +42,7 @@ let websocket_handler user's_websocket_handler socket = (* Frame reader called by websocket/af on each frame received. There is no good way to truly throttle this, hence this frame reader pushes frame objects into the above frame queue for the reader to take from later. *) - let frame ~opcode ~is_fin:_ ~len:_ payload = + let frame ~opcode ~is_fin ~len:_ payload = match opcode with | `Connection_close -> Websocketaf.Wsd.close socket; @@ -56,7 +56,7 @@ let websocket_handler user's_websocket_handler socket = | `Text | `Binary | `Continuation -> - push_frame (Some (`Data payload)) + push_frame (Some (`Data (payload, is_fin))) in let eof () = @@ -67,11 +67,9 @@ let websocket_handler user's_websocket_handler socket = (* The reader retrieves the next frame. If it is a data frame, it keeps a reference to the payload across multiple reader calls, until the payload is exhausted. *) - (* TODO What's the best way to signal FIN? As a property of the last chunk, or - after the last chunk? WebSockets use the former, but the current - websocket/af API suggests the latter. *) let closed = ref false in let current_payload = ref None in + let last_chunk = ref None in (* TODO Can this be canceled by a user's close? i.e. will that eventually cause a call to eof above? *) @@ -93,15 +91,25 @@ let websocket_handler user's_websocket_handler socket = current_payload := Some payload; read ~data ~close ~flush ~ping ~pong end - | Some payload -> + | Some (payload, fin) -> Websocketaf.Payload.schedule_read payload ~on_read:(fun buffer ~off ~len -> - (* TODO Implement FIN. *) - data buffer off len true) + match !last_chunk with + | None -> + last_chunk := Some (buffer, off, len); + read ~data ~close ~flush ~ping ~pong + | Some (last_buffer, last_offset, last_length) -> + last_chunk := Some (buffer, off, len); + data last_buffer last_offset last_length false) ~on_eof:(fun () -> current_payload := None; - read ~data ~close ~flush ~ping ~pong) + match !last_chunk with + | None -> + read ~data ~close ~flush ~ping ~pong + | Some (last_buffer, last_offset, last_length) -> + last_chunk := None; + data last_buffer last_offset last_length fin) in (* TODO Re-expose kind. *) From ec56e226f949a25764494e76aa11d2cc46697175 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 17:00:09 +0300 Subject: [PATCH 036/312] Restore WebSocket message kind handling --- src/dream.mli | 2 +- src/http/adapt.ml | 2 +- src/http/http.ml | 28 +++++++++++++++----------- src/pure/inmost.ml | 20 +++++++++++-------- src/pure/stream.ml | 33 +++++++++++++++++++------------ src/pure/stream.mli | 10 +++++----- test/expect/pure/stream/stream.ml | 30 ++++++++++++++-------------- 7 files changed, 70 insertions(+), 55 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index cee3272e..cf28bf36 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -732,7 +732,7 @@ val body_stream : 'a message -> stream (* TODO Argument order? *) val next : stream -> - data:(buffer -> int -> int -> bool -> unit) -> + data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> diff --git a/src/http/adapt.ml b/src/http/adapt.ml index f1927fe4..1d3dba89 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -38,7 +38,7 @@ let forward_body_general ~ping ~pong - and data chunk off len _fin = + and data chunk off len _binary _fin = write_buffer ~off ~len chunk; send () diff --git a/src/http/http.ml b/src/http/http.ml index 062a8075..35cc5a24 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -38,6 +38,7 @@ let websocket_handler user's_websocket_handler socket = backpressure with the current API of websocket/af, so that will have to be added later. The user-facing API of Dream does support backpressure. *) let frames, push_frame = Lwt_stream.create () in + let message_is_binary = ref true in (* Frame reader called by websocket/af on each frame received. There is no good way to truly throttle this, hence this frame reader pushes frame @@ -53,10 +54,14 @@ let websocket_handler user's_websocket_handler socket = push_frame (Some `Pong) | `Other _ -> () (* TODO Log? *) - | `Text - | `Binary + | `Text -> + message_is_binary := false; + push_frame (Some (`Data (payload, false, is_fin))) + | `Binary -> + message_is_binary := true; + push_frame (Some (`Data (payload, true, is_fin))) | `Continuation -> - push_frame (Some (`Data (payload, is_fin))) + push_frame (Some (`Data (payload, !message_is_binary, is_fin))) in let eof () = @@ -91,7 +96,7 @@ let websocket_handler user's_websocket_handler socket = current_payload := Some payload; read ~data ~close ~flush ~ping ~pong end - | Some (payload, fin) -> + | Some (payload, binary, fin) -> Websocketaf.Payload.schedule_read payload ~on_read:(fun buffer ~off ~len -> @@ -101,7 +106,7 @@ let websocket_handler user's_websocket_handler socket = read ~data ~close ~flush ~ping ~pong | Some (last_buffer, last_offset, last_length) -> last_chunk := Some (buffer, off, len); - data last_buffer last_offset last_length false) + data last_buffer last_offset last_length binary false) ~on_eof:(fun () -> current_payload := None; match !last_chunk with @@ -109,16 +114,15 @@ let websocket_handler user's_websocket_handler socket = read ~data ~close ~flush ~ping ~pong | Some (last_buffer, last_offset, last_length) -> last_chunk := None; - data last_buffer last_offset last_length fin) + data last_buffer last_offset last_length binary fin) in - (* TODO Re-expose kind. *) - let write buffer offset length _fin ~ok ~close = + let write buffer offset length binary _fin ~ok ~close = + let kind = if binary then `Binary else `Text in if !closed then close () else begin - Websocketaf.Wsd.schedule - socket ~kind:`Text buffer ~off:offset ~len:length; + Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; ok () end in @@ -211,7 +215,7 @@ let wrap_handler Httpaf.Body.Reader.schedule_read body ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len false) + ~on_read:(fun buffer ~off ~len -> data buffer off len true false) in let close () = Httpaf.Body.Reader.close body in @@ -354,7 +358,7 @@ let wrap_handler_h2 H2.Body.schedule_read body ~on_eof:close - ~on_read:(fun buffer ~off ~len -> data buffer off len false) + ~on_read:(fun buffer ~off ~len -> data buffer off len true false) in let close () = H2.Body.close_reader body in diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index c5e97f68..d3ad4b53 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -318,6 +318,7 @@ let with_stream message = (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It is hardcoded to true. *) +(* TODO Also expose binary/text. *) let write message chunk = let promise, resolver = Lwt.wait () in let length = String.length chunk in @@ -325,7 +326,7 @@ let write message chunk = (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write message.body - buffer 0 length false + buffer 0 length true false ~ok:(Lwt.wakeup_later resolver) ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); promise @@ -339,9 +340,10 @@ let write_buffer ?(offset = 0) ?length message chunk = in (* TODO Proper handling of close. *) (* TODO As above, properly expose FIN. *) + (* TODO Also expose binary/text. *) Stream.write message.body - chunk offset length false + chunk offset length true false ~ok:(Lwt.wakeup_later resolver) ~close:(Lwt.wakeup_later resolver); promise @@ -560,16 +562,18 @@ let websocket ?headers handler = in Lwt.return response -let send ?kind:_ websocket message = - (* let kind = +let send ?kind websocket message = + let binary = match kind with - | None | Some `Text -> `Text - | Some `Binary -> `Binary - in *) + | None | Some `Text -> false + | Some `Binary -> true + in let promise, resolver = Lwt.wait () in let length = String.length message in Stream.write - websocket (Bigstringaf.of_string ~off:0 ~len:length message) 0 length true + websocket + (Bigstringaf.of_string ~off:0 ~len:length message) 0 length + binary true ~ok:(Lwt.wakeup_later resolver) ~close:(Lwt.wakeup_later resolver); (* TODO The API will likely have to change to report closing. *) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index cbf536c3..d88062c2 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -12,7 +12,7 @@ type 'a promise = 'a Lwt.t type read = - data:(buffer -> int -> int -> bool -> unit) -> + data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> @@ -28,7 +28,7 @@ type stream = { read : read; write : - buffer -> int -> int -> bool -> + buffer -> int -> int -> bool -> bool -> ok:(unit -> unit) -> close:(unit -> unit) -> unit; @@ -65,7 +65,7 @@ let read_only ~read ~close = { read; write = - (fun _buffer _offset _length _fin ~ok:_ ~close:_ -> + (fun _buffer _offset _length _binary _fin ~ok:_ ~close:_ -> raise (Failure "write to a read-only stream")); flush = (fun ~ok:_ ~close:_ -> @@ -100,7 +100,7 @@ let string the_string = let length = String.length stored_string in data (Bigstringaf.of_string ~off:0 ~len:length stored_string) - 0 length true + 0 length true true | None -> close () in @@ -128,8 +128,8 @@ let read stream ~data ~close ~flush = let close stream = stream.close () -let write stream buffer offset length fin ~ok ~close = - stream.write buffer offset length fin ~ok ~close +let write stream buffer offset length binary fin ~ok ~close = + stream.write buffer offset length binary fin ~ok ~close let flush stream ~ok ~close = stream.flush ~ok ~close @@ -148,7 +148,7 @@ type pipe = { | `Closed ]; - mutable read_data_callback : buffer -> int -> int -> bool -> unit; + mutable read_data_callback : buffer -> int -> int -> bool -> bool -> unit; mutable read_close_callback : unit -> unit; mutable read_flush_callback : unit -> unit; mutable read_ping_callback : unit -> unit; @@ -163,6 +163,7 @@ type pipe = { mutable write_buffer : buffer; mutable write_offset : int; mutable write_length : int; + mutable write_binary : bool; mutable write_fin : bool; mutable write_ok_callback : unit -> unit; mutable write_close_callback : unit -> unit; @@ -171,7 +172,7 @@ type pipe = { let dummy_buffer = Bigstringaf.create 0 -let dummy_read_data_callback _buffer _offset _length _fin = +let dummy_read_data_callback _buffer _offset _length _binary _fin = () [@coverage off] let clean_up_reader_fields pipe = @@ -200,6 +201,7 @@ let pipe () = write_buffer = dummy_buffer; write_offset = 0; write_length = 0; + write_binary = true; write_fin = false; write_ok_callback = ignore; write_close_callback = ignore; @@ -224,7 +226,11 @@ let pipe () = begin match internal.write_kind with | `Data -> data - buffer internal.write_offset internal.write_length internal.write_fin + buffer + internal.write_offset + internal.write_length + internal.write_binary + internal.write_fin | `Flush -> flush () | `Ping -> ping () | `Pong -> pong () @@ -234,7 +240,7 @@ let pipe () = close () in - let write buffer offset length fin ~ok ~close = + let write buffer offset length binary fin ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; @@ -242,6 +248,7 @@ let pipe () = internal.write_buffer <- buffer; internal.write_offset <- offset; internal.write_length <- length; + internal.write_binary <- binary; internal.write_fin <- fin; internal.write_ok_callback <- ok; internal.write_close_callback <- close @@ -249,7 +256,7 @@ let pipe () = internal.state <- `Idle; let read_data_callback = internal.read_data_callback in clean_up_reader_fields internal; - read_data_callback buffer offset length fin; + read_data_callback buffer offset length binary fin; ok () | `Writer_waiting -> raise (Failure "stream write: the previous write has not completed") @@ -339,7 +346,7 @@ let read_convenience stream = let rec loop () = stream.read - ~data:(fun buffer offset length _fin -> + ~data:(fun buffer offset length _binary _fin -> Bigstringaf.sub buffer ~off:offset ~len:length |> Bigstringaf.to_string |> Option.some @@ -374,7 +381,7 @@ let read_until_close stream = let rec loop () = stream.read - ~data:(fun chunk offset chunk_length _fin -> + ~data:(fun chunk offset chunk_length _binary _fin -> let new_length = !length + chunk_length in if new_length > Bigstringaf.length !buffer then begin diff --git a/src/pure/stream.mli b/src/pure/stream.mli index e037dbb9..796ed6ca 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -47,7 +47,7 @@ type stream The entire interface is pull-based for flow control. *) type read = - data:(buffer -> int -> int -> bool -> unit) -> + data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(unit -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> @@ -88,7 +88,7 @@ val duplex : read:stream -> write:stream -> close:(unit -> unit) -> stream val stream : read:read -> - write:(buffer -> int -> int -> bool -> write) -> + write:(buffer -> int -> int -> bool -> bool -> write) -> flush:write -> ping:write -> pong:write -> @@ -112,11 +112,11 @@ val read_until_close : stream -> string promise (** Reads a stream completely until [~close], and accumulates the data into a string. *) -val write : stream -> buffer -> int -> int -> bool -> write +val write : stream -> buffer -> int -> int -> bool -> bool -> write (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls - [~ok]. The [bool] argument is the [FIN] flag that indicates the end of a - WebSocket message. It is ignored by non-WebSocket streams. *) + [~ok]. The [bool] arguments are whether the message is binary and whether + the [FIN] flag should be set. They are ignored by non-WebSocket streams. *) val flush : stream -> write (** A writing function that asks for the given stream to be flushed. The meaning diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index c64e47d5..c30f0eed 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -11,9 +11,9 @@ module Stream = Dream__pure.Stream let read_and_dump stream = Stream.read stream - ~data:(fun buffer offset length fin -> - Printf.printf "read: data: FIN=%b %s\n" - fin (Bigstringaf.substring buffer ~off:offset ~len:length)) + ~data:(fun buffer offset length binary fin -> + Printf.printf "read: data: BINARY=%b FIN=%b %s\n" + binary fin (Bigstringaf.substring buffer ~off:offset ~len:length)) ~close:(fun () -> print_endline "read: close") ~flush:(fun () -> @@ -30,8 +30,8 @@ let flush_and_dump stream = ~close:(fun () -> print_endline "flush: close") -let write_and_dump stream buffer offset length fin = - Stream.write stream buffer offset length fin +let write_and_dump stream buffer offset length binary fin = + Stream.write stream buffer offset length binary fin ~ok:(fun () -> print_endline "write: ok") ~close:(fun () -> @@ -80,7 +80,7 @@ let%expect_test _ = Stream.close stream; read_and_dump stream; [%expect {| - read: data: FIN=true foo + read: data: BINARY=true FIN=true foo read: close read: close read: close |}] @@ -101,7 +101,7 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.empty in - (try write_and_dump stream Bigstringaf.empty 0 0 false + (try write_and_dump stream Bigstringaf.empty 0 0 false false with Failure _ as exn -> print_endline (Printexc.to_string exn)); (try flush_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn)); @@ -190,19 +190,19 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - write_and_dump stream buffer 0 3 true; - write_and_dump stream buffer 1 1 false; + write_and_dump stream buffer 0 3 false true; + write_and_dump stream buffer 1 1 true false; print_endline "checkpoint 2"; read_and_dump stream; - write_and_dump stream buffer 0 3 true; - try write_and_dump stream buffer 0 3 false + write_and_dump stream buffer 0 3 true true; + try write_and_dump stream buffer 0 3 false false with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - read: data: FIN=true foo + read: data: BINARY=false FIN=true foo write: ok checkpoint 2 - read: data: FIN=false o + read: data: BINARY=true FIN=false o write: ok (Failure "stream write: the previous write has not completed") |}] @@ -273,9 +273,9 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in - write_and_dump stream buffer 0 3 true; + write_and_dump stream buffer 0 3 true true; Stream.close stream; - write_and_dump stream buffer 0 3 false; + write_and_dump stream buffer 0 3 true false; [%expect {| write: close write: close |}] From a339ef917d5b6d6bb9f3890e4d9f5dca61377287 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 17:32:36 +0300 Subject: [PATCH 037/312] WebSockets: restore and expose close code sending Close codes still can't be received due to limitations of the websocket/af API. --- src/dream.mli | 2 +- src/http/adapt.ml | 4 +- src/http/http.ml | 25 +++++---- src/pure/inmost.ml | 14 ++--- src/pure/stream.ml | 88 ++++++++++++------------------- src/pure/stream.mli | 12 ++--- test/expect/pure/stream/stream.ml | 86 +++++++++++++++--------------- 7 files changed, 106 insertions(+), 125 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index cf28bf36..e87f33b0 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -733,7 +733,7 @@ val body_stream : 'a message -> stream val next : stream -> data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(unit -> unit) -> + close:(int -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> pong:(unit -> unit) -> diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 1d3dba89..a3d13809 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -64,7 +64,7 @@ let forward_body (Httpaf.Body.Writer.write_string body) (Httpaf.Body.Writer.write_bigstring body) (Httpaf.Body.Writer.flush body) - (fun () -> Httpaf.Body.Writer.close body) + (fun _code -> Httpaf.Body.Writer.close body) let forward_body_h2 (response : Dream.response) @@ -75,4 +75,4 @@ let forward_body_h2 (H2.Body.write_string body) (H2.Body.write_bigstring body) (H2.Body.flush body) - (fun () -> H2.Body.close_writer body) + (fun _code -> H2.Body.close_writer body) diff --git a/src/http/http.ml b/src/http/http.ml index 35cc5a24..fef48307 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -80,14 +80,14 @@ let websocket_handler user's_websocket_handler socket = cause a call to eof above? *) let rec read ~data ~close ~flush ~ping ~pong = if !closed then - close () + close 1000 else match !current_payload with | None -> Lwt.on_success (Lwt_stream.get frames) begin function | None -> closed := true; - close () + close 1000 | Some `Ping -> ping () | Some `Pong -> @@ -120,7 +120,7 @@ let websocket_handler user's_websocket_handler socket = let write buffer offset length binary _fin ~ok ~close = let kind = if binary then `Binary else `Text in if !closed then - close () + close 1000 else begin Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; ok () @@ -129,14 +129,14 @@ let websocket_handler user's_websocket_handler socket = let flush ~ok ~close = if !closed then - close () + close 1000 else Websocketaf.Wsd.flushed socket ok in let ping ~ok ~close = if !closed then - close () + close 1000 else begin Websocketaf.Wsd.send_ping socket; ok () @@ -145,17 +145,16 @@ let websocket_handler user's_websocket_handler socket = let pong ~ok ~close = if !closed then - close () + close 1000 else begin Websocketaf.Wsd.send_pong socket; ok () end in - (* TODO Re-expose close code. *) - let close () = + let close code = closed := true; - Websocketaf.Wsd.close socket + Websocketaf.Wsd.close ~code:(`Other code) socket in let websocket = @@ -214,10 +213,10 @@ let wrap_handler let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = Httpaf.Body.Reader.schedule_read body - ~on_eof:close + ~on_eof:(fun () -> close 1000) ~on_read:(fun buffer ~off ~len -> data buffer off len true false) in - let close () = + let close _code = Httpaf.Body.Reader.close body in let body = Stream.read_only ~read ~close in @@ -357,10 +356,10 @@ let wrap_handler_h2 let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = H2.Body.schedule_read body - ~on_eof:close + ~on_eof:(fun () -> close 1000) ~on_read:(fun buffer ~off ~len -> data buffer off len true false) in - let close () = + let close _code = H2.Body.close_reader body in let body = Stream.read_only ~read ~close in diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index d3ad4b53..3b757d84 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -328,7 +328,7 @@ let write message chunk = message.body buffer 0 length true false ~ok:(Lwt.wakeup_later resolver) - ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); promise let write_buffer ?(offset = 0) ?length message chunk = @@ -345,7 +345,7 @@ let write_buffer ?(offset = 0) ?length message chunk = message.body chunk offset length true false ~ok:(Lwt.wakeup_later resolver) - ~close:(Lwt.wakeup_later resolver); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); promise (* TODO How are remote closes actually handled? There is no way for http/af to @@ -355,11 +355,11 @@ let flush message = Stream.flush message.body ~ok:(Lwt.wakeup_later resolver) - ~close:(fun () -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); promise let close_stream message = - Stream.close message.body; + Stream.close message.body 1000; Lwt.return_unit (* TODO Rename. *) @@ -575,15 +575,15 @@ let send ?kind websocket message = (Bigstringaf.of_string ~off:0 ~len:length message) 0 length binary true ~ok:(Lwt.wakeup_later resolver) - ~close:(Lwt.wakeup_later resolver); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); (* TODO The API will likely have to change to report closing. *) promise let receive websocket = Stream.read_convenience websocket -let close_websocket ?code:_ websocket = - Stream.close websocket; +let close_websocket ?(code = 1000) websocket = + Stream.close websocket code; Lwt.return_unit let no_middleware handler request = diff --git a/src/pure/stream.ml b/src/pure/stream.ml index d88062c2..97c7afa6 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -13,7 +13,7 @@ type 'a promise = type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(unit -> unit) -> + close:(int -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> pong:(unit -> unit) -> @@ -21,34 +21,16 @@ type read = type write = ok:(unit -> unit) -> - close:(unit -> unit) -> + close:(int -> unit) -> unit type stream = { read : read; - - write : - buffer -> int -> int -> bool -> bool -> - ok:(unit -> unit) -> - close:(unit -> unit) -> - unit; - - flush : - ok:(unit -> unit) -> - close:(unit -> unit) -> - unit; - - ping : - ok:(unit -> unit) -> - close:(unit -> unit) -> - unit; - - pong : - ok:(unit -> unit) -> - close:(unit -> unit) -> - unit; - - close : unit -> unit; + write : buffer -> int -> int -> bool -> bool -> write; + flush : write; + ping : write; + pong : write; + close : int -> unit; } let stream ~read ~write ~flush ~ping ~pong ~close = @@ -81,7 +63,7 @@ let read_only ~read ~close = let empty = read_only - ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close ()) + ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close 1000) ~close:ignore (* TODO This shows the awkwardness in string-to-string body reading. *) @@ -102,10 +84,10 @@ let string the_string = (Bigstringaf.of_string ~off:0 ~len:length stored_string) 0 length true true | None -> - close () + close 1000 in - let close () = + let close _ = string_ref := None; in @@ -125,8 +107,8 @@ let duplex ~read ~write ~close = let read stream ~data ~close ~flush = stream.read ~data ~close ~flush -let close stream = - stream.close () +let close stream code = + stream.close code let write stream buffer offset length binary fin ~ok ~close = stream.write buffer offset length binary fin ~ok ~close @@ -145,11 +127,11 @@ type pipe = { | `Idle | `Reader_waiting | `Writer_waiting - | `Closed + | `Closed of int ]; mutable read_data_callback : buffer -> int -> int -> bool -> bool -> unit; - mutable read_close_callback : unit -> unit; + mutable read_close_callback : int -> unit; mutable read_flush_callback : unit -> unit; mutable read_ping_callback : unit -> unit; mutable read_pong_callback : unit -> unit; @@ -166,7 +148,7 @@ type pipe = { mutable write_binary : bool; mutable write_fin : bool; mutable write_ok_callback : unit -> unit; - mutable write_close_callback : unit -> unit; + mutable write_close_callback : int -> unit; } let dummy_buffer = @@ -236,8 +218,8 @@ let pipe () = | `Pong -> pong () end; write_ok_callback () - | `Closed -> - close () + | `Closed code -> + close code in let write buffer offset length binary fin ~ok ~close = @@ -260,25 +242,25 @@ let pipe () = ok () | `Writer_waiting -> raise (Failure "stream write: the previous write has not completed") - | `Closed -> - close () + | `Closed code -> + close code in - let close () = + let close code = match internal.state with | `Idle -> - internal.state <- `Closed + internal.state <- `Closed code | `Reader_waiting -> - internal.state <- `Closed; + internal.state <- `Closed code; let read_close_callback = internal.read_close_callback in clean_up_reader_fields internal; - read_close_callback () + read_close_callback code | `Writer_waiting -> - internal.state <- `Closed; + internal.state <- `Closed code; let write_close_callback = internal.write_close_callback in clean_up_writer_fields internal; - write_close_callback () - | `Closed -> + write_close_callback code + | `Closed _code -> () in @@ -297,8 +279,8 @@ let pipe () = ok () | `Writer_waiting -> raise (Failure "stream flush: the previous write has not completed") - | `Closed -> - close () + | `Closed code -> + close code in let ping ~ok ~close = @@ -316,8 +298,8 @@ let pipe () = ok () | `Writer_waiting -> raise (Failure "stream ping: the previous write has not completed") - | `Closed -> - close () + | `Closed code -> + close code in let pong ~ok ~close = @@ -335,8 +317,8 @@ let pipe () = ok () | `Writer_waiting -> raise (Failure "stream pong: the previous write has not completed") - | `Closed -> - close () + | `Closed code -> + close code in {read; write; flush; close; ping; pong} @@ -352,7 +334,7 @@ let read_convenience stream = |> Option.some |> Lwt.wakeup_later resolver) - ~close:(fun () -> + ~close:(fun _code -> Lwt.wakeup_later resolver None) ~flush:loop @@ -360,7 +342,7 @@ let read_convenience stream = ~ping:(fun () -> stream.pong ~ok:loop - ~close:(fun () -> + ~close:(fun _code -> Lwt.wakeup_later resolver None)) ~pong:loop @@ -373,7 +355,7 @@ let read_until_close stream = let promise, resolver = Lwt.wait () in let length = ref 0 in let buffer = ref (Bigstringaf.create 4096) in - let close () = + let close _code = Bigstringaf.sub !buffer ~off:0 ~len:!length |> Bigstringaf.to_string |> Lwt.wakeup_later resolver diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 796ed6ca..5c01faa0 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -48,7 +48,7 @@ type stream type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(unit -> unit) -> + close:(int -> unit) -> flush:(unit -> unit) -> ping:(unit -> unit) -> pong:(unit -> unit) -> @@ -59,12 +59,12 @@ type read = type write = ok:(unit -> unit) -> - close:(unit -> unit) -> + close:(int -> unit) -> unit (** A writing function. Pushes an event into a stream. May take additional arguments before [~ok]. *) -val read_only : read:read -> close:(unit -> unit) -> stream +val read_only : read:read -> close:(int -> unit) -> stream (** Creates a read-only stream from the given reader. [~close] is called in response to {!Stream.close}. It doesn't need to call {!Stream.close} again on the stream. It should be used to free any underlying resources. *) @@ -82,7 +82,7 @@ val pipe : unit -> stream writing functions. For example, calling {!Stream.flush} on a pipe will cause the reader to call its [~flush] callback. *) -val duplex : read:stream -> write:stream -> close:(unit -> unit) -> stream +val duplex : read:stream -> write:stream -> close:(int -> unit) -> stream (** A stream whose reading functions behave like [~read], and whose writing functions behave like [~write]. *) @@ -92,11 +92,11 @@ val stream : flush:write -> ping:write -> pong:write -> - close:(unit -> unit) -> + close:(int -> unit) -> stream (** A general stream. *) -val close : stream -> unit +val close : stream -> int -> unit (** Closes the given stream. Causes a pending reader or writer to call its [~close] callback. *) diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index c30f0eed..34582ce9 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -14,8 +14,8 @@ let read_and_dump stream = ~data:(fun buffer offset length binary fin -> Printf.printf "read: data: BINARY=%b FIN=%b %s\n" binary fin (Bigstringaf.substring buffer ~off:offset ~len:length)) - ~close:(fun () -> - print_endline "read: close") + ~close:(fun code -> + Printf.printf "read: close: CODE=%i\n" code) ~flush:(fun () -> print_endline "read: flush") ~ping:(fun () -> @@ -27,29 +27,29 @@ let flush_and_dump stream = Stream.flush stream ~ok:(fun () -> print_endline "flush: ok") - ~close:(fun () -> - print_endline "flush: close") + ~close:(fun code -> + Printf.printf "flush: close: CODE=%i\n" code) let write_and_dump stream buffer offset length binary fin = Stream.write stream buffer offset length binary fin ~ok:(fun () -> print_endline "write: ok") - ~close:(fun () -> - print_endline "write: close") + ~close:(fun code -> + Printf.printf "write: close: CODE=%i\n" code) let ping_and_dump stream = Stream.ping stream ~ok:(fun () -> print_endline "ping: ok") - ~close:(fun () -> - print_endline "ping: close") + ~close:(fun code -> + Printf.printf "ping: close: CODE=%i\n" code) let pong_and_dump stream = Stream.pong stream ~ok:(fun () -> print_endline "pong: ok") - ~close:(fun () -> - print_endline "pong: close") + ~close:(fun code -> + Printf.printf "pong: close: CODE=%i\n" code) @@ -59,45 +59,45 @@ let%expect_test _ = let stream = Stream.empty in read_and_dump stream; read_and_dump stream; - Stream.close stream; + Stream.close stream 1005; read_and_dump stream; [%expect {| - read: close - read: close - read: close |}] + read: close: CODE=1000 + read: close: CODE=1000 + read: close: CODE=1000 |}] let%expect_test _ = let stream = Stream.empty in - Stream.close stream; + Stream.close stream 1005; read_and_dump stream; - [%expect {| read: close |}] + [%expect {| read: close: CODE=1000 |}] let%expect_test _ = let stream = Stream.string "foo" in read_and_dump stream; read_and_dump stream; read_and_dump stream; - Stream.close stream; + Stream.close stream 1005; read_and_dump stream; [%expect {| read: data: BINARY=true FIN=true foo - read: close - read: close - read: close |}] + read: close: CODE=1000 + read: close: CODE=1000 + read: close: CODE=1000 |}] let%expect_test _ = let stream = Stream.string "" in read_and_dump stream; read_and_dump stream; [%expect {| - read: close - read: close |}] + read: close: CODE=1000 + read: close: CODE=1000 |}] let%expect_test _ = let stream = Stream.string "foo" in - Stream.close stream; + Stream.close stream 1005; read_and_dump stream; - [%expect {| read: close |}] + [%expect {| read: close: CODE=1000 |}] let%expect_test _ = let stream = Stream.empty in @@ -134,26 +134,26 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - Stream.close stream; + Stream.close stream 1005; print_endline "checkpoint 2"; read_and_dump stream; print_endline "checkpoint 3"; - Stream.close stream; + Stream.close stream 1000; [%expect {| checkpoint 1 - read: close + read: close: CODE=1005 checkpoint 2 - read: close + read: close: CODE=1005 checkpoint 3 |}] let%expect_test _ = let stream = Stream.pipe () in - Stream.close stream; + Stream.close stream 1005; read_and_dump stream; read_and_dump stream; [%expect {| - read: close - read: close |}] + read: close: CODE=1005 + read: close: CODE=1005 |}] @@ -261,11 +261,11 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in flush_and_dump stream; - Stream.close stream; + Stream.close stream 1005; flush_and_dump stream; [%expect {| - flush: close - flush: close |}] + flush: close: CODE=1005 + flush: close: CODE=1005 |}] @@ -274,11 +274,11 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in write_and_dump stream buffer 0 3 true true; - Stream.close stream; + Stream.close stream 1005; write_and_dump stream buffer 0 3 true false; [%expect {| - write: close - write: close |}] + write: close: CODE=1005 + write: close: CODE=1005 |}] @@ -287,11 +287,11 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in ping_and_dump stream; - Stream.close stream; + Stream.close stream 1005; ping_and_dump stream; [%expect {| - ping: close - ping: close |}] + ping: close: CODE=1005 + ping: close: CODE=1005 |}] @@ -300,8 +300,8 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in pong_and_dump stream; - Stream.close stream; + Stream.close stream 1005; pong_and_dump stream; [%expect {| - pong: close - pong: close |}] + pong: close: CODE=1005 + pong: close: CODE=1005 |}] From 587d55b92179772eda456b57e22280112e44dca3 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 19:05:40 +0300 Subject: [PATCH 038/312] Primitive HTTP write backpressure Part of #27. --- example/w-stress-response/README.md | 17 +++++++---------- example/w-stress-response/stress_response.ml | 13 ++++++++----- src/http/adapt.ml | 12 ++++++++++-- 3 files changed, 25 insertions(+), 17 deletions(-) diff --git a/example/w-stress-response/README.md b/example/w-stress-response/README.md index c513ff24..14d57492 100644 --- a/example/w-stress-response/README.md +++ b/example/w-stress-response/README.md @@ -10,19 +10,16 @@ by default. To use, $ npx esy start $ curl http://localhost:8080 > /dev/null & -The `curl` command can be repeated for multiple concurrent clients. +The `curl` command can be repeated for multiple concurrent clients, to check +fairness or other effects. -
+The URL supports query parameters: `?mb=16384` sets the total number of +megabytes to respond with (16 GB in this case), and `?chunk=128` changes the +chunk size used during writing (128 KB in this case). -Writing currently slows down for very large streams. This is likely due to the -lack of server-side flow control for writers, which probably causes allocation -of huge internal buffers, which first triggers needless GC, and eventually page -thrashing at the virtual memory level. -[#34](https://github.com/aantron/dream/issues/34) should address this in one of -the early releases of Dream. +
-Nonetheless, for smaller streams, unoptimized Dream is able to peak out at -about 8 Gbits/s, which is more than one curl client can handle (2 Gbits/s). +Dream is currently able to peak out on my machine at about 10 Gbit/s.
diff --git a/example/w-stress-response/stress_response.ml b/example/w-stress-response/stress_response.ml index 4ea54f0b..553d22ed 100644 --- a/example/w-stress-response/stress_response.ml +++ b/example/w-stress-response/stress_response.ml @@ -1,8 +1,8 @@ -(* TODO Once concurrent writing is supported, send N concurrent streams and test - for fairness. *) -(* TODO There seems to be some GC thrashing and even page thrashing or similar - with very large streams, probably due to buffer growth from a lack of - server-side flow control. *) +let show_heap_size () = + Gc.((quick_stat ()).heap_words) * 8 + |> float_of_int + |> fun bytes -> bytes /. 1024. /. 1024. + |> Dream.log "Heap size: %.0f MB" let stress ?(megabytes = 1024) ?(chunk = 64) response = let limit = megabytes * 1024 * 1024 in @@ -28,6 +28,7 @@ let stress ?(megabytes = 1024) ?(chunk = 64) response = Dream.log "%.0f MB/s over %.1f s" ((float_of_int megabytes) /. elapsed) elapsed; + show_heap_size (); Lwt.return_unit @@ -35,6 +36,8 @@ let query_int name request = Dream.query name request |> Option.map int_of_string let () = + show_heap_size (); + Dream.run @@ Dream.logger @@ Dream.router [ diff --git a/src/http/adapt.ml b/src/http/adapt.ml index a3d13809..4624b544 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -19,7 +19,6 @@ let address_to_string : Unix.sockaddr -> string = function (* TODO Write a test simulating client exit during SSE; this was killing the server at some point. *) -(* TODO LATER Will also need to monitor buffer accumulation and use flush. *) let forward_body_general (response : Dream.response) (_write_string : ?off:int -> ?len:int -> string -> unit) @@ -27,6 +26,8 @@ let forward_body_general http_flush close = + let bytes_since_flush = ref 0 in + let rec send () = Dream.body_stream response |> fun stream -> @@ -40,9 +41,16 @@ let forward_body_general and data chunk off len _binary _fin = write_buffer ~off ~len chunk; - send () + bytes_since_flush := !bytes_since_flush + len; + if !bytes_since_flush >= 4096 then begin + bytes_since_flush := 0; + http_flush send + end + else + send () and flush () = + bytes_since_flush := 0; http_flush send and ping () = From 08fd6d0f642affb61b46d3bae02b3f16e8befa55 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 19:47:00 +0300 Subject: [PATCH 039/312] Primitive WebSocket send backpressure Fixes #27. --- example/w-stress-websocket-send/README.md | 11 ++------- .../stress_websocket_send.eml.ml | 9 ++++++++ src/http/http.ml | 23 ++++++++++++------- 3 files changed, 26 insertions(+), 17 deletions(-) diff --git a/example/w-stress-websocket-send/README.md b/example/w-stress-websocket-send/README.md index a0188eb7..334f44a8 100644 --- a/example/w-stress-websocket-send/README.md +++ b/example/w-stress-websocket-send/README.md @@ -5,15 +5,8 @@ This example serves a client which opens four WebSockets. The server then floods each WebSocket with 1 GB of data in 64 KB one-frame messages. -At the moment, the naive and unoptimized Dream massively outpaces Chrome. Dream -sends the 4 GB in about 8 seconds, at a resulting speed of about 4 Gbits/s. -Chrome appears to receive all the messages, but the JavaScript engine processes -them in about 10 minutes (55 Mbit/s), causing massive buffering in Chrome. - -This test should be improved after flow control is added internally to Dream's -writers in [#34](https://github.com/aantron/dream/issues/34). It should probably -be run with multiple separate client tabs or processes, rather than one -JavaScript context. +At the moment, Dream greatly outpaces Chrome, which appears to limit WebSocket +traffic to 64 MB/s per tab.
diff --git a/example/w-stress-websocket-send/stress_websocket_send.eml.ml b/example/w-stress-websocket-send/stress_websocket_send.eml.ml index 7a7c33ca..e9a89ca9 100644 --- a/example/w-stress-websocket-send/stress_websocket_send.eml.ml +++ b/example/w-stress-websocket-send/stress_websocket_send.eml.ml @@ -26,6 +26,12 @@ let home = +let show_heap_size () = + Gc.((quick_stat ()).heap_words) * 8 + |> float_of_int + |> fun bytes -> bytes /. 1024. /. 1024. + |> Dream.log "Heap size: %.0f MB" + let frame = 64 * 1024 let frame_a = String.make frame 'a' @@ -48,10 +54,13 @@ let stress websocket = Dream.log "%.0f MB/s over %.1f s" ((float_of_int limit) /. elapsed /. 1024. /. 1024.) elapsed; + show_heap_size (); Lwt.return_unit let () = + show_heap_size (); + Dream.run @@ Dream.logger @@ Dream.router [ diff --git a/src/http/http.ml b/src/http/http.ml index fef48307..c4fd3e02 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -117,23 +117,30 @@ let websocket_handler user's_websocket_handler socket = data last_buffer last_offset last_length binary fin) in + let bytes_since_flush = ref 0 in + + let flush ~ok ~close = + bytes_since_flush := 0; + if !closed then + close 1000 + else + Websocketaf.Wsd.flushed socket ok + in + let write buffer offset length binary _fin ~ok ~close = let kind = if binary then `Binary else `Text in if !closed then close 1000 else begin Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; - ok () + bytes_since_flush := !bytes_since_flush + length; + if !bytes_since_flush >= 4096 then + flush ~ok ~close + else + ok () end in - let flush ~ok ~close = - if !closed then - close 1000 - else - Websocketaf.Wsd.flushed socket ok - in - let ping ~ok ~close = if !closed then close 1000 From c7e37548da95d309e6c4a16464199b54da3b44db Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 27 Nov 2021 20:35:46 +0300 Subject: [PATCH 040/312] dream.ml: remove obsolete internal module --- src/dream.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 14058753..696b5cce 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -5,12 +5,6 @@ -module Method_and_status = -struct - include Dream__pure.Method - include Dream__pure.Status -end - include Dream__pure.Stream include Dream__pure.Inmost From b5c0e774501911196f201fde107b4b672ba3bc3e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 28 Nov 2021 22:03:31 +0300 Subject: [PATCH 041/312] Streams: document design decision about FIN bit --- src/pure/stream.mli | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 5c01faa0..908ebc8c 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -116,7 +116,18 @@ val write : stream -> buffer -> int -> int -> bool -> bool -> write (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls [~ok]. The [bool] arguments are whether the message is binary and whether - the [FIN] flag should be set. They are ignored by non-WebSocket streams. *) + the [FIN] flag should be set. They are ignored by non-WebSocket streams. + + Note: [FIN] is provided as part of the write call, rather than being a + separate stream event (like [flush]), because the WebSocket writer needs to + immediately know when the last chunk of the last frame in a message is + provided, to transmit the [FIN] bit. If [FIN] were to be provided as a + separate event, the WebSocket writer would have to buffer each one chunk, in + case the next stream event was [FIN], in order to be able to decide whether + to set the [FIN] bit or not. This is awkward and inefficient, as it + introduces an unnecessary delay into the writer, as if the next event is not + [FIN], the next data chunk might take an arbitrary amount of time to be + generated by the writing user code. *) val flush : stream -> write (** A writing function that asks for the given stream to be flushed. The meaning From 639d59dad1ecff2367d3529441c026f01e9627e0 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 08:54:40 +0300 Subject: [PATCH 042/312] WebSocket: tweak binary flag --- src/http/http.ml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index c4fd3e02..f88fd7c2 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -38,7 +38,7 @@ let websocket_handler user's_websocket_handler socket = backpressure with the current API of websocket/af, so that will have to be added later. The user-facing API of Dream does support backpressure. *) let frames, push_frame = Lwt_stream.create () in - let message_is_binary = ref true in + let message_is_binary = ref `Binary in (* Frame reader called by websocket/af on each frame received. There is no good way to truly throttle this, hence this frame reader pushes frame @@ -55,11 +55,11 @@ let websocket_handler user's_websocket_handler socket = | `Other _ -> () (* TODO Log? *) | `Text -> - message_is_binary := false; - push_frame (Some (`Data (payload, false, is_fin))) + message_is_binary := `Text; + push_frame (Some (`Data (payload, `Text, is_fin))) | `Binary -> - message_is_binary := true; - push_frame (Some (`Data (payload, true, is_fin))) + message_is_binary := `Binary; + push_frame (Some (`Data (payload, `Binary, is_fin))) | `Continuation -> push_frame (Some (`Data (payload, !message_is_binary, is_fin))) in @@ -106,6 +106,7 @@ let websocket_handler user's_websocket_handler socket = read ~data ~close ~flush ~ping ~pong | Some (last_buffer, last_offset, last_length) -> last_chunk := Some (buffer, off, len); + let binary = binary = `Binary in data last_buffer last_offset last_length binary false) ~on_eof:(fun () -> current_payload := None; @@ -114,6 +115,7 @@ let websocket_handler user's_websocket_handler socket = read ~data ~close ~flush ~ping ~pong | Some (last_buffer, last_offset, last_length) -> last_chunk := None; + let binary = binary = `Binary in data last_buffer last_offset last_length binary fin) in From 0613640568ea5bb9ffdcd46cf3a19d4ad3f122b3 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 09:14:50 +0300 Subject: [PATCH 043/312] WebSocket: drain all payloads --- src/http/http.ml | 64 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 52 insertions(+), 12 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index f88fd7c2..dbe78f60 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -47,21 +47,22 @@ let websocket_handler user's_websocket_handler socket = match opcode with | `Connection_close -> Websocketaf.Wsd.close socket; - push_frame None; + push_frame (Some (`Close, payload)) | `Ping -> - push_frame (Some `Ping) + push_frame (Some (`Ping, payload)) | `Pong -> - push_frame (Some `Pong) + push_frame (Some (`Pong, payload)) | `Other _ -> - () (* TODO Log? *) + (* TODO Log? *) + push_frame (Some (`Other, payload)) | `Text -> message_is_binary := `Text; - push_frame (Some (`Data (payload, `Text, is_fin))) + push_frame (Some (`Data (`Text, is_fin), payload)) | `Binary -> message_is_binary := `Binary; - push_frame (Some (`Data (payload, `Binary, is_fin))) + push_frame (Some (`Data (`Binary, is_fin), payload)) | `Continuation -> - push_frame (Some (`Data (payload, !message_is_binary, is_fin))) + push_frame (Some (`Data (!message_is_binary, is_fin), payload)) in let eof () = @@ -75,6 +76,37 @@ let websocket_handler user's_websocket_handler socket = let closed = ref false in let current_payload = ref None in let last_chunk = ref None in + (* TODO Review per-chunk allocations, including current_payload contents. *) + + (* For control frames, the payload can be at most 125 bytes long. We assume + that the first chunk will contain the whole payload, and discard any other + chunks that may be reported by websocket/af. *) + let first_chunk_received = ref false in + let first_chunk = ref Bigstringaf.empty in + let first_chunk_offset = ref 0 in + let first_chunk_length = ref 0 in + let rec drain_payload payload continuation = + Websocketaf.Payload.schedule_read + payload + ~on_read:(fun buffer ~off ~len -> + if not !first_chunk_received then begin + first_chunk := buffer; + first_chunk_offset := off; + first_chunk_length := len; + first_chunk_received := true + end; + (* TODO Warn about receiving additional chunks. *) + drain_payload payload continuation) + ~on_eof:(fun () -> + let payload = !first_chunk in + let offset = !first_chunk_offset in + let length = !first_chunk_length in + first_chunk_received := false; + first_chunk := Bigstringaf.empty; + first_chunk_offset := 0; + first_chunk_length := 0; + continuation payload offset length) + in (* TODO Can this be canceled by a user's close? i.e. will that eventually cause a call to eof above? *) @@ -88,15 +120,23 @@ let websocket_handler user's_websocket_handler socket = | None -> closed := true; close 1000 - | Some `Ping -> + | Some (`Close, payload) -> + drain_payload payload @@ fun _buffer _offset _length -> + close 1000 + | Some (`Ping, payload) -> + drain_payload payload @@ fun _buffer _offset _length -> ping () - | Some `Pong -> + | Some (`Pong, payload) -> + drain_payload payload @@ fun _buffer _offset _length -> pong () - | Some (`Data payload) -> - current_payload := Some payload; + | Some (`Other, payload) -> + drain_payload payload @@ fun _buffer _offset _length -> + read ~data ~close ~flush ~ping ~pong + | Some (`Data properties, payload) -> + current_payload := Some (properties, payload); read ~data ~close ~flush ~ping ~pong end - | Some (payload, binary, fin) -> + | Some ((binary, fin), payload) -> Websocketaf.Payload.schedule_read payload ~on_read:(fun buffer ~off ~len -> From d21ca95501539bc6ff69bcee84f5fc523d2f0478 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 09:38:52 +0300 Subject: [PATCH 044/312] WebSocket: read close codes --- src/http/http.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index dbe78f60..d815d39c 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -119,10 +119,15 @@ let websocket_handler user's_websocket_handler socket = Lwt.on_success (Lwt_stream.get frames) begin function | None -> closed := true; - close 1000 + close 1005 | Some (`Close, payload) -> - drain_payload payload @@ fun _buffer _offset _length -> - close 1000 + drain_payload payload @@ fun buffer offset length -> + if length < 2 then + close 1005 + else + let high_byte = Char.code buffer.{offset} + and low_byte = Char.code buffer.{offset + 1} in + close (high_byte lsl 8 lor low_byte) | Some (`Ping, payload) -> drain_payload payload @@ fun _buffer _offset _length -> ping () From 873c0484290d774800d2287e4caabda08c3cf5b5 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 11:00:50 +0300 Subject: [PATCH 045/312] WebSocket: expose ping/pong payloads It's not possible to send them at the moment, due to https://github.com/anmonteiro/websocketaf/issues/36 However, this change should be made now to future-proof the Dream API. --- src/dream.mli | 4 +- src/http/adapt.ml | 4 +- src/http/http.ml | 14 ++++--- src/pure/stream.ml | 68 ++++++++++++++++++------------- src/pure/stream.mli | 12 +++--- test/expect/pure/stream/stream.ml | 56 +++++++++++++------------ 6 files changed, 88 insertions(+), 70 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index e87f33b0..d4847296 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -735,8 +735,8 @@ val next : data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(int -> unit) -> flush:(unit -> unit) -> - ping:(unit -> unit) -> - pong:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> unit (** Waits for the next stream event, and calls: diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 4624b544..372d5860 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -53,10 +53,10 @@ let forward_body_general bytes_since_flush := 0; http_flush send - and ping () = + and ping _buffer _offset _length = send () - and pong () = + and pong _buffer _offset _length = send () in diff --git a/src/http/http.ml b/src/http/http.ml index d815d39c..4d0b722f 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -129,11 +129,11 @@ let websocket_handler user's_websocket_handler socket = and low_byte = Char.code buffer.{offset + 1} in close (high_byte lsl 8 lor low_byte) | Some (`Ping, payload) -> - drain_payload payload @@ fun _buffer _offset _length -> - ping () + drain_payload payload @@ + ping | Some (`Pong, payload) -> - drain_payload payload @@ fun _buffer _offset _length -> - pong () + drain_payload payload @@ + pong | Some (`Other, payload) -> drain_payload payload @@ fun _buffer _offset _length -> read ~data ~close ~flush ~ping ~pong @@ -188,7 +188,9 @@ let websocket_handler user's_websocket_handler socket = end in - let ping ~ok ~close = + (* TODO Log if the length is non-zero, as current websocket/af offers no way + to send the user data. Also log if the length is greater than 125. *) + let ping _buffer _offset _length ~ok ~close = if !closed then close 1000 else begin @@ -197,7 +199,7 @@ let websocket_handler user's_websocket_handler socket = end in - let pong ~ok ~close = + let pong _buffer _offset _length ~ok ~close = if !closed then close 1000 else begin diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 97c7afa6..ca382252 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -15,8 +15,8 @@ type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(int -> unit) -> flush:(unit -> unit) -> - ping:(unit -> unit) -> - pong:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> unit type write = @@ -28,8 +28,8 @@ type stream = { read : read; write : buffer -> int -> int -> bool -> bool -> write; flush : write; - ping : write; - pong : write; + ping : buffer -> int -> int -> write; + pong : buffer -> int -> int -> write; close : int -> unit; } @@ -53,10 +53,10 @@ let read_only ~read ~close = (fun ~ok:_ ~close:_ -> raise (Failure "flush of a read-only stream")); ping = - (fun ~ok:_ ~close:_ -> + (fun _buffer _offset _length ~ok:_ ~close:_ -> raise (Failure "ping on a read-only stream")); pong = - (fun ~ok:_ ~close:_ -> + (fun _buffer _offset _length ~ok:_ ~close:_ -> raise (Failure "pong on a read-only stream")); close; } @@ -87,7 +87,7 @@ let string the_string = close 1000 in - let close _ = + let close _code = string_ref := None; in @@ -116,11 +116,11 @@ let write stream buffer offset length binary fin ~ok ~close = let flush stream ~ok ~close = stream.flush ~ok ~close -let ping stream ~ok ~close = - stream.ping ~ok ~close +let ping stream buffer offset length ~ok ~close = + stream.ping buffer offset length ~ok ~close -let pong stream ~ok ~close = - stream.pong ~ok ~close +let pong stream buffer offset length ~ok ~close = + stream.pong buffer offset length ~ok ~close type pipe = { mutable state : [ @@ -133,8 +133,8 @@ type pipe = { mutable read_data_callback : buffer -> int -> int -> bool -> bool -> unit; mutable read_close_callback : int -> unit; mutable read_flush_callback : unit -> unit; - mutable read_ping_callback : unit -> unit; - mutable read_pong_callback : unit -> unit; + mutable read_ping_callback : buffer -> int -> int -> unit; + mutable read_pong_callback : buffer -> int -> int -> unit; mutable write_kind : [ | `Data @@ -157,12 +157,15 @@ let dummy_buffer = let dummy_read_data_callback _buffer _offset _length _binary _fin = () [@coverage off] +let dummy_ping_pong_callback _buffer _offset _length = + () [@coverage off] + let clean_up_reader_fields pipe = pipe.read_data_callback <- dummy_read_data_callback; pipe.read_close_callback <- ignore; pipe.read_flush_callback <- ignore; - pipe.read_ping_callback <- ignore; - pipe.read_pong_callback <- ignore + pipe.read_ping_callback <- dummy_ping_pong_callback; + pipe.read_pong_callback <- dummy_ping_pong_callback let clean_up_writer_fields pipe = pipe.write_buffer <- dummy_buffer; @@ -176,8 +179,8 @@ let pipe () = read_data_callback = dummy_read_data_callback; read_close_callback = ignore; read_flush_callback = ignore; - read_ping_callback = ignore; - read_pong_callback = ignore; + read_ping_callback = dummy_ping_pong_callback; + read_pong_callback = dummy_ping_pong_callback; write_kind = `Data; write_buffer = dummy_buffer; @@ -214,8 +217,8 @@ let pipe () = internal.write_binary internal.write_fin | `Flush -> flush () - | `Ping -> ping () - | `Pong -> pong () + | `Ping -> ping buffer internal.write_offset internal.write_length + | `Pong -> pong buffer internal.write_offset internal.write_length end; write_ok_callback () | `Closed code -> @@ -283,18 +286,21 @@ let pipe () = close code in - let ping ~ok ~close = + let ping buffer offset length ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; internal.write_kind <- `Ping; + internal.write_buffer <- buffer; + internal.write_offset <- offset; + internal.write_length <- length; internal.write_ok_callback <- ok; internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_ping_callback = internal.read_ping_callback in clean_up_reader_fields internal; - read_ping_callback (); + read_ping_callback buffer offset length; ok () | `Writer_waiting -> raise (Failure "stream ping: the previous write has not completed") @@ -302,18 +308,21 @@ let pipe () = close code in - let pong ~ok ~close = + let pong buffer offset length ~ok ~close = match internal.state with | `Idle -> internal.state <- `Writer_waiting; internal.write_kind <- `Pong; + internal.write_buffer <- buffer; + internal.write_offset <- offset; + internal.write_length <- length; internal.write_ok_callback <- ok; internal.write_close_callback <- close | `Reader_waiting -> internal.state <- `Idle; let read_pong_callback = internal.read_pong_callback in clean_up_reader_fields internal; - read_pong_callback (); + read_pong_callback buffer offset length; ok () | `Writer_waiting -> raise (Failure "stream pong: the previous write has not completed") @@ -339,13 +348,15 @@ let read_convenience stream = ~flush:loop - ~ping:(fun () -> + ~ping:(fun buffer offset length -> stream.pong + buffer offset length ~ok:loop ~close:(fun _code -> Lwt.wakeup_later resolver None)) - ~pong:loop + ~pong:(fun _buffer _offset _length -> + ()) in loop (); @@ -383,10 +394,11 @@ let read_until_close stream = ~flush:loop - ~ping:(fun () -> - stream.pong ~ok:loop ~close) + ~ping:(fun buffer offset length -> + stream.pong buffer offset length ~ok:loop ~close) - ~pong:loop + ~pong:(fun _buffer _offset _length -> + ()) in loop (); diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 908ebc8c..e89165e8 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -50,8 +50,8 @@ type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(int -> unit) -> flush:(unit -> unit) -> - ping:(unit -> unit) -> - pong:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> unit (** A reading function. Awaits the next event on the stream. For each call of a reading function, one of the callbacks will eventually be called, according @@ -90,8 +90,8 @@ val stream : read:read -> write:(buffer -> int -> int -> bool -> bool -> write) -> flush:write -> - ping:write -> - pong:write -> + ping:(buffer -> int -> int -> write) -> + pong:(buffer -> int -> int -> write) -> close:(int -> unit) -> stream (** A general stream. *) @@ -134,10 +134,10 @@ val flush : stream -> write of flushing depends on the implementation of the stream. No more writing functions should be called on the stream until this function calls [~ok]. *) -val ping : stream -> write +val ping : stream -> buffer -> int -> int -> write (** A writing function that sends a ping event on the given stream. This is only meaningful for WebSockets. *) -val pong : stream -> write +val pong : stream -> buffer -> int -> int -> write (** A writing function that sends a pong event on the given stream. This is only meaningful for WebSockets. *) diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 34582ce9..0d042864 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -18,10 +18,12 @@ let read_and_dump stream = Printf.printf "read: close: CODE=%i\n" code) ~flush:(fun () -> print_endline "read: flush") - ~ping:(fun () -> - print_endline "read: ping") - ~pong:(fun () -> - print_endline "read: pong") + ~ping:(fun buffer offset length -> + Printf.printf "read: ping: %s\n" + (Bigstringaf.substring buffer ~off:offset ~len:length)) + ~pong:(fun buffer offset length -> + Printf.printf "read: pong: %s\n" + (Bigstringaf.substring buffer ~off:offset ~len:length)) let flush_and_dump stream = Stream.flush stream @@ -37,15 +39,17 @@ let write_and_dump stream buffer offset length binary fin = ~close:(fun code -> Printf.printf "write: close: CODE=%i\n" code) -let ping_and_dump stream = - Stream.ping stream +let ping_and_dump payload stream = + let length = String.length payload in + Stream.ping stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length ~ok:(fun () -> print_endline "ping: ok") ~close:(fun code -> Printf.printf "ping: close: CODE=%i\n" code) -let pong_and_dump stream = - Stream.pong stream +let pong_and_dump payload stream = + let length = String.length payload in + Stream.pong stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length ~ok:(fun () -> print_endline "pong: ok") ~close:(fun code -> @@ -105,9 +109,9 @@ let%expect_test _ = with Failure _ as exn -> print_endline (Printexc.to_string exn)); (try flush_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn)); - (try ping_and_dump stream + (try ping_and_dump "foo" stream with Failure _ as exn -> print_endline (Printexc.to_string exn)); - (try pong_and_dump stream + (try pong_and_dump "bar" stream with Failure _ as exn -> print_endline (Printexc.to_string exn)); [%expect {| (Failure "write to a read-only stream") @@ -214,19 +218,19 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - ping_and_dump stream; - ping_and_dump stream; + ping_and_dump "foo" stream; + ping_and_dump "bar" stream; print_endline "checkpoint 2"; read_and_dump stream; - ping_and_dump stream; - try ping_and_dump stream + ping_and_dump "baz" stream; + try ping_and_dump "quux" stream with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - read: ping + read: ping: foo ping: ok checkpoint 2 - read: ping + read: ping: bar ping: ok (Failure "stream ping: the previous write has not completed") |}] @@ -238,19 +242,19 @@ let%expect_test _ = let stream = Stream.pipe () in read_and_dump stream; print_endline "checkpoint 1"; - pong_and_dump stream; - pong_and_dump stream; + pong_and_dump "foo" stream; + pong_and_dump "bar" stream; print_endline "checkpoint 2"; read_and_dump stream; - pong_and_dump stream; - try pong_and_dump stream + pong_and_dump "baz" stream; + try pong_and_dump "quux" stream with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 - read: pong + read: pong: foo pong: ok checkpoint 2 - read: pong + read: pong: bar pong: ok (Failure "stream pong: the previous write has not completed") |}] @@ -286,9 +290,9 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in - ping_and_dump stream; + ping_and_dump "foo" stream; Stream.close stream 1005; - ping_and_dump stream; + ping_and_dump "bar" stream; [%expect {| ping: close: CODE=1005 ping: close: CODE=1005 |}] @@ -299,9 +303,9 @@ let%expect_test _ = let%expect_test _ = let stream = Stream.pipe () in - pong_and_dump stream; + pong_and_dump "foo" stream; Stream.close stream 1005; - pong_and_dump stream; + pong_and_dump "bar" stream; [%expect {| pong: close: CODE=1005 pong: close: CODE=1005 |}] From f1cec7222fc5bfc9259d57a0f3e25c1f23a9233d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 12:04:17 +0300 Subject: [PATCH 046/312] WebSocket: better close handshake handling --- src/http/http.ml | 47 ++++++++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 4d0b722f..b26b0279 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -46,7 +46,6 @@ let websocket_handler user's_websocket_handler socket = let frame ~opcode ~is_fin ~len:_ payload = match opcode with | `Connection_close -> - Websocketaf.Wsd.close socket; push_frame (Some (`Close, payload)) | `Ping -> push_frame (Some (`Ping, payload)) @@ -66,14 +65,13 @@ let websocket_handler user's_websocket_handler socket = in let eof () = - Websocketaf.Wsd.close socket; - push_frame None - in + push_frame None in (* The reader retrieves the next frame. If it is a data frame, it keeps a reference to the payload across multiple reader calls, until the payload is exhausted. *) let closed = ref false in + let close_code = ref 1005 in let current_payload = ref None in let last_chunk = ref None in (* TODO Review per-chunk allocations, including current_payload contents. *) @@ -112,22 +110,31 @@ let websocket_handler user's_websocket_handler socket = cause a call to eof above? *) let rec read ~data ~close ~flush ~ping ~pong = if !closed then - close 1000 + close !close_code else match !current_payload with | None -> Lwt.on_success (Lwt_stream.get frames) begin function | None -> - closed := true; - close 1005 + if not !closed then begin + closed := true; + close_code := 1005 + end; + Websocketaf.Wsd.close socket; + close !close_code | Some (`Close, payload) -> drain_payload payload @@ fun buffer offset length -> - if length < 2 then - close 1005 - else - let high_byte = Char.code buffer.{offset} - and low_byte = Char.code buffer.{offset + 1} in - close (high_byte lsl 8 lor low_byte) + let code = + if length < 2 then + 1005 + else + let high_byte = Char.code buffer.{offset} + and low_byte = Char.code buffer.{offset + 1} in + high_byte lsl 8 lor low_byte + in + if not !closed then + close_code := code; + close !close_code | Some (`Ping, payload) -> drain_payload payload @@ ping @@ -169,7 +176,7 @@ let websocket_handler user's_websocket_handler socket = let flush ~ok ~close = bytes_since_flush := 0; if !closed then - close 1000 + close !close_code else Websocketaf.Wsd.flushed socket ok in @@ -177,7 +184,7 @@ let websocket_handler user's_websocket_handler socket = let write buffer offset length binary _fin ~ok ~close = let kind = if binary then `Binary else `Text in if !closed then - close 1000 + close !close_code else begin Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; bytes_since_flush := !bytes_since_flush + length; @@ -192,7 +199,7 @@ let websocket_handler user's_websocket_handler socket = to send the user data. Also log if the length is greater than 125. *) let ping _buffer _offset _length ~ok ~close = if !closed then - close 1000 + close !close_code else begin Websocketaf.Wsd.send_ping socket; ok () @@ -201,7 +208,7 @@ let websocket_handler user's_websocket_handler socket = let pong _buffer _offset _length ~ok ~close = if !closed then - close 1000 + close !close_code else begin Websocketaf.Wsd.send_pong socket; ok () @@ -209,8 +216,10 @@ let websocket_handler user's_websocket_handler socket = in let close code = - closed := true; - Websocketaf.Wsd.close ~code:(`Other code) socket + if not !closed then begin + closed := true; + Websocketaf.Wsd.close ~code:(`Other code) socket + end in let websocket = From bf710df1bc8dead6280244926f57fee52da2d794 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 29 Nov 2021 12:26:25 +0300 Subject: [PATCH 047/312] WebSocket: a bit of logging and internal docs --- src/http/http.ml | 51 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 14 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index b26b0279..f5332eac 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -23,15 +23,14 @@ let to_httpaf_status status = let to_h2_status status = Dream.status_to_int status |> H2.Status.of_code -(* TODO Contact upstream: this is from websocketaf/lwt/websocketaf_lwt.ml, but - it is not exposed. *) let sha1 s = s |> Digestif.SHA1.digest_string |> Digestif.SHA1.to_raw_string -(* TODO It appears that backpressure is impossible in the underlying - implementation... *) +let websocket_log = + Dream__middleware.Log.sub_log "dream.websocket" + let websocket_handler user's_websocket_handler socket = (* Queue of received frames. There doesn't appear to be a nice way to achieve @@ -42,7 +41,8 @@ let websocket_handler user's_websocket_handler socket = (* Frame reader called by websocket/af on each frame received. There is no good way to truly throttle this, hence this frame reader pushes frame - objects into the above frame queue for the reader to take from later. *) + objects into the above frame queue for the reader to take from later. See + https://github.com/anmonteiro/websocketaf/issues/34. *) let frame ~opcode ~is_fin ~len:_ payload = match opcode with | `Connection_close -> @@ -52,7 +52,6 @@ let websocket_handler user's_websocket_handler socket = | `Pong -> push_frame (Some (`Pong, payload)) | `Other _ -> - (* TODO Log? *) push_frame (Some (`Other, payload)) | `Text -> message_is_binary := `Text; @@ -73,6 +72,10 @@ let websocket_handler user's_websocket_handler socket = let closed = ref false in let close_code = ref 1005 in let current_payload = ref None in + + (* Used to convert the separate on_eof payload reading callback into a FIN bit + on the last chunk read. See + https://github.com/anmonteiro/websocketaf/issues/35. *) let last_chunk = ref None in (* TODO Review per-chunk allocations, including current_payload contents. *) @@ -92,8 +95,10 @@ let websocket_handler user's_websocket_handler socket = first_chunk_offset := off; first_chunk_length := len; first_chunk_received := true - end; - (* TODO Warn about receiving additional chunks. *) + end + else + websocket_log.warning (fun log -> + log "Received fragmented control frame"); drain_payload payload continuation) ~on_eof:(fun () -> let payload = !first_chunk in @@ -142,7 +147,9 @@ let websocket_handler user's_websocket_handler socket = drain_payload payload @@ pong | Some (`Other, payload) -> - drain_payload payload @@ fun _buffer _offset _length -> + drain_payload payload @@ fun _buffer _offset length -> + websocket_log.warning (fun log -> + log "Unknown frame type with length %i" length); read ~data ~close ~flush ~ping ~pong | Some (`Data properties, payload) -> current_payload := Some (properties, payload); @@ -181,7 +188,11 @@ let websocket_handler user's_websocket_handler socket = Websocketaf.Wsd.flushed socket ok in - let write buffer offset length binary _fin ~ok ~close = + let write buffer offset length binary fin ~ok ~close = + (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) + if not fin then + websocket_log.error (fun log -> + log "Non-FIN frames not yet supported"); let kind = if binary then `Binary else `Text in if !closed then close !close_code @@ -195,9 +206,13 @@ let websocket_handler user's_websocket_handler socket = end in - (* TODO Log if the length is non-zero, as current websocket/af offers no way - to send the user data. Also log if the length is greater than 125. *) - let ping _buffer _offset _length ~ok ~close = + let ping _buffer _offset length ~ok ~close = + if length > 125 then + raise (Failure "Ping payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + if length > 0 then + websocket_log.warning (fun log -> + log "Ping with non-empty payload not yet supported"); if !closed then close !close_code else begin @@ -206,7 +221,15 @@ let websocket_handler user's_websocket_handler socket = end in - let pong _buffer _offset _length ~ok ~close = + let pong _buffer _offset length ~ok ~close = + (* TODO Is there any way for the peer to send a ping payload with more than + 125 bytes, forcing a too-large pong and an exception? *) + if length > 125 then + raise (Failure "Pong payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + if length > 0 then + websocket_log.warning (fun log -> + log "Pong with non-empty payload not yet supported"); if !closed then close !close_code else begin From 54c4600cb0aac0828f0d4315de09f7839a63cd28 Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Mon, 29 Nov 2021 13:45:58 +0100 Subject: [PATCH 048/312] Update gluten & tls --- src/vendor/gluten | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vendor/gluten b/src/vendor/gluten index 475c3610..0c9341a6 160000 --- a/src/vendor/gluten +++ b/src/vendor/gluten @@ -1 +1 @@ -Subproject commit 475c36109fad6a09cec9d1a1b9b2f9c3818fc854 +Subproject commit 0c9341a64ee7432c7a3e1a5e97b4012fee2775c2 From 9743279d4115b6ce43863bee5ef9c0465376fff3 Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Mon, 29 Nov 2021 17:16:24 +0100 Subject: [PATCH 049/312] Update the MirageOS codebase --- src/mirage/adapt.ml | 55 ++++++++++++++++++----------- src/mirage/mirage.ml | 82 +++++++++++++++---------------------------- src/mirage/mirage.mli | 23 +++++++----- src/vendor/paf | 2 +- 4 files changed, 78 insertions(+), 84 deletions(-) diff --git a/src/mirage/adapt.ml b/src/mirage/adapt.ml index 2fc999ba..bf5d7e54 100644 --- a/src/mirage/adapt.ml +++ b/src/mirage/adapt.ml @@ -7,6 +7,7 @@ depends on [Unix]. *) module Dream = Dream__pure.Inmost +module Stream = Dream__pure.Stream (* TODO Write a test simulating client exit during SSE; this was killing the server at some point. *) @@ -14,45 +15,57 @@ module Dream = Dream__pure.Inmost (* TODO Rewrite using Dream.next. *) let forward_body_general (response : Dream.response) - (write_string : ?off:int -> ?len:int -> string -> unit) - (write_buffer : ?off:int -> ?len:int -> Dream.buffer -> unit) + (_write_string : ?off:int -> ?len:int -> string -> unit) + (write_buffer : ?off:int -> ?len:int -> Stream.buffer -> unit) http_flush close = + let bytes_since_flush = ref 0 in let rec send () = - response - |> Dream.next - ~buffer - ~string - ~flush - ~close - ~exn:ignore + Dream.body_stream response + |> fun stream -> + Stream.read + stream + ~data + ~close + ~flush + ~ping + ~pong - and buffer chunk off len = + and data chunk off len _binary _fin = write_buffer ~off ~len chunk; - send () - - and string chunk off len = - write_string ~off ~len chunk; - send () + bytes_since_flush := !bytes_since_flush + len; + if !bytes_since_flush >= 4096 then begin + bytes_since_flush := 0; + http_flush send + end + else + send () and flush () = + bytes_since_flush := 0; http_flush send + and ping _buffer _offset _length = + send () + + and pong _buffer _offset _length = + send () + in send () let forward_body (response : Dream.response) - (body : [ `write ] Httpaf.Body.t) = + (body : Httpaf.Body.Writer.t) = forward_body_general response - (Httpaf.Body.write_string body) - (Httpaf.Body.write_bigstring body) - (Httpaf.Body.flush body) - (fun () -> Httpaf.Body.close_writer body) + (Httpaf.Body.Writer.write_string body) + (Httpaf.Body.Writer.write_bigstring body) + (Httpaf.Body.Writer.flush body) + (fun _code -> Httpaf.Body.Writer.close body) let forward_body_h2 (response : Dream.response) @@ -63,4 +76,4 @@ let forward_body_h2 (H2.Body.write_string body) (H2.Body.write_bigstring body) (H2.Body.flush body) - (fun () -> H2.Body.close_writer body) + (fun _code -> H2.Body.close_writer body) diff --git a/src/mirage/mirage.ml b/src/mirage/mirage.ml index 03fb47ed..003abcc0 100644 --- a/src/mirage/mirage.ml +++ b/src/mirage/mirage.ml @@ -1,5 +1,3 @@ -[@@@warning "-32"] - module Dream = Dream__pure.Inmost open Rresult @@ -12,14 +10,7 @@ let sha1 str = Digestif.SHA1.(to_raw_string (digest_string str)) let const x = fun _ -> x let ( >>? ) = Lwt_result.bind -let rec transmit_body request stream () = - Lwt_stream.get stream >>= function - | Some (buffer, off, len) -> - Dream__pure.Body.write_bigstring buffer off len request.Dream.body >>= - transmit_body request stream - | None -> Dream.close_stream request - -let wrap_handler_httpaf app (_user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) = +let wrap_handler_httpaf app _user's_error_handler user's_dream_handler = let httpaf_request_handler = fun client reqd -> let httpaf_request = Httpaf.Reqd.request reqd in let method_ = to_dream_method httpaf_request.meth in @@ -27,24 +18,19 @@ let wrap_handler_httpaf app (_user's_error_handler : Dream.error_handler) (user' let version = (httpaf_request.version.major, httpaf_request.version.minor) in let headers = Httpaf.Headers.to_list httpaf_request.headers in let body = Httpaf.Reqd.request_body reqd in - let request = Dream.request_from_http ~app ~client ~method_ ~target ~version ~headers in - Lwt.async begin fun () -> - let%lwt () = Dream.flush request in - let on_eof () = Dream.close_stream request |> ignore in - - let rec loop () = - Httpaf.Body.schedule_read - body - ~on_eof - ~on_read:(fun buffer ~off ~len -> - Lwt.on_success - (Dream__pure.Body.write_bigstring buffer off len request.body) - loop) - in - loop (); - Lwt.return_unit - end; + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + Httpaf.Body.Reader.schedule_read + body + ~on_eof:(fun () -> close 1000) + ~on_read:(fun buffer ~off ~len -> data buffer off len true false) + in + let close _close = + Httpaf.Body.Reader.close body in + let body = + Dream__pure.Stream.read_only ~read ~close in + + let request = Dream.request_from_http ~app ~client ~method_ ~target ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -107,41 +93,32 @@ let wrap_handler_httpaf app (_user's_error_handler : Dream.error_handler) (user' httpaf_request_handler let request_handler - : Dream.app -> Dream.error_handler -> Dream.handler -> string -> [ `write ] Alpn.reqd_handler -> unit + : Dream.app -> Dream.error_handler -> Dream.handler -> string -> Alpn.reqd -> unit = fun app (user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) -> (); fun client_address -> function - | Alpn.Reqd_handler (Alpn.HTTP_1_1, reqd) -> wrap_handler_httpaf app user's_error_handler user's_dream_handler client_address reqd + | Alpn.Reqd_HTTP_1_1 reqd -> wrap_handler_httpaf app user's_error_handler user's_dream_handler client_address reqd | _ -> assert false let error_handler : Dream.app -> Dream.error_handler -> string -> ?request:Alpn.request -> Alpn.server_error -> - (Alpn.headers -> [ `write ] Alpn.body) -> unit + (Alpn.headers -> Alpn.body) -> unit = fun app (user's_error_handler : Dream.error_handler) -> (); fun client ?request error start_response -> match request with - | Some (Alpn.Request (Alpn.HTTP_1_1, request)) -> - let start_response hdrs : [ `write ] Httpaf.Body.t = match start_response Alpn.(Headers (HTTP_1_1, hdrs)) with - | Alpn.(Body (HTTP_1_1, body)) -> body - | Alpn.(Body (HTTP_2_0, _)) -> Fmt.failwith "Impossible to respond with an h2 respond to an HTTP/1.1 client" in + | Some (Alpn.Request_HTTP_1_1 request) -> + let start_response hdrs : Httpaf.Body.Writer.t = match start_response Alpn.(Headers_HTTP_1_1 hdrs) with + | Alpn.Body_HTTP_1_1 (Alpn.Wr, Alpn.Body_wr body) -> body + | _ -> Fmt.failwith "Impossible to respond with an h2 respond to an HTTP/1.1 client" in Error_handler.httpaf app user's_error_handler client ?request:(Some request) error start_response | _ -> assert false (* TODO *) module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirage_stack.V4V6) = struct - module Method_and_status = - struct - include Dream__pure.Method - include Dream__pure.Status - end - + include Dream__pure.Stream include Dream__pure.Inmost - (* Eliminate optional arguments from the public interface for now. *) - let next ~buffer ~close ~exn request = - next ~buffer ~close ~exn request - include Dream__middleware.Log include Dream__middleware.Log.Make (Pclock) include Dream__middleware.Echo @@ -159,8 +136,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag include Dream__middleware.Session include Dream__middleware.Session.Make (Pclock) - (* include Dream__middleware.Flash_message *) - include Dream__middleware.Origin_referrer_check include Dream__middleware.Form include Dream__middleware.Upload @@ -179,8 +154,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag let random = Dream__cipher.Random.random - (* XXX(dinosaure): [Mirage_crypto_rng_mirage] should already be initialized by - * the [main.ml] generated by [mirage]. *) include Dream__pure.Formats @@ -206,7 +179,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag let alpn (_, flow) = match TLS.epoch flow with | Ok { Tls.Core.alpn_protocol; _ } -> alpn_protocol | Error _ -> None in - let peer ((ipaddr, port), _) = Fmt.strf "%a:%d" Ipaddr.pp ipaddr port in + let peer ((ipaddr, port), _) = Fmt.str "%a:%d" Ipaddr.pp ipaddr port in let injection (_, flow) = R.T flow in { Alpn.alpn; peer; injection; } @@ -228,7 +201,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag let https ?stop ~port ?(prefix= "") stack ?(cfg= Tls.Config.server ~certificates:localhost_certificate ()) - ?error_handler:(user's_error_handler= Error_handler.default) user's_dream_handler = + ?error_handler:(user's_error_handler : error_handler = Error_handler.default) (user's_dream_handler : handler) = let prefix = prefix |> Dream__pure.Formats.from_path |> Dream__pure.Formats.drop_trailing_slash in @@ -242,7 +215,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag let user's_dream_handler = built_in_middleware user's_dream_handler in let error_handler = error_handler app user's_error_handler in - let request_handler = request_handler app user's_error_handler user's_dream_handler in + let request_handler = + request_handler app user's_error_handler user's_dream_handler in let service = Alpn.service alpn ~error_handler ~request_handler accept close in init ~port stack >>= fun t -> let `Initialized th = serve ?stop service t in th @@ -253,11 +227,13 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirag | `HTTP_1_1 -> "http/1.1" in let module R = (val Mimic.repr tcp_protocol) in let alpn _ = Some protocol in - let peer ((ipaddr, port), _) = Fmt.strf "%a:%d" Ipaddr.pp ipaddr port in + let peer ((ipaddr, port), _) = Fmt.str "%a:%d" Ipaddr.pp ipaddr port in let injection (_, flow) = R.T flow in { Alpn.alpn; peer; injection; } - let http ?stop ~port ?(prefix= "") ?(protocol= `HTTP_1_1) stack ?error_handler:(user's_error_handler= Error_handler.default) user's_dream_handler = + let http ?stop ~port ?(prefix= "") ?(protocol= `HTTP_1_1) stack + ?error_handler:(user's_error_handler= Error_handler.default) + user's_dream_handler = let prefix = prefix |> Dream__pure.Formats.from_path |> Dream__pure.Formats.drop_trailing_slash in diff --git a/src/mirage/mirage.mli b/src/mirage/mirage.mli index 314aecbd..658a6215 100644 --- a/src/mirage/mirage.mli +++ b/src/mirage/mirage.mli @@ -1,14 +1,19 @@ -type request -type response +type incoming +type outgoing + +type 'a message + +type request = incoming message +type response = outgoing message type handler = request -> response Lwt.t +type middleware = handler -> handler module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Mirage_stack.V4V6) : sig - type middleware = handler -> handler - + type route type method_ = @@ -105,7 +110,7 @@ module Make val error : ('a, unit) conditional_log val warning : ('a, unit) conditional_log val info : ('a, unit) conditional_log - val debug : ('a, unit) conditional_log + (* val debug : ('a, unit) conditional_log *) val html : ?status:status -> ?code:int -> ?headers:(string * string) list -> string -> response Lwt.t @@ -132,8 +137,8 @@ module Make type multipart_form = (string * ((string option * string) list)) list - val form : request -> (string * string) list form_result Lwt.t - val multipart : request -> multipart_form form_result Lwt.t + val form : ?csrf:bool -> request -> (string * string) list form_result Lwt.t + val multipart : ?csrf:bool -> request -> multipart_form form_result Lwt.t val form_tag : ?method_:method_ -> @@ -181,7 +186,7 @@ module Make ?stop:Lwt_switch.t -> port:int -> ?prefix:string - -> Stack.t + -> Stack.TCP.t -> ?cfg:Tls.Config.server -> ?error_handler:error_handler -> handler @@ -192,7 +197,7 @@ module Make -> port:int -> ?prefix:string -> ?protocol:[ `H2 | `HTTP_1_1 ] - -> Stack.t + -> Stack.TCP.t -> ?error_handler:error_handler -> handler -> unit Lwt.t diff --git a/src/vendor/paf b/src/vendor/paf index 11e9a28e..b52b0e6b 160000 --- a/src/vendor/paf +++ b/src/vendor/paf @@ -1 +1 @@ -Subproject commit 11e9a28ece6dbcdcca75fdff160af903d87c88f3 +Subproject commit b52b0e6be8b7bb6f0dcb84c4d82963114468956a From d94b4a2bf1e133b0e37d64116bb3970786db0b9b Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Mon, 29 Nov 2021 17:16:37 +0100 Subject: [PATCH 050/312] Update example about MirageOS --- example/m-mirage/config.ml | 1 + example/m-mirage/unikernel.ml | 16 ++++++++++------ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/example/m-mirage/config.ml b/example/m-mirage/config.ml index b8be79da..65545229 100644 --- a/example/m-mirage/config.ml +++ b/example/m-mirage/config.ml @@ -37,6 +37,7 @@ let dream = ~packages:[ package "ca-certs-nss" ; package "dns-client" ~sublibs:[ "mirage" ] ; package "dream-mirage" ~sublibs:[ "paf.le" ] + ; package "checkseum" ~sublibs:[ "c" ] ; package "dream-mirage" ] ~keys:Key.([ abstract port ; abstract hostname diff --git a/example/m-mirage/unikernel.ml b/example/m-mirage/unikernel.ml index 87b67658..c3700a9b 100644 --- a/example/m-mirage/unikernel.ml +++ b/example/m-mirage/unikernel.ml @@ -22,7 +22,7 @@ module Make ; Dream.get "/echo/:word" echo ] @@ Dream.not_found - module DNS = Dns_client_mirage.Make (Random) (Time) (Mclock) (Stack) + module DNS = Dns_client_mirage.Make (Random) (Time) (Mclock) (Pclock) (Stack) module Let = LE.Make (Time) (Stack) module Nss = Ca_certs_nss.Make (Pclock) module Paf = Paf_mirage.Make (Time) (Stack) @@ -35,7 +35,7 @@ module Make let error_handler _ ?request:_ _ _ = () let get_certificates ?(production= false) cfg stackv4v6 = - Paf.init ~port:80 stackv4v6 >>= fun t -> + Paf.init ~port:80 (Stack.tcp stackv4v6) >>= fun t -> let service = Paf.http_service ~error_handler Let.request_handler in Lwt_switch.with_switch @@ fun stop -> let `Initialized th = Paf.serve ~stop service t in @@ -50,18 +50,22 @@ module Make let https_with_letsencrypt stackv4v6 = let cfg = { LE.certificate_seed= Key_gen.cert_seed () + ; LE.certificate_key_type= `ED25519 + ; LE.certificate_key_bits= None ; LE.email= Option.bind (Key_gen.email ()) (R.to_option <.> Emile.of_string) - ; LE.seed= Key_gen.account_seed () + ; LE.account_seed= Key_gen.account_seed () + ; LE.account_key_type= `ED25519 + ; LE.account_key_bits= None ; LE.hostname= Domain_name.(host_exn <.> of_string_exn) (Key_gen.hostname ()) } in get_certificates ~production:(Key_gen.production ()) cfg stackv4v6 >>= fun certificates -> let tls = Tls.Config.server ~certificates () in - Dream.https ~port:(Key_gen.port ()) stackv4v6 ~cfg:tls dream + Dream.https ~port:(Key_gen.port ()) (Stack.tcp stackv4v6) ~cfg:tls dream let https stackv4v6 = - Dream.https ~port:(Key_gen.port ()) stackv4v6 dream + Dream.https ~port:(Key_gen.port ()) (Stack.tcp stackv4v6) dream let http stackv4v6 = - Dream.http ~port:(Key_gen.port ()) stackv4v6 dream + Dream.http ~port:(Key_gen.port ()) (Stack.tcp stackv4v6) dream let start _console () () () () stackv4v6 = match Key_gen.tls (), Key_gen.letsencrypt () with From 560ea7d9997d0174843a20639e9ba0552fc93567 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 5 Dec 2021 19:40:56 +0300 Subject: [PATCH 051/312] Initial commit of a Dream client library This is just the lowest-level, rough API, to begin exercising the new streams API that is supposed to work on both client and server, and to find out how to best simplify and expose it. --- example/w-client/client.ml | 41 +++++++++++ example/w-client/dune | 6 ++ example/w-client/dune-project | 1 + hyper.opam | 11 +++ src/dune | 10 +++ src/hyper.ml | 127 ++++++++++++++++++++++++++++++++++ src/hyper.mli | 7 ++ 7 files changed, 203 insertions(+) create mode 100644 example/w-client/client.ml create mode 100644 example/w-client/dune create mode 100644 example/w-client/dune-project create mode 100644 hyper.opam create mode 100644 src/hyper.ml create mode 100644 src/hyper.mli diff --git a/example/w-client/client.ml b/example/w-client/client.ml new file mode 100644 index 00000000..add31658 --- /dev/null +++ b/example/w-client/client.ml @@ -0,0 +1,41 @@ +let () = + (* TODO Without Dream.run in the process, this doesn't get set anywhere... *) + Printexc.record_backtrace true; + + (* TODO Eventually replace this by the higher-level wrappers that Hyper will + offer. Move the explicit-request call into a proxy example, that forwards + Dream requests directly to Hyper.send. *) + (* TODO This example is meant for running concurrently with example/w-echo. *) + let request = + Dream.request + ~method_:`POST + ~target:"http://127.0.0.1:8080/echo" "Good morning, world!" + ~headers:["Transfer-Encoding", "chunked"] + in + + (* TODO Note that this wrapper is not necessary if using, for example, + Dream.run. Create a proxy example that has both a Dream server and a Hyper + client, and therefore has no explicit Lwt_main.run. *) + Lwt_main.run begin + let done_, notify_done = Lwt.wait () in + + (* TODO Add some kind of primitive error handling, both for network errors + and for error responses. *) + let%lwt response = Hyper.send request in + let rec read () = + (* TODO Use a higher-level reader once available. *) + Dream.next + (Dream.body_stream response) + ~data:(fun buffer offset length _binary _fin -> + Bigstringaf.substring buffer ~off:offset ~len:length + |> print_string; + read ()) + ~close:(fun _code -> Lwt.wakeup_later notify_done ()) + ~flush:read + ~ping:(fun _buffer _offset _length -> read ()) + ~pong:(fun _buffer _offset _length -> read ()) + in + read (); + + done_ + end diff --git a/example/w-client/dune b/example/w-client/dune new file mode 100644 index 00000000..07ffc06d --- /dev/null +++ b/example/w-client/dune @@ -0,0 +1,6 @@ +(executable + (name client) + (libraries hyper) + (preprocess (pps lwt_ppx))) + +(data_only_dirs _esy esy.lock lib node_modules) diff --git a/example/w-client/dune-project b/example/w-client/dune-project new file mode 100644 index 00000000..929c696e --- /dev/null +++ b/example/w-client/dune-project @@ -0,0 +1 @@ +(lang dune 2.0) diff --git a/hyper.opam b/hyper.opam new file mode 100644 index 00000000..7cbd2efc --- /dev/null +++ b/hyper.opam @@ -0,0 +1,11 @@ +opam-version: "2.0" + +depends: [ + "dream" + "ocaml" + "uri" +] + +build: [ + ["dune" "build" "-p" name "-j" jobs] +] diff --git a/src/dune b/src/dune index c36649b9..d3b4cf10 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,7 @@ (library (public_name dream) (wrapped false) + (modules dream) (libraries caqti-lwt dream.cipher @@ -18,3 +19,12 @@ mirage-crypto-rng.lwt ptime.clock.os )) + +(library + (public_name hyper) + (wrapped false) + (modules hyper) + (libraries + dream + ) + (preprocess (pps lwt_ppx))) diff --git a/src/hyper.ml b/src/hyper.ml new file mode 100644 index 00000000..49a3d42b --- /dev/null +++ b/src/hyper.ml @@ -0,0 +1,127 @@ +type request = Dream.request +type response = Dream.response +type 'a promise = 'a Lwt.t + +type method_ = Dream.method_ + +(* TODO How should the host and port be represented? *) +(* TODO Good error handling. *) +let send hyper_request = + let uri = Uri.of_string (Dream.target hyper_request) in + let host = Uri.host uri |> Option.get + and port = Uri.port uri |> Option.value ~default:80 + and method_ = Dream.method_ hyper_request + and path_and_query = Uri.path_and_query uri + in + (* TODO Usage of Option.get above is temporary, though failure to provide a + host should probably be a logic error, and doesn't have to be reported in a + "neat" way - just a debuggable way. The port can be inferred from the + scheme if it is missing. We are assuming http:// for now. *) + + let%lwt addresses = + Lwt_unix.getaddrinfo host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in + let address = (List.hd addresses).Unix.ai_addr in + (* TODO Note: this can raise. *) + + let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + let%lwt () = Lwt_unix.connect socket address in + let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in + + let response_promise, received_response = Lwt.wait () in + + (* TODO Do we now want to store the verson? *) + let response_handler + (httpaf_response : Httpaf.Response.t) + httpaf_response_body = + + (* TODO Using Dream.stream is awkward here, but it allows getting a response + with a stream inside it without immeidately having to modify Dream. Once + that is fixed, the Lwt.async can be removed, most likely. Dream.stream's + signature will change in Dream either way, so it's best to just hold off + tweaking it now. *) + Lwt.async begin fun () -> + let%lwt hyper_response = + Dream.stream + ~code:(Httpaf.Status.to_code httpaf_response.status) + ~headers:(Httpaf.Headers.to_list httpaf_response.headers) + (fun _response -> Lwt.return ()) + in + Lwt.wakeup_later received_response hyper_response; + + (* TODO A janky reader. Once Dream.stream is fixed and streams are fully + exposed, this can become a good pull-reader. *) + let rec receive () = + Httpaf.Body.Reader.schedule_read + httpaf_response_body + ~on_eof:(fun () -> + Lwt.async (fun () -> + let%lwt () = Dream.close_stream hyper_response in + Httpaf_lwt_unix.Client.shutdown connection)) + (* TODO Make sure there is a way for the reader to abort reading + the stream and yet still get the socket closed. *) + ~on_read:(fun buffer ~off ~len -> + Lwt.async (fun () -> + let%lwt () = + Dream.write_buffer + ~offset:off ~length:len hyper_response buffer in + Lwt.return (receive ()))) + in + receive (); + + Lwt.return () + end + in + + let httpaf_request = + Httpaf.Request.create + ~headers:(Httpaf.Headers.of_list (Dream.all_headers hyper_request)) + (Httpaf.Method.of_string (Dream.method_to_string method_)) + path_and_query in + let httpaf_request_body = + Httpaf_lwt_unix.Client.request + connection + ~error_handler:(fun _ -> failwith "Protocol error") (* TODO *) + ~response_handler + httpaf_request in + + let rec send () = + Dream.body_stream hyper_request + |> fun stream -> + Dream.next stream ~data ~close ~flush ~ping ~pong + + (* TODO Implement flow control like on the server side, using flush. *) + and data buffer offset length _binary _fin = + Httpaf.Body.Writer.write_bigstring + httpaf_request_body + ~off:offset + ~len:length + buffer; + send () + + and close _code = Httpaf.Body.Writer.close httpaf_request_body + and flush () = send () + and ping _buffer _offset _length = send () + and pong _buffer _offset _length = send () + + in + + send (); + + response_promise + + + +(* TODO Which function should be the most fundamental function? Probably the + request -> response runner. But it's probably not the most convenient for + general usage. + + How should the host and port be represented? Can probably just allow them in + [target], but also allow overriding them so that only the path and query are + used. This could get confusing, though. + + To start with, implement a good request -> response runner that does the + basics: create a request, allow streaming out its body, receive a response, + allow streaming in its body. After that, elaborate. Probably should start + with HTTP/2 and SSL. + + How are non-response errors reported? *) diff --git a/src/hyper.mli b/src/hyper.mli new file mode 100644 index 00000000..fddfdaa9 --- /dev/null +++ b/src/hyper.mli @@ -0,0 +1,7 @@ +type request = Dream.request +type response = Dream.response +type 'a promise = 'a Lwt.t + +type method_ = Dream.method_ + +val send : request -> response promise From c98d11063c5b056d11c749506dd7700099c14171 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 6 Dec 2021 21:36:29 +0300 Subject: [PATCH 052/312] Client: proof-of-concept connection pooling --- example/w-client/client.ml | 53 ++++++++++++----------- src/hyper.ml | 87 +++++++++++++++++++++++++++++++++----- src/hyper.mli | 20 ++++++++- 3 files changed, 124 insertions(+), 36 deletions(-) diff --git a/example/w-client/client.ml b/example/w-client/client.ml index add31658..569d8577 100644 --- a/example/w-client/client.ml +++ b/example/w-client/client.ml @@ -1,7 +1,4 @@ -let () = - (* TODO Without Dream.run in the process, this doesn't get set anywhere... *) - Printexc.record_backtrace true; - +let send () = (* TODO Eventually replace this by the higher-level wrappers that Hyper will offer. Move the explicit-request call into a proxy example, that forwards Dream requests directly to Hyper.send. *) @@ -16,26 +13,34 @@ let () = (* TODO Note that this wrapper is not necessary if using, for example, Dream.run. Create a proxy example that has both a Dream server and a Hyper client, and therefore has no explicit Lwt_main.run. *) - Lwt_main.run begin - let done_, notify_done = Lwt.wait () in + let done_, notify_done = Lwt.wait () in + + (* TODO Add some kind of primitive error handling, both for network errors + and for error responses. *) + let%lwt response = Hyper.send request in + let rec read () = + (* TODO Use a higher-level reader once available. *) + Dream.next + (Dream.body_stream response) + ~data:(fun buffer offset length _binary _fin -> + Bigstringaf.substring buffer ~off:offset ~len:length + |> print_string; + read ()) + ~close:(fun _code -> Lwt.wakeup_later notify_done ()) + ~flush:read + ~ping:(fun _buffer _offset _length -> read ()) + ~pong:(fun _buffer _offset _length -> read ()) + in + read (); + + done_ - (* TODO Add some kind of primitive error handling, both for network errors - and for error responses. *) - let%lwt response = Hyper.send request in - let rec read () = - (* TODO Use a higher-level reader once available. *) - Dream.next - (Dream.body_stream response) - ~data:(fun buffer offset length _binary _fin -> - Bigstringaf.substring buffer ~off:offset ~len:length - |> print_string; - read ()) - ~close:(fun _code -> Lwt.wakeup_later notify_done ()) - ~flush:read - ~ping:(fun _buffer _offset _length -> read ()) - ~pong:(fun _buffer _offset _length -> read ()) - in - read (); +let () = + (* TODO Without Dream.run in the process, this doesn't get set anywhere... *) + Printexc.record_backtrace true; - done_ + Lwt_main.run begin + let%lwt () = send () in + let%lwt () = send () in + Lwt.return () end diff --git a/src/hyper.ml b/src/hyper.ml index 49a3d42b..2e546443 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -4,11 +4,65 @@ type 'a promise = 'a Lwt.t type method_ = Dream.method_ +type connection = Httpaf_lwt_unix.Client.t +type host = string * string * int +(* TODO But what should a host be? An unresolved hostname:port, or a resolved + hostname:port? Hosts probably also need a comparison function or + something. And probably a pretty-printing function. These things are entirely + abstract. But, because they are abstract, it's possible to change the + implementation, in particular to switch from unresolved to resolved hosts. + Using unresolved hosts implies doing DNS before deciding whether each request + can reuse a connection from the pool. Though that can be avoided by using a + DNS cache, it seems like the pool should short-circuit that entire process. + So, this becomes some kind of scheme-host-port triplet. *) +(* TODO Also, how should this work with HTTP/2 and multiplexing? Need to address + that next. *) + +type connection_pool = { + obtain : host -> request -> connection option promise; + return : + host -> request -> response -> connection -> (connection -> unit promise) -> + unit promise; +} +(* TODO Return needs to provide a function for destroying a connection. *) + +let connection_pool ~obtain ~return = + {obtain; return} + +let _no_pooling = + connection_pool + ~obtain:(fun _host _request -> + Lwt.return_none) + ~return:(fun _host _request _response connection destroy -> + destroy connection) + +(* TODO Non-trivial pools should always be generated, i.e. this should be a + function of at least (). However, we are just doing proof-of-concept code + here, to work out the protocol details, rather than a great connection + pool. Most connection pool should also examine the Connection: header, and + perhaps other headers. *) +let indefinite_keepalive = + let pool = Hashtbl.create 32 in + connection_pool + ~obtain:(fun host _request -> + match Hashtbl.find_opt pool host with + | Some connection -> + Hashtbl.remove pool host; + Lwt.return (Some connection) + | None -> + Lwt.return_none) + ~return:(fun host _request _response connection _destroy -> + Hashtbl.add pool host connection; + Lwt.return_unit) + (* TODO How should the host and port be represented? *) (* TODO Good error handling. *) -let send hyper_request = +(* TODO Probably change the default to one per-process pool with some + configuration. *) +let send ?(connection_pool = indefinite_keepalive) hyper_request = let uri = Uri.of_string (Dream.target hyper_request) in - let host = Uri.host uri |> Option.get + let scheme = Uri.scheme uri |> Option.get + and host = Uri.host uri |> Option.get and port = Uri.port uri |> Option.value ~default:80 and method_ = Dream.method_ hyper_request and path_and_query = Uri.path_and_query uri @@ -18,14 +72,23 @@ let send hyper_request = "neat" way - just a debuggable way. The port can be inferred from the scheme if it is missing. We are assuming http:// for now. *) - let%lwt addresses = - Lwt_unix.getaddrinfo host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in - let address = (List.hd addresses).Unix.ai_addr in - (* TODO Note: this can raise. *) - - let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in - let%lwt () = Lwt_unix.connect socket address in - let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in + let host_key = (scheme, host, port) in + + let%lwt connection = + match%lwt connection_pool.obtain host_key hyper_request with + | Some connection -> + Lwt.return connection + | None -> + let%lwt addresses = + Lwt_unix.getaddrinfo + host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in + let address = (List.hd addresses).Unix.ai_addr in + (* TODO Note: this can raise. *) + + let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + let%lwt () = Lwt_unix.connect socket address in + Httpaf_lwt_unix.Client.create_connection socket + in let response_promise, received_response = Lwt.wait () in @@ -56,7 +119,9 @@ let send hyper_request = ~on_eof:(fun () -> Lwt.async (fun () -> let%lwt () = Dream.close_stream hyper_response in - Httpaf_lwt_unix.Client.shutdown connection)) + connection_pool.return + host_key hyper_request hyper_response connection + Httpaf_lwt_unix.Client.shutdown)) (* TODO Make sure there is a way for the reader to abort reading the stream and yet still get the socket closed. *) ~on_read:(fun buffer ~off ~len -> diff --git a/src/hyper.mli b/src/hyper.mli index fddfdaa9..cbecfcbe 100644 --- a/src/hyper.mli +++ b/src/hyper.mli @@ -4,4 +4,22 @@ type 'a promise = 'a Lwt.t type method_ = Dream.method_ -val send : request -> response promise +type connection_pool + +val send : + ?connection_pool:connection_pool -> + request -> response promise + +(* TODO The issue with connections is that they depend on the underlying stack + implementation, which is best kept as abstract as possible. That means the + best way to do this is to make the connection type abstract to users, and to + make all connection setup code internal to Hyper. That means the pool + connection get function that is provided by the user will not create + connections, so it must return options. *) +type connection +type host + +val connection_pool : + obtain:(host -> request -> connection option promise) -> + return:(host -> request -> response -> connection -> (connection -> unit promise) -> unit promise) -> + connection_pool From c9ad93b7c99cd514a09afe5f8a55ea7c2f72afa0 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 8 Dec 2021 17:44:33 +0300 Subject: [PATCH 053/312] Client: primitive HTTPS support Currently not doing certificate validation. Also not shutting the connection down very cleanly, as this is best figured out after the I/O rework is finished (for which an approximate client is needed). --- example/w-client/client.ml | 8 +++++--- src/dune | 2 ++ src/hyper.ml | 40 ++++++++++++++++++++++++++++++++++---- 3 files changed, 43 insertions(+), 7 deletions(-) diff --git a/example/w-client/client.ml b/example/w-client/client.ml index 569d8577..b27efe66 100644 --- a/example/w-client/client.ml +++ b/example/w-client/client.ml @@ -5,9 +5,9 @@ let send () = (* TODO This example is meant for running concurrently with example/w-echo. *) let request = Dream.request - ~method_:`POST - ~target:"http://127.0.0.1:8080/echo" "Good morning, world!" - ~headers:["Transfer-Encoding", "chunked"] + ~method_:`GET + ~target:"https://127.0.0.1:8080" "" + (* ~headers:["Transfer-Encoding", "chunked"] *) in (* TODO Note that this wrapper is not necessary if using, for example, @@ -44,3 +44,5 @@ let () = let%lwt () = send () in Lwt.return () end + +(* TODO Run the server in the same process. *) diff --git a/src/dune b/src/dune index d3b4cf10..8c400261 100644 --- a/src/dune +++ b/src/dune @@ -26,5 +26,7 @@ (modules hyper) (libraries dream + lwt_ssl + ssl ) (preprocess (pps lwt_ppx))) diff --git a/src/hyper.ml b/src/hyper.ml index 2e546443..adcade88 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -4,7 +4,11 @@ type 'a promise = 'a Lwt.t type method_ = Dream.method_ -type connection = Httpaf_lwt_unix.Client.t +(* TODO Is this the right representation? *) +type connection = + | Cleartext of Httpaf_lwt_unix.Client.t + | SSL of Httpaf_lwt_unix.Client.SSL.t + type host = string * string * int (* TODO But what should a host be? An unresolved hostname:port, or a resolved hostname:port? Hosts probably also need a comparison function or @@ -87,7 +91,35 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in let%lwt () = Lwt_unix.connect socket address in - Httpaf_lwt_unix.Client.create_connection socket + + match scheme with + | "https" -> + (* TODO The context needs to be created once per process, or a cache + should be used. *) + let context = Ssl.(create_context TLSv1_2 Client_context) in + let%lwt ssl_socket = Lwt_ssl.ssl_connect socket context in + let%lwt connection = + Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in + Lwt.return (SSL connection) + (* TODO Need to do server certificate validation here, etc. *) + | _ -> (* TODO Should be a check for http specifically. *) + let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in + Lwt.return (Cleartext connection) + in + + (* TODO These sorts of things can probably be done by passing the client + modules in as first-class modules. The code might be not so clear to read, + though. *) + let destroy connection = + match connection with + | Cleartext connection -> Httpaf_lwt_unix.Client.shutdown connection + | SSL connection -> Httpaf_lwt_unix.Client.SSL.shutdown connection + in + + let request connection = + match connection with + | Cleartext connection -> Httpaf_lwt_unix.Client.request connection + | SSL connection -> Httpaf_lwt_unix.Client.SSL.request connection in let response_promise, received_response = Lwt.wait () in @@ -121,7 +153,7 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = let%lwt () = Dream.close_stream hyper_response in connection_pool.return host_key hyper_request hyper_response connection - Httpaf_lwt_unix.Client.shutdown)) + destroy)) (* TODO Make sure there is a way for the reader to abort reading the stream and yet still get the socket closed. *) ~on_read:(fun buffer ~off ~len -> @@ -143,7 +175,7 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = (Httpaf.Method.of_string (Dream.method_to_string method_)) path_and_query in let httpaf_request_body = - Httpaf_lwt_unix.Client.request + request connection ~error_handler:(fun _ -> failwith "Protocol error") (* TODO *) ~response_handler From e95f6be28ca13700df8aaacdfadba53092181ea4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 8 Dec 2021 19:45:30 +0300 Subject: [PATCH 054/312] Client: bare-bones HTTP/2 support There is no request multiplexing, and the code is generally very dirty. Saving clarification for a separate refactoring step, after all that needs to be in the client is sketched out. --- src/dune | 6 +++ src/hyper.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 111 insertions(+), 4 deletions(-) diff --git a/src/dune b/src/dune index 8c400261..6e79896b 100644 --- a/src/dune +++ b/src/dune @@ -26,6 +26,12 @@ (modules hyper) (libraries dream + dream.h2 + dream.h2-lwt-unix + dream.httpaf + dream.httpaf-lwt-unix + lwt + lwt.unix lwt_ssl ssl ) diff --git a/src/hyper.ml b/src/hyper.ml index adcade88..f61ae24d 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -8,6 +8,7 @@ type method_ = Dream.method_ type connection = | Cleartext of Httpaf_lwt_unix.Client.t | SSL of Httpaf_lwt_unix.Client.SSL.t + | H2 of H2_lwt_unix.Client.SSL.t (* TODO No h2c support. *) type host = string * string * int (* TODO But what should a host be? An unresolved hostname:port, or a resolved @@ -21,6 +22,9 @@ type host = string * string * int So, this becomes some kind of scheme-host-port triplet. *) (* TODO Also, how should this work with HTTP/2 and multiplexing? Need to address that next. *) +(* TODO The scheme is probably not sufficient. Will also need the negotiated + protocol, as an https connection might have been upgraded to HTTP/2 or not at + the server's discretion during ALPN. *) type connection_pool = { obtain : host -> request -> connection option promise; @@ -97,10 +101,27 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = (* TODO The context needs to be created once per process, or a cache should be used. *) let context = Ssl.(create_context TLSv1_2 Client_context) in + (* TODO For WebSockets (wss://), the client should probably do SSL + without offering h2 by ALPN. Do any servers implement WebSockets over + HTTP/2? *) + Ssl.set_context_alpn_protos context ["h2"; "http/1.1"]; let%lwt ssl_socket = Lwt_ssl.ssl_connect socket context in - let%lwt connection = - Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in - Lwt.return (SSL connection) + (* TODO Next line is pretty suspicious. *) + let underlying = Lwt_ssl.ssl_socket ssl_socket |> Option.get in + begin match Ssl.get_negotiated_alpn_protocol underlying with + | Some "h2" -> + (* TODO What about the error handler? *) + let%lwt connection = + H2_lwt_unix.Client.SSL.create_connection + ~error_handler:ignore + ssl_socket + in + Lwt.return (H2 connection) + | _ -> + let%lwt connection = + Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in + Lwt.return (SSL connection) + end (* TODO Need to do server certificate validation here, etc. *) | _ -> (* TODO Should be a check for http specifically. *) let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in @@ -114,16 +135,24 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = match connection with | Cleartext connection -> Httpaf_lwt_unix.Client.shutdown connection | SSL connection -> Httpaf_lwt_unix.Client.SSL.shutdown connection + | H2 connection -> H2_lwt_unix.Client.SSL.shutdown connection in let request connection = match connection with | Cleartext connection -> Httpaf_lwt_unix.Client.request connection | SSL connection -> Httpaf_lwt_unix.Client.SSL.request connection + | H2 _connection -> assert false + (* TODO H2 is just a separate CF branch for now. *) in let response_promise, received_response = Lwt.wait () in + begin match connection with + | Cleartext _ | SSL _ -> + (* TODO Did not indent the case body; quick and dirty "get it working" + version. *) + (* TODO Do we now want to store the verson? *) let response_handler (httpaf_response : Httpaf.Response.t) @@ -202,7 +231,79 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = in - send (); + send () + + | H2 connection' -> + (* TODO This is a nasty duplicate of the above case, specialized for H2. See + comments above. *) + let response_handler (h2_response : H2.Response.t) h2_response_body = + + Lwt.async begin fun () -> + let%lwt hyper_response = + Dream.stream + ~code:(H2.Status.to_code h2_response.status) + ~headers:(H2.Headers.to_list h2_response.headers) + (fun _response -> Lwt.return ()) + in + Lwt.wakeup_later received_response hyper_response; + + let rec receive () = + H2.Body.schedule_read + h2_response_body + ~on_eof:(fun () -> + Lwt.async (fun () -> + let%lwt () = Dream.close_stream hyper_response in + connection_pool.return + host_key hyper_request hyper_response connection + destroy)) + ~on_read:(fun buffer ~off ~len -> + Lwt.async (fun () -> + let%lwt () = + Dream.write_buffer + ~offset:off ~length:len hyper_response buffer in + Lwt.return (receive ()))) + in + receive (); + + Lwt.return () + end + in + + let h2_request = + H2.Request.create + ~headers:(H2.Headers.of_list (Dream.all_headers hyper_request)) + ~scheme + (H2.Method.of_string (Dream.method_to_string method_)) + path_and_query in + let h2_request_body = + H2_lwt_unix.Client.SSL.request + connection' + h2_request + ~error_handler:(fun _ -> failwith "Protocol error") + ~response_handler in + + let rec send () = + Dream.body_stream hyper_request + |> fun stream -> + Dream.next stream ~data ~close ~flush ~ping ~pong + + and data buffer offset length _binary _fin = + H2.Body.write_bigstring + h2_request_body + ~off:offset + ~len:length + buffer; + send () + + and close _code = H2.Body.close_writer h2_request_body + and flush () = send () + and ping _buffer _offset _length = send () + and pong _buffer _offset _length = send () + + in + + send () + end; response_promise From b178eda5c75a049af3d40ec9591b7f749c76ae9e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 9 Dec 2021 00:13:40 +0300 Subject: [PATCH 055/312] Client: sketch HTTP pipelining and multiplexing --- example/w-client/client.ml | 19 ++- src/hyper.ml | 276 +++++++++++++++++++++++++------------ src/hyper.mli | 24 ++-- 3 files changed, 214 insertions(+), 105 deletions(-) diff --git a/example/w-client/client.ml b/example/w-client/client.ml index b27efe66..ae5b945f 100644 --- a/example/w-client/client.ml +++ b/example/w-client/client.ml @@ -5,9 +5,9 @@ let send () = (* TODO This example is meant for running concurrently with example/w-echo. *) let request = Dream.request - ~method_:`GET - ~target:"https://127.0.0.1:8080" "" - (* ~headers:["Transfer-Encoding", "chunked"] *) + ~method_:`POST + ~target:"http://127.0.0.1:8080/echo" "Good morning, world!" + ~headers:["Transfer-Encoding", "chunked"] in (* TODO Note that this wrapper is not necessary if using, for example, @@ -18,6 +18,10 @@ let send () = (* TODO Add some kind of primitive error handling, both for network errors and for error responses. *) let%lwt response = Hyper.send request in + + (* TODO Janky delay to give time for pipelining to intervene. *) + let%lwt () = Lwt_unix.sleep 5. in + let rec read () = (* TODO Use a higher-level reader once available. *) Dream.next @@ -40,8 +44,13 @@ let () = Printexc.record_backtrace true; Lwt_main.run begin - let%lwt () = send () in - let%lwt () = send () in + let first = send () in + let second = + let%lwt () = Lwt_unix.sleep 1. in + send () + in + let%lwt () = first in + let%lwt () = second in Lwt.return () end diff --git a/src/hyper.ml b/src/hyper.ml index f61ae24d..dbbc9fc6 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -2,7 +2,7 @@ type request = Dream.request type response = Dream.response type 'a promise = 'a Lwt.t -type method_ = Dream.method_ + (* TODO Is this the right representation? *) type connection = @@ -10,7 +10,7 @@ type connection = | SSL of Httpaf_lwt_unix.Client.SSL.t | H2 of H2_lwt_unix.Client.SSL.t (* TODO No h2c support. *) -type host = string * string * int +type endpoint = string * string * int (* TODO But what should a host be? An unresolved hostname:port, or a resolved hostname:port? Hosts probably also need a comparison function or something. And probably a pretty-printing function. These things are entirely @@ -26,48 +26,131 @@ type host = string * string * int protocol, as an https connection might have been upgraded to HTTP/2 or not at the server's discretion during ALPN. *) +(* TODO Implementation of pipelining might make it worthwhile to be able to tell + the client when a request has completed sending (only). However, given + pipelining is buggy and there is HTTP/2, maybe it's not worth complicating + the API for this. *) + +type create_result = { + connection : connection; + destroy : connection -> unit promise; + concurrency : [ `Sequence | `Pipeline | `Multiplex ]; +} +type create = endpoint -> create_result promise + type connection_pool = { - obtain : host -> request -> connection option promise; - return : - host -> request -> response -> connection -> (connection -> unit promise) -> - unit promise; + obtain : endpoint -> request -> create -> (connection * int64) promise; + write_done : int64 -> unit; + all_done : int64 -> response -> unit; + error : int64 -> unit; } (* TODO Return needs to provide a function for destroying a connection. *) -let connection_pool ~obtain ~return = - {obtain; return} - -let _no_pooling = - connection_pool - ~obtain:(fun _host _request -> - Lwt.return_none) - ~return:(fun _host _request _response connection destroy -> - destroy connection) - -(* TODO Non-trivial pools should always be generated, i.e. this should be a - function of at least (). However, we are just doing proof-of-concept code - here, to work out the protocol details, rather than a great connection - pool. Most connection pool should also examine the Connection: header, and - perhaps other headers. *) -let indefinite_keepalive = - let pool = Hashtbl.create 32 in - connection_pool - ~obtain:(fun host _request -> - match Hashtbl.find_opt pool host with - | Some connection -> - Hashtbl.remove pool host; - Lwt.return (Some connection) - | None -> - Lwt.return_none) - ~return:(fun host _request _response connection _destroy -> - Hashtbl.add pool host connection; - Lwt.return_unit) +let connection_pool ~obtain ~write_done ~all_done ~error = + {obtain; write_done; all_done; error} + + + +type pooled_connection = { + create_result : create_result; + id : int64; + created_at : float; + mutable state : [ + | `Writing_request + | `Reading_response_only + | `Idle + ]; + mutable ref_count : int; + mutable idle_since : float; + mutable closing : bool; +} + +(* TODO Add various interesting limits. *) +let general_connection_pool () = + let connections_by_id = Hashtbl.create 32 + and connections_by_endpoint = Hashtbl.create 32 + and next_id = ref 0L in + + let obtain endpoint _request create = + (* TODO There are, in general, multiple connections for each endpoit, so, + properly, the pool would have to either iterate over a list, or have an + acceleration data structure for accessing ready connections by endpoint + directly. *) + (* TODO Must also check whether the connection is closing. However, the + current pool never closes connections (!!!). *) + (* TODO Also should respect connection concurrency. Sequential connections + require the state to be `Idle. Pipeline connections require the state to + be not `Writing_request. Multiplexing connections can be in any state to + be reused. This code is currently hardcoded to do pipelining, which will + conservatively work on HTTP/2 multiplexing, it just won't take advantage + of the full concurrency available. *) + match Hashtbl.find_opt connections_by_endpoint endpoint with + | Some pooled_connection + when pooled_connection.state <> `Writing_request -> + pooled_connection.state <- `Writing_request; + pooled_connection.ref_count <- pooled_connection.ref_count + 1; + let connection = pooled_connection.create_result.connection + and id = pooled_connection.id in + Lwt.return (connection, id) + | _ -> + let%lwt create_result = create endpoint in + let id = !next_id in + next_id := Int64.succ !next_id; + let pooled_connection = { + create_result; + id; + created_at = Unix.time (); + state = `Writing_request; + ref_count = 1; + idle_since = 0.; + closing = false; + } in + Hashtbl.replace connections_by_id pooled_connection.id pooled_connection; + Hashtbl.add connections_by_endpoint endpoint pooled_connection; + Lwt.return (create_result.connection, pooled_connection.id) + + and write_done id = + match Hashtbl.find_opt connections_by_id id with + | None -> + () + | Some pooled_connection -> + pooled_connection.state <- `Reading_response_only + (* TODO In a future version where other writers may be queued, this should + wake up the head writer in the queue. *) + + and all_done id _response = + match Hashtbl.find_opt connections_by_id id with + | None -> + () + | Some pooled_connection -> + pooled_connection.ref_count <- pooled_connection.ref_count - 1; + if pooled_connection.ref_count = 0 then begin + pooled_connection.state <- `Idle; + pooled_connection.idle_since <- Unix.time () + end + + and error = + ignore + (* TODO Definitely not correct - this should put the connection into the + closing state and decrement its ref count. If the connection becomes idle + because of that, it can be closed right away. *) + + in + + connection_pool ~obtain ~write_done ~all_done ~error + + + +let default_connection_pool = + lazy (general_connection_pool ()) + + (* TODO How should the host and port be represented? *) (* TODO Good error handling. *) (* TODO Probably change the default to one per-process pool with some configuration. *) -let send ?(connection_pool = indefinite_keepalive) hyper_request = +let send ?(connection_pool = Lazy.force default_connection_pool) hyper_request = let uri = Uri.of_string (Dream.target hyper_request) in let scheme = Uri.scheme uri |> Option.get and host = Uri.host uri |> Option.get @@ -80,54 +163,6 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = "neat" way - just a debuggable way. The port can be inferred from the scheme if it is missing. We are assuming http:// for now. *) - let host_key = (scheme, host, port) in - - let%lwt connection = - match%lwt connection_pool.obtain host_key hyper_request with - | Some connection -> - Lwt.return connection - | None -> - let%lwt addresses = - Lwt_unix.getaddrinfo - host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in - let address = (List.hd addresses).Unix.ai_addr in - (* TODO Note: this can raise. *) - - let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in - let%lwt () = Lwt_unix.connect socket address in - - match scheme with - | "https" -> - (* TODO The context needs to be created once per process, or a cache - should be used. *) - let context = Ssl.(create_context TLSv1_2 Client_context) in - (* TODO For WebSockets (wss://), the client should probably do SSL - without offering h2 by ALPN. Do any servers implement WebSockets over - HTTP/2? *) - Ssl.set_context_alpn_protos context ["h2"; "http/1.1"]; - let%lwt ssl_socket = Lwt_ssl.ssl_connect socket context in - (* TODO Next line is pretty suspicious. *) - let underlying = Lwt_ssl.ssl_socket ssl_socket |> Option.get in - begin match Ssl.get_negotiated_alpn_protocol underlying with - | Some "h2" -> - (* TODO What about the error handler? *) - let%lwt connection = - H2_lwt_unix.Client.SSL.create_connection - ~error_handler:ignore - ssl_socket - in - Lwt.return (H2 connection) - | _ -> - let%lwt connection = - Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in - Lwt.return (SSL connection) - end - (* TODO Need to do server certificate validation here, etc. *) - | _ -> (* TODO Should be a check for http specifically. *) - let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in - Lwt.return (Cleartext connection) - in - (* TODO These sorts of things can probably be done by passing the client modules in as first-class modules. The code might be not so clear to read, though. *) @@ -138,6 +173,65 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = | H2 connection -> H2_lwt_unix.Client.SSL.shutdown connection in + let create (scheme, host, port) = + let%lwt addresses = + Lwt_unix.getaddrinfo + host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in + let address = (List.hd addresses).Unix.ai_addr in + (* TODO Note: this can raise. *) + + let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + let%lwt () = Lwt_unix.connect socket address in + + match scheme with + | "https" -> + (* TODO The context needs to be created once per process, or a cache + should be used. *) + let context = Ssl.(create_context TLSv1_2 Client_context) in + (* TODO For WebSockets (wss://), the client should probably do SSL + without offering h2 by ALPN. Do any servers implement WebSockets over + HTTP/2? *) + Ssl.set_context_alpn_protos context ["h2"; "http/1.1"]; + let%lwt ssl_socket = Lwt_ssl.ssl_connect socket context in + (* TODO Next line is pretty suspicious. *) + let underlying = Lwt_ssl.ssl_socket ssl_socket |> Option.get in + begin match Ssl.get_negotiated_alpn_protocol underlying with + | Some "h2" -> + (* TODO What about the error handler? *) + let%lwt connection = + H2_lwt_unix.Client.SSL.create_connection + ~error_handler:ignore + ssl_socket + in + Lwt.return { + connection = H2 connection; + destroy; + concurrency = `Multiplex; + } + | _ -> + let%lwt connection = + Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in + Lwt.return { + connection = SSL connection; + destroy; + concurrency = `Pipeline; + } + end + (* TODO Need to do server certificate validation here, etc. *) + | _ -> (* TODO Should be a check for http specifically. *) + let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in + Lwt.return { + connection = Cleartext connection; + destroy; + concurrency = `Pipeline; + } + in + + let endpoint = (scheme, host, port) in + + let%lwt (connection, id) = + connection_pool.obtain endpoint hyper_request create in + let request connection = match connection with | Cleartext connection -> Httpaf_lwt_unix.Client.request connection @@ -180,9 +274,8 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = ~on_eof:(fun () -> Lwt.async (fun () -> let%lwt () = Dream.close_stream hyper_response in - connection_pool.return - host_key hyper_request hyper_response connection - destroy)) + connection_pool.all_done id hyper_response; + Lwt.return_unit)) (* TODO Make sure there is a way for the reader to abort reading the stream and yet still get the socket closed. *) ~on_read:(fun buffer ~off ~len -> @@ -224,7 +317,11 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = buffer; send () - and close _code = Httpaf.Body.Writer.close httpaf_request_body + and close _code = + Httpaf.Body.Writer.close httpaf_request_body; + (* TODO This should only be called if reading is not yet done. *) + connection_pool.write_done id + and flush () = send () and ping _buffer _offset _length = send () and pong _buffer _offset _length = send () @@ -253,9 +350,8 @@ let send ?(connection_pool = indefinite_keepalive) hyper_request = ~on_eof:(fun () -> Lwt.async (fun () -> let%lwt () = Dream.close_stream hyper_response in - connection_pool.return - host_key hyper_request hyper_response connection - destroy)) + connection_pool.all_done id hyper_response; + Lwt.return_unit)) ~on_read:(fun buffer ~off ~len -> Lwt.async (fun () -> let%lwt () = diff --git a/src/hyper.mli b/src/hyper.mli index cbecfcbe..430a194b 100644 --- a/src/hyper.mli +++ b/src/hyper.mli @@ -2,7 +2,7 @@ type request = Dream.request type response = Dream.response type 'a promise = 'a Lwt.t -type method_ = Dream.method_ + type connection_pool @@ -10,16 +10,20 @@ val send : ?connection_pool:connection_pool -> request -> response promise -(* TODO The issue with connections is that they depend on the underlying stack - implementation, which is best kept as abstract as possible. That means the - best way to do this is to make the connection type abstract to users, and to - make all connection setup code internal to Hyper. That means the pool - connection get function that is provided by the user will not create - connections, so it must return options. *) + + type connection -type host +type endpoint +type create_result = { + connection : connection; + destroy : connection -> unit promise; + concurrency : [ `Sequence | `Pipeline | `Multiplex ]; +} +type create = endpoint -> create_result promise val connection_pool : - obtain:(host -> request -> connection option promise) -> - return:(host -> request -> response -> connection -> (connection -> unit promise) -> unit promise) -> + obtain:(endpoint -> request -> create -> (connection * int64) promise) -> + write_done:(int64 -> unit) -> + all_done:(int64 -> response -> unit) -> + error:(int64 -> unit) -> connection_pool From 457258e64ccbb3637c62913f9381def680cb6d4e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 9 Dec 2021 08:26:18 +0300 Subject: [PATCH 056/312] Client: sketch redirect loop --- example/w-client/client.ml | 10 +++--- src/hyper.ml | 63 +++++++++++++++++++++++++++++++++++++- 2 files changed, 67 insertions(+), 6 deletions(-) diff --git a/example/w-client/client.ml b/example/w-client/client.ml index ae5b945f..c51f0b03 100644 --- a/example/w-client/client.ml +++ b/example/w-client/client.ml @@ -5,9 +5,9 @@ let send () = (* TODO This example is meant for running concurrently with example/w-echo. *) let request = Dream.request - ~method_:`POST - ~target:"http://127.0.0.1:8080/echo" "Good morning, world!" - ~headers:["Transfer-Encoding", "chunked"] + ~method_:`GET + ~target:"http://127.0.0.1:8080/abc" "" + (* ~headers:["Transfer-Encoding", "chunked"] *) in (* TODO Note that this wrapper is not necessary if using, for example, @@ -20,7 +20,7 @@ let send () = let%lwt response = Hyper.send request in (* TODO Janky delay to give time for pipelining to intervene. *) - let%lwt () = Lwt_unix.sleep 5. in + (* let%lwt () = Lwt_unix.sleep 5. in *) let rec read () = (* TODO Use a higher-level reader once available. *) @@ -46,7 +46,7 @@ let () = Lwt_main.run begin let first = send () in let second = - let%lwt () = Lwt_unix.sleep 1. in + (* let%lwt () = Lwt_unix.sleep 1. in *) send () in let%lwt () = first in diff --git a/src/hyper.ml b/src/hyper.ml index dbbc9fc6..6674cc2f 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -150,7 +150,7 @@ let default_connection_pool = (* TODO Good error handling. *) (* TODO Probably change the default to one per-process pool with some configuration. *) -let send ?(connection_pool = Lazy.force default_connection_pool) hyper_request = +let send_one_request connection_pool hyper_request = let uri = Uri.of_string (Dream.target hyper_request) in let scheme = Uri.scheme uri |> Option.get and host = Uri.host uri |> Option.get @@ -405,6 +405,67 @@ let send ?(connection_pool = Lazy.force default_connection_pool) hyper_request = +(* TODO Add an option to redirect only to the same host? Or is this better + addressed by just letting the user do redirects manually, if needed? It's + probably best to expose some kind of filter function, because redirect + handling is slightly tricky (with body streams), and the user can benefit by + not having to write code themselves for this. *) +(* TODO Expose a redirect cache callback for permanent redirects. *) +let send ?(connection_pool = Lazy.force default_connection_pool) request = + let rec redirect_loop remaining request = + (* TODO Can save an allocation by binding the promise. *) + let%lwt response = send_one_request connection_pool request in + if remaining <= 0 then + (* TODO Log a warning here if the original redirect limit was not zero. *) + Lwt.return response + else + match Dream.status response with + | `Moved_Permanently + | `Found + | `See_Other + | `Temporary_Redirect + | `Permanent_Redirect -> + begin match Dream.header "Location" response with + | None -> + (* TODO Log a warning here. *) + Lwt.return response + | Some target -> + (* TODO For Moved Permanently, Temporary Redirect, Permanent Redirect, + warn if the server has read the request body, because we won't + easily be able to resend it. *) + (* TODO If requests become mutable, probably a new request should be + explicitly allocated. *) + (* TODO The URI in Location: might be absolute or not. *) + let request : Dream__pure.Inmost.request = + Obj.magic (request : Dream.request) in + let request = + {request with specific = {request.specific with target}} in + let request : Dream.request = + Obj.magic request in + + let request = + match Dream.status response with + | `Found + | `See_Other -> + Dream.with_method_ `GET request + (* TODO Note that doing this for 302 is not correct, but is done + to match established behavior on the Web. *) + (* TODO Should also substitute the body with an empty one here, + and warn if the previous body is not closed (and close it). *) + | _ -> + request + in + + redirect_loop (remaining - 1) request + end + | _ -> + Lwt.return response + in + + redirect_loop 5 request + + + (* TODO Which function should be the most fundamental function? Probably the request -> response runner. But it's probably not the most convenient for general usage. From 38bdb60971a2b67874014fa8e188f4dae8801f63 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 9 Dec 2021 12:17:32 +0300 Subject: [PATCH 057/312] Client: sketch WebSocket client --- example/w-client/client.ml | 11 ++++--- src/dune | 1 + src/http/http.ml | 4 ++- src/hyper.ml | 64 ++++++++++++++++++++++++++++++++++++-- src/hyper.mli | 2 +- src/vendor/dune | 21 +++++++++++++ 6 files changed, 95 insertions(+), 8 deletions(-) diff --git a/example/w-client/client.ml b/example/w-client/client.ml index c51f0b03..eea8088a 100644 --- a/example/w-client/client.ml +++ b/example/w-client/client.ml @@ -6,7 +6,7 @@ let send () = let request = Dream.request ~method_:`GET - ~target:"http://127.0.0.1:8080/abc" "" + ~target:"ws://127.0.0.1:8080/websocket" "" (* ~headers:["Transfer-Encoding", "chunked"] *) in @@ -22,6 +22,8 @@ let send () = (* TODO Janky delay to give time for pipelining to intervene. *) (* let%lwt () = Lwt_unix.sleep 5. in *) + let%lwt () = Dream.write response "Hello?" in + let rec read () = (* TODO Use a higher-level reader once available. *) Dream.next @@ -29,6 +31,7 @@ let send () = ~data:(fun buffer offset length _binary _fin -> Bigstringaf.substring buffer ~off:offset ~len:length |> print_string; + flush stdout; read ()) ~close:(fun _code -> Lwt.wakeup_later notify_done ()) ~flush:read @@ -45,12 +48,12 @@ let () = Lwt_main.run begin let first = send () in - let second = + (* let second = (* let%lwt () = Lwt_unix.sleep 1. in *) send () - in + in *) let%lwt () = first in - let%lwt () = second in + (* let%lwt () = second in *) Lwt.return () end diff --git a/src/dune b/src/dune index 6e79896b..b1f2b371 100644 --- a/src/dune +++ b/src/dune @@ -34,5 +34,6 @@ lwt.unix lwt_ssl ssl + dream.websocketaf-lwt-unix ) (preprocess (pps lwt_ppx))) diff --git a/src/http/http.ml b/src/http/http.ml index f5332eac..410fd158 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -240,7 +240,9 @@ let websocket_handler user's_websocket_handler socket = let close code = if not !closed then begin - closed := true; + (* TODO Really need to work out the "close handshake" and how it is + exposed in the Stream API. *) + (* closed := true; *) Websocketaf.Wsd.close ~code:(`Other code) socket end in diff --git a/src/hyper.ml b/src/hyper.ml index 6674cc2f..1e853a19 100644 --- a/src/hyper.ml +++ b/src/hyper.ml @@ -9,6 +9,13 @@ type connection = | Cleartext of Httpaf_lwt_unix.Client.t | SSL of Httpaf_lwt_unix.Client.SSL.t | H2 of H2_lwt_unix.Client.SSL.t (* TODO No h2c support. *) + | WebSocket of Dream__pure.Stream.stream + (* TODO NOTE WebSocket connections over HTTP/1.1 are currently + single-use. We still go through the pool so as to give it the chance to + refuse the connection based on the number of other connections to the + same endpoint or host. The actual closing of WebSocket connections by the + pool is not yet implemented, so it might try to multiplex them. *) + (* TODO WebSockets over https and WebSockets over HTTP/2. *) type endpoint = string * string * int (* TODO But what should a host be? An unresolved hostname:port, or a resolved @@ -34,7 +41,7 @@ type endpoint = string * string * int type create_result = { connection : connection; destroy : connection -> unit promise; - concurrency : [ `Sequence | `Pipeline | `Multiplex ]; + concurrency : [ `Single_use | `Sequence | `Pipeline | `Multiplex ]; } type create = endpoint -> create_result promise @@ -171,6 +178,7 @@ let send_one_request connection_pool hyper_request = | Cleartext connection -> Httpaf_lwt_unix.Client.shutdown connection | SSL connection -> Httpaf_lwt_unix.Client.SSL.shutdown connection | H2 connection -> H2_lwt_unix.Client.SSL.shutdown connection + | WebSocket stream -> Dream__pure.Stream.close stream 1000; Lwt.return_unit in let create (scheme, host, port) = @@ -218,13 +226,53 @@ let send_one_request connection_pool hyper_request = } end (* TODO Need to do server certificate validation here, etc. *) - | _ -> (* TODO Should be a check for http specifically. *) + + | "http" -> let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in Lwt.return { connection = Cleartext connection; destroy; concurrency = `Pipeline; } + + | "ws" -> + (* TODO The weboscket/af client interface seems pretty awkward to use in + this kind of control flow, since the input handlers need to be defined + immediately. However, the input handlers themselves are ill-conceinved, + since they are a partially push API (i.e. they lack full read flow + control). So hack something together, and await a better API. *) + let stream = ref None in + (* TODO The equality between server and client input handlers is not + exposed in the websocketaf API. *) + let websocket_handler = + Dream__http.Http.websocket_handler (fun the_stream -> + stream := Some the_stream; + Lwt.return_unit) + in + (* TODO Generate random nonces. *) + let%lwt connection = + Websocketaf_lwt_unix.Client.connect + ~nonce:"abcdefghijklmnop" + ~host + ~port + ~resource:path_and_query + ~error_handler:ignore + ~websocket_handler:(Obj.magic websocket_handler) + socket + in + ignore connection; + (* TODO Extremely questionable! The connection should just carry a stream + promise instead, that the handler can wait on later. *) + let%lwt () = Lwt_unix.sleep 1. in + Lwt.return { + connection = WebSocket (Option.get !stream); + destroy; + concurrency = `Single_use; + } + + | _ -> + assert false + (* TODO Need a log and a more intelligent error here. *) in let endpoint = (scheme, host, port) in @@ -238,6 +286,8 @@ let send_one_request connection_pool hyper_request = | SSL connection -> Httpaf_lwt_unix.Client.SSL.request connection | H2 _connection -> assert false (* TODO H2 is just a separate CF branch for now. *) + | WebSocket _stream -> assert false + (* TODO Ditto. *) in let response_promise, received_response = Lwt.wait () in @@ -399,6 +449,16 @@ let send_one_request connection_pool hyper_request = in send () + + | WebSocket websocket -> + let hyper_response = Dream.response "" in + + let hyper_response : Dream__pure.Inmost.response = + Obj.magic (hyper_response : Dream.response) in + let hyper_response = {hyper_response with body = websocket} in + let hyper_response : Dream.response = Obj.magic hyper_response in + + Lwt.wakeup_later received_response hyper_response end; response_promise diff --git a/src/hyper.mli b/src/hyper.mli index 430a194b..747c1b49 100644 --- a/src/hyper.mli +++ b/src/hyper.mli @@ -17,7 +17,7 @@ type endpoint type create_result = { connection : connection; destroy : connection -> unit promise; - concurrency : [ `Sequence | `Pipeline | `Multiplex ]; + concurrency : [ `Single_use | `Sequence | `Pipeline | `Multiplex ]; } type create = endpoint -> create_result promise diff --git a/src/vendor/dune b/src/vendor/dune index 5810080b..9bd5fba3 100644 --- a/src/vendor/dune +++ b/src/vendor/dune @@ -81,6 +81,27 @@ httpaf result))) +(subdir websocketaf/lwt + (library + (name websocketaf_lwt) + (public_name dream.websocketaf-lwt) + (libraries + base64 + digestif.ocaml + dream.gluten-lwt + lwt + dream.websocketaf))) + +(subdir websocketaf/lwt-unix + (library + (name websocketaf_lwt_unix) + (public_name dream.websocketaf-lwt-unix) + (libraries + faraday-lwt-unix + dream.gluten-lwt-unix + lwt.unix + dream.websocketaf-lwt))) + (subdir httpaf/lib From 1e1e7b395826be2b3383713cee59db0b9b4c219d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 14:20:35 +0300 Subject: [PATCH 058/312] Streams: separate read and write ends --- src/http/http.ml | 13 +++- src/pure/inmost.ml | 12 +-- src/pure/stream.ml | 118 +++++++++++++++++------------- src/pure/stream.mli | 30 +++++--- test/expect/pure/stream/stream.ml | 45 +++++++----- 5 files changed, 130 insertions(+), 88 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 410fd158..13b491b1 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -247,8 +247,9 @@ let websocket_handler user's_websocket_handler socket = end in - let websocket = - Stream.stream ~read ~write ~flush ~ping ~pong ~close in + let reader = Stream.reader ~read ~close + and writer = Stream.writer ~write ~flush ~ping ~pong ~close in + let websocket = Stream.stream reader writer in (* TODO Needs error handling like the top-level app has! *) Lwt.async (fun () -> @@ -309,7 +310,9 @@ let wrap_handler let close _code = Httpaf.Body.Reader.close body in let body = - Stream.read_only ~read ~close in + Stream.reader ~read ~close in + let body = + Stream.stream body Stream.no_writer in let request : Dream.request = Dream.request_from_http @@ -452,7 +455,9 @@ let wrap_handler_h2 let close _code = H2.Body.close_reader body in let body = - Stream.read_only ~read ~close in + Stream.reader ~read ~close in + let body = + Stream.stream body Stream.no_writer in let request : Dream.request = Dream.request_from_http diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 3b757d84..58c71a78 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -306,14 +306,16 @@ let next = let with_body body message = let body = if String.length body = 0 then - Stream.empty + (* TODO Should probably preallocate this as a stream. *) + Stream.(stream empty no_writer) else - Stream.string body + Stream.(stream (string body) no_writer) in update {message with body} let with_stream message = - update {message with body = Stream.pipe ()} + let reader, writer = Stream.pipe () in + update {message with body = Stream.stream reader writer} (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It @@ -478,7 +480,7 @@ let request upload = initial_multipart_state (); }; headers; - body = Stream.string body; + body = Stream.(stream (string body) no_writer); locals = Scope.empty; first = request; last = ref request; @@ -505,7 +507,7 @@ let response websocket = None; }; headers; - body = Stream.string body; + body = Stream.(stream (string body) no_writer); locals = Scope.empty; first = response; last = ref response; diff --git a/src/pure/stream.ml b/src/pure/stream.ml index ca382252..9b116b61 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -24,8 +24,12 @@ type write = close:(int -> unit) -> unit -type stream = { +type reader = { read : read; + close : int -> unit; +} + +type writer = { write : buffer -> int -> int -> bool -> bool -> write; flush : write; ping : buffer -> int -> int -> write; @@ -33,36 +37,47 @@ type stream = { close : int -> unit; } -let stream ~read ~write ~flush ~ping ~pong ~close = - { - read; - write; - flush; - ping; - pong; - close; - } +type stream = { + reader : reader; + writer : writer; +} -let read_only ~read ~close = - { - read; - write = - (fun _buffer _offset _length _binary _fin ~ok:_ ~close:_ -> - raise (Failure "write to a read-only stream")); - flush = - (fun ~ok:_ ~close:_ -> - raise (Failure "flush of a read-only stream")); - ping = - (fun _buffer _offset _length ~ok:_ ~close:_ -> - raise (Failure "ping on a read-only stream")); - pong = - (fun _buffer _offset _length ~ok:_ ~close:_ -> - raise (Failure "pong on a read-only stream")); - close; - } +let stream reader writer = + {reader; writer} + +let no_reader = { + read = + (fun ~data:_ ~close:_ ~flush:_ ~ping:_ ~pong:_ -> + raise (Failure "read from a non-readable stream")); + close = + ignore; +} + +let no_writer = { + write = + (fun _buffer _offset _length _binary _fin ~ok:_ ~close:_ -> + raise (Failure "write to a read-only stream")); + flush = + (fun ~ok:_ ~close:_ -> + raise (Failure "flush of a read-only stream")); + ping = + (fun _buffer _offset _length ~ok:_ ~close:_ -> + raise (Failure "ping on a read-only stream")); + pong = + (fun _buffer _offset _length ~ok:_ ~close:_ -> + raise (Failure "pong on a read-only stream")); + close = + ignore; +} + +let reader ~read ~close = + {read; close} + +let writer ~write ~flush ~ping ~pong ~close = + {write; flush; ping; pong; close} let empty = - read_only + reader ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close 1000) ~close:ignore @@ -91,36 +106,27 @@ let string the_string = string_ref := None; in - read_only ~read ~close + reader ~read ~close end -let duplex ~read ~write ~close = - { - read = read.read; - write = write.write; - flush = write.flush; - ping = write.ping; - pong = write.pong; - close; - } - let read stream ~data ~close ~flush = - stream.read ~data ~close ~flush + stream.reader.read ~data ~close ~flush let close stream code = - stream.close code + stream.reader.close code; + stream.writer.close code let write stream buffer offset length binary fin ~ok ~close = - stream.write buffer offset length binary fin ~ok ~close + stream.writer.write buffer offset length binary fin ~ok ~close let flush stream ~ok ~close = - stream.flush ~ok ~close + stream.writer.flush ~ok ~close let ping stream buffer offset length ~ok ~close = - stream.ping buffer offset length ~ok ~close + stream.writer.ping buffer offset length ~ok ~close let pong stream buffer offset length ~ok ~close = - stream.pong buffer offset length ~ok ~close + stream.writer.pong buffer offset length ~ok ~close type pipe = { mutable state : [ @@ -330,13 +336,25 @@ let pipe () = close code in - {read; write; flush; close; ping; pong} + let reader = { + read; + close; + } + and writer = { + write; + flush; + ping; + pong; + close; + } in + + (reader, writer) let read_convenience stream = let promise, resolver = Lwt.wait () in let rec loop () = - stream.read + stream.reader.read ~data:(fun buffer offset length _binary _fin -> Bigstringaf.sub buffer ~off:offset ~len:length |> Bigstringaf.to_string @@ -349,7 +367,7 @@ let read_convenience stream = ~flush:loop ~ping:(fun buffer offset length -> - stream.pong + stream.writer.pong buffer offset length ~ok:loop ~close:(fun _code -> @@ -373,7 +391,7 @@ let read_until_close stream = in let rec loop () = - stream.read + stream.reader.read ~data:(fun chunk offset chunk_length _binary _fin -> let new_length = !length + chunk_length in @@ -395,7 +413,7 @@ let read_until_close stream = ~flush:loop ~ping:(fun buffer offset length -> - stream.pong buffer offset length ~ok:loop ~close) + stream.writer.pong buffer offset length ~ok:loop ~close) ~pong:(fun _buffer _offset _length -> ()) diff --git a/src/pure/stream.mli b/src/pure/stream.mli index e89165e8..da070498 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -13,6 +13,10 @@ type 'a promise = 'a Lwt.t (** Type abbreviation for promises. *) +type reader + +type writer + type stream (** This module's principal type, the {e stream}. @@ -64,37 +68,39 @@ type write = (** A writing function. Pushes an event into a stream. May take additional arguments before [~ok]. *) -val read_only : read:read -> close:(int -> unit) -> stream +val reader : read:read -> close:(int -> unit) -> reader (** Creates a read-only stream from the given reader. [~close] is called in response to {!Stream.close}. It doesn't need to call {!Stream.close} again on the stream. It should be used to free any underlying resources. *) -val empty : stream +val empty : reader (** A read-only stream whose reading function always calls its [~close] callback. *) -val string : string -> stream +val string : string -> reader (** A read-only stream which calls its [~data] callback once with the contents of the given string, and then always calls [~close]. *) -val pipe : unit -> stream +val pipe : unit -> reader * writer (** A stream which matches each call of the reading function to one call of its writing functions. For example, calling {!Stream.flush} on a pipe will cause the reader to call its [~flush] callback. *) -val duplex : read:stream -> write:stream -> close:(int -> unit) -> stream -(** A stream whose reading functions behave like [~read], and whose writing - functions behave like [~write]. *) - -val stream : - read:read -> +val writer : write:(buffer -> int -> int -> bool -> bool -> write) -> flush:write -> ping:(buffer -> int -> int -> write) -> pong:(buffer -> int -> int -> write) -> close:(int -> unit) -> - stream -(** A general stream. *) + writer + +val no_reader : reader + +val no_writer : writer + +val stream : reader -> writer -> stream +(* TODO Consider tupling the arguments, as that will make it easier to pass the + result of Stream.pipe. *) val close : stream -> int -> unit (** Closes the given stream. Causes a pending reader or writer to call its diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 0d042864..01db9a44 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -60,7 +60,7 @@ let pong_and_dump payload stream = (* Read-only streams. *) let%expect_test _ = - let stream = Stream.empty in + let stream = Stream.(stream empty no_writer) in read_and_dump stream; read_and_dump stream; Stream.close stream 1005; @@ -71,13 +71,13 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.empty in + let stream = Stream.(stream empty no_writer) in Stream.close stream 1005; read_and_dump stream; [%expect {| read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.string "foo" in + let stream = Stream.(stream (string "foo") no_writer) in read_and_dump stream; read_and_dump stream; read_and_dump stream; @@ -90,7 +90,7 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.string "" in + let stream = Stream.(stream (string "") no_writer) in read_and_dump stream; read_and_dump stream; [%expect {| @@ -98,13 +98,13 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.string "foo" in + let stream = Stream.(stream (string "foo") no_writer) in Stream.close stream 1005; read_and_dump stream; [%expect {| read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.empty in + let stream = Stream.(stream empty no_writer) in (try write_and_dump stream Bigstringaf.empty 0 0 false false with Failure _ as exn -> print_endline (Printexc.to_string exn)); (try flush_and_dump stream @@ -124,7 +124,8 @@ let%expect_test _ = (* Pipe: double read. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; try read_and_dump stream with Failure _ as exn -> print_endline (Printexc.to_string exn); @@ -135,7 +136,8 @@ let%expect_test _ = (* Pipe: interactions between read and close. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; print_endline "checkpoint 1"; Stream.close stream 1005; @@ -151,7 +153,8 @@ let%expect_test _ = checkpoint 3 |}] let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in Stream.close stream 1005; read_and_dump stream; read_and_dump stream; @@ -164,7 +167,8 @@ let%expect_test _ = (* Pipe: interactions between read and flush. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; print_endline "checkpoint 1"; flush_and_dump stream; @@ -191,7 +195,8 @@ let buffer = Bigstringaf.of_string ~off:0 ~len:3 "foo" let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; print_endline "checkpoint 1"; write_and_dump stream buffer 0 3 false true; @@ -215,7 +220,8 @@ let%expect_test _ = (* Pipe: interactions between read and ping. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; print_endline "checkpoint 1"; ping_and_dump "foo" stream; @@ -239,7 +245,8 @@ let%expect_test _ = (* Pipe: interactions between read and pong. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in read_and_dump stream; print_endline "checkpoint 1"; pong_and_dump "foo" stream; @@ -263,7 +270,8 @@ let%expect_test _ = (* Pipe: interactions between flush and close. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in flush_and_dump stream; Stream.close stream 1005; flush_and_dump stream; @@ -276,7 +284,8 @@ let%expect_test _ = (* Pipe: interactions between write and close. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in write_and_dump stream buffer 0 3 true true; Stream.close stream 1005; write_and_dump stream buffer 0 3 true false; @@ -289,7 +298,8 @@ let%expect_test _ = (* Pipe: interactions between ping and close. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in ping_and_dump "foo" stream; Stream.close stream 1005; ping_and_dump "bar" stream; @@ -302,7 +312,8 @@ let%expect_test _ = (* Pipe: interactions between pong and close. *) let%expect_test _ = - let stream = Stream.pipe () in + let reader, writer = Stream.pipe () in + let stream = Stream.stream reader writer in pong_and_dump "foo" stream; Stream.close stream 1005; pong_and_dump "bar" stream; From faf81b4c2a86df2886c5581971d555a5332a618c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 15:03:57 +0300 Subject: [PATCH 059/312] Streams: don't buffer even one write --- src/http/http.ml | 16 +++- src/pure/stream.ml | 142 ++++++++++-------------------- src/pure/stream.mli | 3 + test/expect/pure/stream/stream.ml | 56 ++++-------- 4 files changed, 80 insertions(+), 137 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 13b491b1..0ab7cfcd 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -180,6 +180,20 @@ let websocket_handler user's_websocket_handler socket = let bytes_since_flush = ref 0 in + (* TODO Not a correct implementation. Need to test moving the flush logic + from [write] to [ready], essentially. Alternatively, can use a pipe and its + logic for turning a writer into a reader. The memory impact is probably the + same. However, this is best done after the duplex stream clarification + commit, since that will change which streams do what in responses. It will + probably force usage of pipes anyway, so that will make piggy-backing on + pipes the natural solution. *) + let ready ~ok ~close = + if !closed then + close !close_code + else + ok () + in + let flush ~ok ~close = bytes_since_flush := 0; if !closed then @@ -248,7 +262,7 @@ let websocket_handler user's_websocket_handler socket = in let reader = Stream.reader ~read ~close - and writer = Stream.writer ~write ~flush ~ping ~pong ~close in + and writer = Stream.writer ~ready ~write ~flush ~ping ~pong ~close in let websocket = Stream.stream reader writer in (* TODO Needs error handling like the top-level app has! *) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 9b116b61..eb501bad 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -30,6 +30,7 @@ type reader = { } type writer = { + ready : write; write : buffer -> int -> int -> bool -> bool -> write; flush : write; ping : buffer -> int -> int -> write; @@ -54,6 +55,9 @@ let no_reader = { } let no_writer = { + ready = + (fun ~ok:_ ~close:_ -> + raise (Failure "ready called on a read-only stream")); write = (fun _buffer _offset _length _binary _fin ~ok:_ ~close:_ -> raise (Failure "write to a read-only stream")); @@ -73,8 +77,8 @@ let no_writer = { let reader ~read ~close = {read; close} -let writer ~write ~flush ~ping ~pong ~close = - {write; flush; ping; pong; close} +let writer ~ready ~write ~flush ~ping ~pong ~close = + {ready; write; flush; ping; pong; close} let empty = reader @@ -116,6 +120,10 @@ let close stream code = stream.reader.close code; stream.writer.close code +(* TODO Test this somehow with guards for early writing on a pipe. *) +let ready stream ~ok ~close = + stream.writer.ready ~ok ~close + let write stream buffer offset length binary fin ~ok ~close = stream.writer.write buffer offset length binary fin ~ok ~close @@ -132,7 +140,6 @@ type pipe = { mutable state : [ | `Idle | `Reader_waiting - | `Writer_waiting | `Closed of int ]; @@ -142,24 +149,10 @@ type pipe = { mutable read_ping_callback : buffer -> int -> int -> unit; mutable read_pong_callback : buffer -> int -> int -> unit; - mutable write_kind : [ - | `Data - | `Flush - | `Ping - | `Pong - ]; - mutable write_buffer : buffer; - mutable write_offset : int; - mutable write_length : int; - mutable write_binary : bool; - mutable write_fin : bool; mutable write_ok_callback : unit -> unit; mutable write_close_callback : int -> unit; } -let dummy_buffer = - Bigstringaf.create 0 - let dummy_read_data_callback _buffer _offset _length _binary _fin = () [@coverage off] @@ -174,7 +167,6 @@ let clean_up_reader_fields pipe = pipe.read_pong_callback <- dummy_ping_pong_callback let clean_up_writer_fields pipe = - pipe.write_buffer <- dummy_buffer; pipe.write_ok_callback <- ignore; pipe.write_close_callback <- ignore @@ -188,12 +180,6 @@ let pipe () = read_ping_callback = dummy_ping_pong_callback; read_pong_callback = dummy_ping_pong_callback; - write_kind = `Data; - write_buffer = dummy_buffer; - write_offset = 0; - write_length = 0; - write_binary = true; - write_fin = false; write_ok_callback = ignore; write_close_callback = ignore; } in @@ -207,50 +193,37 @@ let pipe () = internal.read_flush_callback <- flush; internal.read_ping_callback <- ping; internal.read_pong_callback <- pong; - | `Reader_waiting -> - raise (Failure "stream read: the previous read has not completed") - | `Writer_waiting -> - internal.state <- `Idle; let write_ok_callback = internal.write_ok_callback in - let buffer = internal.write_buffer in clean_up_writer_fields internal; - begin match internal.write_kind with - | `Data -> - data - buffer - internal.write_offset - internal.write_length - internal.write_binary - internal.write_fin - | `Flush -> flush () - | `Ping -> ping buffer internal.write_offset internal.write_length - | `Pong -> pong buffer internal.write_offset internal.write_length - end; write_ok_callback () + | `Reader_waiting -> + raise (Failure "stream read: the previous read has not completed") | `Closed code -> close code in - let write buffer offset length binary fin ~ok ~close = + let ready ~ok ~close = match internal.state with | `Idle -> - internal.state <- `Writer_waiting; - internal.write_kind <- `Data; - internal.write_buffer <- buffer; - internal.write_offset <- offset; - internal.write_length <- length; - internal.write_binary <- binary; - internal.write_fin <- fin; internal.write_ok_callback <- ok; internal.write_close_callback <- close + | `Reader_waiting -> + ok () + | `Closed code -> + close code + in + + let write buffer offset length binary fin ~ok ~close = + match internal.state with + | `Idle -> + raise (Failure "stream write: the stream is not ready") | `Reader_waiting -> internal.state <- `Idle; let read_data_callback = internal.read_data_callback in clean_up_reader_fields internal; + internal.write_ok_callback <- ok; + internal.write_close_callback <- close; read_data_callback buffer offset length binary fin; - ok () - | `Writer_waiting -> - raise (Failure "stream write: the previous write has not completed") | `Closed code -> close code in @@ -258,17 +231,15 @@ let pipe () = let close code = match internal.state with | `Idle -> - internal.state <- `Closed code + internal.state <- `Closed code; + let write_close_callback = internal.write_close_callback in + clean_up_writer_fields internal; + write_close_callback code | `Reader_waiting -> internal.state <- `Closed code; let read_close_callback = internal.read_close_callback in clean_up_reader_fields internal; read_close_callback code - | `Writer_waiting -> - internal.state <- `Closed code; - let write_close_callback = internal.write_close_callback in - clean_up_writer_fields internal; - write_close_callback code | `Closed _code -> () in @@ -276,18 +247,14 @@ let pipe () = let flush ~ok ~close = match internal.state with | `Idle -> - internal.state <- `Writer_waiting; - internal.write_kind <- `Flush; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close + raise (Failure "stream flush: the previous write has not completed") | `Reader_waiting -> internal.state <- `Idle; let read_flush_callback = internal.read_flush_callback in clean_up_reader_fields internal; - read_flush_callback (); - ok () - | `Writer_waiting -> - raise (Failure "stream flush: the previous write has not completed") + internal.write_ok_callback <- ok; + internal.write_close_callback <- close; + read_flush_callback () | `Closed code -> close code in @@ -295,21 +262,14 @@ let pipe () = let ping buffer offset length ~ok ~close = match internal.state with | `Idle -> - internal.state <- `Writer_waiting; - internal.write_kind <- `Ping; - internal.write_buffer <- buffer; - internal.write_offset <- offset; - internal.write_length <- length; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close + raise (Failure "stream ping: the previous write has not completed") | `Reader_waiting -> internal.state <- `Idle; let read_ping_callback = internal.read_ping_callback in clean_up_reader_fields internal; - read_ping_callback buffer offset length; - ok () - | `Writer_waiting -> - raise (Failure "stream ping: the previous write has not completed") + internal.write_ok_callback <- ok; + internal.write_close_callback <- close; + read_ping_callback buffer offset length | `Closed code -> close code in @@ -317,21 +277,14 @@ let pipe () = let pong buffer offset length ~ok ~close = match internal.state with | `Idle -> - internal.state <- `Writer_waiting; - internal.write_kind <- `Pong; - internal.write_buffer <- buffer; - internal.write_offset <- offset; - internal.write_length <- length; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close + raise (Failure "stream pong: the previous write has not completed") | `Reader_waiting -> internal.state <- `Idle; let read_pong_callback = internal.read_pong_callback in clean_up_reader_fields internal; - read_pong_callback buffer offset length; - ok () - | `Writer_waiting -> - raise (Failure "stream pong: the previous write has not completed") + internal.write_ok_callback <- ok; + internal.write_close_callback <- close; + read_pong_callback buffer offset length | `Closed code -> close code in @@ -341,6 +294,7 @@ let pipe () = close; } and writer = { + ready; write; flush; ping; @@ -352,6 +306,7 @@ let pipe () = let read_convenience stream = let promise, resolver = Lwt.wait () in + let close _code = Lwt.wakeup_later resolver None in let rec loop () = stream.reader.read @@ -361,17 +316,12 @@ let read_convenience stream = |> Option.some |> Lwt.wakeup_later resolver) - ~close:(fun _code -> - Lwt.wakeup_later resolver None) + ~close ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong - buffer offset length - ~ok:loop - ~close:(fun _code -> - Lwt.wakeup_later resolver None)) + stream.writer.pong ~close buffer offset length ~ok:loop) ~pong:(fun _buffer _offset _length -> ()) @@ -413,7 +363,7 @@ let read_until_close stream = ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong buffer offset length ~ok:loop ~close) + stream.writer.pong buffer offset length ~close ~ok:loop) ~pong:(fun _buffer _offset _length -> ()) diff --git a/src/pure/stream.mli b/src/pure/stream.mli index da070498..870542e5 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -87,6 +87,7 @@ val pipe : unit -> reader * writer the reader to call its [~flush] callback. *) val writer : + ready:write -> write:(buffer -> int -> int -> bool -> bool -> write) -> flush:write -> ping:(buffer -> int -> int -> write) -> @@ -118,6 +119,8 @@ val read_until_close : stream -> string promise (** Reads a stream completely until [~close], and accumulates the data into a string. *) +val ready : stream -> write + val write : stream -> buffer -> int -> int -> bool -> bool -> write (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 01db9a44..e1a8215d 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -172,20 +172,16 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; flush_and_dump stream; - flush_and_dump stream; - print_endline "checkpoint 2"; + (try flush_and_dump stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); read_and_dump stream; flush_and_dump stream; - try flush_and_dump stream - with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 read: flush + (Failure "stream flush: the previous write has not completed") flush: ok - checkpoint 2 - read: flush - flush: ok - (Failure "stream flush: the previous write has not completed") |}] + read: flush |}] @@ -200,20 +196,16 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; write_and_dump stream buffer 0 3 false true; - write_and_dump stream buffer 1 1 true false; - print_endline "checkpoint 2"; + (try write_and_dump stream buffer 1 1 true false + with Failure _ as exn -> print_endline (Printexc.to_string exn)); read_and_dump stream; write_and_dump stream buffer 0 3 true true; - try write_and_dump stream buffer 0 3 false false - with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 read: data: BINARY=false FIN=true foo + (Failure "stream write: the stream is not ready") write: ok - checkpoint 2 - read: data: BINARY=true FIN=false o - write: ok - (Failure "stream write: the previous write has not completed") |}] + read: data: BINARY=true FIN=true foo |}] @@ -225,20 +217,16 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; ping_and_dump "foo" stream; - ping_and_dump "bar" stream; - print_endline "checkpoint 2"; + (try ping_and_dump "bar" stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); read_and_dump stream; ping_and_dump "baz" stream; - try ping_and_dump "quux" stream - with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 read: ping: foo + (Failure "stream ping: the previous write has not completed") ping: ok - checkpoint 2 - read: ping: bar - ping: ok - (Failure "stream ping: the previous write has not completed") |}] + read: ping: baz |}] @@ -250,20 +238,16 @@ let%expect_test _ = read_and_dump stream; print_endline "checkpoint 1"; pong_and_dump "foo" stream; - pong_and_dump "bar" stream; - print_endline "checkpoint 2"; + (try pong_and_dump "bar" stream + with Failure _ as exn -> print_endline (Printexc.to_string exn)); read_and_dump stream; pong_and_dump "baz" stream; - try pong_and_dump "quux" stream - with Failure _ as exn -> print_endline (Printexc.to_string exn); [%expect {| checkpoint 1 read: pong: foo + (Failure "stream pong: the previous write has not completed") pong: ok - checkpoint 2 - read: pong: bar - pong: ok - (Failure "stream pong: the previous write has not completed") |}] + read: pong: baz |}] @@ -272,11 +256,9 @@ let%expect_test _ = let%expect_test _ = let reader, writer = Stream.pipe () in let stream = Stream.stream reader writer in - flush_and_dump stream; Stream.close stream 1005; flush_and_dump stream; [%expect {| - flush: close: CODE=1005 flush: close: CODE=1005 |}] @@ -286,11 +268,9 @@ let%expect_test _ = let%expect_test _ = let reader, writer = Stream.pipe () in let stream = Stream.stream reader writer in - write_and_dump stream buffer 0 3 true true; Stream.close stream 1005; write_and_dump stream buffer 0 3 true false; [%expect {| - write: close: CODE=1005 write: close: CODE=1005 |}] @@ -300,11 +280,9 @@ let%expect_test _ = let%expect_test _ = let reader, writer = Stream.pipe () in let stream = Stream.stream reader writer in - ping_and_dump "foo" stream; Stream.close stream 1005; ping_and_dump "bar" stream; [%expect {| - ping: close: CODE=1005 ping: close: CODE=1005 |}] @@ -314,9 +292,7 @@ let%expect_test _ = let%expect_test _ = let reader, writer = Stream.pipe () in let stream = Stream.stream reader writer in - pong_and_dump "foo" stream; Stream.close stream 1005; pong_and_dump "bar" stream; [%expect {| - pong: close: CODE=1005 pong: close: CODE=1005 |}] From 4afbe1904619daaae1f992d6bceb1e4f17c571f2 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 16:20:43 +0300 Subject: [PATCH 060/312] Streams: tweak writer continuation order, labels --- src/http/http.ml | 13 +++++---- src/pure/inmost.ml | 16 +++++------ src/pure/stream.ml | 46 +++++++++++++++---------------- src/pure/stream.mli | 2 +- test/expect/pure/stream/stream.ml | 16 +++++------ 5 files changed, 47 insertions(+), 46 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 0ab7cfcd..092342c3 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -187,14 +187,15 @@ let websocket_handler user's_websocket_handler socket = commit, since that will change which streams do what in responses. It will probably force usage of pipes anyway, so that will make piggy-backing on pipes the natural solution. *) - let ready ~ok ~close = + (* TODO Can probably also remove val Stream.writer at that point. *) + let ready ~close ok = if !closed then close !close_code else ok () in - let flush ~ok ~close = + let flush ~close ok = bytes_since_flush := 0; if !closed then close !close_code @@ -202,7 +203,7 @@ let websocket_handler user's_websocket_handler socket = Websocketaf.Wsd.flushed socket ok in - let write buffer offset length binary fin ~ok ~close = + let write buffer offset length binary fin ~close ok = (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) if not fin then websocket_log.error (fun log -> @@ -214,13 +215,13 @@ let websocket_handler user's_websocket_handler socket = Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; bytes_since_flush := !bytes_since_flush + length; if !bytes_since_flush >= 4096 then - flush ~ok ~close + flush ~close ok else ok () end in - let ping _buffer _offset length ~ok ~close = + let ping _buffer _offset length ~close ok = if length > 125 then raise (Failure "Ping payload cannot exceed 125 bytes"); (* See https://github.com/anmonteiro/websocketaf/issues/36. *) @@ -235,7 +236,7 @@ let websocket_handler user's_websocket_handler socket = end in - let pong _buffer _offset length ~ok ~close = + let pong _buffer _offset length ~close ok = (* TODO Is there any way for the peer to send a ping payload with more than 125 bytes, forcing a too-large pong and an exception? *) if length > 125 then diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 58c71a78..9705de59 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -329,8 +329,8 @@ let write message chunk = Stream.write message.body buffer 0 length true false - ~ok:(Lwt.wakeup_later resolver) - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later resolver); promise let write_buffer ?(offset = 0) ?length message chunk = @@ -346,8 +346,8 @@ let write_buffer ?(offset = 0) ?length message chunk = Stream.write message.body chunk offset length true false - ~ok:(Lwt.wakeup_later resolver) - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later resolver); promise (* TODO How are remote closes actually handled? There is no way for http/af to @@ -356,8 +356,8 @@ let flush message = let promise, resolver = Lwt.wait () in Stream.flush message.body - ~ok:(Lwt.wakeup_later resolver) - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later resolver); promise let close_stream message = @@ -576,8 +576,8 @@ let send ?kind websocket message = websocket (Bigstringaf.of_string ~off:0 ~len:length message) 0 length binary true - ~ok:(Lwt.wakeup_later resolver) - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file); + ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + (Lwt.wakeup_later resolver); (* TODO The API will likely have to change to report closing. *) promise diff --git a/src/pure/stream.ml b/src/pure/stream.ml index eb501bad..ee76347a 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -20,8 +20,8 @@ type read = unit type write = - ok:(unit -> unit) -> close:(int -> unit) -> + (unit -> unit) -> unit type reader = { @@ -56,19 +56,19 @@ let no_reader = { let no_writer = { ready = - (fun ~ok:_ ~close:_ -> + (fun ~close:_ _ok -> raise (Failure "ready called on a read-only stream")); write = - (fun _buffer _offset _length _binary _fin ~ok:_ ~close:_ -> + (fun _buffer _offset _length _binary _fin ~close:_ _ok -> raise (Failure "write to a read-only stream")); flush = - (fun ~ok:_ ~close:_ -> + (fun ~close:_ _ok -> raise (Failure "flush of a read-only stream")); ping = - (fun _buffer _offset _length ~ok:_ ~close:_ -> + (fun _buffer _offset _length ~close:_ _ok -> raise (Failure "ping on a read-only stream")); pong = - (fun _buffer _offset _length ~ok:_ ~close:_ -> + (fun _buffer _offset _length ~close:_ _ok -> raise (Failure "pong on a read-only stream")); close = ignore; @@ -121,20 +121,20 @@ let close stream code = stream.writer.close code (* TODO Test this somehow with guards for early writing on a pipe. *) -let ready stream ~ok ~close = - stream.writer.ready ~ok ~close +let ready stream ~close ok = + stream.writer.ready ~close ok -let write stream buffer offset length binary fin ~ok ~close = - stream.writer.write buffer offset length binary fin ~ok ~close +let write stream buffer offset length binary fin ~close ok = + stream.writer.write buffer offset length binary fin ~close ok -let flush stream ~ok ~close = - stream.writer.flush ~ok ~close +let flush stream ~close ok = + stream.writer.flush ~close ok -let ping stream buffer offset length ~ok ~close = - stream.writer.ping buffer offset length ~ok ~close +let ping stream buffer offset length ~close ok = + stream.writer.ping buffer offset length ~close ok -let pong stream buffer offset length ~ok ~close = - stream.writer.pong buffer offset length ~ok ~close +let pong stream buffer offset length ~close ok = + stream.writer.pong buffer offset length ~close ok type pipe = { mutable state : [ @@ -202,7 +202,7 @@ let pipe () = close code in - let ready ~ok ~close = + let ready ~close ok = match internal.state with | `Idle -> internal.write_ok_callback <- ok; @@ -213,7 +213,7 @@ let pipe () = close code in - let write buffer offset length binary fin ~ok ~close = + let write buffer offset length binary fin ~close ok = match internal.state with | `Idle -> raise (Failure "stream write: the stream is not ready") @@ -244,7 +244,7 @@ let pipe () = () in - let flush ~ok ~close = + let flush ~close ok = match internal.state with | `Idle -> raise (Failure "stream flush: the previous write has not completed") @@ -259,7 +259,7 @@ let pipe () = close code in - let ping buffer offset length ~ok ~close = + let ping buffer offset length ~close ok = match internal.state with | `Idle -> raise (Failure "stream ping: the previous write has not completed") @@ -274,7 +274,7 @@ let pipe () = close code in - let pong buffer offset length ~ok ~close = + let pong buffer offset length ~close ok = match internal.state with | `Idle -> raise (Failure "stream pong: the previous write has not completed") @@ -321,7 +321,7 @@ let read_convenience stream = ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong ~close buffer offset length ~ok:loop) + stream.writer.pong buffer offset length ~close loop) ~pong:(fun _buffer _offset _length -> ()) @@ -363,7 +363,7 @@ let read_until_close stream = ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong buffer offset length ~close ~ok:loop) + stream.writer.pong buffer offset length ~close loop) ~pong:(fun _buffer _offset _length -> ()) diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 870542e5..23278e11 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -62,8 +62,8 @@ type read = to which event occurs next on the stream. *) type write = - ok:(unit -> unit) -> close:(int -> unit) -> + (unit -> unit) -> unit (** A writing function. Pushes an event into a stream. May take additional arguments before [~ok]. *) diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index e1a8215d..edd1f877 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -27,33 +27,33 @@ let read_and_dump stream = let flush_and_dump stream = Stream.flush stream - ~ok:(fun () -> - print_endline "flush: ok") ~close:(fun code -> Printf.printf "flush: close: CODE=%i\n" code) + (fun () -> + print_endline "flush: ok") let write_and_dump stream buffer offset length binary fin = Stream.write stream buffer offset length binary fin - ~ok:(fun () -> - print_endline "write: ok") ~close:(fun code -> Printf.printf "write: close: CODE=%i\n" code) + (fun () -> + print_endline "write: ok") let ping_and_dump payload stream = let length = String.length payload in Stream.ping stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length - ~ok:(fun () -> - print_endline "ping: ok") ~close:(fun code -> Printf.printf "ping: close: CODE=%i\n" code) + (fun () -> + print_endline "ping: ok") let pong_and_dump payload stream = let length = String.length payload in Stream.pong stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length - ~ok:(fun () -> - print_endline "pong: ok") ~close:(fun code -> Printf.printf "pong: close: CODE=%i\n" code) + (fun () -> + print_endline "pong: ok") From f69b95644a237be0aa3c9d3c6e29a7be32a5dbdb Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 17:13:46 +0300 Subject: [PATCH 061/312] Streams: split into client and server streams --- src/http/adapt.ml | 2 +- src/http/http.ml | 7 +++++++ src/pure/inmost.ml | 50 ++++++++++++++++++++++++++++++++++------------ 3 files changed, 45 insertions(+), 14 deletions(-) diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 372d5860..bda3685a 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -29,7 +29,7 @@ let forward_body_general let bytes_since_flush = ref 0 in let rec send () = - Dream.body_stream response + Dream.client_stream response |> fun stream -> Stream.read stream diff --git a/src/http/http.ml b/src/http/http.ml index 092342c3..8f4812e8 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -265,6 +265,13 @@ let websocket_handler user's_websocket_handler socket = let reader = Stream.reader ~read ~close and writer = Stream.writer ~ready ~write ~flush ~ping ~pong ~close in let websocket = Stream.stream reader writer in + (* TODO Change WebSockets to use two pipes in the response body, rather than + a weird stream hanging out in the heap. That way, a client and server can + immediately communicate with each other if they are in process, without the + need to interpet the WebSocket response with an HTTP layer. This will also + simplify the WebSocket writing code, as this HTTP adapter code will read + from a pipe rather than implement a writer from scratch. At that point, + Stream.writer can be removed from stream.mli. *) (* TODO Needs error handling like the top-level app has! *) Lwt.async (fun () -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 9705de59..7ca53e6d 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -45,7 +45,8 @@ and response = outgoing message and 'a message = { specific : 'a; headers : (string * string) list; - body : Stream.stream; + client_stream : Stream.stream; + server_stream : Stream.stream; locals : Scope.t; first : 'a message; last : 'a message ref; @@ -284,14 +285,20 @@ let cookie name request = try Some (cookie_exn name request) with Not_found -> None *) +(* TODO NOTE On the client, this will read the client stream until close. *) let body message = - Stream.read_until_close message.body + Stream.read_until_close message.server_stream let read message = - Stream.read_convenience message.body + Stream.read_convenience message.server_stream let body_stream message = - message.body + message.server_stream + +(* TODO Temporary internal function so that the HTTP layer can read response + streams. *) +let client_stream message = + message.client_stream (* TODO Pending the dream.mli interface reorganization for the new stream API. *) @@ -303,7 +310,16 @@ let next = are setting a new body. Indeed, there might be a concurrent read going on. That read should not override the new body. So let it mutate the old request's ref; we generate a new request with a new body ref. *) +(* TODO NOTE In Dream, this should operate on response server_streams. In Hyper, + it should operate on request client_streams, although there is no very good + reason why it can't operate on general messages, which might be useful in + middlewares that preprocess requests on the server and postprocess responses + on the client. Or.... shouldn't this affect the client stream on the server, + replacing its read end? *) let with_body body message = + (* TODO This is partially redundant with a length check in Stream.string, but + that check is no longer useful as it prevents allocation of only a reader, + rather than a complete stream. *) let body = if String.length body = 0 then (* TODO Should probably preallocate this as a stream. *) @@ -311,11 +327,15 @@ let with_body body message = else Stream.(stream (string body) no_writer) in - update {message with body} + update {message with server_stream = body} +(* TODO The critical piece: the pipe should be split between the client and + server streams. adapt.ml should be reading from the client stream. *) let with_stream message = let reader, writer = Stream.pipe () in - update {message with body = Stream.stream reader writer} + let client_stream = Stream.stream reader Stream.no_writer in + let server_stream = Stream.stream Stream.no_reader writer in + update {message with client_stream; server_stream} (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It @@ -327,7 +347,7 @@ let write message chunk = let buffer = Bigstringaf.of_string ~off:0 ~len:length chunk in (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write - message.body + message.server_stream buffer 0 length true false ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) (Lwt.wakeup_later resolver); @@ -344,7 +364,7 @@ let write_buffer ?(offset = 0) ?length message chunk = (* TODO As above, properly expose FIN. *) (* TODO Also expose binary/text. *) Stream.write - message.body + message.server_stream chunk offset length true false ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) (Lwt.wakeup_later resolver); @@ -355,13 +375,13 @@ let write_buffer ?(offset = 0) ?length message chunk = let flush message = let promise, resolver = Lwt.wait () in Stream.flush - message.body + message.server_stream ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) (Lwt.wakeup_later resolver); promise let close_stream message = - Stream.close message.body 1000; + Stream.close message.server_stream 1000; Lwt.return_unit (* TODO Rename. *) @@ -439,7 +459,8 @@ let request_from_http upload = initial_multipart_state (); }; headers; - body; + client_stream = Stream.(stream no_reader no_writer); + server_stream = body; locals = Scope.empty; first = request; (* TODO LATER What OCaml version is required for this? *) last = ref request; @@ -480,7 +501,8 @@ let request upload = initial_multipart_state (); }; headers; - body = Stream.(stream (string body) no_writer); + client_stream = Stream.(stream (string body) no_writer); + server_stream = Stream.(stream no_reader no_writer); locals = Scope.empty; first = request; last = ref request; @@ -507,7 +529,9 @@ let response websocket = None; }; headers; - body = Stream.(stream (string body) no_writer); + client_stream = Stream.(stream (string body) no_writer); + server_stream = Stream.(stream no_reader no_writer); + (* TODO This fully dead stream should be preallocated. *) locals = Scope.empty; first = response; last = ref response; From 1e748506081272aa1e6604130e3c987d4f213710 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 19:26:05 +0300 Subject: [PATCH 062/312] Move the client to its own repository --- example/w-client/client.ml | 60 ---- example/w-client/dune | 6 - example/w-client/dune-project | 1 - hyper.opam | 11 - src/dune | 18 -- src/hyper.ml | 542 ---------------------------------- src/hyper.mli | 29 -- 7 files changed, 667 deletions(-) delete mode 100644 example/w-client/client.ml delete mode 100644 example/w-client/dune delete mode 100644 example/w-client/dune-project delete mode 100644 hyper.opam delete mode 100644 src/hyper.ml delete mode 100644 src/hyper.mli diff --git a/example/w-client/client.ml b/example/w-client/client.ml deleted file mode 100644 index eea8088a..00000000 --- a/example/w-client/client.ml +++ /dev/null @@ -1,60 +0,0 @@ -let send () = - (* TODO Eventually replace this by the higher-level wrappers that Hyper will - offer. Move the explicit-request call into a proxy example, that forwards - Dream requests directly to Hyper.send. *) - (* TODO This example is meant for running concurrently with example/w-echo. *) - let request = - Dream.request - ~method_:`GET - ~target:"ws://127.0.0.1:8080/websocket" "" - (* ~headers:["Transfer-Encoding", "chunked"] *) - in - - (* TODO Note that this wrapper is not necessary if using, for example, - Dream.run. Create a proxy example that has both a Dream server and a Hyper - client, and therefore has no explicit Lwt_main.run. *) - let done_, notify_done = Lwt.wait () in - - (* TODO Add some kind of primitive error handling, both for network errors - and for error responses. *) - let%lwt response = Hyper.send request in - - (* TODO Janky delay to give time for pipelining to intervene. *) - (* let%lwt () = Lwt_unix.sleep 5. in *) - - let%lwt () = Dream.write response "Hello?" in - - let rec read () = - (* TODO Use a higher-level reader once available. *) - Dream.next - (Dream.body_stream response) - ~data:(fun buffer offset length _binary _fin -> - Bigstringaf.substring buffer ~off:offset ~len:length - |> print_string; - flush stdout; - read ()) - ~close:(fun _code -> Lwt.wakeup_later notify_done ()) - ~flush:read - ~ping:(fun _buffer _offset _length -> read ()) - ~pong:(fun _buffer _offset _length -> read ()) - in - read (); - - done_ - -let () = - (* TODO Without Dream.run in the process, this doesn't get set anywhere... *) - Printexc.record_backtrace true; - - Lwt_main.run begin - let first = send () in - (* let second = - (* let%lwt () = Lwt_unix.sleep 1. in *) - send () - in *) - let%lwt () = first in - (* let%lwt () = second in *) - Lwt.return () - end - -(* TODO Run the server in the same process. *) diff --git a/example/w-client/dune b/example/w-client/dune deleted file mode 100644 index 07ffc06d..00000000 --- a/example/w-client/dune +++ /dev/null @@ -1,6 +0,0 @@ -(executable - (name client) - (libraries hyper) - (preprocess (pps lwt_ppx))) - -(data_only_dirs _esy esy.lock lib node_modules) diff --git a/example/w-client/dune-project b/example/w-client/dune-project deleted file mode 100644 index 929c696e..00000000 --- a/example/w-client/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 2.0) diff --git a/hyper.opam b/hyper.opam deleted file mode 100644 index 7cbd2efc..00000000 --- a/hyper.opam +++ /dev/null @@ -1,11 +0,0 @@ -opam-version: "2.0" - -depends: [ - "dream" - "ocaml" - "uri" -] - -build: [ - ["dune" "build" "-p" name "-j" jobs] -] diff --git a/src/dune b/src/dune index b1f2b371..1553ebd8 100644 --- a/src/dune +++ b/src/dune @@ -19,21 +19,3 @@ mirage-crypto-rng.lwt ptime.clock.os )) - -(library - (public_name hyper) - (wrapped false) - (modules hyper) - (libraries - dream - dream.h2 - dream.h2-lwt-unix - dream.httpaf - dream.httpaf-lwt-unix - lwt - lwt.unix - lwt_ssl - ssl - dream.websocketaf-lwt-unix - ) - (preprocess (pps lwt_ppx))) diff --git a/src/hyper.ml b/src/hyper.ml deleted file mode 100644 index 1e853a19..00000000 --- a/src/hyper.ml +++ /dev/null @@ -1,542 +0,0 @@ -type request = Dream.request -type response = Dream.response -type 'a promise = 'a Lwt.t - - - -(* TODO Is this the right representation? *) -type connection = - | Cleartext of Httpaf_lwt_unix.Client.t - | SSL of Httpaf_lwt_unix.Client.SSL.t - | H2 of H2_lwt_unix.Client.SSL.t (* TODO No h2c support. *) - | WebSocket of Dream__pure.Stream.stream - (* TODO NOTE WebSocket connections over HTTP/1.1 are currently - single-use. We still go through the pool so as to give it the chance to - refuse the connection based on the number of other connections to the - same endpoint or host. The actual closing of WebSocket connections by the - pool is not yet implemented, so it might try to multiplex them. *) - (* TODO WebSockets over https and WebSockets over HTTP/2. *) - -type endpoint = string * string * int -(* TODO But what should a host be? An unresolved hostname:port, or a resolved - hostname:port? Hosts probably also need a comparison function or - something. And probably a pretty-printing function. These things are entirely - abstract. But, because they are abstract, it's possible to change the - implementation, in particular to switch from unresolved to resolved hosts. - Using unresolved hosts implies doing DNS before deciding whether each request - can reuse a connection from the pool. Though that can be avoided by using a - DNS cache, it seems like the pool should short-circuit that entire process. - So, this becomes some kind of scheme-host-port triplet. *) -(* TODO Also, how should this work with HTTP/2 and multiplexing? Need to address - that next. *) -(* TODO The scheme is probably not sufficient. Will also need the negotiated - protocol, as an https connection might have been upgraded to HTTP/2 or not at - the server's discretion during ALPN. *) - -(* TODO Implementation of pipelining might make it worthwhile to be able to tell - the client when a request has completed sending (only). However, given - pipelining is buggy and there is HTTP/2, maybe it's not worth complicating - the API for this. *) - -type create_result = { - connection : connection; - destroy : connection -> unit promise; - concurrency : [ `Single_use | `Sequence | `Pipeline | `Multiplex ]; -} -type create = endpoint -> create_result promise - -type connection_pool = { - obtain : endpoint -> request -> create -> (connection * int64) promise; - write_done : int64 -> unit; - all_done : int64 -> response -> unit; - error : int64 -> unit; -} -(* TODO Return needs to provide a function for destroying a connection. *) - -let connection_pool ~obtain ~write_done ~all_done ~error = - {obtain; write_done; all_done; error} - - - -type pooled_connection = { - create_result : create_result; - id : int64; - created_at : float; - mutable state : [ - | `Writing_request - | `Reading_response_only - | `Idle - ]; - mutable ref_count : int; - mutable idle_since : float; - mutable closing : bool; -} - -(* TODO Add various interesting limits. *) -let general_connection_pool () = - let connections_by_id = Hashtbl.create 32 - and connections_by_endpoint = Hashtbl.create 32 - and next_id = ref 0L in - - let obtain endpoint _request create = - (* TODO There are, in general, multiple connections for each endpoit, so, - properly, the pool would have to either iterate over a list, or have an - acceleration data structure for accessing ready connections by endpoint - directly. *) - (* TODO Must also check whether the connection is closing. However, the - current pool never closes connections (!!!). *) - (* TODO Also should respect connection concurrency. Sequential connections - require the state to be `Idle. Pipeline connections require the state to - be not `Writing_request. Multiplexing connections can be in any state to - be reused. This code is currently hardcoded to do pipelining, which will - conservatively work on HTTP/2 multiplexing, it just won't take advantage - of the full concurrency available. *) - match Hashtbl.find_opt connections_by_endpoint endpoint with - | Some pooled_connection - when pooled_connection.state <> `Writing_request -> - pooled_connection.state <- `Writing_request; - pooled_connection.ref_count <- pooled_connection.ref_count + 1; - let connection = pooled_connection.create_result.connection - and id = pooled_connection.id in - Lwt.return (connection, id) - | _ -> - let%lwt create_result = create endpoint in - let id = !next_id in - next_id := Int64.succ !next_id; - let pooled_connection = { - create_result; - id; - created_at = Unix.time (); - state = `Writing_request; - ref_count = 1; - idle_since = 0.; - closing = false; - } in - Hashtbl.replace connections_by_id pooled_connection.id pooled_connection; - Hashtbl.add connections_by_endpoint endpoint pooled_connection; - Lwt.return (create_result.connection, pooled_connection.id) - - and write_done id = - match Hashtbl.find_opt connections_by_id id with - | None -> - () - | Some pooled_connection -> - pooled_connection.state <- `Reading_response_only - (* TODO In a future version where other writers may be queued, this should - wake up the head writer in the queue. *) - - and all_done id _response = - match Hashtbl.find_opt connections_by_id id with - | None -> - () - | Some pooled_connection -> - pooled_connection.ref_count <- pooled_connection.ref_count - 1; - if pooled_connection.ref_count = 0 then begin - pooled_connection.state <- `Idle; - pooled_connection.idle_since <- Unix.time () - end - - and error = - ignore - (* TODO Definitely not correct - this should put the connection into the - closing state and decrement its ref count. If the connection becomes idle - because of that, it can be closed right away. *) - - in - - connection_pool ~obtain ~write_done ~all_done ~error - - - -let default_connection_pool = - lazy (general_connection_pool ()) - - - -(* TODO How should the host and port be represented? *) -(* TODO Good error handling. *) -(* TODO Probably change the default to one per-process pool with some - configuration. *) -let send_one_request connection_pool hyper_request = - let uri = Uri.of_string (Dream.target hyper_request) in - let scheme = Uri.scheme uri |> Option.get - and host = Uri.host uri |> Option.get - and port = Uri.port uri |> Option.value ~default:80 - and method_ = Dream.method_ hyper_request - and path_and_query = Uri.path_and_query uri - in - (* TODO Usage of Option.get above is temporary, though failure to provide a - host should probably be a logic error, and doesn't have to be reported in a - "neat" way - just a debuggable way. The port can be inferred from the - scheme if it is missing. We are assuming http:// for now. *) - - (* TODO These sorts of things can probably be done by passing the client - modules in as first-class modules. The code might be not so clear to read, - though. *) - let destroy connection = - match connection with - | Cleartext connection -> Httpaf_lwt_unix.Client.shutdown connection - | SSL connection -> Httpaf_lwt_unix.Client.SSL.shutdown connection - | H2 connection -> H2_lwt_unix.Client.SSL.shutdown connection - | WebSocket stream -> Dream__pure.Stream.close stream 1000; Lwt.return_unit - in - - let create (scheme, host, port) = - let%lwt addresses = - Lwt_unix.getaddrinfo - host (string_of_int port) [Unix.(AI_FAMILY PF_INET)] in - let address = (List.hd addresses).Unix.ai_addr in - (* TODO Note: this can raise. *) - - let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in - let%lwt () = Lwt_unix.connect socket address in - - match scheme with - | "https" -> - (* TODO The context needs to be created once per process, or a cache - should be used. *) - let context = Ssl.(create_context TLSv1_2 Client_context) in - (* TODO For WebSockets (wss://), the client should probably do SSL - without offering h2 by ALPN. Do any servers implement WebSockets over - HTTP/2? *) - Ssl.set_context_alpn_protos context ["h2"; "http/1.1"]; - let%lwt ssl_socket = Lwt_ssl.ssl_connect socket context in - (* TODO Next line is pretty suspicious. *) - let underlying = Lwt_ssl.ssl_socket ssl_socket |> Option.get in - begin match Ssl.get_negotiated_alpn_protocol underlying with - | Some "h2" -> - (* TODO What about the error handler? *) - let%lwt connection = - H2_lwt_unix.Client.SSL.create_connection - ~error_handler:ignore - ssl_socket - in - Lwt.return { - connection = H2 connection; - destroy; - concurrency = `Multiplex; - } - | _ -> - let%lwt connection = - Httpaf_lwt_unix.Client.SSL.create_connection ssl_socket in - Lwt.return { - connection = SSL connection; - destroy; - concurrency = `Pipeline; - } - end - (* TODO Need to do server certificate validation here, etc. *) - - | "http" -> - let%lwt connection = Httpaf_lwt_unix.Client.create_connection socket in - Lwt.return { - connection = Cleartext connection; - destroy; - concurrency = `Pipeline; - } - - | "ws" -> - (* TODO The weboscket/af client interface seems pretty awkward to use in - this kind of control flow, since the input handlers need to be defined - immediately. However, the input handlers themselves are ill-conceinved, - since they are a partially push API (i.e. they lack full read flow - control). So hack something together, and await a better API. *) - let stream = ref None in - (* TODO The equality between server and client input handlers is not - exposed in the websocketaf API. *) - let websocket_handler = - Dream__http.Http.websocket_handler (fun the_stream -> - stream := Some the_stream; - Lwt.return_unit) - in - (* TODO Generate random nonces. *) - let%lwt connection = - Websocketaf_lwt_unix.Client.connect - ~nonce:"abcdefghijklmnop" - ~host - ~port - ~resource:path_and_query - ~error_handler:ignore - ~websocket_handler:(Obj.magic websocket_handler) - socket - in - ignore connection; - (* TODO Extremely questionable! The connection should just carry a stream - promise instead, that the handler can wait on later. *) - let%lwt () = Lwt_unix.sleep 1. in - Lwt.return { - connection = WebSocket (Option.get !stream); - destroy; - concurrency = `Single_use; - } - - | _ -> - assert false - (* TODO Need a log and a more intelligent error here. *) - in - - let endpoint = (scheme, host, port) in - - let%lwt (connection, id) = - connection_pool.obtain endpoint hyper_request create in - - let request connection = - match connection with - | Cleartext connection -> Httpaf_lwt_unix.Client.request connection - | SSL connection -> Httpaf_lwt_unix.Client.SSL.request connection - | H2 _connection -> assert false - (* TODO H2 is just a separate CF branch for now. *) - | WebSocket _stream -> assert false - (* TODO Ditto. *) - in - - let response_promise, received_response = Lwt.wait () in - - begin match connection with - | Cleartext _ | SSL _ -> - (* TODO Did not indent the case body; quick and dirty "get it working" - version. *) - - (* TODO Do we now want to store the verson? *) - let response_handler - (httpaf_response : Httpaf.Response.t) - httpaf_response_body = - - (* TODO Using Dream.stream is awkward here, but it allows getting a response - with a stream inside it without immeidately having to modify Dream. Once - that is fixed, the Lwt.async can be removed, most likely. Dream.stream's - signature will change in Dream either way, so it's best to just hold off - tweaking it now. *) - Lwt.async begin fun () -> - let%lwt hyper_response = - Dream.stream - ~code:(Httpaf.Status.to_code httpaf_response.status) - ~headers:(Httpaf.Headers.to_list httpaf_response.headers) - (fun _response -> Lwt.return ()) - in - Lwt.wakeup_later received_response hyper_response; - - (* TODO A janky reader. Once Dream.stream is fixed and streams are fully - exposed, this can become a good pull-reader. *) - let rec receive () = - Httpaf.Body.Reader.schedule_read - httpaf_response_body - ~on_eof:(fun () -> - Lwt.async (fun () -> - let%lwt () = Dream.close_stream hyper_response in - connection_pool.all_done id hyper_response; - Lwt.return_unit)) - (* TODO Make sure there is a way for the reader to abort reading - the stream and yet still get the socket closed. *) - ~on_read:(fun buffer ~off ~len -> - Lwt.async (fun () -> - let%lwt () = - Dream.write_buffer - ~offset:off ~length:len hyper_response buffer in - Lwt.return (receive ()))) - in - receive (); - - Lwt.return () - end - in - - let httpaf_request = - Httpaf.Request.create - ~headers:(Httpaf.Headers.of_list (Dream.all_headers hyper_request)) - (Httpaf.Method.of_string (Dream.method_to_string method_)) - path_and_query in - let httpaf_request_body = - request - connection - ~error_handler:(fun _ -> failwith "Protocol error") (* TODO *) - ~response_handler - httpaf_request in - - let rec send () = - Dream.body_stream hyper_request - |> fun stream -> - Dream.next stream ~data ~close ~flush ~ping ~pong - - (* TODO Implement flow control like on the server side, using flush. *) - and data buffer offset length _binary _fin = - Httpaf.Body.Writer.write_bigstring - httpaf_request_body - ~off:offset - ~len:length - buffer; - send () - - and close _code = - Httpaf.Body.Writer.close httpaf_request_body; - (* TODO This should only be called if reading is not yet done. *) - connection_pool.write_done id - - and flush () = send () - and ping _buffer _offset _length = send () - and pong _buffer _offset _length = send () - - in - - send () - - | H2 connection' -> - (* TODO This is a nasty duplicate of the above case, specialized for H2. See - comments above. *) - let response_handler (h2_response : H2.Response.t) h2_response_body = - - Lwt.async begin fun () -> - let%lwt hyper_response = - Dream.stream - ~code:(H2.Status.to_code h2_response.status) - ~headers:(H2.Headers.to_list h2_response.headers) - (fun _response -> Lwt.return ()) - in - Lwt.wakeup_later received_response hyper_response; - - let rec receive () = - H2.Body.schedule_read - h2_response_body - ~on_eof:(fun () -> - Lwt.async (fun () -> - let%lwt () = Dream.close_stream hyper_response in - connection_pool.all_done id hyper_response; - Lwt.return_unit)) - ~on_read:(fun buffer ~off ~len -> - Lwt.async (fun () -> - let%lwt () = - Dream.write_buffer - ~offset:off ~length:len hyper_response buffer in - Lwt.return (receive ()))) - in - receive (); - - Lwt.return () - end - in - - let h2_request = - H2.Request.create - ~headers:(H2.Headers.of_list (Dream.all_headers hyper_request)) - ~scheme - (H2.Method.of_string (Dream.method_to_string method_)) - path_and_query in - let h2_request_body = - H2_lwt_unix.Client.SSL.request - connection' - h2_request - ~error_handler:(fun _ -> failwith "Protocol error") - ~response_handler in - - let rec send () = - Dream.body_stream hyper_request - |> fun stream -> - Dream.next stream ~data ~close ~flush ~ping ~pong - - and data buffer offset length _binary _fin = - H2.Body.write_bigstring - h2_request_body - ~off:offset - ~len:length - buffer; - send () - - and close _code = H2.Body.close_writer h2_request_body - and flush () = send () - and ping _buffer _offset _length = send () - and pong _buffer _offset _length = send () - - in - - send () - - | WebSocket websocket -> - let hyper_response = Dream.response "" in - - let hyper_response : Dream__pure.Inmost.response = - Obj.magic (hyper_response : Dream.response) in - let hyper_response = {hyper_response with body = websocket} in - let hyper_response : Dream.response = Obj.magic hyper_response in - - Lwt.wakeup_later received_response hyper_response - end; - - response_promise - - - -(* TODO Add an option to redirect only to the same host? Or is this better - addressed by just letting the user do redirects manually, if needed? It's - probably best to expose some kind of filter function, because redirect - handling is slightly tricky (with body streams), and the user can benefit by - not having to write code themselves for this. *) -(* TODO Expose a redirect cache callback for permanent redirects. *) -let send ?(connection_pool = Lazy.force default_connection_pool) request = - let rec redirect_loop remaining request = - (* TODO Can save an allocation by binding the promise. *) - let%lwt response = send_one_request connection_pool request in - if remaining <= 0 then - (* TODO Log a warning here if the original redirect limit was not zero. *) - Lwt.return response - else - match Dream.status response with - | `Moved_Permanently - | `Found - | `See_Other - | `Temporary_Redirect - | `Permanent_Redirect -> - begin match Dream.header "Location" response with - | None -> - (* TODO Log a warning here. *) - Lwt.return response - | Some target -> - (* TODO For Moved Permanently, Temporary Redirect, Permanent Redirect, - warn if the server has read the request body, because we won't - easily be able to resend it. *) - (* TODO If requests become mutable, probably a new request should be - explicitly allocated. *) - (* TODO The URI in Location: might be absolute or not. *) - let request : Dream__pure.Inmost.request = - Obj.magic (request : Dream.request) in - let request = - {request with specific = {request.specific with target}} in - let request : Dream.request = - Obj.magic request in - - let request = - match Dream.status response with - | `Found - | `See_Other -> - Dream.with_method_ `GET request - (* TODO Note that doing this for 302 is not correct, but is done - to match established behavior on the Web. *) - (* TODO Should also substitute the body with an empty one here, - and warn if the previous body is not closed (and close it). *) - | _ -> - request - in - - redirect_loop (remaining - 1) request - end - | _ -> - Lwt.return response - in - - redirect_loop 5 request - - - -(* TODO Which function should be the most fundamental function? Probably the - request -> response runner. But it's probably not the most convenient for - general usage. - - How should the host and port be represented? Can probably just allow them in - [target], but also allow overriding them so that only the path and query are - used. This could get confusing, though. - - To start with, implement a good request -> response runner that does the - basics: create a request, allow streaming out its body, receive a response, - allow streaming in its body. After that, elaborate. Probably should start - with HTTP/2 and SSL. - - How are non-response errors reported? *) diff --git a/src/hyper.mli b/src/hyper.mli deleted file mode 100644 index 747c1b49..00000000 --- a/src/hyper.mli +++ /dev/null @@ -1,29 +0,0 @@ -type request = Dream.request -type response = Dream.response -type 'a promise = 'a Lwt.t - - - -type connection_pool - -val send : - ?connection_pool:connection_pool -> - request -> response promise - - - -type connection -type endpoint -type create_result = { - connection : connection; - destroy : connection -> unit promise; - concurrency : [ `Single_use | `Sequence | `Pipeline | `Multiplex ]; -} -type create = endpoint -> create_result promise - -val connection_pool : - obtain:(endpoint -> request -> create -> (connection * int64) promise) -> - write_done:(int64 -> unit) -> - all_done:(int64 -> response -> unit) -> - error:(int64 -> unit) -> - connection_pool From ff6f1d24575d8459a07d68a58791b16aaa435e53 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 21:51:59 +0300 Subject: [PATCH 063/312] Rename phantom types to client/server The names incoming/outgoing are no longer clear when they are also used on the client. Another possibility would be to define type Hyper.outgoing = Dream.incoming type Hyper.incoming = Dream.outgoing ...but this would probably be quite frustrating when switching between Dream and Hyper, reading error messages, etc. It's better to have consistent naming. --- src/dream.mli | 15 ++++++++------- src/pure/inmost.ml | 8 ++++---- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index d4847296..a78c5777 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -10,11 +10,11 @@ Dream is built on just five types. The first two are the data types of Dream. Both are abstract, even though they appear to have definitions: *) -type request = incoming message +type request = client message (** HTTP requests, such as [GET /something HTTP/1.1]. See {!section-requests}. *) -and response = outgoing message +and response = server message (** HTTP responses, such as [200 OK]. See {!section-responses}. *) (** The remaining three types are for building up Web apps. *) @@ -109,13 +109,14 @@ and 'a message val Dream.header : string -> 'a message -> string option ]} *) -and incoming -and outgoing +and client +and server (** Type parameters for {!message} for {!type-request} and {!type-response}, respectively. These are “phantom” types. They have no meaning other than - they are different from each other. Dream only ever creates [incoming - message] and [outgoing message]. [incoming] and [outgoing] are never - mentioned again in the docs. *) + they are different from each other. Dream only ever creates [client message] + and [server message]. [client] and [server] are never mentioned again in the + docs. *) +(* TODO These docs need to be clarified. *) and 'a promise = 'a Lwt.t (** Dream uses {{:https://github.com/ocsigen/lwt} Lwt} for promises and diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 7ca53e6d..f2f784dc 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -39,8 +39,8 @@ module Scope = Hmap.Make (Scope_variable_metadata) type websocket = Stream.stream -type request = incoming message -and response = outgoing message +type request = client message +and response = server message and 'a message = { specific : 'a; @@ -52,7 +52,7 @@ and 'a message = { last : 'a message ref; } -and incoming = { +and client = { app : app; request_client : string; method_ : method_; @@ -65,7 +65,7 @@ and incoming = { } (* Prefix is stored backwards. *) -and outgoing = { +and server = { status : status; websocket : (websocket -> unit Lwt.t) option; } From ce6c0084a0ff62a684fb603e83c499a84880b4dc Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 22:04:53 +0300 Subject: [PATCH 064/312] Streams: expose Dream.client_stream and fix tests --- src/dream.mli | 7 ++++++- src/pure/inmost.ml | 8 +++----- test/expect/middleware/router.ml | 9 +++++++-- 3 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index a78c5777..1a813044 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -725,9 +725,14 @@ type buffer = (* TODO What should the body stream retrieval function be called? *) (* TODO Remove old functions from signature. *) +(* TODO Should there be a section for this somewhere? Probably "low-level + streaming" should be promoted to a top-level section, Streaming. *) type stream -val body_stream : 'a message -> stream +val server_stream : 'a message -> stream +val client_stream : 'a message -> stream +(* TODO Document that this is for middlewares that are transforming a response + stream or a WebSocket. *) (* TODO Probably even close can be made optional. exn can be made optional. *) (* TODO Argument order? *) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index f2f784dc..54984386 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -292,14 +292,12 @@ let body message = let read message = Stream.read_convenience message.server_stream -let body_stream message = - message.server_stream - -(* TODO Temporary internal function so that the HTTP layer can read response - streams. *) let client_stream message = message.client_stream +let server_stream message = + message.server_stream + (* TODO Pending the dream.mli interface reorganization for the new stream API. *) let next = diff --git a/test/expect/middleware/router.ml b/test/expect/middleware/router.ml index d0437b26..22599c80 100644 --- a/test/expect/middleware/router.ml +++ b/test/expect/middleware/router.ml @@ -86,9 +86,14 @@ let show ?(prefix = "/") ?(method_ = `GET) target router = |> Dream.test ~prefix (router @@ fun _ -> Dream.respond ~status:`Not_Found "") |> fun response -> - let status = Dream.status response - and body = Lwt_main.run (Dream.body response) + let body = + Dream.client_stream response + |> Obj.magic (* TODO Needs to be replaced by exposing read_until_close + as a function on abstract streams. *) + |> Dream__pure.Stream.read_until_close + |> Lwt_main.run in + let status = Dream.status response in Printf.printf "Response: %i %s\n" (Dream.status_to_int status) (Dream.status_to_string status); if body <> "" then From ed1c949226c30fad7170b66641ae48fc13159507 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 11 Dec 2021 23:40:21 +0300 Subject: [PATCH 065/312] Add Dream.with_client_stream Primarily useful for the client, so it should be moved to dream-core in the future. Will also be useful for stream-transforming middlewares. --- src/dream.mli | 2 ++ src/pure/inmost.ml | 7 +++++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 1a813044..103e337c 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -733,6 +733,8 @@ val server_stream : 'a message -> stream val client_stream : 'a message -> stream (* TODO Document that this is for middlewares that are transforming a response stream or a WebSocket. *) +val with_client_stream : stream -> 'a message -> 'a message +(* TODO Normalize with with_stream, or add a separate with_server_stream. *) (* TODO Probably even close can be made optional. exn can be made optional. *) (* TODO Argument order? *) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 54984386..b76951fd 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -298,6 +298,9 @@ let client_stream message = let server_stream message = message.server_stream +let with_client_stream client_stream message = + update {message with client_stream} + (* TODO Pending the dream.mli interface reorganization for the new stream API. *) let next = @@ -499,8 +502,8 @@ let request upload = initial_multipart_state (); }; headers; - client_stream = Stream.(stream (string body) no_writer); - server_stream = Stream.(stream no_reader no_writer); + client_stream = Stream.(stream no_reader no_writer); + server_stream = Stream.(stream (string body) no_writer); locals = Scope.empty; first = request; last = ref request; From 2f40d67224d3a3cf72d1dc1f2a29844a136e8554 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 12 Dec 2021 12:12:52 +0300 Subject: [PATCH 066/312] dream.pure should not depend on dream.cipher --- src/cipher/cipher.ml | 23 +++++++ src/cipher/dune | 1 + src/dream.ml | 3 + src/middleware/cookie.ml | 124 ++++++++++++++++++++++++++++++++++ src/middleware/csrf.ml | 7 +- src/middleware/flash.ml | 10 +-- src/middleware/session.ml | 8 +-- src/pure/dune | 1 - src/pure/inmost.ml | 135 -------------------------------------- src/sql/session.ml | 5 +- 10 files changed, 169 insertions(+), 148 deletions(-) create mode 100644 src/middleware/cookie.ml diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 1ba98a69..f4d7402d 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -111,3 +111,26 @@ struct | None -> None | Some plaintext -> Some (Cstruct.to_string plaintext) end + +(* TODO Ideally, get rid of this open. *) +open Dream__pure.Inmost + +let encryption_secret request = + List.hd request.specific.app.secrets + +let decryption_secrets request = + request.specific.app.secrets + +let encrypt ?associated_data request plaintext = + encrypt + (module AEAD_AES_256_GCM) + ?associated_data + (encryption_secret request) + plaintext + +let decrypt ?associated_data request ciphertext = + decrypt + (module AEAD_AES_256_GCM) + ?associated_data + (decryption_secrets request) + ciphertext diff --git a/src/cipher/dune b/src/cipher/dune index bc23d7db..b631d401 100644 --- a/src/cipher/dune +++ b/src/cipher/dune @@ -3,6 +3,7 @@ (name dream__cipher) (libraries cstruct + dream.pure mirage-crypto mirage-crypto-rng ) diff --git a/src/dream.ml b/src/dream.ml index 696b5cce..2726df27 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -28,6 +28,9 @@ let debug = default_log.debug include Dream__middleware.Router include Dream__unix.Static +include Dream__cipher.Cipher +include Dream__middleware.Cookie + include Dream__middleware.Session include Dream__middleware.Session.Make (Ptime_clock) let sql_sessions = Dream__sql.Session.middleware diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml new file mode 100644 index 00000000..06b3c22b --- /dev/null +++ b/src/middleware/cookie.ml @@ -0,0 +1,124 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +module Formats = Dream__pure.Formats +module Dream = Dream__pure.Inmost +module Cipher = Dream__cipher.Cipher + + + +let infer_cookie_prefix prefix domain path secure = + match prefix, domain, path, secure with + | Some (Some `Host), _, _, _ -> "__Host-" + | Some (Some `Secure), _, _, _ -> "__Secure-" + | Some None, _, _, _ -> "" + | None, None, Some "/", true -> "__Host-" + | None, _, _, true -> "__Secure-" + | None, _, _, _ -> "" + +(* TODO Some actual performance in the implementation. *) +let cookie + ?prefix:cookie_prefix + ?decrypt:(decrypt_cookie = true) + ?domain + ?path + ?secure + name + request = + + let path = + match path with + | Some path -> path + | None -> Some (Dream.prefix request) + in + + let secure = + match secure with + | Some secure -> secure + | None -> Dream.https request + in + + let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in + let name = cookie_prefix ^ name in + let test = fun (name', _) -> name = name' in + + match Dream.all_cookies request |> List.find_opt test with + | None -> None + | Some (_, value) -> + if not decrypt_cookie then + Some value + else + match Formats.from_base64url value with + | None -> + None + | Some value -> + Cipher.decrypt request value ~associated_data:("dream.cookie-" ^ name) + +let set_cookie + ?prefix:cookie_prefix + ?encrypt:(encrypt_cookie = true) + ?expires + ?max_age + ?domain + ?path + ?secure + ?(http_only = true) + ?same_site + name + value + request + response = + + (* TODO Need the site prefix, not the subsite prefix! *) + let path = + match path with + | Some path -> path + | None -> Some (Dream.prefix request) + in + + let secure = + match secure with + | Some secure -> secure + | None -> Dream.https request + in + + let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in + + let same_site = + match same_site with + | None -> Some `Strict + | Some None -> None + | Some (Some `Strict) -> Some `Strict + | Some (Some `Lax) -> Some `Lax + | Some (Some `None) -> Some `None + in + + let name = cookie_prefix ^ name in + + let value = + if encrypt_cookie then + (* Give each cookie name a different associated data "space," effectively + partitioning valid ciphertexts among the cookies. See also + https://github.com/aantron/dream/issues/19#issuecomment-820250853. *) + Cipher.encrypt request value ~associated_data:("dream.cookie-" ^ name) + |> Formats.to_base64url + else + value + in + + let set_cookie = + Formats.to_set_cookie + ?expires ?max_age ?domain ?path ~secure ~http_only ?same_site name value + in + + Dream.add_header "Set-Cookie" set_cookie response + +let drop_cookie + ?prefix ?domain ?path ?secure ?http_only ?same_site name request response = + set_cookie + ?prefix ~encrypt:false ~expires:0. ?domain ?path ?secure ?http_only + ?same_site name "" request response diff --git a/src/middleware/csrf.ml b/src/middleware/csrf.ml index a528a1e3..1b615c4c 100644 --- a/src/middleware/csrf.ml +++ b/src/middleware/csrf.ml @@ -6,6 +6,9 @@ module Dream = Dream__pure.Inmost +module Cipher = Dream__cipher.Cipher + + let field_name = "dream.csrf" @@ -21,7 +24,7 @@ let csrf_token ~now ?(valid_for = default_valid_for) request = "expires_at", `Float (floor (now +. valid_for)); ] |> Yojson.Basic.to_string - |> Dream.encrypt ~associated_data:field_name request + |> Cipher.encrypt ~associated_data:field_name request |> Dream__pure.Formats.to_base64url let log = @@ -41,7 +44,7 @@ let verify_csrf_token ~now request token = Lwt.return @@ `Invalid | Some token -> - match Dream.decrypt ~associated_data:field_name request token with + match Cipher.decrypt ~associated_data:field_name request token with | None -> log.warning (fun log -> log ~request "CSRF token could not be verified"); `Invalid diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 5fc1ee97..6f1d352d 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -7,6 +7,8 @@ module Dream = Dream__pure.Inmost + + let log = Log.sub_log "dream.flash" @@ -41,7 +43,7 @@ let flash request = | _ -> failwith "Bad flash message content" in let x = - Dream.cookie flash_cookie request + Cookie.cookie flash_cookie request |>? fun value -> match Yojson.Basic.from_string value with | `List y -> Some (group @@ List.map unpack y) @@ -74,14 +76,14 @@ let flash_messages inner_handler request = log ~request "%s" "No flash messages."); let outbox = ref [] in let request = Dream.with_local storage outbox request in - let existing = Dream.cookie flash_cookie request in + let existing = Cookie.cookie flash_cookie request in let%lwt response = inner_handler request in let entries = List.rev !outbox in let response = match existing, entries with | None, [] -> response | Some _, [] -> - Dream.set_cookie flash_cookie "" request response ~expires:0. + Cookie.set_cookie flash_cookie "" request response ~expires:0. | _, _ -> let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] @@ -96,6 +98,6 @@ let flash_messages inner_handler request = else () in - Dream.set_cookie flash_cookie value request response ~max_age:five_minutes + Cookie.set_cookie flash_cookie value request response ~max_age:five_minutes in Lwt.return response diff --git a/src/middleware/session.ml b/src/middleware/session.ml index bd36af69..7e70ef32 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -153,7 +153,7 @@ struct let now = gettimeofday () in let valid_session = - Dream.cookie ~decrypt:false session_cookie request + Cookie.cookie ~decrypt:false session_cookie request |>? read_session_id |>? Hashtbl.find_opt hash_table |>? fun session -> @@ -188,7 +188,7 @@ struct let id = version_session_id !session.id in let max_age = !session.expires_at -. now () in Lwt.return - (Dream.set_cookie + (Cookie.set_cookie session_cookie id request response ~encrypt:false ~max_age) let back_end ~now lifetime = @@ -240,7 +240,7 @@ struct let now = gettimeofday () in let valid_session = - Dream.cookie session_cookie request + Cookie.cookie session_cookie request |>? read_value |>? fun value -> (* TODO Is there a non-raising version of this? *) @@ -310,7 +310,7 @@ struct |> version_value in Lwt.return - (Dream.set_cookie session_cookie value request response ~max_age) + (Cookie.set_cookie session_cookie value request response ~max_age) let back_end ~now lifetime = { load = load ~now lifetime; diff --git a/src/pure/dune b/src/pure/dune index e489a588..0d479ebf 100644 --- a/src/pure/dune +++ b/src/pure/dune @@ -4,7 +4,6 @@ (libraries base64 bigstringaf - dream.cipher multipart_form hmap lwt diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index b76951fd..f2867332 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -28,9 +28,6 @@ let initial_multipart_state () = { stream = Lwt_stream.of_list []; } -(* TODO Temporary; Ciphers should depend on the core, not the other way. *) -module Cipher = Dream__cipher.Cipher - module Scope_variable_metadata = struct type 'a t = string option * ('a -> string) option @@ -624,135 +621,3 @@ let rec pipeline middlewares handler = let sort_headers headers = List.stable_sort (fun (name, _) (name', _) -> compare name name') headers - -let encryption_secret request = - List.hd request.specific.app.secrets - -let decryption_secrets request = - request.specific.app.secrets - -let encrypt ?associated_data request plaintext = - Cipher.encrypt - (module Cipher.AEAD_AES_256_GCM) - ?associated_data - (encryption_secret request) - plaintext - -let decrypt ?associated_data request ciphertext = - Cipher.decrypt - (module Cipher.AEAD_AES_256_GCM) - ?associated_data - (decryption_secrets request) - ciphertext - -let infer_cookie_prefix prefix domain path secure = - match prefix, domain, path, secure with - | Some (Some `Host), _, _, _ -> "__Host-" - | Some (Some `Secure), _, _, _ -> "__Secure-" - | Some None, _, _, _ -> "" - | None, None, Some "/", true -> "__Host-" - | None, _, _, true -> "__Secure-" - | None, _, _, _ -> "" - -(* TODO Some actual performance in the implementation. *) -let cookie - ?prefix:cookie_prefix - ?decrypt:(decrypt_cookie = true) - ?domain - ?path - ?secure - name - request = - - let path = - match path with - | Some path -> path - | None -> Some (prefix request) - in - - let secure = - match secure with - | Some secure -> secure - | None -> https request - in - - let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in - let name = cookie_prefix ^ name in - let test = fun (name', _) -> name = name' in - - match all_cookies request |> List.find_opt test with - | None -> None - | Some (_, value) -> - if not decrypt_cookie then - Some value - else - match Formats.from_base64url value with - | None -> - None - | Some value -> - decrypt request value ~associated_data:("dream.cookie-" ^ name) - -let set_cookie - ?prefix:cookie_prefix - ?encrypt:(encrypt_cookie = true) - ?expires - ?max_age - ?domain - ?path - ?secure - ?(http_only = true) - ?same_site - name - value - request - response = - - (* TODO Need the site prefix, not the subsite prefix! *) - let path = - match path with - | Some path -> path - | None -> Some (prefix request) - in - - let secure = - match secure with - | Some secure -> secure - | None -> https request - in - - let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in - - let same_site = - match same_site with - | None -> Some `Strict - | Some None -> None - | Some (Some `Strict) -> Some `Strict - | Some (Some `Lax) -> Some `Lax - | Some (Some `None) -> Some `None - in - - let name = cookie_prefix ^ name in - - let value = - if encrypt_cookie then - (* Give each cookie name a different associated data "space," effectively - partitioning valid ciphertexts among the cookies. See also - https://github.com/aantron/dream/issues/19#issuecomment-820250853. *) - encrypt request value ~associated_data:("dream.cookie-" ^ name) - |> Formats.to_base64url - else - value - in - - let set_cookie = - Formats.to_set_cookie - ?expires ?max_age ?domain ?path ~secure ~http_only ?same_site name value - in - - add_header "Set-Cookie" set_cookie response - -let drop_cookie - ?prefix ?domain ?path ?secure ?http_only ?same_site name request response = - set_cookie - ?prefix ~encrypt:false ~expires:0. ?domain ?path ?secure ?http_only - ?same_site name "" request response diff --git a/src/sql/session.ml b/src/sql/session.ml index f2050889..ea5bf26f 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -6,6 +6,7 @@ module Dream = Dream__pure.Inmost +module Cookie = Dream__middleware.Cookie module Session = Dream__middleware.Session @@ -142,7 +143,7 @@ let load lifetime request = let now = Unix.gettimeofday () in let%lwt valid_session = - match Dream.cookie ~decrypt:false Session.session_cookie request with + match Cookie.cookie ~decrypt:false Session.session_cookie request with | None -> Lwt.return_none | Some id -> match Session.read_session_id id with @@ -185,7 +186,7 @@ let send (operations, session) request response = let id = Session.version_session_id !session.Session.id in let max_age = !session.Session.expires_at -. Unix.gettimeofday () in Lwt.return - (Dream.set_cookie + (Cookie.set_cookie Session.session_cookie id request From 3f50f75a01207a4921900ba047fb6b431e4909a5 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 12 Dec 2021 11:48:56 +0300 Subject: [PATCH 067/312] Move dream-pure to its own opam package --- Makefile | 4 ++-- dream.opam | 6 ++---- src/cipher/cipher.ml | 2 +- src/cipher/dune | 2 +- src/dream.ml | 6 +++--- src/dune | 2 +- src/graphql/dune | 2 +- src/graphql/graphql.ml | 2 +- src/http/adapt.ml | 4 ++-- src/http/dune | 2 +- src/http/error_handler.ml | 4 ++-- src/http/error_handler.mli | 2 +- src/http/http.ml | 8 ++++---- src/middleware/catch.ml | 2 +- src/middleware/content_length.ml | 2 +- src/middleware/cookie.ml | 4 ++-- src/middleware/csrf.ml | 6 +++--- src/middleware/dune | 2 +- src/middleware/echo.ml | 2 +- src/middleware/error_template.eml.ml | 4 ++-- src/middleware/flash.ml | 2 +- src/middleware/form.ml | 4 ++-- src/middleware/log.ml | 2 +- src/middleware/lowercase_headers.ml | 2 +- src/middleware/origin_referrer_check.ml | 2 +- src/middleware/request_id.ml | 2 +- src/middleware/router.ml | 2 +- src/middleware/router.mli | 2 +- src/middleware/session.ml | 6 +++--- src/middleware/site_prefix.ml | 2 +- src/middleware/tag.eml.ml | 4 ++-- src/middleware/upload.ml | 2 +- src/mirage/dune | 2 +- src/pure/dune | 4 ++-- src/sql/dune | 2 +- src/sql/session.ml | 2 +- src/sql/sql.ml | 2 +- src/unix/dune | 2 +- src/unix/static.ml | 4 ++-- test/expect/middleware/dune | 2 +- test/expect/middleware/router.ml | 4 ++-- test/expect/pure/dune | 2 +- test/expect/pure/stream/stream.ml | 2 +- 43 files changed, 63 insertions(+), 65 deletions(-) diff --git a/Makefile b/Makefile index 2dde57d5..6fe09425 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,10 @@ .PHONY : build build : - @dune build -p dream --no-print-directory @install + @dune build -p dream-pure,dream --no-print-directory @install .PHONY : watch watch : - @dune build -p dream --no-print-directory -w + @dune build -p dream-pure,dream --no-print-directory -w TEST ?= test diff --git a/dream.opam b/dream.opam index 903f8457..7d0bf5e9 100644 --- a/dream.opam +++ b/dream.opam @@ -48,17 +48,16 @@ maintainer: "Anton Bachin " depends: [ "base-unix" - "base64" {>= "3.1.0"} # Base64.encode_string. "bigarray-compat" "caqti" {>= "1.6.0"} # https://github.com/aantron/dream/issues/44. "caqti-lwt" "conf-libev" {os != "win32"} "cstruct" {>= "6.0.0"} + "dream-pure" "dune" {>= "2.7.0"} # --instrument-with. "fmt" {>= "0.8.7"} # `Italic. "graphql_parser" "graphql-lwt" - "hmap" "lwt" "lwt_ppx" {>= "1.2.2"} "lwt_ssl" @@ -69,10 +68,10 @@ depends: [ "mirage-crypto-rng" {>= "0.8.0"} # Signature of initialize. "multipart_form" {>= "0.3.0"} "ocaml" {>= "4.08.0"} + "ptime" {>= "0.8.1"} # Ptime.v. "ssl" {>= "0.5.8"} # Ssl.get_negotiated_alpn_protocol. "uri" {>= "4.2.0"} "yojson" # ... - "ptime" {>= "0.8.1"} # time and date # Currently vendored. # "gluten" @@ -94,7 +93,6 @@ depends: [ "result" # http/af, websocket/af. # Testing, development. - "alcotest" {with-test} "bisect_ppx" {with-test & >= "2.5.0"} # --instrument-with. "caqti-driver-postgresql" {with-test} "caqti-driver-sqlite3" {with-test} diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index f4d7402d..a2c3879e 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -113,7 +113,7 @@ struct end (* TODO Ideally, get rid of this open. *) -open Dream__pure.Inmost +open Dream_pure.Inmost let encryption_secret request = List.hd request.specific.app.secrets diff --git a/src/cipher/dune b/src/cipher/dune index b631d401..aedd14ee 100644 --- a/src/cipher/dune +++ b/src/cipher/dune @@ -3,7 +3,7 @@ (name dream__cipher) (libraries cstruct - dream.pure + dream-pure mirage-crypto mirage-crypto-rng ) diff --git a/src/dream.ml b/src/dream.ml index 2726df27..9696d516 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -5,8 +5,8 @@ -include Dream__pure.Stream -include Dream__pure.Inmost +include Dream_pure.Stream +include Dream_pure.Inmost include Dream__middleware.Log include Dream__middleware.Log.Make (Ptime_clock) @@ -63,7 +63,7 @@ let () = Dream__cipher.Random.initialize Mirage_crypto_rng_lwt.initialize let random = Dream__cipher.Random.random -include Dream__pure.Formats +include Dream_pure.Formats (* TODO Restore the ability to test with a prefix and re-enable the corresponding tests. *) diff --git a/src/dune b/src/dune index 1553ebd8..ca4934a6 100644 --- a/src/dune +++ b/src/dune @@ -9,7 +9,7 @@ dream.http dream.middleware dream.unix - dream.pure + dream-pure dream.sql fmt.tty graphql-lwt diff --git a/src/graphql/dune b/src/graphql/dune index 4989280c..20eab391 100644 --- a/src/graphql/dune +++ b/src/graphql/dune @@ -4,7 +4,7 @@ (libraries dream.graphiql dream.middleware - dream.pure + dream-pure graphql_parser graphql-lwt lwt diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index f22b1f42..de07a9b0 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/http/adapt.ml b/src/http/adapt.ml index bda3685a..542a652b 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -5,8 +5,8 @@ -module Dream = Dream__pure.Inmost -module Stream = Dream__pure.Stream +module Dream = Dream_pure.Inmost +module Stream = Dream_pure.Stream diff --git a/src/http/dune b/src/http/dune index 1162a6f2..f0ee185b 100644 --- a/src/http/dune +++ b/src/http/dune @@ -8,7 +8,7 @@ dream.cipher dream.localhost dream.middleware - dream.pure + dream-pure dream.gluten dream.gluten-lwt-unix dream.h2 diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 480f49f9..43d129de 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost @@ -196,7 +196,7 @@ let default_template _error debug_dump response = let code = Dream.status_to_int status and reason = Dream.status_to_string status in response - |> Dream.with_header "Content-Type" Dream__pure.Formats.text_html + |> Dream.with_header "Content-Type" Dream_pure.Formats.text_html |> Dream.with_body (Dream__middleware.Error_template.render ~debug_dump ~code ~reason) |> Lwt.return diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index fac335cb..667f271f 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/http/http.ml b/src/http/http.ml index 8f4812e8..e62225c5 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -5,8 +5,8 @@ -module Dream = Dream__pure.Inmost -module Stream = Dream__pure.Stream +module Dream = Dream_pure.Inmost +module Stream = Dream_pure.Stream @@ -763,8 +763,8 @@ let serve_with_maybe_https let prefix = prefix - |> Dream__pure.Formats.from_path - |> Dream__pure.Formats.drop_trailing_slash + |> Dream_pure.Formats.from_path + |> Dream_pure.Formats.drop_trailing_slash in let app = Dream.new_app (Error_handler.app error_handler) prefix in diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 2eda9ec6..582104eb 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/content_length.ml b/src/middleware/content_length.ml index 549f2e56..e2e2b9bc 100644 --- a/src/middleware/content_length.ml +++ b/src/middleware/content_length.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index 06b3c22b..dd2a2789 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -5,8 +5,8 @@ -module Formats = Dream__pure.Formats -module Dream = Dream__pure.Inmost +module Formats = Dream_pure.Formats +module Dream = Dream_pure.Inmost module Cipher = Dream__cipher.Cipher diff --git a/src/middleware/csrf.ml b/src/middleware/csrf.ml index 1b615c4c..d60a260f 100644 --- a/src/middleware/csrf.ml +++ b/src/middleware/csrf.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost module Cipher = Dream__cipher.Cipher @@ -25,7 +25,7 @@ let csrf_token ~now ?(valid_for = default_valid_for) request = ] |> Yojson.Basic.to_string |> Cipher.encrypt ~associated_data:field_name request - |> Dream__pure.Formats.to_base64url + |> Dream_pure.Formats.to_base64url let log = Log.sub_log field_name @@ -38,7 +38,7 @@ type csrf_result = [ ] let verify_csrf_token ~now request token = Lwt.return @@ - match Dream__pure.Formats.from_base64url token with + match Dream_pure.Formats.from_base64url token with | None -> log.warning (fun log -> log ~request "CSRF token not Base64-encoded"); `Invalid diff --git a/src/middleware/dune b/src/middleware/dune index 9c4f3c7f..77a2f0b5 100644 --- a/src/middleware/dune +++ b/src/middleware/dune @@ -4,7 +4,7 @@ (libraries digestif dream.cipher - dream.pure + dream-pure fmt logs lwt diff --git a/src/middleware/echo.ml b/src/middleware/echo.ml index cb22a128..b4f3ff73 100644 --- a/src/middleware/echo.ml +++ b/src/middleware/echo.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/error_template.eml.ml b/src/middleware/error_template.eml.ml index 7414c646..27f8d7ad 100644 --- a/src/middleware/error_template.eml.ml +++ b/src/middleware/error_template.eml.ml @@ -7,8 +7,8 @@ module Dream = struct - include Dream__pure.Inmost - include Dream__pure.Formats + include Dream_pure.Inmost + include Dream_pure.Formats end let render ~debug_dump ~code ~reason = diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 6f1d352d..a2457295 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/form.ml b/src/middleware/form.ml index f1886da2..cd302621 100644 --- a/src/middleware/form.ml +++ b/src/middleware/form.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost @@ -58,7 +58,7 @@ let form ?(csrf = true) ~now request = match Dream.header "Content-Type" request with | Some "application/x-www-form-urlencoded" -> let%lwt body = Dream.body request in - let form = Dream__pure.Formats.from_form_urlencoded body in + let form = Dream_pure.Formats.from_form_urlencoded body in if csrf then sort_and_check_form ~now (fun string -> string) form request else diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 68b6da62..271b02a0 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -29,7 +29,7 @@ module Dream = struct - include Dream__pure.Inmost + include Dream_pure.Inmost module Request_id = Request_id end diff --git a/src/middleware/lowercase_headers.ml b/src/middleware/lowercase_headers.ml index 9d5afec3..43be729b 100644 --- a/src/middleware/lowercase_headers.ml +++ b/src/middleware/lowercase_headers.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/origin_referrer_check.ml b/src/middleware/origin_referrer_check.ml index 9f96bd77..a46d1878 100644 --- a/src/middleware/origin_referrer_check.ml +++ b/src/middleware/origin_referrer_check.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/request_id.ml b/src/middleware/request_id.ml index b4b7f51b..0e27bacf 100644 --- a/src/middleware/request_id.ml +++ b/src/middleware/request_id.ml @@ -9,7 +9,7 @@ be built-in code. So it's probably best to look into building in request_id, and getting rid of the concept of built-in middleware. *) -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/router.ml b/src/middleware/router.ml index e374e5ca..32103e30 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/router.mli b/src/middleware/router.mli index fd3cccd9..ca81eb2e 100644 --- a/src/middleware/router.mli +++ b/src/middleware/router.mli @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost type route diff --git a/src/middleware/session.ml b/src/middleware/session.ml index 7e70ef32..0f6c34a9 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -7,7 +7,7 @@ (* https://cheatsheetseries.owasp.org/cheatsheets/Session_Management_Cheat_Sheet.html *) -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost @@ -89,10 +89,10 @@ let (|>?) = two IDs among 100,000,000,000 concurrent sessions (5x the monthly traffic of google.com in February 2021). *) let new_id () = - Dream__cipher.Random.random 18 |> Dream__pure.Formats.to_base64url + Dream__cipher.Random.random 18 |> Dream_pure.Formats.to_base64url let new_label () = - Dream__cipher.Random.random 9 |> Dream__pure.Formats.to_base64url + Dream__cipher.Random.random 9 |> Dream_pure.Formats.to_base64url let version_session_id id = "0" ^ id diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index 7c9fa250..92a3958b 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/middleware/tag.eml.ml b/src/middleware/tag.eml.ml index 6e012436..6942e2b1 100644 --- a/src/middleware/tag.eml.ml +++ b/src/middleware/tag.eml.ml @@ -7,8 +7,8 @@ module Dream = struct - include Dream__pure.Formats - include Dream__pure.Method + include Dream_pure.Formats + include Dream_pure.Method end (* TODO Include the path prefix. *) diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index 0ffde2b7..16143024 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost let field_to_string (request : Dream.request) field = let open Multipart_form in diff --git a/src/mirage/dune b/src/mirage/dune index bd97dc89..6f9f8613 100644 --- a/src/mirage/dune +++ b/src/mirage/dune @@ -8,7 +8,7 @@ dream.cipher dream.localhost dream.middleware - dream.pure + dream-pure dream.h2 dream.httpaf lwt diff --git a/src/pure/dune b/src/pure/dune index 0d479ebf..093a25cf 100644 --- a/src/pure/dune +++ b/src/pure/dune @@ -1,6 +1,6 @@ (library - (public_name dream.pure) - (name dream__pure) + (public_name dream-pure) + (name dream_pure) (libraries base64 bigstringaf diff --git a/src/sql/dune b/src/sql/dune index 8f8fb4a1..7966abac 100644 --- a/src/sql/dune +++ b/src/sql/dune @@ -6,7 +6,7 @@ caqti-lwt dream.cipher dream.middleware - dream.pure + dream-pure uri yojson) (preprocess (pps lwt_ppx)) diff --git a/src/sql/session.ml b/src/sql/session.ml index ea5bf26f..8a37895d 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost module Cookie = Dream__middleware.Cookie module Session = Dream__middleware.Session diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 223f963a..4e97dbdf 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost diff --git a/src/unix/dune b/src/unix/dune index 95128180..824895de 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -3,7 +3,7 @@ (name dream__unix) (libraries digestif - dream.pure + dream-pure lwt.unix magic-mime ) diff --git a/src/unix/static.ml b/src/unix/static.ml index 46c5b688..744ed55b 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -5,7 +5,7 @@ -module Dream = Dream__pure.Inmost +module Dream = Dream_pure.Inmost @@ -17,7 +17,7 @@ module Dream = Dream__pure.Inmost let mime_lookup filename = let content_type = match Magic_mime.lookup filename with - | "text/html" -> Dream__pure.Formats.text_html + | "text/html" -> Dream_pure.Formats.text_html | content_type -> content_type in ["Content-Type", content_type] diff --git a/test/expect/middleware/dune b/test/expect/middleware/dune index 8aef70e3..fb43c9d0 100644 --- a/test/expect/middleware/dune +++ b/test/expect/middleware/dune @@ -4,7 +4,7 @@ base dream dream.middleware - dream.pure + dream-pure lwt lwt.unix ppx_expect.common diff --git a/test/expect/middleware/router.ml b/test/expect/middleware/router.ml index 22599c80..a4c380a7 100644 --- a/test/expect/middleware/router.ml +++ b/test/expect/middleware/router.ml @@ -10,7 +10,7 @@ let () = let path request = Dream.path request - |> Dream__pure.Formats.make_path + |> Dream_pure.Formats.make_path @@ -90,7 +90,7 @@ let show ?(prefix = "/") ?(method_ = `GET) target router = Dream.client_stream response |> Obj.magic (* TODO Needs to be replaced by exposing read_until_close as a function on abstract streams. *) - |> Dream__pure.Stream.read_until_close + |> Dream_pure.Stream.read_until_close |> Lwt_main.run in let status = Dream.status response in diff --git a/test/expect/pure/dune b/test/expect/pure/dune index f0bbebdc..8e509ce2 100644 --- a/test/expect/pure/dune +++ b/test/expect/pure/dune @@ -5,7 +5,7 @@ dream dream.cipher dream.middleware - dream.pure + dream-pure lwt lwt.unix ppx_expect.common diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index edd1f877..90a89410 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -5,7 +5,7 @@ -module Stream = Dream__pure.Stream +module Stream = Dream_pure.Stream From 655be1f754606950efcca11bf40e990bc48efaf9 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 14:48:57 +0300 Subject: [PATCH 068/312] Begin delimiting dream-pure with an .mli file --- src/cipher/cipher.ml | 13 +- src/dream.ml | 53 ++- src/graphql/graphql.ml | 18 +- src/http/adapt.ml | 4 +- src/http/error_handler.ml | 32 +- src/http/error_handler.mli | 2 +- src/http/http.ml | 4 +- src/middleware/catch.ml | 7 +- src/middleware/content_length.ml | 2 +- src/middleware/cookie.ml | 2 +- src/middleware/csrf.ml | 2 +- src/middleware/echo.ml | 9 +- src/middleware/error_template.eml.ml | 7 +- src/middleware/flash.ml | 2 +- src/middleware/form.ml | 2 +- src/middleware/log.ml | 17 +- src/middleware/lowercase_headers.ml | 2 +- src/middleware/origin_referrer_check.ml | 21 +- src/middleware/request_id.ml | 2 +- src/middleware/router.ml | 2 +- src/middleware/router.mli | 2 +- src/middleware/session.ml | 2 +- src/middleware/site_prefix.ml | 10 +- src/middleware/tag.eml.ml | 7 +- src/middleware/upload.ml | 26 +- src/pure/dream_pure.ml | 14 + src/pure/dream_pure.mli | 478 ++++++++++++++++++++++++ src/pure/inmost.ml | 93 ++--- src/pure/stream.mli | 152 -------- src/sql/session.ml | 2 +- src/sql/sql.ml | 2 +- src/unix/static.ml | 29 +- 32 files changed, 743 insertions(+), 277 deletions(-) create mode 100644 src/pure/dream_pure.ml create mode 100644 src/pure/dream_pure.mli delete mode 100644 src/pure/stream.mli diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index a2c3879e..85a5b258 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -112,25 +112,16 @@ struct | Some plaintext -> Some (Cstruct.to_string plaintext) end -(* TODO Ideally, get rid of this open. *) -open Dream_pure.Inmost - -let encryption_secret request = - List.hd request.specific.app.secrets - -let decryption_secrets request = - request.specific.app.secrets - let encrypt ?associated_data request plaintext = encrypt (module AEAD_AES_256_GCM) ?associated_data - (encryption_secret request) + (Dream_pure.encryption_secret request) plaintext let decrypt ?associated_data request ciphertext = decrypt (module AEAD_AES_256_GCM) ?associated_data - (decryption_secrets request) + (Dream_pure.decryption_secrets request) ciphertext diff --git a/src/dream.ml b/src/dream.ml index 9696d516..c0eaecd3 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -6,7 +6,7 @@ include Dream_pure.Stream -include Dream_pure.Inmost +include Dream_pure include Dream__middleware.Log include Dream__middleware.Log.Make (Ptime_clock) @@ -83,6 +83,45 @@ let log = include Dream__middleware.Tag +let respond ?status ?code ?headers body = + let client_stream = stream (string body) no_writer + and server_stream = stream no_reader no_writer in + response ?status ?code ?headers client_stream server_stream + |> Lwt.return + +(* TODO Actually use the request and extract the site prefix. *) +let redirect ?status ?code ?headers _request location = + let status = (status :> redirection option) in + let status = + match status, code with + | None, None -> Some (`See_Other) + | _ -> status + in + (* TODO The streams. *) + let client_stream = stream empty no_writer + and server_stream = stream no_reader no_writer in + response ?status ?code ?headers client_stream server_stream + |> with_header "Location" location + |> Lwt.return + +let stream ?status ?code ?headers f = + (* TODO Streams. *) + let client_stream = stream empty no_writer + and server_stream = stream no_reader no_writer in + let response = + response ?status ?code ?headers client_stream server_stream + |> with_stream + in + (* TODO Should set up an error handler for this. *) + Lwt.async (fun () -> f response); + Lwt.return response + +let empty ?headers status = + respond ?headers ~status "" + +let not_found _ = + respond ~status:`Not_Found "" + let now () = Ptime.to_float_s (Ptime.v (Ptime_clock.now_d_ps ())) let form = form ~now @@ -91,3 +130,15 @@ let csrf_token = csrf_token ~now let verify_csrf_token = verify_csrf_token ~now let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request + +let request ?client ?method_ ?target ?version ?headers body = + (* TODO Streams. *) + let client_stream = Dream_pure.Stream.stream no_reader no_writer + and server_stream = Dream_pure.Stream.stream (string body) no_writer in + request ?client ?method_ ?target ?version ?headers client_stream server_stream + +let response ?status ?code ?headers body = + (* TODO Streams. *) + let client_stream = Dream_pure.Stream.stream (string body) no_writer + and server_stream = Dream_pure.Stream.stream no_reader no_writer in + response ?status ?code ?headers client_stream server_stream diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index de07a9b0..c63c940f 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -282,7 +282,11 @@ let graphql make_context schema = fun request -> (handle_over_websocket make_context schema (Hashtbl.create 16) request) | _ -> log.warning (fun log -> log ~request "Upgrade: websocket header missing"); - Dream.empty `Not_Found + (* TODO Simplify stream creation. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Not_Found client_stream server_stream + |> Lwt.return end | `POST -> @@ -310,13 +314,19 @@ let graphql make_context schema = fun request -> | _ -> log.warning (fun log -> log ~request "Content-Type not 'application/json'"); - Dream.empty `Bad_Request + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Request client_stream server_stream + |> Lwt.return end | method_ -> log.error (fun log -> log ~request "Method %s; must be GET or POST" (Dream.method_to_string method_)); - Dream.empty `Not_Found + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Not_Found client_stream server_stream + |> Lwt.return diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 542a652b..fdb1f7a6 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure module Stream = Dream_pure.Stream @@ -22,7 +22,7 @@ let address_to_string : Unix.sockaddr -> string = function let forward_body_general (response : Dream.response) (_write_string : ?off:int -> ?len:int -> string -> unit) - (write_buffer : ?off:int -> ?len:int -> Stream.buffer -> unit) + (write_buffer : ?off:int -> ?len:int -> Dream.buffer -> unit) http_flush close = diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 43d129de..d6a4cd0e 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -176,7 +176,10 @@ let customize template (error : Dream.error) = | `Server -> `Internal_Server_Error | `Client -> `Bad_Request in - Dream.response ~status "" + (* TODO Simplify the streams creation. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status client_stream server_stream in (* No need to catch errors when calling the template, because every call @@ -238,9 +241,19 @@ let respond_with_option f = f () |> Lwt.map (function | Some response -> response - | None -> Dream.response ~status:`Internal_Server_Error "")) + | None -> + (* TODO Simplify streams. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response + ~status:`Internal_Server_Error client_stream server_stream)) (fun () -> - Dream.empty `Internal_Server_Error) + (* TODO Simplify streams. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response + ~status:`Internal_Server_Error client_stream server_stream + |> Lwt.return) @@ -316,9 +329,16 @@ let app +(* TODO Simplify streams. *) let default_response = function - | `Server -> Dream.response ~status:`Internal_Server_Error "" - | `Client -> Dream.response ~status:`Bad_Request "" + | `Server -> + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Internal_Server_Error client_stream server_stream + | `Client -> + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Request client_stream server_stream let httpaf app user's_error_handler = diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index 667f271f..cea4917e 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/http/http.ml b/src/http/http.ml index e62225c5..97cbae38 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure module Stream = Dream_pure.Stream @@ -803,7 +803,7 @@ let serve_with_maybe_https user's_dream_handler | `OpenSSL | `OCaml_TLS as tls_library -> - app.https <- true; + Dream.set_https true app; (* TODO Writing temporary files is extremely questionable for anything except the fake localhost certificate. This needs loud warnings. IIRC diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 582104eb..01cc30ca 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -44,7 +44,8 @@ let catch_errors next_handler request = will_send_response = true; } in - let user's_error_handler = (Dream.app request).error_handler in + let user's_error_handler = + Dream.app_error_handler (Dream.app request) in user's_error_handler error end else @@ -67,5 +68,5 @@ let catch_errors next_handler request = will_send_response = true; } in - let user's_error_handler = (Dream.app request).error_handler in + let user's_error_handler = Dream.app_error_handler (Dream.app request) in user's_error_handler error) diff --git a/src/middleware/content_length.ml b/src/middleware/content_length.ml index e2e2b9bc..20c8b87a 100644 --- a/src/middleware/content_length.ml +++ b/src/middleware/content_length.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index dd2a2789..cd6fd8bc 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -6,7 +6,7 @@ module Formats = Dream_pure.Formats -module Dream = Dream_pure.Inmost +module Dream = Dream_pure module Cipher = Dream__cipher.Cipher diff --git a/src/middleware/csrf.ml b/src/middleware/csrf.ml index d60a260f..13da958b 100644 --- a/src/middleware/csrf.ml +++ b/src/middleware/csrf.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure module Cipher = Dream__cipher.Cipher diff --git a/src/middleware/echo.ml b/src/middleware/echo.ml index b4f3ff73..2bf28d82 100644 --- a/src/middleware/echo.ml +++ b/src/middleware/echo.ml @@ -5,10 +5,15 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure (* TODO Convert to streaming later. *) let echo request = - Lwt.map Dream.response (Dream.body request) + (* TODO Simplfy this code. Can in fact just pass the request's server stream + as the response's client stream. *) + let client_stream = Dream.server_stream request in + let server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response client_stream server_stream + |> Lwt.return diff --git a/src/middleware/error_template.eml.ml b/src/middleware/error_template.eml.ml index 27f8d7ad..b55bb40c 100644 --- a/src/middleware/error_template.eml.ml +++ b/src/middleware/error_template.eml.ml @@ -7,9 +7,14 @@ module Dream = struct - include Dream_pure.Inmost + include Dream_pure include Dream_pure.Formats end +(* This slightly awkward simulation of the overall Dream module using a + composition of internal modules is necessary to get all the helpers at the + right positions expected by the EML templater. *) + + let render ~debug_dump ~code ~reason = diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index a2457295..101de0e8 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/form.ml b/src/middleware/form.ml index cd302621..804fb7fc 100644 --- a/src/middleware/form.ml +++ b/src/middleware/form.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 271b02a0..d32d8081 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -27,11 +27,7 @@ This is sufficient for attaching a request id to most log messages, in practice. *) -module Dream = -struct - include Dream_pure.Inmost - module Request_id = Request_id -end +module Dream = Dream_pure @@ -157,7 +153,7 @@ let reporter ~now () = match request_id_from_tags with | Some _ -> request_id_from_tags | None -> - Dream.Request_id.get_option () + Request_id.get_option () in let request_id, request_style = @@ -211,13 +207,6 @@ let set_async_exception_hook = let _initialized = ref None -type log_level = [ - | `Error - | `Warning - | `Info - | `Debug -] - let to_logs_level l = match l with | `Error -> Logs.Error @@ -273,7 +262,7 @@ let sub_log ?level:level_ name = match request with | None -> Logs.Tag.empty | Some request -> - match Dream.Request_id.get_option ~request () with + match Request_id.get_option ~request () with | None -> Logs.Tag.empty | Some request_id -> Logs.Tag.add logs_lib_tag request_id Logs.Tag.empty diff --git a/src/middleware/lowercase_headers.ml b/src/middleware/lowercase_headers.ml index 43be729b..1a4cea4c 100644 --- a/src/middleware/lowercase_headers.ml +++ b/src/middleware/lowercase_headers.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/origin_referrer_check.ml b/src/middleware/origin_referrer_check.ml index a46d1878..3668d3ae 100644 --- a/src/middleware/origin_referrer_check.ml +++ b/src/middleware/origin_referrer_check.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -30,7 +30,11 @@ let origin_referrer_check inner_handler request = | None -> log.warning (fun log -> log ~request "Origin and Referer headers both missing"); - Dream.empty `Bad_Request + (* TODO Simplify. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Request client_stream server_stream + |> Lwt.return (* TODO Also recommend Uri to users. *) | Some origin -> @@ -38,7 +42,12 @@ let origin_referrer_check inner_handler request = match Dream.header "Host" request with | None -> log.warning (fun log -> log ~request "Host header missing"); - Dream.empty `Bad_Request + (* TODO Simplify. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Request client_stream server_stream + |> Lwt.return + | Some host -> let origin_uri = Uri.of_string origin in @@ -71,5 +80,9 @@ let origin_referrer_check inner_handler request = else begin log.warning (fun log -> log ~request "Origin-Host mismatch: '%s' vs. '%s'" origin host); - Dream.empty `Bad_Request + (* TODO Simplify. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Request client_stream server_stream + |> Lwt.return end diff --git a/src/middleware/request_id.ml b/src/middleware/request_id.ml index 0e27bacf..3e8056f0 100644 --- a/src/middleware/request_id.ml +++ b/src/middleware/request_id.ml @@ -9,7 +9,7 @@ be built-in code. So it's probably best to look into building in request_id, and getting rid of the concept of built-in middleware. *) -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/router.ml b/src/middleware/router.ml index 32103e30..b5bc3913 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/router.mli b/src/middleware/router.mli index ca81eb2e..77161c7f 100644 --- a/src/middleware/router.mli +++ b/src/middleware/router.mli @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure type route diff --git a/src/middleware/session.ml b/src/middleware/session.ml index 0f6c34a9..4e984b31 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -7,7 +7,7 @@ (* https://cheatsheetseries.owasp.org/cheatsheets/Session_Management_Cheat_Sheet.html *) -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index 92a3958b..cbec6545 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -25,10 +25,14 @@ let rec match_site_prefix prefix path = (* TODO The path and prefix representations and accessors need a cleanup. *) let chop_site_prefix next_handler request = - let prefix = (Dream.app request).site_prefix in + let prefix = Dream.site_prefix request in match match_site_prefix prefix (Dream.path request) with | None -> - Dream.empty `Bad_Gateway + (* TODO Streams. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Bad_Gateway client_stream server_stream + |> Lwt.return | Some path -> (* TODO This doesn't need to be recomputed on each request - can cache the result in the app. *) diff --git a/src/middleware/tag.eml.ml b/src/middleware/tag.eml.ml index 6942e2b1..237197fd 100644 --- a/src/middleware/tag.eml.ml +++ b/src/middleware/tag.eml.ml @@ -7,9 +7,14 @@ module Dream = struct + include Dream_pure include Dream_pure.Formats - include Dream_pure.Method end +(* This slightly awkward simulation of the overall Dream module using a + composition of internal modules is necessary to get all the helpers at the + right positions expected by the EML templater. *) + + (* TODO Include the path prefix. *) let form_tag diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index 16143024..cd9a024b 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -5,7 +5,9 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure + + let field_to_string (request : Dream.request) field = let open Multipart_form in @@ -13,8 +15,9 @@ let field_to_string (request : Dream.request) field = | Field.Field (field_name, Field.Content_type, v) -> (field_name :> string), Content_type.to_string v | Field.Field (field_name, Field.Content_disposition, v) -> - request.specific.upload.filename <- Content_disposition.filename v ; - request.specific.upload.name <- Content_disposition.name v ; + let state = Dream.multipart_state request in + state.filename <- Content_disposition.filename v ; + state.name <- Content_disposition.name v ; (field_name :> string), Content_disposition.to_string v | Field.Field (field_name, Field.Content_encoding, v) -> (field_name :> string), Content_encoding.to_string v @@ -24,14 +27,15 @@ let field_to_string (request : Dream.request) field = let log = Log.sub_log "dream.upload" let upload_part (request : Dream.request) = - match%lwt Lwt_stream.peek request.specific.upload.stream with + let state = Dream.multipart_state request in + match%lwt Lwt_stream.peek state.stream with | None -> Lwt.return_none | Some (_uid, _header, stream) -> match%lwt Lwt_stream.get stream with | Some _ as v -> Lwt.return v | None -> log.debug (fun m -> m "End of the part.") ; - let%lwt () = Lwt_stream.junk request.specific.upload.stream in + let%lwt () = Lwt_stream.junk state.stream in (* XXX(dinosaure): delete the current part from the [stream]. *) Lwt.return_none @@ -40,7 +44,8 @@ let identify _ = object end type part = string option * string option * ((string * string) list) let rec state (request : Dream.request) = - let stream = request.specific.upload.stream in + let state' = Dream.multipart_state request in + let stream = state'.stream in match%lwt Lwt_stream.peek stream with | None -> let%lwt () = Lwt_stream.junk stream in Lwt.return_none | Some (_, headers, _stream) -> @@ -50,11 +55,12 @@ let rec state (request : Dream.request) = |> List.map (field_to_string request) in let part = - request.specific.upload.name, request.specific.upload.filename, headers in + state'.name, state'.filename, headers in Lwt.return (Some part) and upload (request : Dream.request) = - match request.specific.upload.state_init with + let state' = Dream.multipart_state request in + match state'.state_init with | false -> state request @@ -79,8 +85,8 @@ and upload (request : Dream.request) = let `Parse th, stream = Multipart_form_lwt.stream ~identify body content_type in Lwt.async (fun () -> let%lwt _ = th in Lwt.return_unit); - request.specific.upload.stream <- stream; - request.specific.upload.state_init <- false; + state'.stream <- stream; + state'.state_init <- false; state request type multipart_form = diff --git a/src/pure/dream_pure.ml b/src/pure/dream_pure.ml new file mode 100644 index 00000000..ed3ecab7 --- /dev/null +++ b/src/pure/dream_pure.ml @@ -0,0 +1,14 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +module Formats = Formats + +module Stream = Stream +type buffer = Stream.buffer +type stream = Stream.stream + +include Inmost diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli new file mode 100644 index 00000000..95ec6e1e --- /dev/null +++ b/src/pure/dream_pure.mli @@ -0,0 +1,478 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +type 'a message + +type client +type server + +type request = client message +type response = server message + +type 'a promise = 'a Lwt.t +type handler = request -> response promise +type middleware = handler -> handler + +type buffer = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t +type stream + + + +type method_ = [ + | `GET + | `POST + | `PUT + | `DELETE + | `HEAD + | `CONNECT + | `OPTIONS + | `TRACE + | `PATCH + | `Method of string +] + +val method_to_string : [< method_ ] -> string +val string_to_method : string -> method_ +val methods_equal : [< method_ ] -> [< method_ ] -> bool +val normalize_method : [< method_ ] -> method_ + + + +type informational = [ + | `Continue + | `Switching_Protocols +] + +type successful = [ + | `OK + | `Created + | `Accepted + | `Non_Authoritative_Information + | `No_Content + | `Reset_Content + | `Partial_Content +] + +type redirection = [ + | `Multiple_Choices + | `Moved_Permanently + | `Found + | `See_Other + | `Not_Modified + | `Temporary_Redirect + | `Permanent_Redirect +] + +type client_error = [ + | `Bad_Request + | `Unauthorized + | `Payment_Required + | `Forbidden + | `Not_Found + | `Method_Not_Allowed + | `Not_Acceptable + | `Proxy_Authentication_Required + | `Request_Timeout + | `Conflict + | `Gone + | `Length_Required + | `Precondition_Failed + | `Payload_Too_Large + | `URI_Too_Long + | `Unsupported_Media_Type + | `Range_Not_Satisfiable + | `Expectation_Failed + | `Misdirected_Request + | `Too_Early + | `Upgrade_Required + | `Precondition_Required + | `Too_Many_Requests + | `Request_Header_Fields_Too_Large + | `Unavailable_For_Legal_Reasons +] + +type server_error = [ + | `Internal_Server_Error + | `Not_Implemented + | `Bad_Gateway + | `Service_Unavailable + | `Gateway_Timeout + | `HTTP_Version_Not_Supported +] + +type standard_status = [ + | informational + | successful + | redirection + | client_error + | server_error +] + +type status = [ + | standard_status + | `Status of int +] + +val status_to_string : [< status ] -> string +val status_to_reason : [< status ] -> string option +val status_to_int : [< status ] -> int +val int_to_status : int -> status +val is_informational : [< status ] -> bool +val is_successful : [< status ] -> bool +val is_redirection : [< status ] -> bool +val is_client_error : [< status ] -> bool +val is_server_error : [< status ] -> bool +val status_codes_equal : [< status ] -> [< status ] -> bool +val normalize_status : [< status ] -> status + + + +val client : request -> string +val https : request -> bool +val method_ : request -> method_ +val target : request -> string +val prefix : request -> string +val internal_prefix : request -> string list +val path : request -> string list +val version : request -> int * int +val encryption_secret : request -> string +val decryption_secrets : request -> string list +(* TODO Get the encryption secrets out of here and into the server only. + Also try to move the whole "app" mechanism to the server only. However, how + will that interact with in-process testing? *) +val site_prefix : request -> string list +(* TODO This will be moved out of dream-pure and become just a server-side + middleware.. *) +val with_client : string -> request -> request +val with_method_ : [< method_ ] -> request -> request +val with_prefix : string list -> request -> request +val with_path : string list -> request -> request +val with_version : int * int -> request -> request +(* TODO Path handling should also be done by server-side-only helpers. *) +val query : string -> request -> string option +val queries : string -> request -> string list +val all_queries : request -> (string * string) list + + + +val response : + ?status:[< status ] -> + ?code:int -> + ?headers:(string * string) list -> + stream -> + stream -> + response + +val html : + ?status:[< status ] -> + ?code:int -> + ?headers:(string * string) list -> + string -> response promise +(* TODO Remove these. *) + +val json : + ?status:[< status ] -> + ?code:int -> + ?headers:(string * string) list -> + string -> response promise + +val status : response -> status + + + +val header : string -> 'a message -> string option +val headers : string -> 'a message -> string list +val all_headers : 'a message -> (string * string) list +val has_header : string -> 'a message -> bool +val add_header : string -> string -> 'a message -> 'a message +val drop_header : string -> 'a message -> 'a message +val with_header : string -> string -> 'a message -> 'a message +val with_all_headers : (string * string) list -> 'a message -> 'a message + + + +val all_cookies : request -> (string * string) list +(* TODO Should become server-side-only. *) + + + +val body : 'a message -> string promise +val with_body : string -> response -> response +val read : request -> string option promise +val with_stream : 'a message -> 'a message +val write : response -> string -> unit promise +val flush : response -> unit promise +val close_stream : response -> unit promise +(* TODO This will need to read different streams depending on whether it is + passed a request or a response. *) +val client_stream : 'a message -> stream +val server_stream : 'a message -> stream +val with_client_stream : stream -> 'a message -> 'a message +val next : + stream -> + data:(buffer -> int -> int -> bool -> bool -> unit) -> + close:(int -> unit) -> + flush:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> + unit +val write_buffer : + ?offset:int -> ?length:int -> response -> buffer -> unit promise + +module Stream : +sig +type reader + +type writer + +type read = + data:(buffer -> int -> int -> bool -> bool -> unit) -> + close:(int -> unit) -> + flush:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> + unit +(** A reading function. Awaits the next event on the stream. For each call of a + reading function, one of the callbacks will eventually be called, according + to which event occurs next on the stream. *) + +type write = + close:(int -> unit) -> + (unit -> unit) -> + unit +(** A writing function. Pushes an event into a stream. May take additional + arguments before [~ok]. *) + +val reader : read:read -> close:(int -> unit) -> reader +(** Creates a read-only stream from the given reader. [~close] is called in + response to {!Stream.close}. It doesn't need to call {!Stream.close} again + on the stream. It should be used to free any underlying resources. *) + +val empty : reader +(** A read-only stream whose reading function always calls its [~close] + callback. *) + +val string : string -> reader +(** A read-only stream which calls its [~data] callback once with the contents + of the given string, and then always calls [~close]. *) + +val pipe : unit -> reader * writer +(** A stream which matches each call of the reading function to one call of its + writing functions. For example, calling {!Stream.flush} on a pipe will cause + the reader to call its [~flush] callback. *) + +val writer : + ready:write -> + write:(buffer -> int -> int -> bool -> bool -> write) -> + flush:write -> + ping:(buffer -> int -> int -> write) -> + pong:(buffer -> int -> int -> write) -> + close:(int -> unit) -> + writer + +val no_reader : reader + +val no_writer : writer + +val stream : reader -> writer -> stream +(* TODO Consider tupling the arguments, as that will make it easier to pass the + result of Stream.pipe. *) + +val close : stream -> int -> unit +(** Closes the given stream. Causes a pending reader or writer to call its + [~close] callback. *) + +val read : stream -> read +(** Awaits the next stream event. See {!Stream.type-read}. *) + +val read_convenience : stream -> string option promise +(** A wrapper around {!Stream.read} that converts [~data] with content [s] into + [Some s], and [~close] into [None], and uses them to resolve a promise. + [~flush] is ignored. *) + +val read_until_close : stream -> string promise +(** Reads a stream completely until [~close], and accumulates the data into a + string. *) + +val ready : stream -> write + +val write : stream -> buffer -> int -> int -> bool -> bool -> write +(** A writing function that sends a data buffer on the given stream. No more + writing functions should be called on the stream until this function calls + [~ok]. The [bool] arguments are whether the message is binary and whether + the [FIN] flag should be set. They are ignored by non-WebSocket streams. + + Note: [FIN] is provided as part of the write call, rather than being a + separate stream event (like [flush]), because the WebSocket writer needs to + immediately know when the last chunk of the last frame in a message is + provided, to transmit the [FIN] bit. If [FIN] were to be provided as a + separate event, the WebSocket writer would have to buffer each one chunk, in + case the next stream event was [FIN], in order to be able to decide whether + to set the [FIN] bit or not. This is awkward and inefficient, as it + introduces an unnecessary delay into the writer, as if the next event is not + [FIN], the next data chunk might take an arbitrary amount of time to be + generated by the writing user code. *) + +val flush : stream -> write +(** A writing function that asks for the given stream to be flushed. The meaning + of flushing depends on the implementation of the stream. No more writing + functions should be called on the stream until this function calls [~ok]. *) + +val ping : stream -> buffer -> int -> int -> write +(** A writing function that sends a ping event on the given stream. This is only + meaningful for WebSockets. *) + +val pong : stream -> buffer -> int -> int -> write +(** A writing function that sends a pong event on the given stream. This is only + meaningful for WebSockets. *) +end + +(* TODO Remove to server-side code. *) +type multipart_state = { + mutable state_init : bool; + mutable name : string option; + mutable filename : string option; + mutable stream : (< > * Multipart_form.Header.t * string Lwt_stream.t) Lwt_stream.t; +} + +val multipart_state : request -> multipart_state + + + +val no_middleware : middleware +val pipeline : middleware list -> middleware + + + +type websocket = stream +val websocket : + ?headers:(string * string) list -> + (websocket -> unit promise) -> + response promise +val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise +val receive : websocket -> string option promise +val close_websocket : ?code:int -> websocket -> unit promise +val is_websocket : response -> (websocket -> unit promise) option + + + +(* TODO All of this should become server-side-only once the error handling + middleware is clarified. *) +type app + +type log_level = [ + | `Error + | `Warning + | `Info + | `Debug +] + +type error = { + condition : [ + | `Response of response + | `String of string + | `Exn of exn + ]; + layer : [ + | `App + | `HTTP + | `HTTP2 + | `TLS + | `WebSocket + ]; + caused_by : [ + | `Server + | `Client + ]; + request : request option; + response : response option; + client : string option; + severity : log_level; + debug : bool; + will_send_response : bool; +} + +type error_handler = error -> response option promise + +val new_app : (error -> response Lwt.t) -> string list -> app +val app : request -> app +val debug : app -> bool +val set_debug : bool -> app -> unit +val app_error_handler : app -> (error -> response promise) +val set_secrets : string list -> app -> unit +val set_https : bool -> app -> unit +val request_from_http : + app:app -> + client:string -> + method_:method_ -> + target:string -> + version:int * int -> + headers:(string * string) list -> + stream -> + request + + + +module Formats : +sig + val html_escape : string -> string + val to_base64url : string -> string + val from_base64url : string -> string option + val to_percent_encoded : ?international:bool -> string -> string + val from_percent_encoded : string -> string + val to_form_urlencoded : (string * string) list -> string + val from_form_urlencoded : string -> (string * string) list + val from_cookie : string -> (string * string) list + val to_set_cookie : + ?expires:float -> + ?max_age:float -> + ?domain:string -> + ?path:string -> + ?secure:bool -> + ?http_only:bool -> + ?same_site:[ `Strict | `Lax | `None ] -> + string -> string -> string + val split_target : string -> string * string + val from_path : string -> string list + val to_path : ?relative:bool -> ?international:bool -> string list -> string + val drop_trailing_slash : string list -> string list + val text_html : string + val application_json : string +end + + + +type 'a local +val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local +val local : 'a local -> 'b message -> 'a option +val with_local : 'a local -> 'a -> 'b message -> 'b message +val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a + +type 'a global +val new_global : + ?name:string -> ?show_value:('a -> string) -> (unit -> 'a) -> 'a global +val global : 'a global -> request -> 'a +(* TODO Get rid of globals completely as a concept, once the site_prefix + middleware is clarified. *) +val fold_globals : (string -> string -> 'a -> 'a) -> 'a -> request -> 'a + + + +(* TODO Delete once requests are mutable. *) +val request : + ?client:string -> + ?method_:[< method_ ] -> + ?target:string -> + ?version:int * int -> + ?headers:(string * string) list -> + stream -> + stream -> + request +val first : 'a message -> 'a message +val last : 'a message -> 'a message +val sort_headers : (string * string) list -> (string * string) list diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index f2867332..4e712a7c 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -8,6 +8,8 @@ include Method include Status + + (* Used for converting the stream interface of [multipart_form] into the pull interface of Dream. @@ -78,6 +80,13 @@ and app = { and error_handler = error -> response option Lwt.t +and log_level = [ + | `Error + | `Warning + | `Info + | `Debug +] + and error = { condition : [ | `Response of response @@ -115,6 +124,10 @@ let debug app = let set_debug value app = app.app_debug <- value +(* TODO Remove. *) +let app_error_handler app = + app.error_handler + (* TODO Delete; now using key. *) let secret app = List.hd app.secrets @@ -122,6 +135,12 @@ let secret app = let set_secrets secrets app = app.secrets <- secrets +let set_https https app = + app.https <- https + +let site_prefix request = + request.specific.app.site_prefix + let new_app error_handler site_prefix = { globals = ref Scope.empty; app_debug = false; @@ -472,7 +491,8 @@ let request ?(target = "/") ?(version = 1, 1) ?(headers = []) - body = + client_stream + server_stream = let method_ = match (method_ :> method_ option) with @@ -499,8 +519,8 @@ let request upload = initial_multipart_state (); }; headers; - client_stream = Stream.(stream no_reader no_writer); - server_stream = Stream.(stream (string body) no_writer); + client_stream; + server_stream; locals = Scope.empty; first = request; last = ref request; @@ -509,10 +529,7 @@ let request request let response - ?status - ?code - ?(headers = []) - body = + ?status ?code ?(headers = []) client_stream server_stream = let status = match status, code with @@ -527,8 +544,8 @@ let response websocket = None; }; headers; - client_stream = Stream.(stream (string body) no_writer); - server_stream = Stream.(stream no_reader no_writer); + client_stream; + server_stream; (* TODO This fully dead stream should be preallocated. *) locals = Scope.empty; first = response; @@ -537,49 +554,29 @@ let response response -let respond ?status ?code ?headers body = - response ?status ?code ?headers body - |> Lwt.return - let html ?status ?code ?headers body = - response ?status ?code ?headers body + (* TODO The streams. *) + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + response ?status ?code ?headers client_stream server_stream |> with_header "Content-Type" Formats.text_html |> Lwt.return let json ?status ?code ?headers body = - response ?status ?code ?headers body + (* TODO The streams. *) + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + response ?status ?code ?headers client_stream server_stream |> with_header "Content-Type" Formats.application_json |> Lwt.return -(* TODO Actually use the request and extract the site prefix. *) -let redirect ?status ?code ?headers _request location = - let status = (status :> redirection option) in - let status = - match status, code with - | None, None -> Some (`See_Other) - | _ -> status - in - response ?status ?code ?headers "" - |> with_header "Location" location - |> Lwt.return - -let stream ?status ?code ?headers f = - let response = - response ?status ?code ?headers "" - |> with_stream - in - (* TODO Should set up an error handler for this. *) - Lwt.async (fun () -> f response); - Lwt.return response - -let empty ?headers status = - respond ?headers ~status "" - -let not_found _ = - respond ~status:`Not_Found "" - let websocket ?headers handler = - let response = response ?headers ~status:`Switching_Protocols "" in + (* TODO Simplify stream creation. *) + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + let response = + response + ?headers ~status:`Switching_Protocols client_stream server_stream in let response = {response with specific = {response.specific with websocket = Some handler}} @@ -621,3 +618,13 @@ let rec pipeline middlewares handler = let sort_headers headers = List.stable_sort (fun (name, _) (name', _) -> compare name name') headers + +let encryption_secret request = + List.hd request.specific.app.secrets + +let decryption_secrets request = + request.specific.app.secrets + +(* TODO Remove to server-side code. *) +let multipart_state request = + request.specific.upload diff --git a/src/pure/stream.mli b/src/pure/stream.mli deleted file mode 100644 index 23278e11..00000000 --- a/src/pure/stream.mli +++ /dev/null @@ -1,152 +0,0 @@ -(* This file is part of Dream, released under the MIT license. See LICENSE.md - for details, or visit https://github.com/aantron/dream. - - Copyright 2021 Anton Bachin *) - - - -type buffer = - (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -(** Type abbreviation for byte buffers in the C heap. *) - -type 'a promise = - 'a Lwt.t -(** Type abbreviation for promises. *) - -type reader - -type writer - -type stream -(** This module's principal type, the {e stream}. - - Streams are basically just tuples of a reading function and several writing - functions. In C++ terms, they are vtables. Different stream objects can have - completely different implementations of these functions. Concrete stream - constructors, such as {!Stream.empty} and {!Stream.pipe} implement those - functions in interesting ways. - - There are three main kinds of streams used in Dream: - - - {e Read-only streams} have the reading function implemented, and the - writers raise exceptions when called. These are typically created by the - HTTP layer as facades for the underlying HTTP server's request body - reader. - - {e Pipes} have their reading function connected to their writing - functions. Pipes are essentially a synchronization primitive that allows - one reader to be satisfied by one writer. These are created for responses, - because responses are created deep in the user's Web application, and the - HTTP layer reads them later to process the application's writes. Pipes can - also be created by middlewares that transform messages bodies, such as for - compression. - - {e Duplex streams} have the reading function and writing functions - implemented, but connected to different streams. This is used primarily - for WebSockets, where writing to the stream causes data to be sent to the - client, and reading from the stream awaits data to be received from the - client. - - Streams are asynchronous. Readers and writers expect callbacks, and call - them when underlying operations complete. - - The entire interface is pull-based for flow control. *) - -type read = - data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> - flush:(unit -> unit) -> - ping:(buffer -> int -> int -> unit) -> - pong:(buffer -> int -> int -> unit) -> - unit -(** A reading function. Awaits the next event on the stream. For each call of a - reading function, one of the callbacks will eventually be called, according - to which event occurs next on the stream. *) - -type write = - close:(int -> unit) -> - (unit -> unit) -> - unit -(** A writing function. Pushes an event into a stream. May take additional - arguments before [~ok]. *) - -val reader : read:read -> close:(int -> unit) -> reader -(** Creates a read-only stream from the given reader. [~close] is called in - response to {!Stream.close}. It doesn't need to call {!Stream.close} again - on the stream. It should be used to free any underlying resources. *) - -val empty : reader -(** A read-only stream whose reading function always calls its [~close] - callback. *) - -val string : string -> reader -(** A read-only stream which calls its [~data] callback once with the contents - of the given string, and then always calls [~close]. *) - -val pipe : unit -> reader * writer -(** A stream which matches each call of the reading function to one call of its - writing functions. For example, calling {!Stream.flush} on a pipe will cause - the reader to call its [~flush] callback. *) - -val writer : - ready:write -> - write:(buffer -> int -> int -> bool -> bool -> write) -> - flush:write -> - ping:(buffer -> int -> int -> write) -> - pong:(buffer -> int -> int -> write) -> - close:(int -> unit) -> - writer - -val no_reader : reader - -val no_writer : writer - -val stream : reader -> writer -> stream -(* TODO Consider tupling the arguments, as that will make it easier to pass the - result of Stream.pipe. *) - -val close : stream -> int -> unit -(** Closes the given stream. Causes a pending reader or writer to call its - [~close] callback. *) - -val read : stream -> read -(** Awaits the next stream event. See {!Stream.type-read}. *) - -val read_convenience : stream -> string option promise -(** A wrapper around {!Stream.read} that converts [~data] with content [s] into - [Some s], and [~close] into [None], and uses them to resolve a promise. - [~flush] is ignored. *) - -val read_until_close : stream -> string promise -(** Reads a stream completely until [~close], and accumulates the data into a - string. *) - -val ready : stream -> write - -val write : stream -> buffer -> int -> int -> bool -> bool -> write -(** A writing function that sends a data buffer on the given stream. No more - writing functions should be called on the stream until this function calls - [~ok]. The [bool] arguments are whether the message is binary and whether - the [FIN] flag should be set. They are ignored by non-WebSocket streams. - - Note: [FIN] is provided as part of the write call, rather than being a - separate stream event (like [flush]), because the WebSocket writer needs to - immediately know when the last chunk of the last frame in a message is - provided, to transmit the [FIN] bit. If [FIN] were to be provided as a - separate event, the WebSocket writer would have to buffer each one chunk, in - case the next stream event was [FIN], in order to be able to decide whether - to set the [FIN] bit or not. This is awkward and inefficient, as it - introduces an unnecessary delay into the writer, as if the next event is not - [FIN], the next data chunk might take an arbitrary amount of time to be - generated by the writing user code. *) - -val flush : stream -> write -(** A writing function that asks for the given stream to be flushed. The meaning - of flushing depends on the implementation of the stream. No more writing - functions should be called on the stream until this function calls [~ok]. *) - -val ping : stream -> buffer -> int -> int -> write -(** A writing function that sends a ping event on the given stream. This is only - meaningful for WebSockets. *) - -val pong : stream -> buffer -> int -> int -> write -(** A writing function that sends a pong event on the given stream. This is only - meaningful for WebSockets. *) diff --git a/src/sql/session.ml b/src/sql/session.ml index 8a37895d..41791ff8 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure module Cookie = Dream__middleware.Cookie module Session = Dream__middleware.Session diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 4e97dbdf..c1ec2d80 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure diff --git a/src/unix/static.ml b/src/unix/static.ml index 744ed55b..5c09e463 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Dream = Dream_pure @@ -28,8 +28,17 @@ let from_filesystem local_root path _ = (fun () -> Lwt_io.(with_file ~mode:Input file) (fun channel -> let%lwt content = Lwt_io.read channel in - Dream.respond ~headers:(mime_lookup path) content)) - (fun _exn -> Dream.empty `Not_Found) + (* TODO Can use some pre-allocated streams or helpers here and below. *) + let client_stream = Dream.Stream.(stream (string content) no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~headers:(mime_lookup path) client_stream server_stream + |> Lwt.return)) + (fun _exn -> + (* TODO Improve the two-stream code using some helper. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Not_Found client_stream server_stream + |> Lwt.return) (* TODO Add ETag handling. *) (* TODO Add Content-Length handling? *) @@ -67,11 +76,21 @@ let validate_path request = let static ?(loader = from_filesystem) local_root = fun request -> if not @@ Dream.methods_equal (Dream.method_ request) `GET then - Dream.empty `Not_Found + (* TODO Simplify this code and reduce allocations. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Not_Found client_stream server_stream + |> Lwt.return else match validate_path request with - | None -> Dream.empty `Not_Found + | None -> + (* TODO Improve with helpers. *) + let client_stream = Dream.Stream.(stream empty no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ~status:`Not_Found client_stream server_stream + |> Lwt.return + | Some path -> let%lwt response = loader local_root path request in From e106e6ec37e3859261f55acf845dd830c8a18bba Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 14:54:16 +0300 Subject: [PATCH 069/312] Fix .gitignore and commit dream-pure.opam --- .gitignore | 3 ++- dream-pure.opam | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 dream-pure.opam diff --git a/.gitignore b/.gitignore index 9969b6bd..575d62a5 100644 --- a/.gitignore +++ b/.gitignore @@ -15,7 +15,8 @@ _esy/ esy.lock # Release script -dream-* +dream-*.gz +dream-*/ # Bisect_ppx _coverage/ diff --git a/dream-pure.opam b/dream-pure.opam new file mode 100644 index 00000000..13382927 --- /dev/null +++ b/dream-pure.opam @@ -0,0 +1,34 @@ +opam-version: "2.0" + +synopsis: "Internal: shared HTTP types for Dream (server) and Hyper (client)" + +license: "MIT" +homepage: "https://github.com/aantron/dream" +doc: "https://aantron.github.io/dream" +bug-reports: "https://github.com/aantron/dream/issues" +dev-repo: "git+https://github.com/aantron/dream.git" + +author: "Anton Bachin " +maintainer: "Anton Bachin " + +depends: [ + "base64" {>= "3.1.0"} # Base64.encode_string. + "bigstringaf" {>= "0.5.0"} # Bigstringaf.to_string. + "dune" {>= "2.7.0"} # --instrument-with. + "hmap" + "lwt" + "multipart_form" {>= "0.3.0"} + "ocaml" {>= "4.08.0"} + "ptime" {>= "0.8.1"} # Ptime.weekday. + "uri" {>= "4.2.0"} + + # Testing, development. + "alcotest" {with-test} + "bisect_ppx" {with-test & >= "2.5.0"} # --instrument-with. + "ppx_expect" {with-test} + "ppx_yojson_conv" {with-test} +] + +build: [ + ["dune" "build" "-p" name "-j" jobs] +] From bb2924de0bb9d3f0aa3a679f401603e651099d8e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 17:45:20 +0300 Subject: [PATCH 070/312] Assign request ids lazily and implicitly --- src/dream.ml | 2 - src/dream.mli | 4 -- src/http/http.ml | 5 +- src/middleware/log.ml | 69 ++++++++++++++++++++++++-- src/middleware/request_id.ml | 94 ------------------------------------ 5 files changed, 66 insertions(+), 108 deletions(-) delete mode 100644 src/middleware/request_id.ml diff --git a/src/dream.ml b/src/dream.ml index c0eaecd3..9f8d0561 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -52,7 +52,6 @@ include Dream__http.Http include Dream__middleware.Lowercase_headers include Dream__middleware.Catch -include Dream__middleware.Request_id include Dream__middleware.Site_prefix let error_template = @@ -71,7 +70,6 @@ let test ?(prefix = "") handler request = ignore prefix; let app = content_length - @@ assign_request_id @@ chop_site_prefix @@ handler in diff --git a/src/dream.mli b/src/dream.mli index 103e337c..424caf49 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2087,7 +2087,6 @@ val serve : @@ Dream.lowercase_headers @@ Dream.content_length @@ Dream.catch_errors - @@ Dream.assign_request_id @@ Dream.chop_site_prefix @@ my_app ]} @@ -2115,9 +2114,6 @@ val catch_errors : middleware (** Forwards exceptions, rejections, and [4xx], [5xx] responses from the application to the error handler. See {!section-errors}. *) -val assign_request_id : middleware -(** Assigns an id to each request. *) - val chop_site_prefix : middleware (** Removes {!Dream.run} [~prefix] from the path in each request, and adds it to the request prefix. Responds with [502 Bad Gateway] if the path does not diff --git a/src/http/http.ml b/src/http/http.ml index 97cbae38..221493b4 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -403,8 +403,8 @@ let wrap_handler request_id field in requests. *) let user's_websocket_handler websocket = Lwt.with_value - Dream__middleware.Request_id.lwt_key - (Dream__middleware.Request_id.get_option + Dream__middleware.Log.lwt_key + (Dream__middleware.Log.get_request_id ~request:(Dream.last request) ()) (fun () -> user's_websocket_handler websocket) in @@ -651,7 +651,6 @@ let built_in_middleware = Dream__middleware.Lowercase_headers.lowercase_headers; Dream__middleware.Content_length.content_length; Dream__middleware.Catch.catch_errors; - Dream__middleware.Request_id.assign_request_id; Dream__middleware.Site_prefix.chop_site_prefix; ] diff --git a/src/middleware/log.ml b/src/middleware/log.ml index d32d8081..a7d69a89 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -31,11 +31,60 @@ module Dream = Dream_pure +(* The logging middleware assigns request ids to requests, and tries to show + them in the logs. The scheme works as follows: + + - Request ids are strings stored in request-local variables. + - The automatically assigned request ids are taken from a simple global + sequence. + - The user can override the automatic request id by assigning a request id + in a middleware that runs before the logger. User-provided request ids can + be per-thread, can come from a proxy header, etc. + - The logger makes a best effort to forward the request id to all logging + statements that are being formatted. If the ~request argument is provided + during a logging call, that request's id is shown. To handle all other + cases, the logger puts the request's id into an Lwt sequence-associated + storage key, and the log message formatter tries to get it from there. *) +(* TODO Necessary helpers for the user setting the request id are not yet + exposed in the API, pending some other refactoring (request mutability). *) + +let request_id_label = "dream.request_id" + +(* Logs library tag uesd to pass an id from a request provided through + ~request. *) let logs_lib_tag : string Logs.Tag.def = Logs.Tag.def - "dream.request_id" + request_id_label Format.pp_print_string +(* Lwt sequence-associated storage key used to pass request ids for use when + ~request is not provided. *) +let lwt_key : string Lwt.key = + Lwt.new_key () + +(* The actual request id "field" associated with each request by the logger. If + this field is missing, the logger assigns the request a fresh id. *) +let id = + Dream.new_local + ~name:request_id_label + ~show_value:(fun id -> id) + () + +(* Makes a best-effort attempt to retrieve the request id. *) +let get_request_id ?request () = + let request_id = + match request with + | None -> None + | Some request -> Dream.local id request + in + match request_id with + | Some _ -> request_id + | None -> Lwt.get lwt_key + +(* The current state of the request id sequence. *) +let last_id = + ref 0 + (* TODO Nice logging for multiline strings? *) @@ -152,8 +201,7 @@ let reporter ~now () = let request_id = match request_id_from_tags with | Some _ -> request_id_from_tags - | None -> - Request_id.get_option () + | None -> get_request_id () in let request_id, request_style = @@ -262,7 +310,7 @@ let sub_log ?level:level_ name = match request with | None -> Logs.Tag.empty | Some request -> - match Request_id.get_option ~request () with + match get_request_id ~request () with | None -> Logs.Tag.empty | Some request_id -> Logs.Tag.add logs_lib_tag request_id Logs.Tag.empty @@ -409,6 +457,16 @@ struct set_printexc := false end; + (* Get the requwst's id or assign a new one. *) + let request, id = + match Dream.local id request with + | Some id -> request, id + | None -> + last_id := !last_id + 1; + let new_id = string_of_int !last_id in + Dream.with_local id new_id request, new_id + in + (* Identify the request in the log. *) let user_agent = Dream.headers "User-Agent" request @@ -425,7 +483,8 @@ struct (* Call the rest of the app. *) Lwt.try_bind (fun () -> - next_handler request) + Lwt.with_value lwt_key (Some id) (fun () -> + next_handler request)) (fun response -> (* Log the elapsed time. If the response is a redirection, log the target. *) diff --git a/src/middleware/request_id.ml b/src/middleware/request_id.ml deleted file mode 100644 index 3e8056f0..00000000 --- a/src/middleware/request_id.ml +++ /dev/null @@ -1,94 +0,0 @@ -(* This file is part of Dream, released under the MIT license. See LICENSE.md - for details, or visit https://github.com/aantron/dream. - - Copyright 2021 Anton Bachin *) - - - -(* TODO The other major built-in middleware, prefix, is actually just going to - be built-in code. So it's probably best to look into building in request_id, - and getting rid of the concept of built-in middleware. *) - -module Dream = Dream_pure - - - -let name = - "dream.request_id" - -let last_id = - Dream.new_global - (fun () -> ref 0) - ~name:"dream.request_id.last_id" - ~show_value:(fun id -> string_of_int !id) - -let id = - Dream.new_local - () - ~name - ~show_value:(fun id -> id) - -(* TODO Expose this in a more organized fashion? It is used in several - places. *) -let lwt_key = - Lwt.new_key () - - - -(* TODO Restore the prefix, make the id random, or something else. *) -(* TODO Now that the request id is built in, there is no good way for the user - to pass in a prefix... except perhaps through the app. However, this is - probably worth it, because adding request_id to every single middleware - stack is extremely annoying, given that you always want it and it's so cheap - that there is no reason not to use it. It's probably very rare that someone - needs a prefix. *) -let assign_request_id next_handler request = - - (* Get the last id for this request's app. *) - let last_id_ref : int ref = - Dream.global last_id request in - - incr last_id_ref; - - let new_id = - string_of_int !last_id_ref in - - (* Store the new id in the request and in the Lwt promise values map for - best-effort delivery to all code that might want the id. Continue into the - rest of the app. *) - let request = - Dream.with_local id new_id request in - - Lwt.with_value - lwt_key - (Some new_id) - (fun () -> - next_handler request) - - - -let get_option ?request () = - - (* First, try to get the id from the request, if one was provided. *) - let request_id = - match request with - | None -> None - | Some request -> - Dream.local id request - in - - (* If no id was found from the maybe-request, look in the promise-chain-local - storage. *) - match request_id with - | Some _ -> request_id - | None -> - Lwt.get lwt_key - - - -(* TODO LATER Maybe it's better to build the request id straight into the - runtime? There's no real cost to it... is there? And when wouldn't the user - want a request id? *) -(* TODO LATER List arguments for built-in middlewares: 0 or so cost, highly - beneficial, in some cases (prefix) actually necessary for correct operation - of a website. *) From d81b1986b67ccf8024deeb3d1c223452116fdb4d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 17:51:48 +0300 Subject: [PATCH 071/312] Delete per-server "global" variables as a concept --- example/4-counter/README.md | 8 -------- src/dream.mli | 15 +-------------- src/http/error_handler.ml | 20 ++++++++------------ src/pure/dream_pure.mli | 8 -------- src/pure/inmost.ml | 24 ------------------------ 5 files changed, 9 insertions(+), 66 deletions(-) diff --git a/example/4-counter/README.md b/example/4-counter/README.md index f65f3f3d..f976ed66 100644 --- a/example/4-counter/README.md +++ b/example/4-counter/README.md @@ -42,14 +42,6 @@ promise with [Lwt](https://github.com/ocsigen/lwt#readme), the promise library used by Dream. The next example, [**`5-promise`**](../5-promise#files), does exactly that! -
**Next steps:** diff --git a/src/dream.mli b/src/dream.mli index 424caf49..a23c5302 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2290,14 +2290,11 @@ val decrypt : (** {1 Variables} - Dream provides two variable scopes for use by middlewares. *) + Dream supports user-defined per-message variables for use by middlewares. *) type 'a local (** Per-message variable. *) -type 'a global -(** Per-server variable. *) - val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local (** Declares a variable of type ['a] in all messages. The variable is initially unset in each message. The optional [~name] and [~show_value] are used by @@ -2309,16 +2306,6 @@ val local : 'a local -> 'b message -> 'a option val with_local : 'a local -> 'a -> 'b message -> 'b message (** Sets the per-message variable to the value. *) -val new_global : - ?name:string -> ?show_value:('a -> string) -> (unit -> 'a) -> 'a global -(** Declares a variable of type ['a] in all servers. The first time the variable - is accessed, the given initializer function is called to get its value. - Global variables cannot be changed. So, they are typically refs or other - mutable data structures, such as hash tables. *) - -val global : 'a global -> request -> 'a -(** Retrieves the value of the per-server variable. *) - (** {1 Testing} *) diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index d6a4cd0e..04178541 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -94,18 +94,14 @@ let dump (error : Dream.error) = Dream.all_headers last |> List.iter (fun (name, value) -> p "\n%s: %s" name value); - let show_variables kind = - kind (fun name value first -> - if first then - p "\n"; - p "\n%s: %s" name value; - false) - true - request - |> ignore - in - show_variables Dream.fold_locals; - show_variables Dream.fold_globals + Dream.fold_locals (fun name value first -> + if first then + p "\n"; + p "\n%s: %s" name value; + false) + true + request + |> ignore end; Buffer.contents buffer diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 95ec6e1e..ed8fbcb0 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -453,14 +453,6 @@ val local : 'a local -> 'b message -> 'a option val with_local : 'a local -> 'a -> 'b message -> 'b message val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a -type 'a global -val new_global : - ?name:string -> ?show_value:('a -> string) -> (unit -> 'a) -> 'a global -val global : 'a global -> request -> 'a -(* TODO Get rid of globals completely as a concept, once the site_prefix - middleware is clarified. *) -val fold_globals : (string -> string -> 'a -> 'a) -> 'a -> request -> 'a - (* TODO Delete once requests are mutable. *) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 4e712a7c..57e5dc07 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -70,7 +70,6 @@ and server = { } and app = { - globals : Scope.t ref; mutable app_debug : bool; mutable https : bool; mutable secrets : string list; @@ -142,7 +141,6 @@ let site_prefix request = request.specific.app.site_prefix let new_app error_handler site_prefix = { - globals = ref Scope.empty; app_debug = false; https = false; secrets = []; @@ -427,28 +425,6 @@ let with_local key value message = let fold_locals f initial message = fold_scope f initial message.locals -type 'a global = { - key : 'a Scope.key; - initializer_ : unit -> 'a; -} - -let new_global ?name ?show_value initializer_ = { - key = Scope.Key.create (name, show_value); - initializer_; -} - -let global {key; initializer_} request = - match Scope.find key !(request.specific.app.globals) with - | Some value -> value - | None -> - let value = initializer_ () in - request.specific.app.globals := - Scope.add key value !(request.specific.app.globals); - value - -let fold_globals f initial request = - fold_scope f initial !(request.specific.app.globals) - let app request = request.specific.app From 2529b9adda670746ab766dcb4ea5664816ef87a0 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 18:59:42 +0300 Subject: [PATCH 072/312] Set secrets using a middleware --- src/cipher/cipher.ml | 40 ++++++++++++++++++++++++++++++++++++++-- src/dream.mli | 39 +++++++++++++++++++++++---------------- src/http/http.ml | 19 +++---------------- src/pure/dream_pure.mli | 6 ------ src/pure/inmost.ml | 15 --------------- 5 files changed, 64 insertions(+), 55 deletions(-) diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 85a5b258..64cafcf5 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -11,6 +11,12 @@ (* TODO LATER Switch to AEAD_AES_256_GCM_SIV. See https://github.com/mirage/mirage-crypto/issues/111. *) + + +module Dream = Dream_pure + + + module type Cipher = sig val prefix : char @@ -112,16 +118,46 @@ struct | Some plaintext -> Some (Cstruct.to_string plaintext) end +let secrets = + Dream.new_local + ~name:"dream.secret" + ~show_value:(fun _secrets -> "[redacted]") + () + +(* TODO Add warnings about secret length and such. *) +(* TODO Also add warnings about implicit secret generation. However, these + warnings might be pretty spammy. *) +(* TODO Update examples and docs. *) +let with_secret ?(old_secrets = []) secret = + let value = secret::old_secrets in + fun next_handler request -> + request + |> Dream.with_local secrets value + |> next_handler + +let fallback_secrets = + lazy [Random.random 32] + +let encryption_secret request = + match Dream.local secrets request with + | Some secrets -> List.hd secrets + | None -> List.hd (Lazy.force fallback_secrets) + +let decryption_secrets request = + match Dream.local secrets request with + | Some secrets -> secrets + | None -> Lazy.force fallback_secrets + let encrypt ?associated_data request plaintext = encrypt (module AEAD_AES_256_GCM) ?associated_data - (Dream_pure.encryption_secret request) + (encryption_secret request) plaintext let decrypt ?associated_data request ciphertext = decrypt (module AEAD_AES_256_GCM) ?associated_data - (Dream_pure.decryption_secrets request) + (decryption_secrets request) ciphertext diff --git a/src/dream.mli b/src/dream.mli index a23c5302..8985080a 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1973,8 +1973,6 @@ val run : ?stop:unit promise -> ?debug:bool -> ?error_handler:error_handler -> - ?secret:string -> - ?old_secrets:string list -> ?prefix:string -> ?https:bool -> ?certificate_file:string -> @@ -2006,18 +2004,6 @@ val run : low-level errors. See {!section-errors} and example {{:https://github.com/aantron/dream/tree/master/example/9-error#files} [9-error]} \[{{:http://dream.as/9-error} playground}\]. - - [~secret] is a key to be used for cryptographic operations, such as - signing CSRF tokens. By default, a random secret is generated on each call - to {!Dream.run}. For production, generate a 256-bit key with - {[ - Dream.to_base64url (Dream.random 32) - ]} - and load it from file. A medium-sized Web app serving 1000 fresh encrypted - cookies per second should rotate keys about once a year. See argument - [~old_secrets] below for key rotation. See {!Dream.encrypt} for cipher - information. - - [~old_secrets] is a list of previous secrets that can still be used for - decryption, but not for encryption. This is intended for key rotation. - [~prefix] is a site prefix for applications that are not running at the root ([/]) of their domain. The default is ["/"], for no prefix. - [~https:true] enables HTTPS. You should also specify [~certificate_file] @@ -2050,8 +2036,6 @@ val serve : ?stop:unit promise -> ?debug:bool -> ?error_handler:error_handler -> - ?secret:string -> - ?old_secrets:string list -> ?prefix:string -> ?https:bool -> ?certificate_file:string -> @@ -2239,6 +2223,29 @@ val application_json : string (** {1 Cryptography} *) +val with_secret : ?old_secrets:string list -> string -> middleware +(** Sets a key to be used for cryptographic operations, such as signing CSRF + tokens and encrypting cookies. + + If this middleware is not used, a random secret is generated the first time + a secret is needed. The random secret persists for the lifetime of the + process. This is useful for quick testing and prototyping, but it means that + restarts of the server will not be able to verify tokens or decrypt cookies + generated by earlier runs, and multiple servers in a load-balancing + arrangement will not accept each others' tokens and cookies. + + For production, generate a 256-bit key with + + {[ + Dream.to_base64url (Dream.random 32) + ]} + + [~old_secrets] is a list of previous secrets that will not be used for + encryption or signing, but will still be tried for decryption and + verification. This is intended for key rotation. A medium-sized Web app + serving 1000 fresh encrypted cookies per second should rotate keys about + once a year. *) + val random : int -> string (** Generates the requested number of bytes using a {{:https://github.com/mirage/mirage-crypto} cryptographically secure random diff --git a/src/http/http.ml b/src/http/http.ml index 221493b4..364f6941 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -751,8 +751,6 @@ let serve_with_maybe_https ~stop ?debug ~error_handler - ?(secret = Dream__cipher.Random.random 32) - ?(old_secrets = []) ~prefix ~https ?certificate_file ?key_file @@ -775,16 +773,13 @@ let serve_with_maybe_https (* This check will at least catch secrets like "foo" when used on a public interface. *) - if not (is_localhost interface) then + (* if not (is_localhost interface) then if String.length secret < 32 then begin log.warning (fun log -> log "Using a short key on a public interface"); log.warning (fun log -> log "Consider using Dream.to_base64url (Dream.random 32)"); - end; - - (* TODO The interface needs to allow not messing with the secret if an app - is passed. *) - Dream.set_secrets (secret::old_secrets) app; + end; *) + (* TODO Make sure there is a similar check in cipher.ml now.Hpack *) match https with | `No -> @@ -920,8 +915,6 @@ let serve ?(stop = never) ?debug ?(error_handler = Error_handler.default) - ?secret - ?old_secrets ?(prefix = "") ?(https = false) ?certificate_file @@ -936,8 +929,6 @@ let serve ~stop ?debug ~error_handler - ?secret - ?old_secrets ~prefix ~https:(if https then `OpenSSL else `No) ?certificate_file @@ -955,8 +946,6 @@ let run ?(stop = never) ?debug ?(error_handler = Error_handler.default) - ?secret - ?old_secrets ?(prefix = "") ?(https = false) ?certificate_file @@ -1036,8 +1025,6 @@ let run ~stop ?debug ~error_handler - ?secret - ?old_secrets ~prefix ~https:(if https then `OpenSSL else `No) ?certificate_file ?key_file diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index ed8fbcb0..4c919c4e 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -140,11 +140,6 @@ val prefix : request -> string val internal_prefix : request -> string list val path : request -> string list val version : request -> int * int -val encryption_secret : request -> string -val decryption_secrets : request -> string list -(* TODO Get the encryption secrets out of here and into the server only. - Also try to move the whole "app" mechanism to the server only. However, how - will that interact with in-process testing? *) val site_prefix : request -> string list (* TODO This will be moved out of dream-pure and become just a server-side middleware.. *) @@ -404,7 +399,6 @@ val app : request -> app val debug : app -> bool val set_debug : bool -> app -> unit val app_error_handler : app -> (error -> response promise) -val set_secrets : string list -> app -> unit val set_https : bool -> app -> unit val request_from_http : app:app -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 57e5dc07..9b7bcb7b 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -72,7 +72,6 @@ and server = { and app = { mutable app_debug : bool; mutable https : bool; - mutable secrets : string list; error_handler : error -> response Lwt.t; site_prefix : string list; } @@ -127,13 +126,6 @@ let set_debug value app = let app_error_handler app = app.error_handler -(* TODO Delete; now using key. *) -let secret app = - List.hd app.secrets - -let set_secrets secrets app = - app.secrets <- secrets - let set_https https app = app.https <- https @@ -143,7 +135,6 @@ let site_prefix request = let new_app error_handler site_prefix = { app_debug = false; https = false; - secrets = []; error_handler; site_prefix; } @@ -595,12 +586,6 @@ let rec pipeline middlewares handler = let sort_headers headers = List.stable_sort (fun (name, _) (name', _) -> compare name name') headers -let encryption_secret request = - List.hd request.specific.app.secrets - -let decryption_secrets request = - request.specific.app.secrets - (* TODO Remove to server-side code. *) let multipart_state request = request.specific.upload From 3da5e2354d28c728ddbcc222e1729664decb2cbf Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 19:11:54 +0300 Subject: [PATCH 073/312] Move site prefix handling to a middleware --- src/dream.ml | 3 +-- src/dream.mli | 18 +++++++++--------- src/http/http.ml | 14 +------------- src/middleware/site_prefix.ml | 9 +++++++-- src/pure/dream_pure.mli | 5 +---- src/pure/inmost.ml | 9 ++------- 6 files changed, 21 insertions(+), 37 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 9f8d0561..9395b927 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -67,10 +67,9 @@ include Dream_pure.Formats (* TODO Restore the ability to test with a prefix and re-enable the corresponding tests. *) let test ?(prefix = "") handler request = - ignore prefix; let app = content_length - @@ chop_site_prefix + @@ with_site_prefix prefix @@ handler in diff --git a/src/dream.mli b/src/dream.mli index 8985080a..63bc6c36 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1973,7 +1973,6 @@ val run : ?stop:unit promise -> ?debug:bool -> ?error_handler:error_handler -> - ?prefix:string -> ?https:bool -> ?certificate_file:string -> ?key_file:string -> @@ -2004,8 +2003,6 @@ val run : low-level errors. See {!section-errors} and example {{:https://github.com/aantron/dream/tree/master/example/9-error#files} [9-error]} \[{{:http://dream.as/9-error} playground}\]. - - [~prefix] is a site prefix for applications that are not running at the - root ([/]) of their domain. The default is ["/"], for no prefix. - [~https:true] enables HTTPS. You should also specify [~certificate_file] and [~key_file]. However, for development, Dream includes an insecure compiled-in @@ -2036,7 +2033,6 @@ val serve : ?stop:unit promise -> ?debug:bool -> ?error_handler:error_handler -> - ?prefix:string -> ?https:bool -> ?certificate_file:string -> ?key_file:string -> @@ -2071,7 +2067,6 @@ val serve : @@ Dream.lowercase_headers @@ Dream.content_length @@ Dream.catch_errors - @@ Dream.chop_site_prefix @@ my_app ]} @@ -2098,10 +2093,15 @@ val catch_errors : middleware (** Forwards exceptions, rejections, and [4xx], [5xx] responses from the application to the error handler. See {!section-errors}. *) -val chop_site_prefix : middleware -(** Removes {!Dream.run} [~prefix] from the path in each request, and adds it to - the request prefix. Responds with [502 Bad Gateway] if the path does not - have the expected prefix. *) +val with_site_prefix : string -> middleware +(** Removes the given prefix from the path in each request, and adds it to the + request prefix. Responds with [502 Bad Gateway] if the path does not have + the expected prefix. + + This is for applications that are not running at the root ([/]) of their + domain. The default is ["/"], for no prefix. After [with_site_prefix], + routing is done relative to the prefix, and the prefix is also necessary for + emitting secure cookies. *) diff --git a/src/http/http.ml b/src/http/http.ml index 364f6941..0104f0c8 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -651,7 +651,6 @@ let built_in_middleware = Dream__middleware.Lowercase_headers.lowercase_headers; Dream__middleware.Content_length.content_length; Dream__middleware.Catch.catch_errors; - Dream__middleware.Site_prefix.chop_site_prefix; ] @@ -743,7 +742,6 @@ let serve_with_details let is_localhost interface = interface = "localhost" || interface = "127.0.0.1" -(* TODO Validate the prefix here. *) let serve_with_maybe_https caller_function_for_error_messages ~interface @@ -751,19 +749,13 @@ let serve_with_maybe_https ~stop ?debug ~error_handler - ~prefix ~https ?certificate_file ?key_file ?certificate_string ?key_string ~builtins user's_dream_handler = - let prefix = - prefix - |> Dream_pure.Formats.from_path - |> Dream_pure.Formats.drop_trailing_slash - in - let app = Dream.new_app (Error_handler.app error_handler) prefix in + let app = Dream.new_app (Error_handler.app error_handler) in try%lwt begin match debug with @@ -915,7 +907,6 @@ let serve ?(stop = never) ?debug ?(error_handler = Error_handler.default) - ?(prefix = "") ?(https = false) ?certificate_file ?key_file @@ -929,7 +920,6 @@ let serve ~stop ?debug ~error_handler - ~prefix ~https:(if https then `OpenSSL else `No) ?certificate_file ?key_file @@ -946,7 +936,6 @@ let run ?(stop = never) ?debug ?(error_handler = Error_handler.default) - ?(prefix = "") ?(https = false) ?certificate_file ?key_file @@ -1025,7 +1014,6 @@ let run ~stop ?debug ~error_handler - ~prefix ~https:(if https then `OpenSSL else `No) ?certificate_file ?key_file ?certificate_string:None ?key_string:None diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index cbec6545..bc7aab29 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -24,8 +24,13 @@ let rec match_site_prefix prefix path = (* TODO The path and prefix representations and accessors need a cleanup. *) -let chop_site_prefix next_handler request = - let prefix = Dream.site_prefix request in +let with_site_prefix prefix = + let prefix = + prefix + |> Dream_pure.Formats.from_path + |> Dream_pure.Formats.drop_trailing_slash + in + fun next_handler request -> match match_site_prefix prefix (Dream.path request) with | None -> (* TODO Streams. *) diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 4c919c4e..c7495332 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -140,9 +140,6 @@ val prefix : request -> string val internal_prefix : request -> string list val path : request -> string list val version : request -> int * int -val site_prefix : request -> string list -(* TODO This will be moved out of dream-pure and become just a server-side - middleware.. *) val with_client : string -> request -> request val with_method_ : [< method_ ] -> request -> request val with_prefix : string list -> request -> request @@ -394,7 +391,7 @@ type error = { type error_handler = error -> response option promise -val new_app : (error -> response Lwt.t) -> string list -> app +val new_app : (error -> response Lwt.t) -> app val app : request -> app val debug : app -> bool val set_debug : bool -> app -> unit diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 9b7bcb7b..0bedc672 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -73,7 +73,6 @@ and app = { mutable app_debug : bool; mutable https : bool; error_handler : error -> response Lwt.t; - site_prefix : string list; } and error_handler = error -> response option Lwt.t @@ -129,14 +128,10 @@ let app_error_handler app = let set_https https app = app.https <- https -let site_prefix request = - request.specific.app.site_prefix - -let new_app error_handler site_prefix = { +let new_app error_handler = { app_debug = false; https = false; error_handler; - site_prefix; } type 'a promise = 'a Lwt.t @@ -475,7 +470,7 @@ let request specific = { (* TODO Is there a better fake error handler? Maybe this function should come after the response constructors? *) - app = new_app (fun _ -> assert false) []; + app = new_app (fun _ -> assert false); request_client = client; method_; target; From ebeac7c7359b76556b109ffc7c17203f645cc492 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 19:17:05 +0300 Subject: [PATCH 074/312] Reorder dream-pure.mli a bit Looks like a paste went to the wrong place before. --- src/pure/dream_pure.mli | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index c7495332..c4c68186 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -132,6 +132,16 @@ val normalize_status : [< status ] -> status +val request : + ?client:string -> + ?method_:[< method_ ] -> + ?target:string -> + ?version:int * int -> + ?headers:(string * string) list -> + stream -> + stream -> + request + val client : request -> string val https : request -> bool val method_ : request -> method_ @@ -447,15 +457,6 @@ val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a (* TODO Delete once requests are mutable. *) -val request : - ?client:string -> - ?method_:[< method_ ] -> - ?target:string -> - ?version:int * int -> - ?headers:(string * string) list -> - stream -> - stream -> - request val first : 'a message -> 'a message val last : 'a message -> 'a message val sort_headers : (string * string) list -> (string * string) list From 6c726d527176b51dee791b36b612f6ad1a24aa74 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 13 Dec 2021 19:24:03 +0300 Subject: [PATCH 075/312] Move the https field to requests --- src/http/http.ml | 16 ++++++++-------- src/pure/dream_pure.mli | 2 +- src/pure/inmost.ml | 11 +++++------ 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index 0104f0c8..57b06773 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -294,6 +294,7 @@ let websocket_handler user's_websocket_handler socket = (* TODO Rename conn like in the body branch. *) let wrap_handler app + https (user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) = @@ -338,7 +339,7 @@ let wrap_handler let request : Dream.request = Dream.request_from_http - ~app ~client ~method_ ~target ~version ~headers body in + ~app ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -445,6 +446,7 @@ let wrap_handler (* TODO Factor out what is in common between the http/af and h2 handlers. *) let wrap_handler_h2 app + https (_user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) = @@ -483,7 +485,7 @@ let wrap_handler_h2 let request : Dream.request = Dream.request_from_http - ~app ~client ~method_ ~target ~version ~headers body in + ~app ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -566,7 +568,7 @@ let no_tls = { ~error_handler -> Httpaf_lwt_unix.Server.create_connection_handler ?config:None - ~request_handler:(wrap_handler app error_handler handler) + ~request_handler:(wrap_handler app false error_handler handler) ~error_handler:(Error_handler.httpaf app error_handler) end; } @@ -581,14 +583,14 @@ let openssl = { let httpaf_handler = Httpaf_lwt_unix.Server.SSL.create_connection_handler ?config:None - ~request_handler:(wrap_handler app error_handler handler) + ~request_handler:(wrap_handler app true error_handler handler) ~error_handler:(Error_handler.httpaf app error_handler) in let h2_handler = H2_lwt_unix.Server.SSL.create_connection_handler ?config:None - ~request_handler:(wrap_handler_h2 app error_handler handler) + ~request_handler:(wrap_handler_h2 app true error_handler handler) ~error_handler:(Error_handler.h2 app error_handler) in @@ -640,7 +642,7 @@ let ocaml_tls = { Httpaf_lwt_unix.Server.TLS.create_connection_handler_with_default ~certfile:certificate_file ~keyfile:key_file ?config:None - ~request_handler:(wrap_handler app error_handler handler) + ~request_handler:(wrap_handler app true error_handler handler) ~error_handler:(Error_handler.httpaf app error_handler) } @@ -789,8 +791,6 @@ let serve_with_maybe_https user's_dream_handler | `OpenSSL | `OCaml_TLS as tls_library -> - Dream.set_https true app; - (* TODO Writing temporary files is extremely questionable for anything except the fake localhost certificate. This needs loud warnings. IIRC the SSL binding already supports in-memory certificates. Does TLS? In diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index c4c68186..d5866232 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -406,12 +406,12 @@ val app : request -> app val debug : app -> bool val set_debug : bool -> app -> unit val app_error_handler : app -> (error -> response promise) -val set_https : bool -> app -> unit val request_from_http : app:app -> client:string -> method_:method_ -> target:string -> + https:bool -> version:int * int -> headers:(string * string) list -> stream -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 0bedc672..837fba90 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -59,6 +59,7 @@ and client = { prefix : string list; path : string list; query : (string * string) list; + https : bool; request_version : int * int; upload : multipart_state; } @@ -71,7 +72,6 @@ and server = { and app = { mutable app_debug : bool; - mutable https : bool; error_handler : error -> response Lwt.t; } @@ -125,12 +125,8 @@ let set_debug value app = let app_error_handler app = app.error_handler -let set_https https app = - app.https <- https - let new_app error_handler = { app_debug = false; - https = false; error_handler; } @@ -153,7 +149,7 @@ let client request = request.specific.request_client let https request = - request.specific.app.https + request.specific.https let method_ request = request.specific.method_ @@ -419,6 +415,7 @@ let request_from_http ~client ~method_ ~target + ~https ~version ~headers body = @@ -434,6 +431,7 @@ let request_from_http prefix = []; path = Formats.from_path path; query = Formats.from_form_urlencoded query; + https; request_version = version; upload = initial_multipart_state (); }; @@ -477,6 +475,7 @@ let request prefix = []; path = Formats.from_path path; query = Formats.from_form_urlencoded query; + https = false; request_version = version; upload = initial_multipart_state (); }; From 640a1b218b0c6932088077416455463ffd34f036 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 10:40:56 +0300 Subject: [PATCH 076/312] Replace ~debug flag by separate error handler --- src/dream.ml | 2 ++ src/dream.mli | 23 ++++++----------------- src/http/error_handler.ml | 38 +++++++++++++++----------------------- src/http/error_handler.mli | 3 ++- src/http/http.ml | 10 ---------- src/middleware/catch.ml | 2 -- src/pure/dream_pure.mli | 3 --- src/pure/inmost.ml | 9 --------- 8 files changed, 25 insertions(+), 65 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 9395b927..914f8c9a 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -54,6 +54,8 @@ include Dream__middleware.Lowercase_headers include Dream__middleware.Catch include Dream__middleware.Site_prefix +let debug_error_handler = + Dream__http.Error_handler.debug_error_handler let error_template = Dream__http.Error_handler.customize diff --git a/src/dream.mli b/src/dream.mli index 63bc6c36..f35d6d2c 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1818,7 +1818,6 @@ type error = { response : response option; client : string option; severity : log_level; - debug : bool; will_send_response : bool; } (** Detailed errors. Ignore this type if only using {!Dream.error_template}. @@ -1887,17 +1886,6 @@ type error = { [`Server] errors and [`Warning] for client errors. } - {li - [debug] is [true] if {!Dream.run} was called with [~debug]. - - If so, the default error handler gathers various fields from the current - request, formats the error condition, and passes the resulting string to the - template as [debug_dump]. - - The default template shows this string in its repsonse, instead of returning - a response with no body. - } - {li [will_send_response] is [true] in error contexts where Dream will still send a response. @@ -1921,7 +1909,7 @@ type error_handler = error -> response option promise {!Dream.type-error}. *) val error_template : - (error -> string option -> response -> response promise) -> error_handler + (error -> string -> response -> response promise) -> error_handler (** Builds an {!error_handler} from a template. See example {{:https://github.com/aantron/dream/tree/master/example/9-error#files} [9-error]} \[{{:http://dream.as/9-error} playground}\]. @@ -1951,8 +1939,7 @@ val error_template : the error was likely caused by the client, and [500 Internal Server Error] if the error was likely caused by the server. - If [~debug] was passed to {!Dream.run}, [~debug_dump] will be [Some info], - where [info] is a multi-line string containing an error description, stack + [~debug_dump] is a multi-line string containing an error description, stack trace, request state, and other information. When an error occurs in a context where a response is not possible, the @@ -1963,6 +1950,10 @@ val error_template : If the template itself raises an exception or rejects, an empty [500 Internal Server Error] will be sent in contexts that require a response. *) +val debug_error_handler : error_handler +(** An {!error_handler} for showing extra information about requests and + exceptions, for use during development. *) + (** {1 Servers} *) @@ -1971,7 +1962,6 @@ val run : ?interface:string -> ?port:int -> ?stop:unit promise -> - ?debug:bool -> ?error_handler:error_handler -> ?https:bool -> ?certificate_file:string -> @@ -2031,7 +2021,6 @@ val serve : ?interface:string -> ?port:int -> ?stop:unit promise -> - ?debug:bool -> ?error_handler:error_handler -> ?https:bool -> ?certificate_file:string -> diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 04178541..acfbb8c5 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -157,11 +157,7 @@ let customize template (error : Dream.error) = Lwt.return_none else - let debug_dump = - match error.debug with - | false -> None - | true -> Some (dump error) - in + let debug_dump = dump error in let response = match error.condition with @@ -187,24 +183,25 @@ let customize template (error : Dream.error) = -let default_template _error debug_dump response = - match debug_dump with - | None -> Lwt.return response - | Some debug_dump -> - let status = Dream.status response in - let code = Dream.status_to_int status - and reason = Dream.status_to_string status in - response - |> Dream.with_header "Content-Type" Dream_pure.Formats.text_html - |> Dream.with_body - (Dream__middleware.Error_template.render ~debug_dump ~code ~reason) - |> Lwt.return - +let default_template _error _debug_dump response = + Lwt.return response +let debug_template _error debug_dump response = + let status = Dream.status response in + let code = Dream.status_to_int status + and reason = Dream.status_to_string status in + response + |> Dream.with_header "Content-Type" Dream_pure.Formats.text_html + |> Dream.with_body + (Dream__middleware.Error_template.render ~debug_dump ~code ~reason) + |> Lwt.return let default = customize default_template +let debug_error_handler = + customize debug_template + (* Error reporters (called in various places by the framework). *) @@ -371,7 +368,6 @@ let httpaf response = None; client = Some (Adapt.address_to_string client_address); severity; - debug = Dream.debug app; will_send_response = true; } in @@ -430,7 +426,6 @@ let h2 response = None; client = Some (Adapt.address_to_string client_address); severity; - debug = Dream.debug app; will_send_response = true; } in @@ -472,7 +467,6 @@ let tls response = None; client = Some (Adapt.address_to_string client_address); severity = `Warning; - debug = Dream.debug app; will_send_response = false; } in @@ -504,7 +498,6 @@ let websocket response = Some response; client = Some (Dream.client request); severity = `Warning; (* Not sure what these errors are, yet. *) - debug = Dream.debug (Dream.app request); will_send_response = false; } in @@ -527,7 +520,6 @@ let websocket_handshake response = Some response; client = Some (Dream.client request); severity = `Warning; - debug = Dream.debug (Dream.app request); will_send_response = true; } in diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index cea4917e..cd476551 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -13,8 +13,9 @@ module Dream = Dream_pure templates and/or do logging. *) val default : Dream.error_handler +val debug_error_handler : Dream.error_handler val customize : - (Dream.error -> string option -> Dream.response -> Dream.response Lwt.t) -> + (Dream.error -> string -> Dream.response -> Dream.response Lwt.t) -> Dream.error_handler diff --git a/src/http/http.ml b/src/http/http.ml index 57b06773..9b3641ca 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -749,7 +749,6 @@ let serve_with_maybe_https ~interface ~port ~stop - ?debug ~error_handler ~https ?certificate_file ?key_file @@ -760,11 +759,6 @@ let serve_with_maybe_https let app = Dream.new_app (Error_handler.app error_handler) in try%lwt - begin match debug with - | Some debug -> Dream.set_debug debug app - | None -> () - end; - (* This check will at least catch secrets like "foo" when used on a public interface. *) (* if not (is_localhost interface) then @@ -905,7 +899,6 @@ let serve ?(interface = default_interface) ?(port = default_port) ?(stop = never) - ?debug ?(error_handler = Error_handler.default) ?(https = false) ?certificate_file @@ -918,7 +911,6 @@ let serve ~interface ~port ~stop - ?debug ~error_handler ~https:(if https then `OpenSSL else `No) ?certificate_file @@ -934,7 +926,6 @@ let run ?(interface = default_interface) ?(port = default_port) ?(stop = never) - ?debug ?(error_handler = Error_handler.default) ?(https = false) ?certificate_file @@ -1012,7 +1003,6 @@ let run ~interface ~port ~stop - ?debug ~error_handler ~https:(if https then `OpenSSL else `No) ?certificate_file ?key_file diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 01cc30ca..c661eaa7 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -40,7 +40,6 @@ let catch_errors next_handler request = response = Some response; client = Some (Dream.client request); severity = severity; - debug = Dream.debug (Dream.app request); will_send_response = true; } in @@ -64,7 +63,6 @@ let catch_errors next_handler request = response = None; client = Some (Dream.client request); severity = `Error; - debug = Dream.debug (Dream.app request); will_send_response = true; } in diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index d5866232..56555659 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -395,7 +395,6 @@ type error = { response : response option; client : string option; severity : log_level; - debug : bool; will_send_response : bool; } @@ -403,8 +402,6 @@ type error_handler = error -> response option promise val new_app : (error -> response Lwt.t) -> app val app : request -> app -val debug : app -> bool -val set_debug : bool -> app -> unit val app_error_handler : app -> (error -> response promise) val request_from_http : app:app -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 837fba90..a7df9b26 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -71,7 +71,6 @@ and server = { } and app = { - mutable app_debug : bool; error_handler : error -> response Lwt.t; } @@ -111,22 +110,14 @@ and error = { | `Info | `Debug ]; - debug : bool; will_send_response : bool; } -let debug app = - app.app_debug - -let set_debug value app = - app.app_debug <- value - (* TODO Remove. *) let app_error_handler app = app.error_handler let new_app error_handler = { - app_debug = false; error_handler; } From b355e00f8ff914aac28b1d0915824827c22c1b77 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 11:05:07 +0300 Subject: [PATCH 077/312] Pass error handlers around explicitly --- src/dream.mli | 14 +++++++++----- src/http/http.ml | 6 +++--- src/middleware/catch.ml | 11 ++++------- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index f35d6d2c..cadd0a9f 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1954,6 +1954,12 @@ val debug_error_handler : error_handler (** An {!error_handler} for showing extra information about requests and exceptions, for use during development. *) +val catch : (error -> response promise) -> middleware +(** Forwards exceptions, rejections, and [4xx], [5xx] responses from the + application to the error handler. See {!section-errors}. *) +(* TODO Error handler should not return an option, and then the type can be + used here. *) + (** {1 Servers} *) @@ -2055,7 +2061,7 @@ val serve : Dream.run ~builtins:false @@ Dream.lowercase_headers @@ Dream.content_length - @@ Dream.catch_errors + @@ Dream.catch ~error_handler @@ my_app ]} @@ -2078,10 +2084,6 @@ val content_length : middleware headers are necessary in HTTP/1, and forbidden or redundant and difficult to use in HTTP/2. *) -val catch_errors : middleware -(** Forwards exceptions, rejections, and [4xx], [5xx] responses from the - application to the error handler. See {!section-errors}. *) - val with_site_prefix : string -> middleware (** Removes the given prefix from the path in each request, and adds it to the request prefix. Responds with [502 Bad Gateway] if the path does not have @@ -2091,6 +2093,8 @@ val with_site_prefix : string -> middleware domain. The default is ["/"], for no prefix. After [with_site_prefix], routing is done relative to the prefix, and the prefix is also necessary for emitting secure cookies. *) +(* TODO Clarify that this isn't included with the built-ins, but is something on + topic that one might want to use. *) diff --git a/src/http/http.ml b/src/http/http.ml index 9b3641ca..827af401 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -648,11 +648,11 @@ let ocaml_tls = { -let built_in_middleware = +let built_in_middleware error_handler = Dream.pipeline [ Dream__middleware.Lowercase_headers.lowercase_headers; Dream__middleware.Content_length.content_length; - Dream__middleware.Catch.catch_errors; + Dream__middleware.Catch.catch (Error_handler.app error_handler); ] @@ -675,7 +675,7 @@ let serve_with_details let user's_dream_handler = if builtins then - built_in_middleware user's_dream_handler + built_in_middleware error_handler user's_dream_handler else user's_dream_handler in diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index c661eaa7..405564e1 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -13,8 +13,8 @@ module Dream = Dream_pure reaching the centralized error handler provided by the user, so it is built into the framework. *) -(* TODO The option thing is pretty awkward. *) -let catch_errors next_handler request = +(* TODO The option return value thing is pretty awkward. *) +let catch error_handler next_handler request = Lwt.try_bind @@ -43,9 +43,7 @@ let catch_errors next_handler request = will_send_response = true; } in - let user's_error_handler = - Dream.app_error_handler (Dream.app request) in - user's_error_handler error + error_handler error end else Lwt.return response) @@ -66,5 +64,4 @@ let catch_errors next_handler request = will_send_response = true; } in - let user's_error_handler = Dream.app_error_handler (Dream.app request) in - user's_error_handler error) + error_handler error) From af8085a5f1e7f0cde709c613c90982d281e9033f Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 11:12:36 +0300 Subject: [PATCH 078/312] Delete the "app" concept --- src/http/error_handler.ml | 62 ++------------------------------------ src/http/error_handler.mli | 3 -- src/http/http.ml | 35 +++++++-------------- src/pure/dream_pure.mli | 8 ----- src/pure/inmost.ml | 19 ------------ 5 files changed, 14 insertions(+), 113 deletions(-) diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index acfbb8c5..3d57e2da 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -264,62 +264,6 @@ let app respond_with_option (fun () -> user's_error_handler error) -(* let app - app user's_error_handler = - fun next_handler request -> - - Lwt.try_bind - - (fun () -> - next_handler request) - - (fun response -> - let status = Dream.status response in - - if Dream.is_client_error status || Dream.is_server_error status then begin - let caused_by, severity = - if Dream.is_client_error status then - `Client, `Warning - else - `Server, `Error - in - - let error = Error.{ - condition = `Response response; - layer = `App; - caused_by; - request = Some request; - response = Some response; - client = Some (Dream.client request); - severity = severity; - debug = Dream.debug app; - will_send_response = true; - } in - - respond_with_option (fun () -> user's_error_handler error) - end - else - Lwt.return response) - - (* This exception handler is partially redundant, in that the HTTP-level - handlers will also catch exceptions. However, this handler is able to - capture more relevant context. We leave the HTTP-level handlers for truly - severe protocol-level errors and integration mistakes. *) - (fun exn -> - let error = Error.{ - condition = `Exn exn; - layer = `App; - caused_by = `Server; - request = Some request; - response = None; - client = Some (Dream.client request); - severity = `Error; - debug = Dream.debug app; - will_send_response = true; - } in - - respond_with_option (fun () -> user's_error_handler error)) *) - (* TODO Simplify streams. *) @@ -334,7 +278,7 @@ let default_response = function Dream.response ~status:`Bad_Request client_stream server_stream let httpaf - app user's_error_handler = + user's_error_handler = fun client_address ?request error start_response -> ignore (request : Httpaf.Request.t option); @@ -394,7 +338,7 @@ let httpaf let h2 - app user's_error_handler = + user's_error_handler = fun client_address ?request error start_response -> ignore request; (* TODO Recover something from the request. *) @@ -457,7 +401,7 @@ let h2 However, SSL protocol errors are not wrapped in any of these, so we add an edditional top-level handler to catch them. *) let tls - app user's_error_handler client_address error = + user's_error_handler client_address error = let error = { Dream.condition = `Exn error; diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index cd476551..d25b71c6 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -36,17 +36,14 @@ val app : (Dream.error -> Dream.response Lwt.t) val httpaf : - Dream.app -> Dream.error_handler -> (Unix.sockaddr -> Httpaf.Server_connection.error_handler) val h2 : - Dream.app -> Dream.error_handler -> (Unix.sockaddr -> H2.Server_connection.error_handler) val tls : - Dream.app -> Dream.error_handler -> (Unix.sockaddr -> exn -> unit) diff --git a/src/http/http.ml b/src/http/http.ml index 827af401..966c3f10 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -293,7 +293,6 @@ let websocket_handler user's_websocket_handler socket = chance to tell the user that something is wrong with their app. *) (* TODO Rename conn like in the body branch. *) let wrap_handler - app https (user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) = @@ -339,7 +338,7 @@ let wrap_handler let request : Dream.request = Dream.request_from_http - ~app ~client ~method_ ~target ~https ~version ~headers body in + ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -445,7 +444,6 @@ let wrap_handler (* TODO Factor out what is in common between the http/af and h2 handlers. *) let wrap_handler_h2 - app https (_user's_error_handler : Dream.error_handler) (user's_dream_handler : Dream.handler) = @@ -485,7 +483,7 @@ let wrap_handler_h2 let request : Dream.request = Dream.request_from_http - ~app ~client ~method_ ~target ~https ~version ~headers body in + ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -552,7 +550,6 @@ type tls_library = { create_handler : certificate_file:string -> key_file:string -> - app:Dream.app -> handler:Dream.handler -> error_handler:Dream.error_handler -> Unix.sockaddr -> @@ -563,35 +560,33 @@ type tls_library = { let no_tls = { create_handler = begin fun ~certificate_file:_ ~key_file:_ - ~app ~handler ~error_handler -> Httpaf_lwt_unix.Server.create_connection_handler ?config:None - ~request_handler:(wrap_handler app false error_handler handler) - ~error_handler:(Error_handler.httpaf app error_handler) + ~request_handler:(wrap_handler false error_handler handler) + ~error_handler:(Error_handler.httpaf error_handler) end; } let openssl = { create_handler = begin fun ~certificate_file ~key_file - ~app ~handler ~error_handler -> let httpaf_handler = Httpaf_lwt_unix.Server.SSL.create_connection_handler ?config:None - ~request_handler:(wrap_handler app true error_handler handler) - ~error_handler:(Error_handler.httpaf app error_handler) + ~request_handler:(wrap_handler true error_handler handler) + ~error_handler:(Error_handler.httpaf error_handler) in let h2_handler = H2_lwt_unix.Server.SSL.create_connection_handler ?config:None - ~request_handler:(wrap_handler_h2 app true error_handler handler) - ~error_handler:(Error_handler.h2 app error_handler) + ~request_handler:(wrap_handler_h2 true error_handler handler) + ~error_handler:(Error_handler.h2 error_handler) in let perform_tls_handshake = @@ -636,14 +631,13 @@ let openssl = { let ocaml_tls = { create_handler = fun ~certificate_file ~key_file - ~app ~handler ~error_handler -> Httpaf_lwt_unix.Server.TLS.create_connection_handler_with_default ~certfile:certificate_file ~keyfile:key_file ?config:None - ~request_handler:(wrap_handler app true error_handler handler) - ~error_handler:(Error_handler.httpaf app error_handler) + ~request_handler:(wrap_handler true error_handler handler) + ~error_handler:(Error_handler.httpaf error_handler) } @@ -664,7 +658,6 @@ let serve_with_details ~port ~stop ~error_handler - ~app ~certificate_file ~key_file ~builtins @@ -685,13 +678,12 @@ let serve_with_details tls_library.create_handler ~certificate_file ~key_file - ~app ~handler:user's_dream_handler ~error_handler in (* TODO Should probably move out to the TLS library options. *) - let tls_error_handler = Error_handler.tls app error_handler in + let tls_error_handler = Error_handler.tls error_handler in (* Some parts of the various HTTP servers that are under heavy development ( *cough* Gluten SSL/TLS at the moment) leak exceptions out of the @@ -756,8 +748,6 @@ let serve_with_maybe_https ~builtins user's_dream_handler = - let app = Dream.new_app (Error_handler.app error_handler) in - try%lwt (* This check will at least catch secrets like "foo" when used on a public interface. *) @@ -778,7 +768,6 @@ let serve_with_maybe_https ~port ~stop ~error_handler - ~app ~certificate_file:"" ~key_file:"" ~builtins @@ -840,7 +829,6 @@ let serve_with_maybe_https ~port ~stop ~error_handler - ~app ~certificate_file ~key_file ~builtins @@ -869,7 +857,6 @@ let serve_with_maybe_https ~port ~stop ~error_handler - ~app ~certificate_file ~key_file ~builtins diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 56555659..63ad95ed 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -363,10 +363,6 @@ val is_websocket : response -> (websocket -> unit promise) option -(* TODO All of this should become server-side-only once the error handling - middleware is clarified. *) -type app - type log_level = [ | `Error | `Warning @@ -400,11 +396,7 @@ type error = { type error_handler = error -> response option promise -val new_app : (error -> response Lwt.t) -> app -val app : request -> app -val app_error_handler : app -> (error -> response promise) val request_from_http : - app:app -> client:string -> method_:method_ -> target:string -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index a7df9b26..c0d91c29 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -52,7 +52,6 @@ and 'a message = { } and client = { - app : app; request_client : string; method_ : method_; target : string; @@ -70,10 +69,6 @@ and server = { websocket : (websocket -> unit Lwt.t) option; } -and app = { - error_handler : error -> response Lwt.t; -} - and error_handler = error -> response option Lwt.t and log_level = [ @@ -113,14 +108,6 @@ and error = { will_send_response : bool; } -(* TODO Remove. *) -let app_error_handler app = - app.error_handler - -let new_app error_handler = { - error_handler; -} - type 'a promise = 'a Lwt.t type handler = request -> response Lwt.t @@ -398,11 +385,7 @@ let with_local key value message = let fold_locals f initial message = fold_scope f initial message.locals -let app request = - request.specific.app - let request_from_http - ~app ~client ~method_ ~target @@ -415,7 +398,6 @@ let request_from_http let rec request = { specific = { - app; request_client = client; method_; target; @@ -459,7 +441,6 @@ let request specific = { (* TODO Is there a better fake error handler? Maybe this function should come after the response constructors? *) - app = new_app (fun _ -> assert false); request_client = client; method_; target; From 037645f5ff489f8b99f192506607610fb03224a6 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 13:27:07 +0300 Subject: [PATCH 079/312] Move client field from dream-pure to server --- src/dream.ml | 9 +++++++-- src/dream.mli | 1 - src/http/error_handler.ml | 5 +++-- src/http/http.ml | 7 +++---- src/middleware/catch.ml | 4 ++-- src/middleware/log.ml | 2 +- src/middleware/server.ml | 35 +++++++++++++++++++++++++++++++++++ src/pure/dream_pure.mli | 4 ---- src/pure/inmost.ml | 12 ------------ 9 files changed, 51 insertions(+), 28 deletions(-) create mode 100644 src/middleware/server.ml diff --git a/src/dream.ml b/src/dream.ml index 914f8c9a..f0f3b358 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -130,11 +130,16 @@ let verify_csrf_token = verify_csrf_token ~now let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request -let request ?client ?method_ ?target ?version ?headers body = +let client = + Dream__middleware.Server.client +let with_client = + Dream__middleware.Server.with_client + +let request ?method_ ?target ?version ?headers body = (* TODO Streams. *) let client_stream = Dream_pure.Stream.stream no_reader no_writer and server_stream = Dream_pure.Stream.stream (string body) no_writer in - request ?client ?method_ ?target ?version ?headers client_stream server_stream + request ?method_ ?target ?version ?headers client_stream server_stream let response ?status ?code ?headers body = (* TODO Streams. *) diff --git a/src/dream.mli b/src/dream.mli index cadd0a9f..27301312 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2311,7 +2311,6 @@ val with_local : 'a local -> 'a -> 'b message -> 'b message (** {1 Testing} *) val request : - ?client:string -> ?method_:[< method_ ] -> ?target:string -> ?version:int * int -> diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 3d57e2da..26d1cccd 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -6,6 +6,7 @@ module Dream = Dream_pure +module Server = Dream__middleware.Server @@ -440,7 +441,7 @@ let websocket caused_by = `Server; request = Some request; response = Some response; - client = Some (Dream.client request); + client = Some (Server.client request); severity = `Warning; (* Not sure what these errors are, yet. *) will_send_response = false; } in @@ -462,7 +463,7 @@ let websocket_handshake caused_by = `Client; request = Some request; response = Some response; - client = Some (Dream.client request); + client = Some (Server.client request); severity = `Warning; will_send_response = true; } in diff --git a/src/http/http.ml b/src/http/http.ml index 966c3f10..3a7e62d3 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -7,6 +7,7 @@ module Dream = Dream_pure module Stream = Dream_pure.Stream +module Server = Dream__middleware.Server @@ -337,8 +338,7 @@ let wrap_handler Stream.stream body Stream.no_writer in let request : Dream.request = - Dream.request_from_http - ~client ~method_ ~target ~https ~version ~headers body in + Server.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -482,8 +482,7 @@ let wrap_handler_h2 Stream.stream body Stream.no_writer in let request : Dream.request = - Dream.request_from_http - ~client ~method_ ~target ~https ~version ~headers body in + Server.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 405564e1..a6f59a03 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -38,7 +38,7 @@ let catch error_handler next_handler request = caused_by; request = Some request; response = Some response; - client = Some (Dream.client request); + client = Some (Server.client request); severity = severity; will_send_response = true; } in @@ -59,7 +59,7 @@ let catch error_handler next_handler request = caused_by = `Server; request = Some request; response = None; - client = Some (Dream.client request); + client = Some (Server.client request); severity = `Error; will_send_response = true; } in diff --git a/src/middleware/log.ml b/src/middleware/log.ml index a7d69a89..77651d25 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -477,7 +477,7 @@ struct log ~request "%s %s %s %s" (Dream.method_to_string (Dream.method_ request)) (Dream.target request) - (Dream.client request) + (Server.client request) user_agent); (* Call the rest of the app. *) diff --git a/src/middleware/server.ml b/src/middleware/server.ml new file mode 100644 index 00000000..d7047ae9 --- /dev/null +++ b/src/middleware/server.ml @@ -0,0 +1,35 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +module Dream = Dream_pure + + + +let client_variable = + Dream.new_local + ~name:"dream.client" + ~show_value:(fun client -> client) + () + +(* TODO What should be reported when the client address is missing? This is a + sign of local testing. *) +let client request = + match Dream.local client_variable request with + | None -> "127.0.0.1:0" + | Some client -> client + +let with_client client request = + Dream.with_local client_variable client request + + + +(* TODO Eventually remove Dream.request_from_http as all of its functionality + is moved here. *) +let request ~client ~method_ ~target ~https ~version ~headers server_stream = + Dream.request_from_http + ~method_ ~target ~https ~version ~headers server_stream + |> with_client client diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 63ad95ed..062158c8 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -133,7 +133,6 @@ val normalize_status : [< status ] -> status val request : - ?client:string -> ?method_:[< method_ ] -> ?target:string -> ?version:int * int -> @@ -142,7 +141,6 @@ val request : stream -> request -val client : request -> string val https : request -> bool val method_ : request -> method_ val target : request -> string @@ -150,7 +148,6 @@ val prefix : request -> string val internal_prefix : request -> string list val path : request -> string list val version : request -> int * int -val with_client : string -> request -> request val with_method_ : [< method_ ] -> request -> request val with_prefix : string list -> request -> request val with_path : string list -> request -> request @@ -397,7 +394,6 @@ type error = { type error_handler = error -> response option promise val request_from_http : - client:string -> method_:method_ -> target:string -> https:bool -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index c0d91c29..ab24f7fc 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -52,7 +52,6 @@ and 'a message = { } and client = { - request_client : string; method_ : method_; target : string; prefix : string list; @@ -123,9 +122,6 @@ let update message = message.last := message; message -let client request = - request.specific.request_client - let https request = request.specific.https @@ -147,10 +143,6 @@ let path request = let version request = request.specific.request_version -let with_client client request = - update - {request with specific = {request.specific with request_client = client}} - let with_method_ method_ request = update {request with specific = {request.specific with method_ = (method_ :> method_)}} @@ -386,7 +378,6 @@ let fold_locals f initial message = fold_scope f initial message.locals let request_from_http - ~client ~method_ ~target ~https @@ -398,7 +389,6 @@ let request_from_http let rec request = { specific = { - request_client = client; method_; target; prefix = []; @@ -419,7 +409,6 @@ let request_from_http request let request - ?(client = "127.0.0.1:12345") ?method_ ?(target = "/") ?(version = 1, 1) @@ -441,7 +430,6 @@ let request specific = { (* TODO Is there a better fake error handler? Maybe this function should come after the response constructors? *) - request_client = client; method_; target; prefix = []; From 3dcb88d6eab010273818d5eca8d7d5a90fe3b2df Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 13:40:24 +0300 Subject: [PATCH 080/312] Move https field from dream-pure to server --- src/dream.ml | 2 ++ src/middleware/cookie.ml | 4 ++-- src/middleware/origin_referrer_check.ml | 4 ++-- src/middleware/server.ml | 20 ++++++++++++++++++-- src/pure/dream_pure.mli | 2 -- src/pure/inmost.ml | 7 ------- 6 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index f0f3b358..67da3e4e 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -134,6 +134,8 @@ let client = Dream__middleware.Server.client let with_client = Dream__middleware.Server.with_client +let https = + Dream__middleware.Server.https let request ?method_ ?target ?version ?headers body = (* TODO Streams. *) diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index cd6fd8bc..19d7d783 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -39,7 +39,7 @@ let cookie let secure = match secure with | Some secure -> secure - | None -> Dream.https request + | None -> Server.https request in let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in @@ -83,7 +83,7 @@ let set_cookie let secure = match secure with | Some secure -> secure - | None -> Dream.https request + | None -> Server.https request in let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in diff --git a/src/middleware/origin_referrer_check.ml b/src/middleware/origin_referrer_check.ml index 3668d3ae..b265877a 100644 --- a/src/middleware/origin_referrer_check.ml +++ b/src/middleware/origin_referrer_check.ml @@ -54,8 +54,8 @@ let origin_referrer_check inner_handler request = let schemes_match = match Uri.scheme origin_uri with - | Some "http" -> not (Dream.https request) - | Some "https" -> Dream.https request + | Some "http" -> not (Server.https request) + | Some "https" -> Server.https request | _ -> false in diff --git a/src/middleware/server.ml b/src/middleware/server.ml index d7047ae9..021dfbb0 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -27,9 +27,25 @@ let with_client client request = +let https_variable = + Dream.new_local + ~name:"dream.https" + ~show_value:string_of_bool + () + +let https request = + match Dream.local https_variable request with + | Some true -> true + | _ -> false + +let with_https https request = + Dream.with_local https_variable https request + + + (* TODO Eventually remove Dream.request_from_http as all of its functionality is moved here. *) let request ~client ~method_ ~target ~https ~version ~headers server_stream = - Dream.request_from_http - ~method_ ~target ~https ~version ~headers server_stream + Dream.request_from_http ~method_ ~target ~version ~headers server_stream |> with_client client + |> with_https https diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 062158c8..0be0938e 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -141,7 +141,6 @@ val request : stream -> request -val https : request -> bool val method_ : request -> method_ val target : request -> string val prefix : request -> string @@ -396,7 +395,6 @@ type error_handler = error -> response option promise val request_from_http : method_:method_ -> target:string -> - https:bool -> version:int * int -> headers:(string * string) list -> stream -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index ab24f7fc..633e8f46 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -57,7 +57,6 @@ and client = { prefix : string list; path : string list; query : (string * string) list; - https : bool; request_version : int * int; upload : multipart_state; } @@ -122,9 +121,6 @@ let update message = message.last := message; message -let https request = - request.specific.https - let method_ request = request.specific.method_ @@ -380,7 +376,6 @@ let fold_locals f initial message = let request_from_http ~method_ ~target - ~https ~version ~headers body = @@ -394,7 +389,6 @@ let request_from_http prefix = []; path = Formats.from_path path; query = Formats.from_form_urlencoded query; - https; request_version = version; upload = initial_multipart_state (); }; @@ -435,7 +429,6 @@ let request prefix = []; path = Formats.from_path path; query = Formats.from_form_urlencoded query; - https = false; request_version = version; upload = initial_multipart_state (); }; From 0c7b464f90f5086e6158d3778af01ef15925d7be Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 18:47:08 +0300 Subject: [PATCH 081/312] Move paths and prefixes from dream-pure to server --- src/middleware/cookie.ml | 4 +-- src/middleware/router.ml | 64 +++++++++++++++++++++++++++++------ src/middleware/router.mli | 6 ++++ src/middleware/site_prefix.ml | 6 ++-- src/pure/dream_pure.mli | 6 +--- src/pure/inmost.ml | 22 ------------ src/unix/dune | 1 + src/unix/static.ml | 2 +- 8 files changed, 68 insertions(+), 43 deletions(-) diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index 19d7d783..36e6afe3 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -33,7 +33,7 @@ let cookie let path = match path with | Some path -> path - | None -> Some (Dream.prefix request) + | None -> Some (Router.prefix request) in let secure = @@ -77,7 +77,7 @@ let set_cookie let path = match path with | Some path -> path - | None -> Some (Dream.prefix request) + | None -> Some (Router.prefix request) in let secure = diff --git a/src/middleware/router.ml b/src/middleware/router.ml index b5bc3913..f80a17ca 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -163,9 +163,53 @@ let scope prefix middlewares routes = -(* TODO LATER Pretty-print for the debugger. *) -let params : (string * string) list Dream.local = - Dream.new_local () +let path_variable : string list Dream.local = + Dream.new_local + ~name:"dream.path" + ~show_value:(fun path -> String.concat "/" path) + () + +(* TODO It would be nice not to repeat the work of splitting the path and query + string. *) +(* TODO Remove this from the API. *) +let path the_request = + match Dream.local path_variable the_request with + | Some path -> path + | None -> + Dream.(Formats.(the_request |> target |> split_target |> fst |> from_path)) + +(* TODO Move site_prefix into this file and remove with_path from the API. *) +let with_path path request = + Dream.with_local path_variable path request + +(* Prefix is stored backwards. *) +let prefix_variable : string list Dream.local = + Dream.new_local + ~name:"dream.prefix" + ~show_value:(fun prefix -> String.concat "/" (List.rev prefix)) + () + +let internal_prefix request = + match Dream.local prefix_variable request with + | Some prefix -> prefix + | None -> [] + +let prefix request = + Dream.Formats.make_path (List.rev (internal_prefix request)) + +let with_prefix prefix request = + Dream.with_local prefix_variable prefix request + +let params_variable : (string * string) list Dream.local = + Dream.new_local + ~name:"dream.params" + ~show_value:(fun params -> + params + |> List.map (fun (param, value) -> Printf.sprintf "%s=%s" param value) + |> String.concat ", ") + () + + let log = Log.sub_log "dream.router" @@ -176,7 +220,7 @@ let missing_param name request = failwith message let param name request = - match Dream.local params request with + match Dream.local params_variable request with | None -> missing_param name request | Some params -> try List.assoc name params @@ -215,11 +259,11 @@ let router routes = match node with | Handler (method_, handler) when method_matches method_ (Dream.method_ request) -> - let request = Dream.with_local params bindings request in + let request = Dream.with_local params_variable bindings request in if is_wildcard then request - |> Dream.with_prefix prefix - |> Dream.with_path path + |> with_prefix prefix + |> with_path path |> ok handler else if path = [] then @@ -233,14 +277,14 @@ let router routes = in let params = - match Dream.local params request with + match Dream.local params_variable request with | Some params -> params | None -> [] in (* let next_prefix = Dream.next_prefix request *) - let prefix = Dream.internal_prefix request in - let path = Dream.path request in + let prefix = internal_prefix request in + let path = path request in (* match match_site_prefix next_prefix path with | None -> next_handler request diff --git a/src/middleware/router.mli b/src/middleware/router.mli index 77161c7f..7486979f 100644 --- a/src/middleware/router.mli +++ b/src/middleware/router.mli @@ -31,6 +31,12 @@ val scope : string -> Dream.middleware list -> route list -> route val router : route list -> Dream.middleware val param : string -> Dream.request -> string +(* Variables used by the router. *) +val path : Dream.request -> string list +val prefix : Dream.request -> string +val with_path : string list -> Dream.request -> Dream.request +val with_prefix : string list -> Dream.request -> Dream.request + (**/**) type token = diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index bc7aab29..469f0cd3 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -31,7 +31,7 @@ let with_site_prefix prefix = |> Dream_pure.Formats.drop_trailing_slash in fun next_handler request -> - match match_site_prefix prefix (Dream.path request) with + match match_site_prefix prefix (Router.path request) with | None -> (* TODO Streams. *) let client_stream = Dream.Stream.(stream empty no_writer) @@ -43,6 +43,6 @@ let with_site_prefix prefix = result in the app. *) let prefix_reversed = List.rev prefix in request - |> Dream.with_prefix prefix_reversed - |> Dream.with_path path + |> Router.with_prefix prefix_reversed + |> Router.with_path path |> next_handler diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 0be0938e..68616b73 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -143,13 +143,8 @@ val request : val method_ : request -> method_ val target : request -> string -val prefix : request -> string -val internal_prefix : request -> string list -val path : request -> string list val version : request -> int * int val with_method_ : [< method_ ] -> request -> request -val with_prefix : string list -> request -> request -val with_path : string list -> request -> request val with_version : int * int -> request -> request (* TODO Path handling should also be done by server-side-only helpers. *) val query : string -> request -> string option @@ -425,6 +420,7 @@ sig val from_path : string -> string list val to_path : ?relative:bool -> ?international:bool -> string list -> string val drop_trailing_slash : string list -> string list + val make_path : string list -> string val text_html : string val application_json : string end diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 633e8f46..95eddc41 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -54,13 +54,10 @@ and 'a message = { and client = { method_ : method_; target : string; - prefix : string list; - path : string list; query : (string * string) list; request_version : int * int; upload : multipart_state; } -(* Prefix is stored backwards. *) and server = { status : status; @@ -127,15 +124,6 @@ let method_ request = let target request = request.specific.target -let internal_prefix request = - request.specific.prefix - -let prefix request = - Formats.make_path (List.rev request.specific.prefix) - -let path request = - request.specific.path - let version request = request.specific.request_version @@ -143,12 +131,6 @@ let with_method_ method_ request = update {request with specific = {request.specific with method_ = (method_ :> method_)}} -let with_prefix prefix request = - update {request with specific = {request.specific with prefix}} - -let with_path path request = - update {request with specific = {request.specific with path}} - let with_version version request = update {request with specific = {request.specific with request_version = version}} @@ -386,8 +368,6 @@ let request_from_http specific = { method_; target; - prefix = []; - path = Formats.from_path path; query = Formats.from_form_urlencoded query; request_version = version; upload = initial_multipart_state (); @@ -426,8 +406,6 @@ let request come after the response constructors? *) method_; target; - prefix = []; - path = Formats.from_path path; query = Formats.from_form_urlencoded query; request_version = version; upload = initial_multipart_state (); diff --git a/src/unix/dune b/src/unix/dune index 824895de..7cc1e262 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -3,6 +3,7 @@ (name dream__unix) (libraries digestif + dream.middleware dream-pure lwt.unix magic-mime diff --git a/src/unix/static.ml b/src/unix/static.ml index 5c09e463..3ce56849 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -47,7 +47,7 @@ let from_filesystem local_root path _ = (* TODO On Windows, should we also check for \ and drive letters? *) (* TODO Not an efficient implementation at the moment. *) let validate_path request = - let path = Dream.path request in + let path = Dream__middleware.Router.path request in let has_slash component = String.contains component '/' in let has_backslash component = String.contains component '\\' in From 598367067b9d8d77b07261733a414889198b1133 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 18:56:20 +0300 Subject: [PATCH 082/312] Move query strings from dream-pure to server --- src/dream.ml | 2 ++ src/middleware/query.ml | 41 +++++++++++++++++++++++++++++++++++++++++ src/pure/dream_pure.mli | 4 ---- src/pure/inmost.ml | 23 ----------------------- 4 files changed, 43 insertions(+), 27 deletions(-) create mode 100644 src/middleware/query.ml diff --git a/src/dream.ml b/src/dream.ml index 67da3e4e..c545b21c 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -137,6 +137,8 @@ let with_client = let https = Dream__middleware.Server.https +include Dream__middleware.Query + let request ?method_ ?target ?version ?headers body = (* TODO Streams. *) let client_stream = Dream_pure.Stream.stream no_reader no_writer diff --git a/src/middleware/query.ml b/src/middleware/query.ml new file mode 100644 index 00000000..86e2a299 --- /dev/null +++ b/src/middleware/query.ml @@ -0,0 +1,41 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +(* TODO Long-term, query string handler is likely to become part of the + router. *) + +module Dream = Dream_pure + + + +(* TODO Actually cache the result of parsing the query string. *) +(* let query_variable : (string * string) list Dream.local = + Dream.new_local + ~name:"dream.query" + ~show_value:(fun query -> + query + |> List.map (fun (name, value) -> Printf.sprintf "%s=%s" name value) + |> String.concat ", ") *) + +let all_queries request = + Dream.target request + |> Dream.Formats.split_target + |> snd + |> Dream.Formats.from_form_urlencoded + +let query name request = + List.assoc_opt name (all_queries request) + +let queries name request = + all_queries request + |> List.fold_left (fun accumulator (name', value) -> + if name' = name then + value::accumulator + else + accumulator) + [] + |> List.rev diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 68616b73..4019cf3a 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -146,10 +146,6 @@ val target : request -> string val version : request -> int * int val with_method_ : [< method_ ] -> request -> request val with_version : int * int -> request -> request -(* TODO Path handling should also be done by server-side-only helpers. *) -val query : string -> request -> string option -val queries : string -> request -> string list -val all_queries : request -> (string * string) list diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 95eddc41..b029edef 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -54,7 +54,6 @@ and 'a message = { and client = { method_ : method_; target : string; - query : (string * string) list; request_version : int * int; upload : multipart_state; } @@ -138,23 +137,6 @@ let with_version version request = let status response = response.specific.status -let all_queries request = - request.specific.query - -(* TODO percent-decode name and value. *) -let query name request = - List.assoc_opt name request.specific.query - -let queries name request = - request.specific.query - |> List.fold_left (fun accumulator (name', value) -> - if name' = name then - value::accumulator - else - accumulator) - [] - |> List.rev - let all_headers message = message.headers @@ -362,13 +344,10 @@ let request_from_http ~headers body = - let path, query = Formats.split_target target in - let rec request = { specific = { method_; target; - query = Formats.from_form_urlencoded query; request_version = version; upload = initial_multipart_state (); }; @@ -398,7 +377,6 @@ let request (* This function is used for debugging, so it's fine to allocate a fake body and then immediately replace it. *) - let path, query = Formats.split_target target in let rec request = { specific = { @@ -406,7 +384,6 @@ let request come after the response constructors? *) method_; target; - query = Formats.from_form_urlencoded query; request_version = version; upload = initial_multipart_state (); }; From 267e2de87b41a83e81c8287dbb37a54676db8e32 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 19:03:24 +0300 Subject: [PATCH 083/312] Move html and json helpers from dream-pure --- src/dream.ml | 4 ++++ src/graphql/graphql.ml | 9 +++++---- src/middleware/server.ml | 18 ++++++++++++++++++ src/pure/dream_pure.mli | 13 ------------- src/pure/inmost.ml | 16 ---------------- 5 files changed, 27 insertions(+), 33 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index c545b21c..2515a5e4 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -136,6 +136,10 @@ let with_client = Dream__middleware.Server.with_client let https = Dream__middleware.Server.https +let html = + Dream__middleware.Server.html +let json = + Dream__middleware.Server.json include Dream__middleware.Query diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index c63c940f..c5b0bf55 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -6,6 +6,7 @@ module Dream = Dream_pure +module Server = Dream__middleware.Server @@ -299,16 +300,16 @@ let graphql make_context schema = fun request -> begin match%lwt run_query make_context schema request json with | Error json -> Yojson.Basic.to_string json - |> Dream.json + |> Server.json | Ok (`Response json) -> Yojson.Basic.to_string json - |> Dream.json + |> Server.json | Ok (`Stream _) -> make_error "Subscriptions and streaming should use WebSocket transport" |> Yojson.Basic.to_string - |> Dream.json + |> Server.json end | _ -> @@ -351,4 +352,4 @@ let graphiql ?(default_query = "") graphql_endpoint = in fun _request -> - Dream.html (Lazy.force html) + Server.html (Lazy.force html) diff --git a/src/middleware/server.ml b/src/middleware/server.ml index 021dfbb0..f99aa8ee 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -49,3 +49,21 @@ let request ~client ~method_ ~target ~https ~version ~headers server_stream = Dream.request_from_http ~method_ ~target ~version ~headers server_stream |> with_client client |> with_https https + + + +let html ?status ?code ?headers body = + (* TODO The streams. *) + let client_stream = Dream.Stream.(stream (string body) no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ?status ?code ?headers client_stream server_stream + |> Dream.with_header "Content-Type" Dream.Formats.text_html + |> Lwt.return + +let json ?status ?code ?headers body = + (* TODO The streams. *) + let client_stream = Dream.Stream.(stream (string body) no_writer) + and server_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.response ?status ?code ?headers client_stream server_stream + |> Dream.with_header "Content-Type" Dream.Formats.application_json + |> Lwt.return diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 4019cf3a..7c015f6b 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -157,19 +157,6 @@ val response : stream -> response -val html : - ?status:[< status ] -> - ?code:int -> - ?headers:(string * string) list -> - string -> response promise -(* TODO Remove these. *) - -val json : - ?status:[< status ] -> - ?code:int -> - ?headers:(string * string) list -> - string -> response promise - val status : response -> status diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index b029edef..6ca07b5d 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -423,22 +423,6 @@ let response response -let html ?status ?code ?headers body = - (* TODO The streams. *) - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - response ?status ?code ?headers client_stream server_stream - |> with_header "Content-Type" Formats.text_html - |> Lwt.return - -let json ?status ?code ?headers body = - (* TODO The streams. *) - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - response ?status ?code ?headers client_stream server_stream - |> with_header "Content-Type" Formats.application_json - |> Lwt.return - let websocket ?headers handler = (* TODO Simplify stream creation. *) let client_stream = Stream.(stream empty no_writer) From 5d391a62a203e40bbe5747a4d3845ffe40f04489 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 19:05:44 +0300 Subject: [PATCH 084/312] Move all_cookies from dream-pure to server --- src/middleware/cookie.ml | 20 +++++++++++++++++++- src/pure/dream_pure.mli | 5 ----- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index 36e6afe3..23248d3b 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -11,6 +11,24 @@ module Cipher = Dream__cipher.Cipher +(* TODO LATER Optimize by caching the parsed cookies in a local key. *) +(* TODO LATER: API: Dream.cookie : string -> request -> string, cookie-option... + the thing with cookies is that they have a high likelihood of being absent. *) +(* TODO LATER Can decide whether to accept multiple Cookie: headers based on + request version. But that would entail an actual middleware - is that worth + it? *) +(* TODO LATER Also not efficient, at all. Need faster parser + the cache. *) +(* TODO DOC Using only raw cookies. *) +(* TODO However, is it best to URL-encode cookies by default, and provide a + variable for opting out? *) +(* TODO DOC We allow multiple headers sent by the client, to support HTTP/2. + What is this about? *) +let all_cookies request = + request + |> Dream.headers "Cookie" + |> List.map Formats.from_cookie + |> List.flatten + let infer_cookie_prefix prefix domain path secure = match prefix, domain, path, secure with | Some (Some `Host), _, _, _ -> "__Host-" @@ -46,7 +64,7 @@ let cookie let name = cookie_prefix ^ name in let test = fun (name', _) -> name = name' in - match Dream.all_cookies request |> List.find_opt test with + match all_cookies request |> List.find_opt test with | None -> None | Some (_, value) -> if not decrypt_cookie then diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 7c015f6b..4167a96b 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -172,11 +172,6 @@ val with_all_headers : (string * string) list -> 'a message -> 'a message -val all_cookies : request -> (string * string) list -(* TODO Should become server-side-only. *) - - - val body : 'a message -> string promise val with_body : string -> response -> response val read : request -> string option promise From 918cb3cb35c82ea57358f4b1b6061176c05e49cb Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 19:12:25 +0300 Subject: [PATCH 085/312] Move multipart state from dream-pure and break it It will be much easier to reimplement multipart upload state once requests become mutable, since the state can be simply written into the request. For now, multipart uploads are broken. --- src/middleware/upload.ml | 39 ++++++++++++++++++++++++++++++---- src/pure/dream_pure.mli | 10 --------- src/pure/inmost.ml | 45 ---------------------------------------- 3 files changed, 35 insertions(+), 59 deletions(-) diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index cd9a024b..c9427dac 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -9,13 +9,44 @@ module Dream = Dream_pure +(* Used for converting the stream interface of [multipart_form] into the pull + interface of Dream. + + [state] permits to dissociate the initial state made by + [initial_multipart_state] and one which started to consume the body stream + (see the call of [Upload.upload]). *) +type multipart_state = { + mutable state_init : bool; + mutable name : string option; + mutable filename : string option; + mutable stream : (< > * Multipart_form.Header.t * string Lwt_stream.t) Lwt_stream.t; +} + +let initial_multipart_state () = { + state_init = true; + name = None; + filename = None; + stream = Lwt_stream.of_list []; +} + +(* TODO Dump the value of the multipart state somehow? *) +let multipart_state_variable : multipart_state Dream.local = + Dream.new_local + ~name:"dream.multipart" + () + +(* TODO This would be MUCH easier if requests were mutable. It's probably best + to just break multipart until then, and have the branch be "unstable." *) +let multipart_state request = + assert false + let field_to_string (request : Dream.request) field = let open Multipart_form in match field with | Field.Field (field_name, Field.Content_type, v) -> (field_name :> string), Content_type.to_string v | Field.Field (field_name, Field.Content_disposition, v) -> - let state = Dream.multipart_state request in + let state = multipart_state request in state.filename <- Content_disposition.filename v ; state.name <- Content_disposition.name v ; (field_name :> string), Content_disposition.to_string v @@ -27,7 +58,7 @@ let field_to_string (request : Dream.request) field = let log = Log.sub_log "dream.upload" let upload_part (request : Dream.request) = - let state = Dream.multipart_state request in + let state = multipart_state request in match%lwt Lwt_stream.peek state.stream with | None -> Lwt.return_none | Some (_uid, _header, stream) -> @@ -44,7 +75,7 @@ let identify _ = object end type part = string option * string option * ((string * string) list) let rec state (request : Dream.request) = - let state' = Dream.multipart_state request in + let state' = multipart_state request in let stream = state'.stream in match%lwt Lwt_stream.peek stream with | None -> let%lwt () = Lwt_stream.junk stream in Lwt.return_none @@ -59,7 +90,7 @@ let rec state (request : Dream.request) = Lwt.return (Some part) and upload (request : Dream.request) = - let state' = Dream.multipart_state request in + let state' = multipart_state request in match state'.state_init with | false -> state request diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 4167a96b..725d1f38 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -303,16 +303,6 @@ val pong : stream -> buffer -> int -> int -> write meaningful for WebSockets. *) end -(* TODO Remove to server-side code. *) -type multipart_state = { - mutable state_init : bool; - mutable name : string option; - mutable filename : string option; - mutable stream : (< > * Multipart_form.Header.t * string Lwt_stream.t) Lwt_stream.t; -} - -val multipart_state : request -> multipart_state - val no_middleware : middleware diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 6ca07b5d..5c1465bb 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -10,26 +10,6 @@ include Status -(* Used for converting the stream interface of [multipart_form] into the pull - interface of Dream. - - [state] permits to dissociate the initial state made by - [initial_multipart_state] and one which started to consume the body stream - (see the call of [Upload.upload]). *) -type multipart_state = { - mutable state_init : bool; - mutable name : string option; - mutable filename : string option; - mutable stream : (< > * Multipart_form.Header.t * string Lwt_stream.t) Lwt_stream.t; -} - -let initial_multipart_state () = { - state_init = true; - name = None; - filename = None; - stream = Lwt_stream.of_list []; -} - module Scope_variable_metadata = struct type 'a t = string option * ('a -> string) option @@ -55,7 +35,6 @@ and client = { method_ : method_; target : string; request_version : int * int; - upload : multipart_state; } and server = { @@ -184,24 +163,6 @@ let with_header name value message = |> drop_header name |> add_header name value -(* TODO LATER Optimize by caching the parsed cookies in a local key. *) -(* TODO LATER: API: Dream.cookie : string -> request -> string, cookie-option... - the thing with cookies is that they have a high likelihood of being absent. *) -(* TODO LATER Can decide whether to accept multiple Cookie: headers based on - request version. But that would entail an actual middleware - is that worth - it? *) -(* TODO LATER Also not efficient, at all. Need faster parser + the cache. *) -(* TODO DOC Using only raw cookies. *) -(* TODO However, is it best to URL-encode cookies by default, and provide a - variable for opting out? *) -(* TODO DOC We allow multiple headers sent by the client, to support HTTP/2. - What is this about? *) -let all_cookies request = - request - |> headers "Cookie" - |> List.map Formats.from_cookie - |> List.flatten - (* TODO Don't use this exception-raising function, to avoid clobbering user backtraces more. *) (* let cookie_exn name request = @@ -349,7 +310,6 @@ let request_from_http method_; target; request_version = version; - upload = initial_multipart_state (); }; headers; client_stream = Stream.(stream no_reader no_writer); @@ -385,7 +345,6 @@ let request method_; target; request_version = version; - upload = initial_multipart_state (); }; headers; client_stream; @@ -471,7 +430,3 @@ let rec pipeline middlewares handler = let sort_headers headers = List.stable_sort (fun (name, _) (name', _) -> compare name name') headers - -(* TODO Remove to server-side code. *) -let multipart_state request = - request.specific.upload From ba859abb23fb737d898715a991a6af01d59889ae Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 19:34:26 +0300 Subject: [PATCH 086/312] Move error types from dream-pure to server --- src/http/error_handler.ml | 15 ++++++++------- src/http/error_handler.mli | 23 +++++++++++----------- src/http/http.ml | 6 +++++- src/middleware/catch.ml | 30 +++++++++++++++++++++++++++-- src/middleware/log.ml | 9 +++++++++ src/pure/dream_pure.mli | 33 -------------------------------- src/pure/inmost.ml | 39 -------------------------------------- 7 files changed, 62 insertions(+), 93 deletions(-) diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 26d1cccd..24e81ae9 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -6,6 +6,7 @@ module Dream = Dream_pure +module Catch = Dream__middleware.Catch module Server = Dream__middleware.Server @@ -26,7 +27,7 @@ let select_log = function -let dump (error : Dream.error) = +let dump (error : Catch.error) = let buffer = Buffer.create 4096 in let p format = Printf.bprintf buffer format in @@ -110,7 +111,7 @@ let dump (error : Dream.error) = (* TODO LATER Some library is registering S-exp-based printers for expressions, which are calling functions that use exceptions during parsing, which are clobbering the backtrace. *) -let customize template (error : Dream.error) = +let customize template (error : Catch.error) = (* First, log the error. *) @@ -306,7 +307,7 @@ let httpaf in let error = { - Dream.condition; + Catch.condition; layer = `HTTP; caused_by; request = None; @@ -364,7 +365,7 @@ let h2 in let error = { - Dream.condition; + Catch.condition; layer = `HTTP2; caused_by; request = None; @@ -405,7 +406,7 @@ let tls user's_error_handler client_address error = let error = { - Dream.condition = `Exn error; + Catch.condition = `Exn error; layer = `TLS; caused_by = `Client; request = None; @@ -436,7 +437,7 @@ let websocket let `Exn exn = error in let error = { - Dream.condition = `Exn exn; + Catch.condition = `Exn exn; layer = `WebSocket; caused_by = `Server; request = Some request; @@ -458,7 +459,7 @@ let websocket_handshake fun request response error_string -> let error = { - Dream.condition = `String error_string; + Catch.condition = `String error_string; layer = `WebSocket; caused_by = `Client; request = Some request; diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index d25b71c6..97c7c201 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -6,17 +6,18 @@ module Dream = Dream_pure +module Catch = Dream__middleware.Catch (* User's error handlers and defaults. These actually generate error response templates and/or do logging. *) -val default : Dream.error_handler -val debug_error_handler : Dream.error_handler +val default : Catch.error_handler +val debug_error_handler : Catch.error_handler val customize : - (Dream.error -> string -> Dream.response -> Dream.response Lwt.t) -> - Dream.error_handler + (Catch.error -> string -> Dream.response -> Dream.response Lwt.t) -> + Catch.error_handler @@ -32,29 +33,29 @@ val customize : Dream.middleware *) val app : - Dream.error_handler -> - (Dream.error -> Dream.response Lwt.t) + Catch.error_handler -> + (Catch.error -> Dream.response Lwt.t) val httpaf : - Dream.error_handler -> + Catch.error_handler -> (Unix.sockaddr -> Httpaf.Server_connection.error_handler) val h2 : - Dream.error_handler -> + Catch.error_handler -> (Unix.sockaddr -> H2.Server_connection.error_handler) val tls : - Dream.error_handler -> + Catch.error_handler -> (Unix.sockaddr -> exn -> unit) val websocket : - Dream.error_handler -> + Catch.error_handler -> Dream.request -> Dream.response -> (Websocketaf.Wsd.t -> [ `Exn of exn ] -> unit) val websocket_handshake : - Dream.error_handler -> + Catch.error_handler -> (Dream.request -> Dream.response -> string -> Dream.response Lwt.t) diff --git a/src/http/http.ml b/src/http/http.ml index 3a7e62d3..d87d2c11 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -5,7 +5,11 @@ -module Dream = Dream_pure +module Dream = +struct + include Dream_pure + include Dream__middleware.Catch +end module Stream = Dream_pure.Stream module Server = Dream__middleware.Server diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index a6f59a03..00eae005 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -9,6 +9,32 @@ module Dream = Dream_pure +type error = { + condition : [ + | `Response of Dream.response + | `String of string + | `Exn of exn + ]; + layer : [ + | `App + | `HTTP + | `HTTP2 + | `TLS + | `WebSocket + ]; + caused_by : [ + | `Server + | `Client + ]; + request : Dream.request option; + response : Dream.response option; + client : string option; + severity : Log.log_level; + will_send_response : bool; +} + +type error_handler = error -> Dream.response option Dream.promise + (* This error handler actually *is* a middleware, but it is just one pathway for reaching the centralized error handler provided by the user, so it is built into the framework. *) @@ -33,7 +59,7 @@ let catch error_handler next_handler request = in let error = { - Dream.condition = `Response response; + condition = `Response response; layer = `App; caused_by; request = Some request; @@ -54,7 +80,7 @@ let catch error_handler next_handler request = severe protocol-level errors and integration mistakes. *) (fun exn -> let error = { - Dream.condition = `Exn exn; + condition = `Exn exn; layer = `App; caused_by = `Server; request = Some request; diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 77651d25..2d43b181 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -31,6 +31,15 @@ module Dream = Dream_pure +type log_level = [ + | `Error + | `Warning + | `Info + | `Debug +] + + + (* The logging middleware assigns request ids to requests, and tries to show them in the logs. The scheme works as follows: diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 725d1f38..3e6b63c7 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -322,39 +322,6 @@ val is_websocket : response -> (websocket -> unit promise) option -type log_level = [ - | `Error - | `Warning - | `Info - | `Debug -] - -type error = { - condition : [ - | `Response of response - | `String of string - | `Exn of exn - ]; - layer : [ - | `App - | `HTTP - | `HTTP2 - | `TLS - | `WebSocket - ]; - caused_by : [ - | `Server - | `Client - ]; - request : request option; - response : response option; - client : string option; - severity : log_level; - will_send_response : bool; -} - -type error_handler = error -> response option promise - val request_from_http : method_:method_ -> target:string -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 5c1465bb..c1a00d6d 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -42,45 +42,6 @@ and server = { websocket : (websocket -> unit Lwt.t) option; } -and error_handler = error -> response option Lwt.t - -and log_level = [ - | `Error - | `Warning - | `Info - | `Debug -] - -and error = { - condition : [ - | `Response of response - | `String of string - | `Exn of exn - ]; - layer : [ - | `TLS - | `HTTP - | `HTTP2 - | `WebSocket - | `App - ]; - (* TODO Any point in distinguishing HTTP and HTTP2 errors? *) - caused_by : [ - | `Server - | `Client - ]; - request : request option; - response : response option; - client : string option; - severity : [ - | `Error - | `Warning - | `Info - | `Debug - ]; - will_send_response : bool; -} - type 'a promise = 'a Lwt.t type handler = request -> response Lwt.t From 865217859faa59de5dd46b43af13646b8696df5c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 14 Dec 2021 19:37:41 +0300 Subject: [PATCH 087/312] Cut request_from_http from dream-pure This completes an initial version of the refactoring mentioned in #8. --- src/middleware/server.ml | 4 +++- src/pure/dream_pure.mli | 10 ---------- src/pure/inmost.ml | 23 ----------------------- 3 files changed, 3 insertions(+), 34 deletions(-) diff --git a/src/middleware/server.ml b/src/middleware/server.ml index f99aa8ee..81ac76f1 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -46,7 +46,9 @@ let with_https https request = (* TODO Eventually remove Dream.request_from_http as all of its functionality is moved here. *) let request ~client ~method_ ~target ~https ~version ~headers server_stream = - Dream.request_from_http ~method_ ~target ~version ~headers server_stream + (* TODO Use pre-allocated streams. *) + let client_stream = Dream.Stream.(stream no_reader no_writer) in + Dream.request ~method_ ~target ~version ~headers client_stream server_stream |> with_client client |> with_https https diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 3e6b63c7..90ebd85d 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -322,16 +322,6 @@ val is_websocket : response -> (websocket -> unit promise) option -val request_from_http : - method_:method_ -> - target:string -> - version:int * int -> - headers:(string * string) list -> - stream -> - request - - - module Formats : sig val html_escape : string -> string diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index c1a00d6d..cb3968d7 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -259,29 +259,6 @@ let with_local key value message = let fold_locals f initial message = fold_scope f initial message.locals -let request_from_http - ~method_ - ~target - ~version - ~headers - body = - - let rec request = { - specific = { - method_; - target; - request_version = version; - }; - headers; - client_stream = Stream.(stream no_reader no_writer); - server_stream = body; - locals = Scope.empty; - first = request; (* TODO LATER What OCaml version is required for this? *) - last = ref request; - } in - - request - let request ?method_ ?(target = "/") From d7e81a28fe873814227f2619a3cf8d28243d9da4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Dec 2021 20:44:02 +0300 Subject: [PATCH 088/312] Convert to mutable requests and responses Begin adopting a t-first style suitable for mutable objects. Resolves #21. --- src/cipher/cipher.ml | 13 ++- src/dream.ml | 54 ++++++++++-- src/dream.mli | 110 +++++++++++++++++++----- src/graphql/graphql.ml | 6 +- src/http/error_handler.ml | 19 ++-- src/http/http.ml | 3 +- src/middleware/content_length.ml | 9 +- src/middleware/cookie.ml | 13 ++- src/middleware/flash.ml | 19 ++-- src/middleware/form.ml | 2 +- src/middleware/log.ml | 15 ++-- src/middleware/lowercase_headers.ml | 13 ++- src/middleware/origin_referrer_check.ml | 6 +- src/middleware/router.ml | 36 ++++---- src/middleware/router.mli | 6 +- src/middleware/server.ml | 37 ++++---- src/middleware/session.ml | 39 ++++----- src/middleware/site_prefix.ml | 8 +- src/middleware/upload.ml | 4 +- src/pure/dream_pure.mli | 32 ++++--- src/pure/inmost.ml | 103 +++++++++------------- src/sql/session.ml | 23 +++-- src/sql/sql.ml | 9 +- src/unix/static.ml | 28 +++--- 24 files changed, 336 insertions(+), 271 deletions(-) diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 64cafcf5..9000d652 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -118,7 +118,7 @@ struct | Some plaintext -> Some (Cstruct.to_string plaintext) end -let secrets = +let secrets_variable = Dream.new_local ~name:"dream.secret" ~show_value:(fun _secrets -> "[redacted]") @@ -128,23 +128,22 @@ let secrets = (* TODO Also add warnings about implicit secret generation. However, these warnings might be pretty spammy. *) (* TODO Update examples and docs. *) -let with_secret ?(old_secrets = []) secret = +let set_secret ?(old_secrets = []) secret = let value = secret::old_secrets in fun next_handler request -> - request - |> Dream.with_local secrets value - |> next_handler + Dream.set_local request secrets_variable value; + next_handler request let fallback_secrets = lazy [Random.random 32] let encryption_secret request = - match Dream.local secrets request with + match Dream.local request secrets_variable with | Some secrets -> List.hd secrets | None -> List.hd (Lazy.force fallback_secrets) let decryption_secrets request = - match Dream.local secrets request with + match Dream.local request secrets_variable with | Some secrets -> secrets | None -> Lazy.force fallback_secrets diff --git a/src/dream.ml b/src/dream.ml index 2515a5e4..1d42cf57 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -99,18 +99,16 @@ let redirect ?status ?code ?headers _request location = (* TODO The streams. *) let client_stream = stream empty no_writer and server_stream = stream no_reader no_writer in - response ?status ?code ?headers client_stream server_stream - |> with_header "Location" location - |> Lwt.return + let response = response ?status ?code ?headers client_stream server_stream in + set_header response "Location" location; + Lwt.return response let stream ?status ?code ?headers f = (* TODO Streams. *) let client_stream = stream empty no_writer and server_stream = stream no_reader no_writer in - let response = - response ?status ?code ?headers client_stream server_stream - |> with_stream - in + let response = response ?status ?code ?headers client_stream server_stream in + set_stream response; (* TODO Should set up an error handler for this. *) Lwt.async (fun () -> f response); Lwt.return response @@ -132,8 +130,8 @@ let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = let client = Dream__middleware.Server.client -let with_client = - Dream__middleware.Server.with_client +let set_client = + Dream__middleware.Server.set_client let https = Dream__middleware.Server.https let html = @@ -154,3 +152,41 @@ let response ?status ?code ?headers body = let client_stream = Dream_pure.Stream.stream (string body) no_writer and server_stream = Dream_pure.Stream.stream no_reader no_writer in response ?status ?code ?headers client_stream server_stream + +let with_client client message = + set_client message client; + message + +let with_method_ method_ message = + set_method_ message method_; + message + +let with_version version message = + set_version message version; + message + +let with_path path message = + set_path message path; + message + +let with_header name value message = + set_header message name value; + message + +let with_body body message = + set_body message body; + message + +let with_stream message = + set_stream message; + message + +let with_local key value message = + set_local message key value; + message + +let first message = + message + +let last message = + message diff --git a/src/dream.mli b/src/dream.mli index 27301312..4c934e3e 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -364,29 +364,65 @@ val method_ : request -> method_ (** Request method. For example, [`GET]. *) val target : request -> string -(** Request target. For example, ["/foo/bar"]. See {!Dream.val-path}. *) +(** Request target. For example, ["/foo/bar"]. *) (**/**) val prefix : request -> string (**/**) +(**/**) val path : request -> string list +[@@ocaml.deprecated +" Router path access is being removed from the API. Comment at + https://github.com/aantron/dream/issues"] (** Parsed request path. For example, ["foo"; "bar"]. *) +(**/**) +(**/**) val version : request -> int * int (** Protocol version. [(1, 1)] for HTTP/1.1 and [(2, 0)] for HTTP/2. *) +[@@ocaml.deprecated +" Protocol version access is being removed from the API. Comment at + https://github.com/aantron/dream/issues"] +(**/**) -val with_client : string -> request -> request +val set_client : request -> string -> unit (** Replaces the client. See {!Dream.val-client}. *) -val with_method_ : [< method_ ] -> request -> request +(**/**) +val with_client : string -> request -> request +[@@ocaml.deprecated +" Use Dream.set_client. See + https://aantron.github.io/dream/#val-set_client"] +(**/**) + +val set_method_ : request -> [< method_ ] -> unit (** Replaces the method. See {!Dream.type-method_}. *) +(**/**) +val with_method_ : [< method_ ] -> request -> request +[@@ocaml.deprecated +" Use Dream.set_method_. See + https://aantron.github.io/dream/#val-set_method_"] +(**/**) + +(**/**) val with_path : string list -> request -> request (** Replaces the path. See {!Dream.val-path}. *) +[@@ocaml.deprecated +" Router path access is being removed from the API. Comment at + https://github.com/aantron/dream/issues"] +(**/**) +(**/**) val with_version : int * int -> request -> request (** Replaces the version. See {!Dream.version}. *) +[@@ocaml.deprecated +" Protocol version access is being removed from the API. Comment at + https://github.com/aantron/dream/issues"] +(**/**) + +(* TODO Convert query string functions to the new t-first style. *) val query : string -> request -> string option (** First query parameter with the given name. See @@ -477,7 +513,7 @@ val stream : ?code:int -> ?headers:(string * string) list -> (response -> unit promise) -> response promise -(** Same as {!Dream.val-respond}, but calls {!Dream.with_stream} internally to +(** Same as {!Dream.val-respond}, but calls {!Dream.set_stream} internally to prepare the response for stream writing, and then runs the callback asynchronously to do it. See example {{:https://github.com/aantron/dream/tree/master/example/j-stream#files} @@ -497,30 +533,37 @@ val status : response -> status (** {1 Headers} *) -val header : string -> 'a message -> string option +val header : 'a message -> string -> string option (** First header with the given name. Header names are case-insensitive. See {{:https://tools.ietf.org/html/rfc7230#section-3.2} RFC 7230 §3.2} and {{:https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers} MDN}. *) -val headers : string -> 'a message -> string list +val headers : 'a message -> string -> string list (** All headers with the given name. *) val all_headers : 'a message -> (string * string) list (** Entire header set as name-value list. *) -val has_header : string -> 'a message -> bool +val has_header : 'a message -> string -> bool (** Whether the message has a header with the given name. *) -val add_header : string -> string -> 'a message -> 'a message +val add_header : 'a message -> string -> string -> unit (** Appends a header with the given name and value. Does not remove any existing headers with the same name. *) -val drop_header : string -> 'a message -> 'a message +val drop_header : 'a message -> string -> unit (** Removes all headers with the given name. *) -val with_header : string -> string -> 'a message -> 'a message +val set_header : 'a message -> string -> string -> unit (** Equivalent to {!Dream.drop_header} followed by {!Dream.add_header}. *) +(**/**) +val with_header : string -> string -> 'a message -> 'a message +[@@ocaml.deprecated +" Use Dream.set_header. See + https://aantron.github.io/dream/#val-with_header"] +(**/**) + (** {1 Cookies} @@ -558,7 +601,7 @@ val set_cookie : ?secure:bool -> ?http_only:bool -> ?same_site:[< `Strict | `Lax | `None ] option -> - string -> string -> request -> response -> response + response -> string -> string -> request -> unit (** Appends a [Set-Cookie:] header to the {!type-response}. Infers the most secure defaults from the {!type-request}. @@ -642,7 +685,7 @@ val set_cookie : ?secure:bool -> ?http_only:bool -> ?same_site:[< `Strict | `Lax | `None ] option -> - string -> request -> response -> response + response -> string -> request -> unit (** Deletes the given cookie. This function works by calling {!Dream.set_cookie}, and setting the cookie @@ -655,7 +698,7 @@ val cookie : ?domain:string -> ?path:string option -> ?secure:bool -> - string -> request -> string option + request -> string -> string option (** First cookie with the given name. See example {{:https://github.com/aantron/dream/tree/master/example/c-cookie#files} [c-cookie]}. @@ -681,9 +724,16 @@ val body : 'a message -> string promise {{:https://github.com/aantron/dream/tree/master/example/6-echo#files} [6-echo]}. *) -val with_body : string -> response -> response +val set_body : response -> string -> unit (** Replaces the body. *) +(**/**) +val with_body : string -> response -> response +[@@ocaml.deprecated +" Use Dream.set_body. See + https://aantron.github.io/dream/#val-set_body"] +(**/**) + (** {2 Streaming} *) val read : request -> string option promise @@ -692,12 +742,19 @@ val read : request -> string option promise {{:https://github.com/aantron/dream/tree/master/example/j-stream#files} [j-stream]}. *) -val with_stream : response -> response +val set_stream : response -> unit (** Makes the {!type-response} ready for stream writing with {!Dream.write}. You should return it from your handler soon after — only one call to {!Dream.write} will be accepted before then. See {!Dream.stream} for a more convenient wrapper. *) +(**/**) +val with_stream : response -> response +[@@ocaml.deprecated +" Use Dream.set_stream instead. See + https://aantron.github.io/dream/#val-set_stream"] +(**/**) + val write : response -> string -> unit promise (** Streams out the string. The promise is fulfilled when the response can accept more writes. *) @@ -733,7 +790,7 @@ val server_stream : 'a message -> stream val client_stream : 'a message -> stream (* TODO Document that this is for middlewares that are transforming a response stream or a WebSocket. *) -val with_client_stream : stream -> 'a message -> 'a message +val set_client_stream : 'a message -> stream -> unit (* TODO Normalize with with_stream, or add a separate with_server_stream. *) (* TODO Probably even close can be made optional. exn can be made optional. *) @@ -1249,7 +1306,7 @@ val not_found : handler (** Always responds with [404 Not Found]. *) (* :((( *) -val param : string -> request -> string +val param : request -> string -> string (** Retrieves the path parameter. If it is missing, {!Dream.param} raises an exception — the program is buggy. *) @@ -1453,7 +1510,7 @@ val flash_messages : middleware val flash : request -> (string * string) list (** The request's flash messages. *) -val put_flash : string -> string -> request -> unit +val put_flash : request -> string -> string -> unit (** Adds a flash message to the request. *) @@ -2216,7 +2273,7 @@ val application_json : string (** {1 Cryptography} *) -val with_secret : ?old_secrets:string list -> string -> middleware +val set_secret : ?old_secrets:string list -> string -> middleware (** Sets a key to be used for cryptographic operations, such as signing CSRF tokens and encrypting cookies. @@ -2300,12 +2357,19 @@ val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local unset in each message. The optional [~name] and [~show_value] are used by {!Dream.run} [~debug] to show the variable in debug dumps. *) -val local : 'a local -> 'b message -> 'a option +val local : 'b message -> 'a local -> 'a option (** Retrieves the value of the per-message variable. *) -val with_local : 'a local -> 'a -> 'b message -> 'b message +val set_local : 'b message -> 'a local -> 'a -> unit (** Sets the per-message variable to the value. *) +(**/**) +val with_local : 'a local -> 'a -> 'b message -> 'b message +[@@ocaml.deprecated +" Use Dream.set_local instead. See + https://aantron.github.io/dream/#val-set_local"] +(**/**) + (** {1 Testing} *) @@ -2329,17 +2393,21 @@ val test : ?prefix:string -> handler -> (request -> response) the test is not wrapped in a promise. If you don't need these facilities, you can test [handler] by calling it directly with a request. *) +(**/**) val first : 'a message -> 'a message +[@@ocaml.deprecated " Simply returns its own argument."] (** [Dream.first message] evaluates to the original request or response that [message] is immutably derived from. This is useful for getting the original state of requests especially, when they were first created inside the HTTP server ({!Dream.run}). *) val last : 'a message -> 'a message +[@@ocaml.deprecated " Simply returns its own argument."] (** [Dream.last message] evaluates to the latest request or response that was derived from [message]. This is most useful for obtaining the state of requests at the time an exception was raised, without having to instrument the latest version of the request before the exception. *) +(**/**) val sort_headers : (string * string) list -> (string * string) list (** Sorts headers by name. Headers with the same name are not sorted by value or diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index c5b0bf55..2cf3478d 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -274,8 +274,8 @@ let handle_over_websocket make_context schema subscriptions request websocket = let graphql make_context schema = fun request -> match Dream.method_ request with | `GET -> - let upgrade = Dream.header "Upgrade" request - and protocol = Dream.header "Sec-WebSocket-Protocol" request in + let upgrade = Dream.header request "Upgrade" + and protocol = Dream.header request "Sec-WebSocket-Protocol" in begin match upgrade, protocol with | Some "websocket", Some "graphql-transport-ws" -> Dream.websocket @@ -291,7 +291,7 @@ let graphql make_context schema = fun request -> end | `POST -> - begin match Dream.header "Content-Type" request with + begin match Dream.header request "Content-Type" with | Some "application/json" -> let%lwt body = Dream.body request in (* TODO This almost certainly raises exceptions... *) diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 24e81ae9..d4275921 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -85,15 +85,13 @@ let dump (error : Catch.error) = begin match error.request with | None -> () | Some request -> - let last = Dream.last request in - - let major, minor = Dream.version last in + let major, minor = Dream.version request in p "\n\n%s %s HTTP/%i.%i" - (Dream.method_to_string (Dream.method_ last)) - (Dream.target last) + (Dream.method_to_string (Dream.method_ request)) + (Dream.target request) major minor; - Dream.all_headers last + Dream.all_headers request |> List.iter (fun (name, value) -> p "\n%s: %s" name value); Dream.fold_locals (fun name value first -> @@ -192,11 +190,10 @@ let debug_template _error debug_dump response = let status = Dream.status response in let code = Dream.status_to_int status and reason = Dream.status_to_string status in - response - |> Dream.with_header "Content-Type" Dream_pure.Formats.text_html - |> Dream.with_body - (Dream__middleware.Error_template.render ~debug_dump ~code ~reason) - |> Lwt.return + Dream.set_header response "Content-Type" Dream_pure.Formats.text_html; + Dream.set_body response + (Dream__middleware.Error_template.render ~debug_dump ~code ~reason); + Lwt.return response let default = customize default_template diff --git a/src/http/http.ml b/src/http/http.ml index d87d2c11..bcc9770a 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -408,8 +408,7 @@ let wrap_handler let user's_websocket_handler websocket = Lwt.with_value Dream__middleware.Log.lwt_key - (Dream__middleware.Log.get_request_id - ~request:(Dream.last request) ()) + (Dream__middleware.Log.get_request_id ~request ()) (fun () -> user's_websocket_handler websocket) in diff --git a/src/middleware/content_length.ml b/src/middleware/content_length.ml index 20c8b87a..9b0571e7 100644 --- a/src/middleware/content_length.ml +++ b/src/middleware/content_length.ml @@ -19,9 +19,6 @@ let content_length next_handler request = next_handler request else let%lwt (response : Dream.response) = next_handler request in - if Dream.has_header "Transfer-Encoding" response then - Lwt.return response - else - response - |> Dream.add_header "Transfer-Encoding" "chunked" - |> Lwt.return + if not (Dream.has_header response "Transfer-Encoding") then + Dream.add_header response "Transfer-Encoding" "chunked"; + Lwt.return response diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index 23248d3b..32202efa 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -24,8 +24,7 @@ module Cipher = Dream__cipher.Cipher (* TODO DOC We allow multiple headers sent by the client, to support HTTP/2. What is this about? *) let all_cookies request = - request - |> Dream.headers "Cookie" + Dream.headers request "Cookie" |> List.map Formats.from_cookie |> List.flatten @@ -45,8 +44,8 @@ let cookie ?domain ?path ?secure - name - request = + request + name = let path = match path with @@ -86,10 +85,10 @@ let set_cookie ?secure ?(http_only = true) ?same_site + response name value - request - response = + request = (* TODO Need the site prefix, not the subsite prefix! *) let path = @@ -133,7 +132,7 @@ let set_cookie ?expires ?max_age ?domain ?path ~secure ~http_only ?same_site name value in - Dream.add_header "Set-Cookie" set_cookie response + Dream.add_header response "Set-Cookie" set_cookie let drop_cookie ?prefix ?domain ?path ?secure ?http_only ?same_site name request response = diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 101de0e8..4cadf421 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -43,7 +43,7 @@ let flash request = | _ -> failwith "Bad flash message content" in let x = - Cookie.cookie flash_cookie request + Cookie.cookie request flash_cookie |>? fun value -> match Yojson.Basic.from_string value with | `List y -> Some (group @@ List.map unpack y) @@ -51,9 +51,9 @@ let flash request = in Option.value x ~default:[] -let put_flash category message request = +let put_flash request category message = let outbox = - match Dream.local storage request with + match Dream.local request storage with | Some outbox -> outbox | None -> let message = "Missing flash message middleware" in @@ -75,15 +75,15 @@ let flash_messages inner_handler request = else log ~request "%s" "No flash messages."); let outbox = ref [] in - let request = Dream.with_local storage outbox request in - let existing = Cookie.cookie flash_cookie request in + Dream.set_local request storage outbox; + let existing = Cookie.cookie request flash_cookie in let%lwt response = inner_handler request in let entries = List.rev !outbox in - let response = + let () = match existing, entries with - | None, [] -> response + | None, [] -> () | Some _, [] -> - Cookie.set_cookie flash_cookie "" request response ~expires:0. + Cookie.set_cookie response flash_cookie "" request ~expires:0. | _, _ -> let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] @@ -98,6 +98,7 @@ let flash_messages inner_handler request = else () in - Cookie.set_cookie flash_cookie value request response ~max_age:five_minutes + Cookie.set_cookie + response flash_cookie value request ~max_age:five_minutes in Lwt.return response diff --git a/src/middleware/form.ml b/src/middleware/form.ml index 804fb7fc..6a054670 100644 --- a/src/middleware/form.ml +++ b/src/middleware/form.ml @@ -55,7 +55,7 @@ let sort_and_check_form ~now to_value form request = Lwt.return (`Many_tokens form) let form ?(csrf = true) ~now request = - match Dream.header "Content-Type" request with + match Dream.header request "Content-Type" with | Some "application/x-www-form-urlencoded" -> let%lwt body = Dream.body request in let form = Dream_pure.Formats.from_form_urlencoded body in diff --git a/src/middleware/log.ml b/src/middleware/log.ml index 2d43b181..c17bcd3c 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -84,7 +84,7 @@ let get_request_id ?request () = let request_id = match request with | None -> None - | Some request -> Dream.local id request + | Some request -> Dream.local request id in match request_id with | Some _ -> request_id @@ -467,18 +467,19 @@ struct end; (* Get the requwst's id or assign a new one. *) - let request, id = - match Dream.local id request with - | Some id -> request, id + let id = + match Dream.local request id with + | Some id -> id | None -> last_id := !last_id + 1; let new_id = string_of_int !last_id in - Dream.with_local id new_id request, new_id + Dream.set_local request id new_id; + new_id in (* Identify the request in the log. *) let user_agent = - Dream.headers "User-Agent" request + Dream.headers request "User-Agent" |> String.concat " " in @@ -499,7 +500,7 @@ struct target. *) let location = if Dream.is_redirection (Dream.status response) then - match Dream.header "Location" response with + match Dream.header response "Location" with | Some location -> " " ^ location | None -> "" else "" diff --git a/src/middleware/lowercase_headers.ml b/src/middleware/lowercase_headers.ml index 1a4cea4c..bfcaa1e7 100644 --- a/src/middleware/lowercase_headers.ml +++ b/src/middleware/lowercase_headers.ml @@ -15,12 +15,9 @@ module Dream = Dream_pure (* TODO This can be optimized not to convert a header if it is already lowercase. Another option is to use memoization to reduce GC pressure. *) let lowercase_headers inner_handler request = - if fst (Dream.version request) = 1 then - inner_handler request - else - let%lwt response = inner_handler request in - response - |> Dream.all_headers + let%lwt response = inner_handler request in + if fst (Dream.version request) <> 1 then + Dream.all_headers response |> List.map (fun (name, value) -> String.lowercase_ascii name, value) - |> fun headers -> Dream.with_all_headers headers response - |> Lwt.return + |> Dream.set_all_headers response; + Lwt.return response diff --git a/src/middleware/origin_referrer_check.ml b/src/middleware/origin_referrer_check.ml index b265877a..8a8f2bc1 100644 --- a/src/middleware/origin_referrer_check.ml +++ b/src/middleware/origin_referrer_check.ml @@ -21,8 +21,8 @@ let origin_referrer_check inner_handler request = | _ -> let origin = - match Dream.header "Origin" request with - | Some "null" | None -> Dream.header "Referer" request + match Dream.header request "Origin" with + | Some "null" | None -> Dream.header request "Referer" | Some _ as origin -> origin in @@ -39,7 +39,7 @@ let origin_referrer_check inner_handler request = (* TODO Also recommend Uri to users. *) | Some origin -> - match Dream.header "Host" request with + match Dream.header request "Host" with | None -> log.warning (fun log -> log ~request "Host header missing"); (* TODO Simplify. *) diff --git a/src/middleware/router.ml b/src/middleware/router.ml index f80a17ca..1d49fb91 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -173,14 +173,14 @@ let path_variable : string list Dream.local = string. *) (* TODO Remove this from the API. *) let path the_request = - match Dream.local path_variable the_request with + match Dream.local the_request path_variable with | Some path -> path | None -> Dream.(Formats.(the_request |> target |> split_target |> fst |> from_path)) (* TODO Move site_prefix into this file and remove with_path from the API. *) -let with_path path request = - Dream.with_local path_variable path request +let set_path request path = + Dream.set_local request path_variable path (* Prefix is stored backwards. *) let prefix_variable : string list Dream.local = @@ -190,15 +190,15 @@ let prefix_variable : string list Dream.local = () let internal_prefix request = - match Dream.local prefix_variable request with + match Dream.local request prefix_variable with | Some prefix -> prefix | None -> [] let prefix request = Dream.Formats.make_path (List.rev (internal_prefix request)) -let with_prefix prefix request = - Dream.with_local prefix_variable prefix request +let set_prefix request prefix = + Dream.set_local request prefix_variable prefix let params_variable : (string * string) list Dream.local = Dream.new_local @@ -214,17 +214,17 @@ let params_variable : (string * string) list Dream.local = let log = Log.sub_log "dream.router" -let missing_param name request = +let missing_param request name = let message = Printf.sprintf "Dream.param: missing path parameter %S" name in log.error (fun log -> log ~request "%s" message); failwith message -let param name request = - match Dream.local params_variable request with - | None -> missing_param name request +let param request name = + match Dream.local request params_variable with + | None -> missing_param request name | Some params -> try List.assoc name params - with _ -> missing_param name request + with _ -> missing_param request name let router routes = let routes = List.flatten routes in @@ -259,12 +259,12 @@ let router routes = match node with | Handler (method_, handler) when method_matches method_ (Dream.method_ request) -> - let request = Dream.with_local params_variable bindings request in - if is_wildcard then - request - |> with_prefix prefix - |> with_path path - |> ok handler + Dream.set_local request params_variable bindings; + if is_wildcard then begin + set_prefix request prefix; + set_path request path; + ok handler request + end else if path = [] then ok handler request @@ -277,7 +277,7 @@ let router routes = in let params = - match Dream.local params_variable request with + match Dream.local request params_variable with | Some params -> params | None -> [] in diff --git a/src/middleware/router.mli b/src/middleware/router.mli index 7486979f..76e1305d 100644 --- a/src/middleware/router.mli +++ b/src/middleware/router.mli @@ -29,13 +29,13 @@ val scope : string -> Dream.middleware list -> route list -> route parameters, the middleware is the setter, and the retriever is, of course, the getter. *) val router : route list -> Dream.middleware -val param : string -> Dream.request -> string +val param : Dream.request -> string -> string (* Variables used by the router. *) val path : Dream.request -> string list val prefix : Dream.request -> string -val with_path : string list -> Dream.request -> Dream.request -val with_prefix : string list -> Dream.request -> Dream.request +val set_path : Dream.request -> string list -> unit +val set_prefix : Dream.request -> string list -> unit (**/**) diff --git a/src/middleware/server.ml b/src/middleware/server.ml index 81ac76f1..004253a4 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -18,12 +18,12 @@ let client_variable = (* TODO What should be reported when the client address is missing? This is a sign of local testing. *) let client request = - match Dream.local client_variable request with + match Dream.local request client_variable with | None -> "127.0.0.1:0" | Some client -> client -let with_client client request = - Dream.with_local client_variable client request +let set_client request client = + Dream.set_local request client_variable client @@ -34,23 +34,24 @@ let https_variable = () let https request = - match Dream.local https_variable request with + match Dream.local request https_variable with | Some true -> true | _ -> false -let with_https https request = - Dream.with_local https_variable https request +let set_https request https = + Dream.set_local request https_variable https -(* TODO Eventually remove Dream.request_from_http as all of its functionality - is moved here. *) let request ~client ~method_ ~target ~https ~version ~headers server_stream = (* TODO Use pre-allocated streams. *) let client_stream = Dream.Stream.(stream no_reader no_writer) in - Dream.request ~method_ ~target ~version ~headers client_stream server_stream - |> with_client client - |> with_https https + let request = + Dream.request + ~method_ ~target ~version ~headers client_stream server_stream in + set_client request client; + set_https request https; + request @@ -58,14 +59,16 @@ let html ?status ?code ?headers body = (* TODO The streams. *) let client_stream = Dream.Stream.(stream (string body) no_writer) and server_stream = Dream.Stream.(stream no_reader no_writer) in - Dream.response ?status ?code ?headers client_stream server_stream - |> Dream.with_header "Content-Type" Dream.Formats.text_html - |> Lwt.return + let response = + Dream.response ?status ?code ?headers client_stream server_stream in + Dream.set_header response "Content-Type" Dream.Formats.text_html; + Lwt.return response let json ?status ?code ?headers body = (* TODO The streams. *) let client_stream = Dream.Stream.(stream (string body) no_writer) and server_stream = Dream.Stream.(stream no_reader no_writer) in - Dream.response ?status ?code ?headers client_stream server_stream - |> Dream.with_header "Content-Type" Dream.Formats.application_json - |> Lwt.return + let response = + Dream.response ?status ?code ?headers client_stream server_stream in + Dream.set_header response "Content-Type" Dream.Formats.application_json; + Lwt.return response diff --git a/src/middleware/session.ml b/src/middleware/session.ml index 4e984b31..672e8b3a 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -20,19 +20,13 @@ type 'a back_end = { } let middleware local back_end = fun inner_handler request -> - - let%lwt session = - back_end.load request in - let request = - Dream.with_local local session request in - - let%lwt response = - inner_handler request in - + let%lwt session = back_end.load request in + Dream.set_local request local session; + let%lwt response = inner_handler request in back_end.send session request response let getter local request = - match Dream.local local request with + match Dream.local request local with | Some session -> session | None -> @@ -153,7 +147,7 @@ struct let now = gettimeofday () in let valid_session = - Cookie.cookie ~decrypt:false session_cookie request + Cookie.cookie ~decrypt:false request session_cookie |>? read_session_id |>? Hashtbl.find_opt hash_table |>? fun session -> @@ -182,14 +176,14 @@ struct Lwt.return (operations ~now:gettimeofday hash_table lifetime session dirty, session) let send ~now (operations, session) request response = - if not operations.dirty then - Lwt.return response - else + if operations.dirty then + if not operations.dirty then begin let id = version_session_id !session.id in let max_age = !session.expires_at -. now () in - Lwt.return - (Cookie.set_cookie - session_cookie id request response ~encrypt:false ~max_age) + Cookie.set_cookie + response session_cookie id request ~encrypt:false ~max_age + end; + Lwt.return response let back_end ~now lifetime = let hash_table = Hashtbl.create 256 in @@ -240,7 +234,7 @@ struct let now = gettimeofday () in let valid_session = - Cookie.cookie session_cookie request + Cookie.cookie request session_cookie |>? read_value |>? fun value -> (* TODO Is there a non-raising version of this? *) @@ -294,9 +288,7 @@ struct Lwt.return (operations ~now:gettimeofday lifetime session dirty, session) let send ~now (operations, session) request response = - if not operations.dirty then - Lwt.return response - else + if operations.dirty then begin let max_age = !session.expires_at -. now () in let value = `Assoc [ @@ -309,8 +301,9 @@ struct |> Yojson.Basic.to_string |> version_value in - Lwt.return - (Cookie.set_cookie session_cookie value request response ~max_age) + Cookie.set_cookie response session_cookie value request ~max_age + end; + Lwt.return response let back_end ~now lifetime = { load = load ~now lifetime; diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index 469f0cd3..d3faf4d0 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -41,8 +41,6 @@ let with_site_prefix prefix = | Some path -> (* TODO This doesn't need to be recomputed on each request - can cache the result in the app. *) - let prefix_reversed = List.rev prefix in - request - |> Router.with_prefix prefix_reversed - |> Router.with_path path - |> next_handler + Router.set_prefix request (List.rev prefix); + Router.set_path request path; + next_handler request diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index c9427dac..1ee75250 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -96,7 +96,7 @@ and upload (request : Dream.request) = state request | true -> - let content_type = match Dream.header "content-type" request with + let content_type = match Dream.header request "Content-Type" with | Some content_type -> Result.to_option (Multipart_form.Content_type.of_string (content_type ^ "\r\n")) @@ -125,7 +125,7 @@ type multipart_form = module Map = Map.Make (String) let multipart ?(csrf=true) ~now request = - let content_type = match Dream.header "content-type" request with + let content_type = match Dream.header request "Content-Type" with | Some content_type -> Result.to_option (Multipart_form.Content_type.of_string (content_type ^ "\r\n")) | None -> None in diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 90ebd85d..7c888bb6 100644 --- a/src/pure/dream_pure.mli +++ b/src/pure/dream_pure.mli @@ -144,8 +144,8 @@ val request : val method_ : request -> method_ val target : request -> string val version : request -> int * int -val with_method_ : [< method_ ] -> request -> request -val with_version : int * int -> request -> request +val set_method_ : request -> [< method_ ] -> unit +val set_version : request -> int * int -> unit @@ -161,21 +161,22 @@ val status : response -> status -val header : string -> 'a message -> string option -val headers : string -> 'a message -> string list +val header : 'a message -> string -> string option +val headers : 'a message -> string -> string list val all_headers : 'a message -> (string * string) list -val has_header : string -> 'a message -> bool -val add_header : string -> string -> 'a message -> 'a message -val drop_header : string -> 'a message -> 'a message -val with_header : string -> string -> 'a message -> 'a message -val with_all_headers : (string * string) list -> 'a message -> 'a message +val has_header : 'a message -> string -> bool +val add_header : 'a message -> string -> string -> unit +val drop_header : 'a message -> string -> unit +val set_header : 'a message -> string -> string -> unit +val set_all_headers : 'a message -> (string * string) list -> unit val body : 'a message -> string promise -val with_body : string -> response -> response +val set_body : response -> string -> unit val read : request -> string option promise -val with_stream : 'a message -> 'a message +val set_stream : 'a message -> unit +(* TODO Rename set_stream, it makes kind of no sense now. *) val write : response -> string -> unit promise val flush : response -> unit promise val close_stream : response -> unit promise @@ -183,7 +184,7 @@ val close_stream : response -> unit promise passed a request or a response. *) val client_stream : 'a message -> stream val server_stream : 'a message -> stream -val with_client_stream : stream -> 'a message -> 'a message +val set_client_stream : 'a message -> stream -> unit val next : stream -> data:(buffer -> int -> int -> bool -> bool -> unit) -> @@ -354,13 +355,10 @@ end type 'a local val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local -val local : 'a local -> 'b message -> 'a option -val with_local : 'a local -> 'a -> 'b message -> 'b message +val local : 'b message -> 'a local -> 'a option +val set_local : 'b message -> 'a local -> 'a -> unit val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a -(* TODO Delete once requests are mutable. *) -val first : 'a message -> 'a message -val last : 'a message -> 'a message val sort_headers : (string * string) list -> (string * string) list diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index cb3968d7..d436fcd4 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -15,6 +15,9 @@ struct type 'a t = string option * ('a -> string) option end module Scope = Hmap.Make (Scope_variable_metadata) +(* TODO Rename Scope, because there is now only one scope. *) +(* TODO Given there are now only locals, maybe it's worth renaming them to + something else - there is now only one concept of variables. *) type websocket = Stream.stream @@ -23,19 +26,22 @@ and response = server message and 'a message = { specific : 'a; - headers : (string * string) list; - client_stream : Stream.stream; - server_stream : Stream.stream; - locals : Scope.t; - first : 'a message; - last : 'a message ref; + mutable headers : (string * string) list; + mutable client_stream : Stream.stream; + mutable server_stream : Stream.stream; + mutable locals : Scope.t; } and client = { - method_ : method_; + mutable method_ : method_; target : string; - request_version : int * int; + mutable request_version : int * int; } +(* TODO Get rid of the version field completely? At least don't expose it in + Dream. It is only used internally on the server side to add the right + Content-Length, etc., headers. But even that can be moved out of the + middleware and into transport so that the version field is not necessary for + some middleware to decide which headers to add. *) and server = { status : status; @@ -47,16 +53,6 @@ type 'a promise = 'a Lwt.t type handler = request -> response Lwt.t type middleware = handler -> handler -let first message = - message.first - -let last message = - !(message.last) - -let update message = - message.last := message; - message - let method_ request = request.specific.method_ @@ -66,13 +62,11 @@ let target request = let version request = request.specific.request_version -let with_method_ method_ request = - update {request with - specific = {request.specific with method_ = (method_ :> method_)}} +let set_method_ request method_ = + request.specific.method_ <- (method_ :> method_) -let with_version version request = - update {request with - specific = {request.specific with request_version = version}} +let set_version request version = + request.specific.request_version <- version let status response = response.specific.status @@ -80,10 +74,10 @@ let status response = let all_headers message = message.headers -let with_all_headers headers message = - update {message with headers} +let set_all_headers message headers = + message.headers <- headers -let headers name message = +let headers message name = let name = String.lowercase_ascii name in message.headers @@ -101,37 +95,27 @@ let header_basic name message = |> List.find (fun (name', _) -> String.lowercase_ascii name' = name) |> snd -let header name message = +let header message name = try Some (header_basic name message) with Not_found -> None -let has_header name message = +let has_header message name = try ignore (header_basic name message); true with Not_found -> false -let add_header name value message = - update {message with headers = message.headers @ [(name, value)]} +let add_header message name value = + message.headers <- message.headers @ [(name, value)] (* TODO Can optimize this if the header is not found? *) -let drop_header name message = +let drop_header message name = let name = String.lowercase_ascii name in - update {message with headers = + message.headers <- message.headers - |> List.filter (fun (name', _) -> String.lowercase_ascii name' <> name)} - -let with_header name value message = - message - |> drop_header name - |> add_header name value - -(* TODO Don't use this exception-raising function, to avoid clobbering user - backtraces more. *) -(* let cookie_exn name request = - snd (all_cookies request |> List.find (fun (name', _) -> name' = name)) + |> List.filter (fun (name', _) -> String.lowercase_ascii name' <> name) -let cookie name request = - try Some (cookie_exn name request) - with Not_found -> None *) +let set_header message name value = + drop_header message name; + add_header message name value (* TODO NOTE On the client, this will read the client stream until close. *) let body message = @@ -146,8 +130,8 @@ let client_stream message = let server_stream message = message.server_stream -let with_client_stream client_stream message = - update {message with client_stream} +let set_client_stream message client_stream = + message.client_stream <- client_stream (* TODO Pending the dream.mli interface reorganization for the new stream API. *) @@ -165,7 +149,7 @@ let next = middlewares that preprocess requests on the server and postprocess responses on the client. Or.... shouldn't this affect the client stream on the server, replacing its read end? *) -let with_body body message = +let set_body message body = (* TODO This is partially redundant with a length check in Stream.string, but that check is no longer useful as it prevents allocation of only a reader, rather than a complete stream. *) @@ -176,15 +160,16 @@ let with_body body message = else Stream.(stream (string body) no_writer) in - update {message with server_stream = body} + message.server_stream <- body (* TODO The critical piece: the pipe should be split between the client and server streams. adapt.ml should be reading from the client stream. *) -let with_stream message = +let set_stream message = let reader, writer = Stream.pipe () in let client_stream = Stream.stream reader Stream.no_writer in let server_stream = Stream.stream Stream.no_reader writer in - update {message with client_stream; server_stream} + message.client_stream <- client_stream; + message.server_stream <- server_stream (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It @@ -250,11 +235,13 @@ type 'a local = 'a Scope.key let new_local ?name ?show_value () = Scope.Key.create (name, show_value) -let local key message = +(* TODO Tension between "t-first" and not, because typically, for a getter, the + "index" parameter could be partially applied. *) +let local message key = Scope.find key message.locals -let with_local key value message = - update {message with locals = Scope.add key value message.locals} +let set_local message key value = + message.locals <- Scope.add key value message.locals let fold_locals f initial message = fold_scope f initial message.locals @@ -288,8 +275,6 @@ let request client_stream; server_stream; locals = Scope.empty; - first = request; - last = ref request; } in request @@ -314,8 +299,6 @@ let response server_stream; (* TODO This fully dead stream should be preallocated. *) locals = Scope.empty; - first = response; - last = ref response; } in response diff --git a/src/sql/session.ml b/src/sql/session.ml index 41791ff8..fd868afa 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -143,7 +143,7 @@ let load lifetime request = let now = Unix.gettimeofday () in let%lwt valid_session = - match Cookie.cookie ~decrypt:false Session.session_cookie request with + match Cookie.cookie request ~decrypt:false Session.session_cookie with | None -> Lwt.return_none | Some id -> match Session.read_session_id id with @@ -180,19 +180,18 @@ let load lifetime request = end let send (operations, session) request response = - if not operations.Session.dirty then - Lwt.return response - else + if operations.Session.dirty then begin let id = Session.version_session_id !session.Session.id in let max_age = !session.Session.expires_at -. Unix.gettimeofday () in - Lwt.return - (Cookie.set_cookie - Session.session_cookie - id - request - response - ~encrypt:false - ~max_age) + Cookie.set_cookie + response + Session.session_cookie + id + request + ~encrypt:false + ~max_age + end; + Lwt.return response let back_end lifetime = { Session.load = load lifetime; diff --git a/src/sql/sql.ml b/src/sql/sql.ml index c1ec2d80..84435836 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -29,7 +29,9 @@ let sql_pool ?size uri = fun inner_handler request -> begin match !pool_cell with - | Some pool -> inner_handler (Dream.with_local pool_variable pool request) + | Some pool -> + Dream.set_local request pool_variable pool; + inner_handler request | None -> (* The correctness of this code is subtle. There is no race condition with two requests attempting to create a pool only because none of the code @@ -44,7 +46,8 @@ let sql_pool ?size uri = match pool with | Ok pool -> pool_cell := Some pool; - inner_handler (Dream.with_local pool_variable pool request) + Dream.set_local request pool_variable pool; + inner_handler request | Error error -> (* Deliberately raise an exception so that it can be communicated to any debug handler. *) @@ -56,7 +59,7 @@ let sql_pool ?size uri = end let sql request callback = - match Dream.local pool_variable request with + match Dream.local request pool_variable with | None -> let message = "Dream.sql: no pool; did you apply Dream.sql_pool?" in log.error (fun log -> log ~request "%s" message); diff --git a/src/unix/static.ml b/src/unix/static.ml index 3ce56849..42547362 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -92,22 +92,16 @@ let static ?(loader = from_filesystem) local_root = fun request -> |> Lwt.return | Some path -> - let%lwt response = loader local_root path request in - - let response = - if Dream.has_header "Content-Type" response then - response - else - match Dream.status response with - | `OK - | `Non_Authoritative_Information - | `No_Content - | `Reset_Content - | `Partial_Content -> - Dream.add_header "Content-Type" (Magic_mime.lookup path) response - | _ -> - response - in - + if not (Dream.has_header response "Content-Type") then begin + match Dream.status response with + | `OK + | `Non_Authoritative_Information + | `No_Content + | `Reset_Content + | `Partial_Content -> + Dream.add_header response "Content-Type" (Magic_mime.lookup path) + | _ -> + () + end; Lwt.return response From 7aa5e7ba1cf3661e6e5d3824490ec8dfb778e559 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Dec 2021 21:33:11 +0300 Subject: [PATCH 089/312] dream-pure no longer depends on multipart_form The server and client will depend on multipart_form independently. --- dream-pure.opam | 1 - 1 file changed, 1 deletion(-) diff --git a/dream-pure.opam b/dream-pure.opam index 13382927..11300971 100644 --- a/dream-pure.opam +++ b/dream-pure.opam @@ -17,7 +17,6 @@ depends: [ "dune" {>= "2.7.0"} # --instrument-with. "hmap" "lwt" - "multipart_form" {>= "0.3.0"} "ocaml" {>= "4.08.0"} "ptime" {>= "0.8.1"} # Ptime.weekday. "uri" {>= "4.2.0"} From 110575db83e5714ef19bab716ea0eafa49b3f5ef Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Dec 2021 22:05:42 +0300 Subject: [PATCH 090/312] Factor out dream-httpaf --- Makefile | 4 +-- dream-httpaf.opam | 44 +++++++++++++++++++++++++++ dream.opam | 20 +------------ src/http/dune | 14 ++++----- src/vendor/dune | 76 +++++++++++++++++++++++++---------------------- 5 files changed, 94 insertions(+), 64 deletions(-) create mode 100644 dream-httpaf.opam diff --git a/Makefile b/Makefile index 6fe09425..fe0f7ad4 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,10 @@ .PHONY : build build : - @dune build -p dream-pure,dream --no-print-directory @install + @dune build -p dream-pure,dream-httpaf,dream --no-print-directory @install .PHONY : watch watch : - @dune build -p dream-pure,dream --no-print-directory -w + @dune build -p dream-pure,dream-httpaf,dream --no-print-directory -w TEST ?= test diff --git a/dream-httpaf.opam b/dream-httpaf.opam new file mode 100644 index 00000000..c3ebf5a9 --- /dev/null +++ b/dream-httpaf.opam @@ -0,0 +1,44 @@ +opam-version: "2.0" + +synopsis: "Internal: shared http/af stack for Dream (server) and Hyper (client)" + +license: "MIT" +homepage: "https://github.com/aantron/dream" +doc: "https://aantron.github.io/dream" +bug-reports: "https://github.com/aantron/dream/issues" +dev-repo: "git+https://github.com/aantron/dream.git" + +author: "Anton Bachin " +maintainer: "Anton Bachin " + +depends: [ + "dune" {>= "2.7.0"} # --instrument-with. + "lwt" + "lwt_ssl" + "ocaml" {>= "4.08.0"} + "ssl" {>= "0.5.8"} # Ssl.get_negotiated_alpn_protocol. + + # Currently vendored. + # "gluten" + # "gluten-lwt-unix" + # "httpaf" + # "httpaf-lwt-unix" + # "h2" + # "h2-lwt-unix" + # "hpack" + # "websocketaf" + + # Dependencies of vendored packages. + "angstrom" {>= "0.14.0"} + "base64" {>= "3.0.0"} + "bigstringaf" {>= "0.5.0"} # h2. + "digestif" {>= "0.7.2"} # websocket/af, sha1, default implementation. + "faraday" {>= "0.6.1"} + "faraday-lwt-unix" + "psq" # h2. + "result" # http/af, websocket/af. +] + +build: [ + ["dune" "build" "-p" name "-j" jobs] +] diff --git a/dream.opam b/dream.opam index 7d0bf5e9..f1d3f0f5 100644 --- a/dream.opam +++ b/dream.opam @@ -54,6 +54,7 @@ depends: [ "conf-libev" {os != "win32"} "cstruct" {>= "6.0.0"} "dream-pure" + "dream-httpaf" "dune" {>= "2.7.0"} # --instrument-with. "fmt" {>= "0.8.7"} # `Italic. "graphql_parser" @@ -73,25 +74,6 @@ depends: [ "uri" {>= "4.2.0"} "yojson" # ... - # Currently vendored. - # "gluten" - # "gluten-lwt-unix" - # "httpaf" - # "httpaf-lwt-unix" - # "h2" - # "h2-lwt-unix" - # "hpack" - # "websocketaf" - - # Dependencies of vendored packages. - "angstrom" {>= "0.14.0"} - "bigstringaf" {>= "0.5.0"} # h2. - "digestif" {>= "0.7.2"} # websocket/af, sha1, default implementation. - "faraday" {>= "0.6.1"} - "faraday-lwt-unix" - "psq" # h2. - "result" # http/af, websocket/af. - # Testing, development. "bisect_ppx" {with-test & >= "2.5.0"} # --instrument-with. "caqti-driver-postgresql" {with-test} diff --git a/src/http/dune b/src/http/dune index f0ee185b..78693aca 100644 --- a/src/http/dune +++ b/src/http/dune @@ -9,17 +9,17 @@ dream.localhost dream.middleware dream-pure - dream.gluten - dream.gluten-lwt-unix - dream.h2 - dream.h2-lwt-unix - dream.httpaf - dream.httpaf-lwt-unix + dream-httpaf.gluten + dream-httpaf.gluten-lwt-unix + dream-httpaf.h2 + dream-httpaf.h2-lwt-unix + dream-httpaf.httpaf + dream-httpaf.httpaf-lwt-unix lwt lwt.unix lwt_ssl ssl - dream.websocketaf + dream-httpaf.websocketaf ) (preprocess (pps lwt_ppx)) (instrumentation (backend bisect_ppx))) diff --git a/src/vendor/dune b/src/vendor/dune index 9bd5fba3..ac440a8b 100644 --- a/src/vendor/dune +++ b/src/vendor/dune @@ -1,5 +1,7 @@ (data_only_dirs *) + + (subdir paf/lib (library (name paf) @@ -12,7 +14,7 @@ (name alpn) (public_name dream-mirage.paf.alpn) (modules alpn) - (libraries dream-mirage.paf dream.httpaf dream.h2))) + (libraries dream-mirage.paf dream-httpaf.httpaf dream-httpaf.h2))) (subdir paf/lib (library @@ -27,13 +29,15 @@ (wrapped false) (public_name dream-mirage.paf.le) (modules lE) - (libraries dream.httpaf dream-mirage.paf mirage-time mirage-stack duration tls-mirage emile + (libraries dream-httpaf.httpaf dream-mirage.paf mirage-time mirage-stack duration tls-mirage emile letsencrypt))) + + (subdir gluten/lib (library (name gluten) - (public_name dream.gluten) + (public_name dream-httpaf.gluten) (libraries bigstringaf faraday))) @@ -41,18 +45,18 @@ (subdir gluten/lwt (library (name gluten_lwt) - (public_name dream.gluten-lwt) + (public_name dream-httpaf.gluten-lwt) (libraries - dream.gluten + dream-httpaf.gluten lwt))) (subdir gluten/lwt-unix (library (name gluten_lwt_unix) - (public_name dream.gluten-lwt-unix) + (public_name dream-httpaf.gluten-lwt-unix) (libraries faraday-lwt-unix - dream.gluten-lwt + dream-httpaf.gluten-lwt lwt.unix (select ssl_io.ml @@ -71,43 +75,43 @@ (subdir websocketaf/lib (library (name websocketaf) - (public_name dream.websocketaf) + (public_name dream-httpaf.websocketaf) (libraries angstrom base64 bigstringaf faraday - dream.gluten + dream-httpaf.gluten httpaf result))) (subdir websocketaf/lwt (library (name websocketaf_lwt) - (public_name dream.websocketaf-lwt) + (public_name dream-httpaf.websocketaf-lwt) (libraries base64 digestif.ocaml - dream.gluten-lwt + dream-httpaf.gluten-lwt lwt - dream.websocketaf))) + dream-httpaf.websocketaf))) (subdir websocketaf/lwt-unix (library (name websocketaf_lwt_unix) - (public_name dream.websocketaf-lwt-unix) + (public_name dream-httpaf.websocketaf-lwt-unix) (libraries faraday-lwt-unix - dream.gluten-lwt-unix + dream-httpaf.gluten-lwt-unix lwt.unix - dream.websocketaf-lwt))) + dream-httpaf.websocketaf-lwt))) (subdir httpaf/lib (library (name httpaf) - (public_name dream.httpaf) + (public_name dream-httpaf.httpaf) (libraries angstrom bigstringaf @@ -117,22 +121,22 @@ (subdir httpaf/lwt (library (name httpaf_lwt) - (public_name dream.httpaf-lwt) + (public_name dream-httpaf.httpaf-lwt) (libraries - dream.gluten - dream.gluten-lwt - dream.httpaf + dream-httpaf.gluten + dream-httpaf.gluten-lwt + dream-httpaf.httpaf lwt))) (subdir httpaf/lwt-unix (library (name httpaf_lwt_unix) - (public_name dream.httpaf-lwt-unix) + (public_name dream-httpaf.httpaf-lwt-unix) (libraries faraday-lwt-unix - dream.gluten-lwt-unix - dream.httpaf - dream.httpaf-lwt + dream-httpaf.gluten-lwt-unix + dream-httpaf.httpaf + dream-httpaf.httpaf-lwt lwt.unix))) @@ -146,7 +150,7 @@ (subdir h2/hpack/src (library (name hpack) - (public_name dream.hpack) + (public_name dream-httpaf.hpack) (libraries angstrom faraday)) @@ -161,34 +165,34 @@ (subdir h2/lib (library (name h2) - (public_name dream.h2) + (public_name dream-httpaf.h2) (libraries angstrom base64 bigstringaf faraday - dream.hpack - dream.httpaf + dream-httpaf.hpack + dream-httpaf.httpaf psq result))) (subdir h2/lwt (library (name h2_lwt) - (public_name dream.h2-lwt) + (public_name dream-httpaf.h2-lwt) (libraries - dream.gluten - dream.gluten-lwt + dream-httpaf.gluten + dream-httpaf.gluten-lwt lwt - dream.h2))) + dream-httpaf.h2))) (subdir h2/lwt-unix (library (name h2_lwt_unix) - (public_name dream.h2-lwt-unix) + (public_name dream-httpaf.h2-lwt-unix) (libraries faraday-lwt-unix - dream.gluten-lwt-unix - dream.h2 - dream.h2-lwt + dream-httpaf.gluten-lwt-unix + dream-httpaf.h2 + dream-httpaf.h2-lwt lwt.unix))) From 73c56ce1c4406e939a5fc5d2ef2f10d7675241c4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Dec 2021 22:10:08 +0300 Subject: [PATCH 091/312] Fix some warnings --- src/dream.mli | 6 +++--- src/middleware/upload.ml | 2 +- src/pure/inmost.ml | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 4c934e3e..27748882 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -380,10 +380,10 @@ val path : request -> string list (**/**) val version : request -> int * int -(** Protocol version. [(1, 1)] for HTTP/1.1 and [(2, 0)] for HTTP/2. *) [@@ocaml.deprecated " Protocol version access is being removed from the API. Comment at https://github.com/aantron/dream/issues"] +(** Protocol version. [(1, 1)] for HTTP/1.1 and [(2, 0)] for HTTP/2. *) (**/**) val set_client : request -> string -> unit @@ -408,18 +408,18 @@ val with_method_ : [< method_ ] -> request -> request (**/**) val with_path : string list -> request -> request -(** Replaces the path. See {!Dream.val-path}. *) [@@ocaml.deprecated " Router path access is being removed from the API. Comment at https://github.com/aantron/dream/issues"] +(** Replaces the path. See {!Dream.val-path}. *) (**/**) (**/**) val with_version : int * int -> request -> request -(** Replaces the version. See {!Dream.version}. *) [@@ocaml.deprecated " Protocol version access is being removed from the API. Comment at https://github.com/aantron/dream/issues"] +(** Replaces the version. See {!Dream.version}. *) (**/**) (* TODO Convert query string functions to the new t-first style. *) diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index 1ee75250..dfa723d6 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -37,7 +37,7 @@ let multipart_state_variable : multipart_state Dream.local = (* TODO This would be MUCH easier if requests were mutable. It's probably best to just break multipart until then, and have the branch be "unstable." *) -let multipart_state request = +let multipart_state _request = assert false let field_to_string (request : Dream.request) field = diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index d436fcd4..7b0bcadc 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -263,7 +263,7 @@ let request (* This function is used for debugging, so it's fine to allocate a fake body and then immediately replace it. *) - let rec request = { + let request = { specific = { (* TODO Is there a better fake error handler? Maybe this function should come after the response constructors? *) @@ -289,7 +289,7 @@ let response | None, Some code -> int_to_status code in - let rec response = { + let response = { specific = { status; websocket = None; From dd41df9e6502912db91ad60825a7af11c408a514 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Dec 2021 22:46:50 +0300 Subject: [PATCH 092/312] Break up dream-pure.mli --- dream-httpaf.opam | 1 + dream-pure.opam | 1 + src/cipher/cipher.ml | 2 +- src/dream.ml | 7 +- src/graphql/graphql.ml | 18 +- src/http/adapt.ml | 2 +- src/http/error_handler.ml | 33 ++- src/http/error_handler.mli | 2 +- src/http/http.ml | 23 +- src/middleware/catch.ml | 8 +- src/middleware/content_length.ml | 2 +- src/middleware/cookie.ml | 4 +- src/middleware/echo.ml | 5 +- src/middleware/flash.ml | 2 +- src/middleware/form.ml | 2 +- src/middleware/log.ml | 14 +- src/middleware/lowercase_headers.ml | 2 +- src/middleware/origin_referrer_check.ml | 15 +- src/middleware/query.ml | 7 +- src/middleware/router.ml | 8 +- src/middleware/router.mli | 2 +- src/middleware/server.ml | 18 +- src/middleware/session.ml | 2 +- src/middleware/site_prefix.ml | 12 +- src/middleware/tag.eml.ml | 5 +- src/middleware/upload.ml | 2 +- src/pure/dream_pure.ml | 14 - src/pure/dream_pure.mli | 364 ------------------------ src/pure/formats.mli | 36 +++ src/pure/inmost.ml | 9 +- src/pure/inmost.mli | 118 ++++++++ src/pure/stream.mli | 120 ++++++++ src/sql/sql.ml | 2 +- src/unix/static.ml | 22 +- 34 files changed, 402 insertions(+), 482 deletions(-) delete mode 100644 src/pure/dream_pure.ml delete mode 100644 src/pure/dream_pure.mli create mode 100644 src/pure/formats.mli create mode 100644 src/pure/inmost.mli create mode 100644 src/pure/stream.mli diff --git a/dream-httpaf.opam b/dream-httpaf.opam index c3ebf5a9..40c1509d 100644 --- a/dream-httpaf.opam +++ b/dream-httpaf.opam @@ -1,6 +1,7 @@ opam-version: "2.0" synopsis: "Internal: shared http/af stack for Dream (server) and Hyper (client)" +description: "This package does not have a stable API." license: "MIT" homepage: "https://github.com/aantron/dream" diff --git a/dream-pure.opam b/dream-pure.opam index 11300971..19c3b80c 100644 --- a/dream-pure.opam +++ b/dream-pure.opam @@ -1,6 +1,7 @@ opam-version: "2.0" synopsis: "Internal: shared HTTP types for Dream (server) and Hyper (client)" +description: "This package does not have a stable API." license: "MIT" homepage: "https://github.com/aantron/dream" diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 9000d652..4d963bd8 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -13,7 +13,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/dream.ml b/src/dream.ml index 1d42cf57..1cd455c7 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -5,8 +5,11 @@ +include Dream_pure.Status include Dream_pure.Stream -include Dream_pure +include Dream_pure.Method +include Dream_pure.Inmost +include Dream_pure.Formats include Dream__middleware.Log include Dream__middleware.Log.Make (Ptime_clock) @@ -64,8 +67,6 @@ let () = Dream__cipher.Random.initialize Mirage_crypto_rng_lwt.initialize let random = Dream__cipher.Random.random -include Dream_pure.Formats - (* TODO Restore the ability to test with a prefix and re-enable the corresponding tests. *) let test ?(prefix = "") handler request = diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index 2cf3478d..fc776826 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -5,8 +5,10 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Method = Dream_pure.Method module Server = Dream__middleware.Server +module Stream = Dream_pure.Stream @@ -284,8 +286,8 @@ let graphql make_context schema = fun request -> | _ -> log.warning (fun log -> log ~request "Upgrade: websocket header missing"); (* TODO Simplify stream creation. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Not_Found client_stream server_stream |> Lwt.return end @@ -315,17 +317,17 @@ let graphql make_context schema = fun request -> | _ -> log.warning (fun log -> log ~request "Content-Type not 'application/json'"); - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Request client_stream server_stream |> Lwt.return end | method_ -> log.error (fun log -> log ~request - "Method %s; must be GET or POST" (Dream.method_to_string method_)); - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + "Method %s; must be GET or POST" (Method.method_to_string method_)); + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Not_Found client_stream server_stream |> Lwt.return diff --git a/src/http/adapt.ml b/src/http/adapt.ml index fdb1f7a6..3613b379 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost module Stream = Dream_pure.Stream diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index d4275921..1ec3f2f5 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -5,9 +5,12 @@ -module Dream = Dream_pure module Catch = Dream__middleware.Catch +module Dream = Dream_pure.Inmost +module Method = Dream_pure.Method module Server = Dream__middleware.Server +module Status = Dream_pure.Status +module Stream = Dream_pure.Stream @@ -34,7 +37,7 @@ let dump (error : Catch.error) = begin match error.condition with | `Response response -> let status = Dream.status response in - p "%i %s\n" (Dream.status_to_int status) (Dream.status_to_string status) + p "%i %s\n" (Status.status_to_int status) (Status.status_to_string status) | `String "" -> p "(Library error without description payload)\n" @@ -87,7 +90,7 @@ let dump (error : Catch.error) = | Some request -> let major, minor = Dream.version request in p "\n\n%s %s HTTP/%i.%i" - (Dream.method_to_string (Dream.method_ request)) + (Method.method_to_string (Dream.method_ request)) (Dream.target request) major minor; @@ -169,8 +172,8 @@ let customize template (error : Catch.error) = | `Client -> `Bad_Request in (* TODO Simplify the streams creation. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status client_stream server_stream in @@ -188,8 +191,8 @@ let default_template _error _debug_dump response = let debug_template _error debug_dump response = let status = Dream.status response in - let code = Dream.status_to_int status - and reason = Dream.status_to_string status in + let code = Status.status_to_int status + and reason = Status.status_to_string status in Dream.set_header response "Content-Type" Dream_pure.Formats.text_html; Dream.set_body response (Dream__middleware.Error_template.render ~debug_dump ~code ~reason); @@ -235,14 +238,14 @@ let respond_with_option f = | Some response -> response | None -> (* TODO Simplify streams. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Internal_Server_Error client_stream server_stream)) (fun () -> (* TODO Simplify streams. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Internal_Server_Error client_stream server_stream |> Lwt.return) @@ -268,12 +271,12 @@ let app (* TODO Simplify streams. *) let default_response = function | `Server -> - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Internal_Server_Error client_stream server_stream | `Client -> - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Request client_stream server_stream let httpaf diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index 97c7c201..6e1854f9 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost module Catch = Dream__middleware.Catch diff --git a/src/http/http.ml b/src/http/http.ml index bcc9770a..0a88e8b1 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -5,13 +5,12 @@ -module Dream = -struct - include Dream_pure - include Dream__middleware.Catch -end -module Stream = Dream_pure.Stream +module Catch = Dream__middleware.Catch +module Dream = Dream_pure.Inmost +module Method = Dream_pure.Method module Server = Dream__middleware.Server +module Status = Dream_pure.Status +module Stream = Dream_pure.Stream @@ -20,13 +19,13 @@ module Server = Dream__middleware.Server let to_dream_method method_ = - Httpaf.Method.to_string method_ |> Dream.string_to_method + Httpaf.Method.to_string method_ |> Method.string_to_method let to_httpaf_status status = - Dream.status_to_int status |> Httpaf.Status.of_code + Status.status_to_int status |> Httpaf.Status.of_code let to_h2_status status = - Dream.status_to_int status |> H2.Status.of_code + Status.status_to_int status |> H2.Status.of_code let sha1 s = s @@ -299,7 +298,7 @@ let websocket_handler user's_websocket_handler socket = (* TODO Rename conn like in the body branch. *) let wrap_handler https - (user's_error_handler : Dream.error_handler) + (user's_error_handler : Catch.error_handler) (user's_dream_handler : Dream.handler) = let httpaf_request_handler = fun client_address (conn : _ Gluten.Reqd.t) -> @@ -448,7 +447,7 @@ let wrap_handler (* TODO Factor out what is in common between the http/af and h2 handlers. *) let wrap_handler_h2 https - (_user's_error_handler : Dream.error_handler) + (_user's_error_handler : Catch.error_handler) (user's_dream_handler : Dream.handler) = let httpaf_request_handler = fun client_address (conn : H2.Reqd.t) -> @@ -553,7 +552,7 @@ type tls_library = { certificate_file:string -> key_file:string -> handler:Dream.handler -> - error_handler:Dream.error_handler -> + error_handler:Catch.error_handler -> Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t; diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 00eae005..7e29d8bc 100644 --- a/src/middleware/catch.ml +++ b/src/middleware/catch.ml @@ -5,7 +5,8 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Status = Dream_pure.Status @@ -50,9 +51,10 @@ let catch error_handler next_handler request = (fun response -> let status = Dream.status response in - if Dream.is_client_error status || Dream.is_server_error status then begin + (* TODO Overfull hbox. *) + if Status.is_client_error status || Status.is_server_error status then begin let caused_by, severity = - if Dream.is_client_error status then + if Status.is_client_error status then `Client, `Warning else `Server, `Error diff --git a/src/middleware/content_length.ml b/src/middleware/content_length.ml index 9b0571e7..ba7a6338 100644 --- a/src/middleware/content_length.ml +++ b/src/middleware/content_length.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/middleware/cookie.ml b/src/middleware/cookie.ml index 32202efa..dfe24375 100644 --- a/src/middleware/cookie.ml +++ b/src/middleware/cookie.ml @@ -5,9 +5,9 @@ -module Formats = Dream_pure.Formats -module Dream = Dream_pure module Cipher = Dream__cipher.Cipher +module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats diff --git a/src/middleware/echo.ml b/src/middleware/echo.ml index 2bf28d82..2a9fb8b0 100644 --- a/src/middleware/echo.ml +++ b/src/middleware/echo.ml @@ -5,7 +5,8 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Stream = Dream_pure.Stream @@ -14,6 +15,6 @@ let echo request = (* TODO Simplfy this code. Can in fact just pass the request's server stream as the response's client stream. *) let client_stream = Dream.server_stream request in - let server_stream = Dream.Stream.(stream no_reader no_writer) in + let server_stream = Stream.(stream no_reader no_writer) in Dream.response client_stream server_stream |> Lwt.return diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 4cadf421..22d5e78e 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/middleware/form.ml b/src/middleware/form.ml index 6a054670..98871168 100644 --- a/src/middleware/form.ml +++ b/src/middleware/form.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/middleware/log.ml b/src/middleware/log.ml index c17bcd3c..e7290602 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -27,7 +27,9 @@ This is sufficient for attaching a request id to most log messages, in practice. *) -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Method = Dream_pure.Method +module Status = Dream_pure.Status @@ -485,7 +487,7 @@ struct log.info (fun log -> log ~request "%s %s %s %s" - (Dream.method_to_string (Dream.method_ request)) + (Method.method_to_string (Dream.method_ request)) (Dream.target request) (Server.client request) user_agent); @@ -499,7 +501,7 @@ struct (* Log the elapsed time. If the response is a redirection, log the target. *) let location = - if Dream.is_redirection (Dream.status response) then + if Status.is_redirection (Dream.status response) then match Dream.header response "Location" with | Some location -> " " ^ location | None -> "" @@ -514,16 +516,16 @@ struct fun log -> let elapsed = now () -. start in log ~request "%i%s in %.0f μs" - (Dream.status_to_int status) + (Status.status_to_int status) location (elapsed *. 1e6) in begin - if Dream.is_server_error status then + if Status.is_server_error status then log.error report else - if Dream.is_client_error status then + if Status.is_client_error status then log.warning report else log.info report diff --git a/src/middleware/lowercase_headers.ml b/src/middleware/lowercase_headers.ml index bfcaa1e7..590f52bc 100644 --- a/src/middleware/lowercase_headers.ml +++ b/src/middleware/lowercase_headers.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/middleware/origin_referrer_check.ml b/src/middleware/origin_referrer_check.ml index 8a8f2bc1..9cccfe9f 100644 --- a/src/middleware/origin_referrer_check.ml +++ b/src/middleware/origin_referrer_check.ml @@ -5,7 +5,8 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Stream = Dream_pure.Stream @@ -31,8 +32,8 @@ let origin_referrer_check inner_handler request = log.warning (fun log -> log ~request "Origin and Referer headers both missing"); (* TODO Simplify. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Request client_stream server_stream |> Lwt.return @@ -43,8 +44,8 @@ let origin_referrer_check inner_handler request = | None -> log.warning (fun log -> log ~request "Host header missing"); (* TODO Simplify. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Request client_stream server_stream |> Lwt.return @@ -81,8 +82,8 @@ let origin_referrer_check inner_handler request = log.warning (fun log -> log ~request "Origin-Host mismatch: '%s' vs. '%s'" origin host); (* TODO Simplify. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Request client_stream server_stream |> Lwt.return end diff --git a/src/middleware/query.ml b/src/middleware/query.ml index 86e2a299..cba19087 100644 --- a/src/middleware/query.ml +++ b/src/middleware/query.ml @@ -8,7 +8,8 @@ (* TODO Long-term, query string handler is likely to become part of the router. *) -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats @@ -23,9 +24,9 @@ module Dream = Dream_pure let all_queries request = Dream.target request - |> Dream.Formats.split_target + |> Formats.split_target |> snd - |> Dream.Formats.from_form_urlencoded + |> Formats.from_form_urlencoded let query name request = List.assoc_opt name (all_queries request) diff --git a/src/middleware/router.ml b/src/middleware/router.ml index 1d49fb91..e188716f 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -5,7 +5,9 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats +module Method = Dream_pure.Method @@ -97,7 +99,7 @@ type method_set = [ let method_matches method_set method_ = match method_set with - | #Dream.method_ as method' -> Dream.methods_equal method' method_ + | #Method.method_ as method' -> Method.methods_equal method' method_ | `Any -> true type node = @@ -195,7 +197,7 @@ let internal_prefix request = | None -> [] let prefix request = - Dream.Formats.make_path (List.rev (internal_prefix request)) + Formats.make_path (List.rev (internal_prefix request)) let set_prefix request prefix = Dream.set_local request prefix_variable prefix diff --git a/src/middleware/router.mli b/src/middleware/router.mli index 76e1305d..4d71e769 100644 --- a/src/middleware/router.mli +++ b/src/middleware/router.mli @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost type route diff --git a/src/middleware/server.ml b/src/middleware/server.ml index 004253a4..df027256 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -5,7 +5,9 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats +module Stream = Dream_pure.Stream @@ -45,7 +47,7 @@ let set_https request https = let request ~client ~method_ ~target ~https ~version ~headers server_stream = (* TODO Use pre-allocated streams. *) - let client_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream no_reader no_writer) in let request = Dream.request ~method_ ~target ~version ~headers client_stream server_stream in @@ -57,18 +59,18 @@ let request ~client ~method_ ~target ~https ~version ~headers server_stream = let html ?status ?code ?headers body = (* TODO The streams. *) - let client_stream = Dream.Stream.(stream (string body) no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in let response = Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_header response "Content-Type" Dream.Formats.text_html; + Dream.set_header response "Content-Type" Formats.text_html; Lwt.return response let json ?status ?code ?headers body = (* TODO The streams. *) - let client_stream = Dream.Stream.(stream (string body) no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in let response = Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_header response "Content-Type" Dream.Formats.application_json; + Dream.set_header response "Content-Type" Formats.application_json; Lwt.return response diff --git a/src/middleware/session.ml b/src/middleware/session.ml index 672e8b3a..df09c3c2 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -7,7 +7,7 @@ (* https://cheatsheetseries.owasp.org/cheatsheets/Session_Management_Cheat_Sheet.html *) -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/middleware/site_prefix.ml b/src/middleware/site_prefix.ml index d3faf4d0..cb64e463 100644 --- a/src/middleware/site_prefix.ml +++ b/src/middleware/site_prefix.ml @@ -5,7 +5,9 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats +module Stream = Dream_pure.Stream @@ -27,15 +29,15 @@ let rec match_site_prefix prefix path = let with_site_prefix prefix = let prefix = prefix - |> Dream_pure.Formats.from_path - |> Dream_pure.Formats.drop_trailing_slash + |> Formats.from_path + |> Formats.drop_trailing_slash in fun next_handler request -> match match_site_prefix prefix (Router.path request) with | None -> (* TODO Streams. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Bad_Gateway client_stream server_stream |> Lwt.return | Some path -> diff --git a/src/middleware/tag.eml.ml b/src/middleware/tag.eml.ml index 237197fd..afb9589a 100644 --- a/src/middleware/tag.eml.ml +++ b/src/middleware/tag.eml.ml @@ -13,6 +13,7 @@ end (* This slightly awkward simulation of the overall Dream module using a composition of internal modules is necessary to get all the helpers at the right positions expected by the EML templater. *) +module Method = Dream_pure.Method @@ -22,8 +23,8 @@ let form_tag let method_ = match method_ with - | None -> Dream.method_to_string `POST - | Some method_ -> Dream.method_to_string method_ + | None -> Method.method_to_string `POST + | Some method_ -> Method.method_to_string method_ in let target = match target with diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index dfa723d6..15def736 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/pure/dream_pure.ml b/src/pure/dream_pure.ml deleted file mode 100644 index ed3ecab7..00000000 --- a/src/pure/dream_pure.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* This file is part of Dream, released under the MIT license. See LICENSE.md - for details, or visit https://github.com/aantron/dream. - - Copyright 2021 Anton Bachin *) - - - -module Formats = Formats - -module Stream = Stream -type buffer = Stream.buffer -type stream = Stream.stream - -include Inmost diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli deleted file mode 100644 index 7c888bb6..00000000 --- a/src/pure/dream_pure.mli +++ /dev/null @@ -1,364 +0,0 @@ -(* This file is part of Dream, released under the MIT license. See LICENSE.md - for details, or visit https://github.com/aantron/dream. - - Copyright 2021 Anton Bachin *) - - - -type 'a message - -type client -type server - -type request = client message -type response = server message - -type 'a promise = 'a Lwt.t -type handler = request -> response promise -type middleware = handler -> handler - -type buffer = - (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -type stream - - - -type method_ = [ - | `GET - | `POST - | `PUT - | `DELETE - | `HEAD - | `CONNECT - | `OPTIONS - | `TRACE - | `PATCH - | `Method of string -] - -val method_to_string : [< method_ ] -> string -val string_to_method : string -> method_ -val methods_equal : [< method_ ] -> [< method_ ] -> bool -val normalize_method : [< method_ ] -> method_ - - - -type informational = [ - | `Continue - | `Switching_Protocols -] - -type successful = [ - | `OK - | `Created - | `Accepted - | `Non_Authoritative_Information - | `No_Content - | `Reset_Content - | `Partial_Content -] - -type redirection = [ - | `Multiple_Choices - | `Moved_Permanently - | `Found - | `See_Other - | `Not_Modified - | `Temporary_Redirect - | `Permanent_Redirect -] - -type client_error = [ - | `Bad_Request - | `Unauthorized - | `Payment_Required - | `Forbidden - | `Not_Found - | `Method_Not_Allowed - | `Not_Acceptable - | `Proxy_Authentication_Required - | `Request_Timeout - | `Conflict - | `Gone - | `Length_Required - | `Precondition_Failed - | `Payload_Too_Large - | `URI_Too_Long - | `Unsupported_Media_Type - | `Range_Not_Satisfiable - | `Expectation_Failed - | `Misdirected_Request - | `Too_Early - | `Upgrade_Required - | `Precondition_Required - | `Too_Many_Requests - | `Request_Header_Fields_Too_Large - | `Unavailable_For_Legal_Reasons -] - -type server_error = [ - | `Internal_Server_Error - | `Not_Implemented - | `Bad_Gateway - | `Service_Unavailable - | `Gateway_Timeout - | `HTTP_Version_Not_Supported -] - -type standard_status = [ - | informational - | successful - | redirection - | client_error - | server_error -] - -type status = [ - | standard_status - | `Status of int -] - -val status_to_string : [< status ] -> string -val status_to_reason : [< status ] -> string option -val status_to_int : [< status ] -> int -val int_to_status : int -> status -val is_informational : [< status ] -> bool -val is_successful : [< status ] -> bool -val is_redirection : [< status ] -> bool -val is_client_error : [< status ] -> bool -val is_server_error : [< status ] -> bool -val status_codes_equal : [< status ] -> [< status ] -> bool -val normalize_status : [< status ] -> status - - - -val request : - ?method_:[< method_ ] -> - ?target:string -> - ?version:int * int -> - ?headers:(string * string) list -> - stream -> - stream -> - request - -val method_ : request -> method_ -val target : request -> string -val version : request -> int * int -val set_method_ : request -> [< method_ ] -> unit -val set_version : request -> int * int -> unit - - - -val response : - ?status:[< status ] -> - ?code:int -> - ?headers:(string * string) list -> - stream -> - stream -> - response - -val status : response -> status - - - -val header : 'a message -> string -> string option -val headers : 'a message -> string -> string list -val all_headers : 'a message -> (string * string) list -val has_header : 'a message -> string -> bool -val add_header : 'a message -> string -> string -> unit -val drop_header : 'a message -> string -> unit -val set_header : 'a message -> string -> string -> unit -val set_all_headers : 'a message -> (string * string) list -> unit - - - -val body : 'a message -> string promise -val set_body : response -> string -> unit -val read : request -> string option promise -val set_stream : 'a message -> unit -(* TODO Rename set_stream, it makes kind of no sense now. *) -val write : response -> string -> unit promise -val flush : response -> unit promise -val close_stream : response -> unit promise -(* TODO This will need to read different streams depending on whether it is - passed a request or a response. *) -val client_stream : 'a message -> stream -val server_stream : 'a message -> stream -val set_client_stream : 'a message -> stream -> unit -val next : - stream -> - data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> - flush:(unit -> unit) -> - ping:(buffer -> int -> int -> unit) -> - pong:(buffer -> int -> int -> unit) -> - unit -val write_buffer : - ?offset:int -> ?length:int -> response -> buffer -> unit promise - -module Stream : -sig -type reader - -type writer - -type read = - data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> - flush:(unit -> unit) -> - ping:(buffer -> int -> int -> unit) -> - pong:(buffer -> int -> int -> unit) -> - unit -(** A reading function. Awaits the next event on the stream. For each call of a - reading function, one of the callbacks will eventually be called, according - to which event occurs next on the stream. *) - -type write = - close:(int -> unit) -> - (unit -> unit) -> - unit -(** A writing function. Pushes an event into a stream. May take additional - arguments before [~ok]. *) - -val reader : read:read -> close:(int -> unit) -> reader -(** Creates a read-only stream from the given reader. [~close] is called in - response to {!Stream.close}. It doesn't need to call {!Stream.close} again - on the stream. It should be used to free any underlying resources. *) - -val empty : reader -(** A read-only stream whose reading function always calls its [~close] - callback. *) - -val string : string -> reader -(** A read-only stream which calls its [~data] callback once with the contents - of the given string, and then always calls [~close]. *) - -val pipe : unit -> reader * writer -(** A stream which matches each call of the reading function to one call of its - writing functions. For example, calling {!Stream.flush} on a pipe will cause - the reader to call its [~flush] callback. *) - -val writer : - ready:write -> - write:(buffer -> int -> int -> bool -> bool -> write) -> - flush:write -> - ping:(buffer -> int -> int -> write) -> - pong:(buffer -> int -> int -> write) -> - close:(int -> unit) -> - writer - -val no_reader : reader - -val no_writer : writer - -val stream : reader -> writer -> stream -(* TODO Consider tupling the arguments, as that will make it easier to pass the - result of Stream.pipe. *) - -val close : stream -> int -> unit -(** Closes the given stream. Causes a pending reader or writer to call its - [~close] callback. *) - -val read : stream -> read -(** Awaits the next stream event. See {!Stream.type-read}. *) - -val read_convenience : stream -> string option promise -(** A wrapper around {!Stream.read} that converts [~data] with content [s] into - [Some s], and [~close] into [None], and uses them to resolve a promise. - [~flush] is ignored. *) - -val read_until_close : stream -> string promise -(** Reads a stream completely until [~close], and accumulates the data into a - string. *) - -val ready : stream -> write - -val write : stream -> buffer -> int -> int -> bool -> bool -> write -(** A writing function that sends a data buffer on the given stream. No more - writing functions should be called on the stream until this function calls - [~ok]. The [bool] arguments are whether the message is binary and whether - the [FIN] flag should be set. They are ignored by non-WebSocket streams. - - Note: [FIN] is provided as part of the write call, rather than being a - separate stream event (like [flush]), because the WebSocket writer needs to - immediately know when the last chunk of the last frame in a message is - provided, to transmit the [FIN] bit. If [FIN] were to be provided as a - separate event, the WebSocket writer would have to buffer each one chunk, in - case the next stream event was [FIN], in order to be able to decide whether - to set the [FIN] bit or not. This is awkward and inefficient, as it - introduces an unnecessary delay into the writer, as if the next event is not - [FIN], the next data chunk might take an arbitrary amount of time to be - generated by the writing user code. *) - -val flush : stream -> write -(** A writing function that asks for the given stream to be flushed. The meaning - of flushing depends on the implementation of the stream. No more writing - functions should be called on the stream until this function calls [~ok]. *) - -val ping : stream -> buffer -> int -> int -> write -(** A writing function that sends a ping event on the given stream. This is only - meaningful for WebSockets. *) - -val pong : stream -> buffer -> int -> int -> write -(** A writing function that sends a pong event on the given stream. This is only - meaningful for WebSockets. *) -end - - - -val no_middleware : middleware -val pipeline : middleware list -> middleware - - - -type websocket = stream -val websocket : - ?headers:(string * string) list -> - (websocket -> unit promise) -> - response promise -val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise -val receive : websocket -> string option promise -val close_websocket : ?code:int -> websocket -> unit promise -val is_websocket : response -> (websocket -> unit promise) option - - - -module Formats : -sig - val html_escape : string -> string - val to_base64url : string -> string - val from_base64url : string -> string option - val to_percent_encoded : ?international:bool -> string -> string - val from_percent_encoded : string -> string - val to_form_urlencoded : (string * string) list -> string - val from_form_urlencoded : string -> (string * string) list - val from_cookie : string -> (string * string) list - val to_set_cookie : - ?expires:float -> - ?max_age:float -> - ?domain:string -> - ?path:string -> - ?secure:bool -> - ?http_only:bool -> - ?same_site:[ `Strict | `Lax | `None ] -> - string -> string -> string - val split_target : string -> string * string - val from_path : string -> string list - val to_path : ?relative:bool -> ?international:bool -> string list -> string - val drop_trailing_slash : string list -> string list - val make_path : string list -> string - val text_html : string - val application_json : string -end - - - -type 'a local -val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local -val local : 'b message -> 'a local -> 'a option -val set_local : 'b message -> 'a local -> 'a -> unit -val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a - - - -val sort_headers : (string * string) list -> (string * string) list diff --git a/src/pure/formats.mli b/src/pure/formats.mli new file mode 100644 index 00000000..e7f74869 --- /dev/null +++ b/src/pure/formats.mli @@ -0,0 +1,36 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +(* Note: this is not a stable API! *) + + + +val html_escape : string -> string +val to_base64url : string -> string +val from_base64url : string -> string option +val to_percent_encoded : ?international:bool -> string -> string +val from_percent_encoded : string -> string +val to_form_urlencoded : (string * string) list -> string +val from_form_urlencoded : string -> (string * string) list +val from_cookie : string -> (string * string) list +val split_target : string -> string * string +val from_path : string -> string list +val to_path : ?relative:bool -> ?international:bool -> string list -> string +val drop_trailing_slash : string list -> string list +val make_path : string list -> string +val text_html : string +val application_json : string + +val to_set_cookie : + ?expires:float -> + ?max_age:float -> + ?domain:string -> + ?path:string -> + ?secure:bool -> + ?http_only:bool -> + ?same_site:[ `Strict | `Lax | `None ] -> + string -> string -> string diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 7b0bcadc..d54aa98c 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -5,10 +5,11 @@ -include Method -include Status - +type method_ = Method.method_ +type status = Status.status +type stream = Stream.stream +type buffer = Stream.buffer module Scope_variable_metadata = struct @@ -286,7 +287,7 @@ let response match status, code with | None, None -> `OK | Some status, _ -> (status :> status) - | None, Some code -> int_to_status code + | None, Some code -> Status.int_to_status code in let response = { diff --git a/src/pure/inmost.mli b/src/pure/inmost.mli new file mode 100644 index 00000000..56cae5f3 --- /dev/null +++ b/src/pure/inmost.mli @@ -0,0 +1,118 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +(* Note: this is not a stable API! *) + + + +type client +type server +type 'a message +type request = client message +type response = server message + +type 'a promise = 'a Lwt.t +type handler = request -> response promise +type middleware = handler -> handler + +type method_ = Method.method_ +type status = Status.status + +type stream = Stream.stream +type buffer = Stream.buffer + + + +val request : + ?method_:[< method_ ] -> + ?target:string -> + ?version:int * int -> + ?headers:(string * string) list -> + stream -> + stream -> + request + +val method_ : request -> method_ +val target : request -> string +val version : request -> int * int +val set_method_ : request -> [< method_ ] -> unit +val set_version : request -> int * int -> unit + + + +val response : + ?status:[< status ] -> + ?code:int -> + ?headers:(string * string) list -> + stream -> + stream -> + response + +val status : response -> status + + + +val header : 'a message -> string -> string option +val headers : 'a message -> string -> string list +val all_headers : 'a message -> (string * string) list +val has_header : 'a message -> string -> bool +val add_header : 'a message -> string -> string -> unit +val drop_header : 'a message -> string -> unit +val set_header : 'a message -> string -> string -> unit +val set_all_headers : 'a message -> (string * string) list -> unit +val sort_headers : (string * string) list -> (string * string) list + + + +val body : 'a message -> string promise +val set_body : response -> string -> unit +val read : request -> string option promise +val set_stream : 'a message -> unit +(* TODO Rename set_stream, it makes kind of no sense now. *) +val write : response -> string -> unit promise +val flush : response -> unit promise +val close_stream : response -> unit promise +(* TODO This will need to read different streams depending on whether it is + passed a request or a response. *) +val client_stream : 'a message -> stream +val server_stream : 'a message -> stream +val set_client_stream : 'a message -> stream -> unit +val next : + stream -> + data:(buffer -> int -> int -> bool -> bool -> unit) -> + close:(int -> unit) -> + flush:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> + unit +val write_buffer : + ?offset:int -> ?length:int -> response -> buffer -> unit promise + + + +val no_middleware : middleware +val pipeline : middleware list -> middleware + + + +type websocket = stream +val websocket : + ?headers:(string * string) list -> + (websocket -> unit promise) -> + response promise +val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise +val receive : websocket -> string option promise +val close_websocket : ?code:int -> websocket -> unit promise +val is_websocket : response -> (websocket -> unit promise) option + + + +type 'a local +val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local +val local : 'b message -> 'a local -> 'a option +val set_local : 'b message -> 'a local -> 'a -> unit +val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a diff --git a/src/pure/stream.mli b/src/pure/stream.mli new file mode 100644 index 00000000..a525f9dc --- /dev/null +++ b/src/pure/stream.mli @@ -0,0 +1,120 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021 Anton Bachin *) + + + +(* Note: this is not a stable API! *) + + + +type reader +type writer +type stream + +type buffer = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t +type 'a promise = + 'a Lwt.t + +type read = + data:(buffer -> int -> int -> bool -> bool -> unit) -> + close:(int -> unit) -> + flush:(unit -> unit) -> + ping:(buffer -> int -> int -> unit) -> + pong:(buffer -> int -> int -> unit) -> + unit +(** A reading function. Awaits the next event on the stream. For each call of a + reading function, one of the callbacks will eventually be called, according + to which event occurs next on the stream. *) + +type write = + close:(int -> unit) -> + (unit -> unit) -> + unit +(** A writing function. Pushes an event into a stream. May take additional + arguments before [~ok]. *) + +val reader : read:read -> close:(int -> unit) -> reader +(** Creates a read-only stream from the given reader. [~close] is called in + response to {!Stream.close}. It doesn't need to call {!Stream.close} again + on the stream. It should be used to free any underlying resources. *) + +val empty : reader +(** A read-only stream whose reading function always calls its [~close] + callback. *) + +val string : string -> reader +(** A read-only stream which calls its [~data] callback once with the contents + of the given string, and then always calls [~close]. *) + +val pipe : unit -> reader * writer +(** A stream which matches each call of the reading function to one call of its + writing functions. For example, calling {!Stream.flush} on a pipe will cause + the reader to call its [~flush] callback. *) + +val writer : + ready:write -> + write:(buffer -> int -> int -> bool -> bool -> write) -> + flush:write -> + ping:(buffer -> int -> int -> write) -> + pong:(buffer -> int -> int -> write) -> + close:(int -> unit) -> + writer + +val no_reader : reader + +val no_writer : writer + +val stream : reader -> writer -> stream +(* TODO Consider tupling the arguments, as that will make it easier to pass the + result of Stream.pipe. *) + +val close : stream -> int -> unit +(** Closes the given stream. Causes a pending reader or writer to call its + [~close] callback. *) + +val read : stream -> read +(** Awaits the next stream event. See {!Stream.type-read}. *) + +val read_convenience : stream -> string option promise +(** A wrapper around {!Stream.read} that converts [~data] with content [s] into + [Some s], and [~close] into [None], and uses them to resolve a promise. + [~flush] is ignored. *) + +val read_until_close : stream -> string promise +(** Reads a stream completely until [~close], and accumulates the data into a + string. *) + +val ready : stream -> write + +val write : stream -> buffer -> int -> int -> bool -> bool -> write +(** A writing function that sends a data buffer on the given stream. No more + writing functions should be called on the stream until this function calls + [~ok]. The [bool] arguments are whether the message is binary and whether + the [FIN] flag should be set. They are ignored by non-WebSocket streams. + + Note: [FIN] is provided as part of the write call, rather than being a + separate stream event (like [flush]), because the WebSocket writer needs to + immediately know when the last chunk of the last frame in a message is + provided, to transmit the [FIN] bit. If [FIN] were to be provided as a + separate event, the WebSocket writer would have to buffer each one chunk, in + case the next stream event was [FIN], in order to be able to decide whether + to set the [FIN] bit or not. This is awkward and inefficient, as it + introduces an unnecessary delay into the writer, as if the next event is not + [FIN], the next data chunk might take an arbitrary amount of time to be + generated by the writing user code. *) + +val flush : stream -> write +(** A writing function that asks for the given stream to be flushed. The meaning + of flushing depends on the implementation of the stream. No more writing + functions should be called on the stream until this function calls [~ok]. *) + +val ping : stream -> buffer -> int -> int -> write +(** A writing function that sends a ping event on the given stream. This is only + meaningful for WebSockets. *) + +val pong : stream -> buffer -> int -> int -> write +(** A writing function that sends a pong event on the given stream. This is only + meaningful for WebSockets. *) diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 84435836..69a667ad 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost diff --git a/src/unix/static.ml b/src/unix/static.ml index 42547362..0c89e21f 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -5,7 +5,9 @@ -module Dream = Dream_pure +module Dream = Dream_pure.Inmost +module Method = Dream_pure.Method +module Stream = Dream_pure.Stream @@ -29,14 +31,14 @@ let from_filesystem local_root path _ = Lwt_io.(with_file ~mode:Input file) (fun channel -> let%lwt content = Lwt_io.read channel in (* TODO Can use some pre-allocated streams or helpers here and below. *) - let client_stream = Dream.Stream.(stream (string content) no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream (string content) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~headers:(mime_lookup path) client_stream server_stream |> Lwt.return)) (fun _exn -> (* TODO Improve the two-stream code using some helper. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Not_Found client_stream server_stream |> Lwt.return) @@ -75,10 +77,10 @@ let validate_path request = let static ?(loader = from_filesystem) local_root = fun request -> - if not @@ Dream.methods_equal (Dream.method_ request) `GET then + if not @@ Method.methods_equal (Dream.method_ request) `GET then (* TODO Simplify this code and reduce allocations. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Not_Found client_stream server_stream |> Lwt.return @@ -86,8 +88,8 @@ let static ?(loader = from_filesystem) local_root = fun request -> match validate_path request with | None -> (* TODO Improve with helpers. *) - let client_stream = Dream.Stream.(stream empty no_writer) - and server_stream = Dream.Stream.(stream no_reader no_writer) in + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in Dream.response ~status:`Not_Found client_stream server_stream |> Lwt.return From 5a54d5c1eefbd527afd30734c08da950f6fd480c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Dec 2021 07:26:57 +0300 Subject: [PATCH 093/312] Rename "locals" to "fields" --- src/cipher/cipher.ml | 10 ++++---- src/dream.ml | 6 ++++- src/dream.mli | 28 +++++++++++++++++++---- src/http/error_handler.ml | 2 +- src/http/http.ml | 2 +- src/middleware/flash.ml | 8 +++---- src/middleware/log.ml | 20 ++++++++-------- src/middleware/router.ml | 26 ++++++++++----------- src/middleware/server.ml | 16 ++++++------- src/middleware/session.ml | 14 ++++++------ src/middleware/upload.ml | 4 ++-- src/pure/inmost.ml | 48 ++++++++++++++++++--------------------- src/pure/inmost.mli | 10 ++++---- src/sql/sql.ml | 10 ++++---- 14 files changed, 112 insertions(+), 92 deletions(-) diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 4d963bd8..75577d3f 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -118,8 +118,8 @@ struct | Some plaintext -> Some (Cstruct.to_string plaintext) end -let secrets_variable = - Dream.new_local +let secrets_field = + Dream.new_field ~name:"dream.secret" ~show_value:(fun _secrets -> "[redacted]") () @@ -131,19 +131,19 @@ let secrets_variable = let set_secret ?(old_secrets = []) secret = let value = secret::old_secrets in fun next_handler request -> - Dream.set_local request secrets_variable value; + Dream.set_field request secrets_field value; next_handler request let fallback_secrets = lazy [Random.random 32] let encryption_secret request = - match Dream.local request secrets_variable with + match Dream.field request secrets_field with | Some secrets -> List.hd secrets | None -> List.hd (Lazy.force fallback_secrets) let decryption_secrets request = - match Dream.local request secrets_variable with + match Dream.field request secrets_field with | Some secrets -> secrets | None -> Lazy.force fallback_secrets diff --git a/src/dream.ml b/src/dream.ml index 1cd455c7..0cb5be04 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -182,8 +182,12 @@ let with_stream message = set_stream message; message +type 'a local = 'a field +let new_local = new_field +let local = field + let with_local key value message = - set_local message key value; + set_field message key value; message let first message = diff --git a/src/dream.mli b/src/dream.mli index 27748882..cfb8101e 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2349,20 +2349,40 @@ val decrypt : Dream supports user-defined per-message variables for use by middlewares. *) -type 'a local +type 'a field (** Per-message variable. *) -val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local +(**/**) +type 'a local = 'a field +[@@ocaml.deprecated " Renamed to type Dream.field."] +(**/**) + +val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field (** Declares a variable of type ['a] in all messages. The variable is initially unset in each message. The optional [~name] and [~show_value] are used by {!Dream.run} [~debug] to show the variable in debug dumps. *) -val local : 'b message -> 'a local -> 'a option +(**/**) +val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field +[@@ocaml.deprecated " Renamed to Dream.new_field."] +(**/**) + +val field : 'b message -> 'a field -> 'a option (** Retrieves the value of the per-message variable. *) -val set_local : 'b message -> 'a local -> 'a -> unit +(**/**) +val local : 'b message -> 'a field -> 'a option +[@@ocaml.deprecated " Renamed to Dream.field."] +(**/**) + +val set_field : 'b message -> 'a field -> 'a -> unit (** Sets the per-message variable to the value. *) +(**/**) +val set_field : 'b message -> 'a field -> 'a -> unit +[@@ocaml.deprecated " Renamed to Dream.set_field."] +(**/**) + (**/**) val with_local : 'a local -> 'a -> 'b message -> 'b message [@@ocaml.deprecated diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 1ec3f2f5..d1ed9611 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -97,7 +97,7 @@ let dump (error : Catch.error) = Dream.all_headers request |> List.iter (fun (name, value) -> p "\n%s: %s" name value); - Dream.fold_locals (fun name value first -> + Dream.fold_fields (fun name value first -> if first then p "\n"; p "\n%s: %s" name value; diff --git a/src/http/http.ml b/src/http/http.ml index 0a88e8b1..09dd274f 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -406,7 +406,7 @@ let wrap_handler request_id field in requests. *) let user's_websocket_handler websocket = Lwt.with_value - Dream__middleware.Log.lwt_key + Dream__middleware.Log.id_lwt_key (Dream__middleware.Log.get_request_id ~request ()) (fun () -> user's_websocket_handler websocket) in diff --git a/src/middleware/flash.ml b/src/middleware/flash.ml index 22d5e78e..17e0640c 100644 --- a/src/middleware/flash.ml +++ b/src/middleware/flash.ml @@ -15,8 +15,8 @@ let log = let five_minutes = 5. *. 60. -let storage = - Dream.new_local ~name:"dream.flash" () +let storage_field = + Dream.new_field ~name:"dream.flash" () let flash_cookie = "dream.flash" @@ -53,7 +53,7 @@ let flash request = let put_flash request category message = let outbox = - match Dream.local request storage with + match Dream.field request storage_field with | Some outbox -> outbox | None -> let message = "Missing flash message middleware" in @@ -75,7 +75,7 @@ let flash_messages inner_handler request = else log ~request "%s" "No flash messages."); let outbox = ref [] in - Dream.set_local request storage outbox; + Dream.set_field request storage_field outbox; let existing = Cookie.cookie request flash_cookie in let%lwt response = inner_handler request in let entries = List.rev !outbox in diff --git a/src/middleware/log.ml b/src/middleware/log.ml index e7290602..f488e9ab 100644 --- a/src/middleware/log.ml +++ b/src/middleware/log.ml @@ -70,13 +70,13 @@ let logs_lib_tag : string Logs.Tag.def = (* Lwt sequence-associated storage key used to pass request ids for use when ~request is not provided. *) -let lwt_key : string Lwt.key = +let id_lwt_key : string Lwt.key = Lwt.new_key () (* The actual request id "field" associated with each request by the logger. If this field is missing, the logger assigns the request a fresh id. *) -let id = - Dream.new_local +let id_field = + Dream.new_field ~name:request_id_label ~show_value:(fun id -> id) () @@ -86,11 +86,11 @@ let get_request_id ?request () = let request_id = match request with | None -> None - | Some request -> Dream.local request id + | Some request -> Dream.field request id_field in match request_id with | Some _ -> request_id - | None -> Lwt.get lwt_key + | None -> Lwt.get id_lwt_key (* The current state of the request id sequence. *) let last_id = @@ -470,13 +470,13 @@ struct (* Get the requwst's id or assign a new one. *) let id = - match Dream.local request id with + match Dream.field request id_field with | Some id -> id | None -> last_id := !last_id + 1; - let new_id = string_of_int !last_id in - Dream.set_local request id new_id; - new_id + let id = string_of_int !last_id in + Dream.set_field request id_field id; + id in (* Identify the request in the log. *) @@ -495,7 +495,7 @@ struct (* Call the rest of the app. *) Lwt.try_bind (fun () -> - Lwt.with_value lwt_key (Some id) (fun () -> + Lwt.with_value id_lwt_key (Some id) (fun () -> next_handler request)) (fun response -> (* Log the elapsed time. If the response is a redirection, log the diff --git a/src/middleware/router.ml b/src/middleware/router.ml index e188716f..108837ea 100644 --- a/src/middleware/router.ml +++ b/src/middleware/router.ml @@ -165,8 +165,8 @@ let scope prefix middlewares routes = -let path_variable : string list Dream.local = - Dream.new_local +let path_field : string list Dream.field = + Dream.new_field ~name:"dream.path" ~show_value:(fun path -> String.concat "/" path) () @@ -175,24 +175,24 @@ let path_variable : string list Dream.local = string. *) (* TODO Remove this from the API. *) let path the_request = - match Dream.local the_request path_variable with + match Dream.field the_request path_field with | Some path -> path | None -> Dream.(Formats.(the_request |> target |> split_target |> fst |> from_path)) (* TODO Move site_prefix into this file and remove with_path from the API. *) let set_path request path = - Dream.set_local request path_variable path + Dream.set_field request path_field path (* Prefix is stored backwards. *) -let prefix_variable : string list Dream.local = - Dream.new_local +let prefix_field : string list Dream.field = + Dream.new_field ~name:"dream.prefix" ~show_value:(fun prefix -> String.concat "/" (List.rev prefix)) () let internal_prefix request = - match Dream.local request prefix_variable with + match Dream.field request prefix_field with | Some prefix -> prefix | None -> [] @@ -200,10 +200,10 @@ let prefix request = Formats.make_path (List.rev (internal_prefix request)) let set_prefix request prefix = - Dream.set_local request prefix_variable prefix + Dream.set_field request prefix_field prefix -let params_variable : (string * string) list Dream.local = - Dream.new_local +let params_field : (string * string) list Dream.field = + Dream.new_field ~name:"dream.params" ~show_value:(fun params -> params @@ -222,7 +222,7 @@ let missing_param request name = failwith message let param request name = - match Dream.local request params_variable with + match Dream.field request params_field with | None -> missing_param request name | Some params -> try List.assoc name params @@ -261,7 +261,7 @@ let router routes = match node with | Handler (method_, handler) when method_matches method_ (Dream.method_ request) -> - Dream.set_local request params_variable bindings; + Dream.set_field request params_field bindings; if is_wildcard then begin set_prefix request prefix; set_path request path; @@ -279,7 +279,7 @@ let router routes = in let params = - match Dream.local request params_variable with + match Dream.field request params_field with | Some params -> params | None -> [] in diff --git a/src/middleware/server.ml b/src/middleware/server.ml index df027256..89a4977d 100644 --- a/src/middleware/server.ml +++ b/src/middleware/server.ml @@ -11,8 +11,8 @@ module Stream = Dream_pure.Stream -let client_variable = - Dream.new_local +let client_field = + Dream.new_field ~name:"dream.client" ~show_value:(fun client -> client) () @@ -20,28 +20,28 @@ let client_variable = (* TODO What should be reported when the client address is missing? This is a sign of local testing. *) let client request = - match Dream.local request client_variable with + match Dream.field request client_field with | None -> "127.0.0.1:0" | Some client -> client let set_client request client = - Dream.set_local request client_variable client + Dream.set_field request client_field client -let https_variable = - Dream.new_local +let https_field = + Dream.new_field ~name:"dream.https" ~show_value:string_of_bool () let https request = - match Dream.local request https_variable with + match Dream.field request https_field with | Some true -> true | _ -> false let set_https request https = - Dream.set_local request https_variable https + Dream.set_field request https_field https diff --git a/src/middleware/session.ml b/src/middleware/session.ml index df09c3c2..d7169597 100644 --- a/src/middleware/session.ml +++ b/src/middleware/session.ml @@ -19,14 +19,14 @@ type 'a back_end = { send : 'a -> Dream.request -> Dream.response -> Dream.response Lwt.t; } -let middleware local back_end = fun inner_handler request -> +let middleware field back_end = fun inner_handler request -> let%lwt session = back_end.load request in - Dream.set_local request local session; + Dream.set_field request field session; let%lwt response = inner_handler request in back_end.send session request response -let getter local request = - match Dream.local request local with +let getter field request = + match Dream.field request field with | Some session -> session | None -> @@ -40,10 +40,10 @@ type 'a typed_middleware = { } let typed_middleware ?show_value () = - let local = Dream.new_local ~name:"dream.session" ?show_value () in + let field = Dream.new_field ~name:"dream.session" ?show_value () in { - middleware = middleware local; - getter = getter local; + middleware = middleware field; + getter = getter field; } diff --git a/src/middleware/upload.ml b/src/middleware/upload.ml index 15def736..9417c255 100644 --- a/src/middleware/upload.ml +++ b/src/middleware/upload.ml @@ -30,8 +30,8 @@ let initial_multipart_state () = { } (* TODO Dump the value of the multipart state somehow? *) -let multipart_state_variable : multipart_state Dream.local = - Dream.new_local +let multipart_state_field : multipart_state Dream.field = + Dream.new_field ~name:"dream.multipart" () diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index d54aa98c..24ef3019 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -11,14 +11,11 @@ type status = Status.status type stream = Stream.stream type buffer = Stream.buffer -module Scope_variable_metadata = +module Custom_field_metadata = struct type 'a t = string option * ('a -> string) option end -module Scope = Hmap.Make (Scope_variable_metadata) -(* TODO Rename Scope, because there is now only one scope. *) -(* TODO Given there are now only locals, maybe it's worth renaming them to - something else - there is now only one concept of variables. *) +module Fields = Hmap.Make (Custom_field_metadata) type websocket = Stream.stream @@ -30,7 +27,7 @@ and 'a message = { mutable headers : (string * string) list; mutable client_stream : Stream.stream; mutable server_stream : Stream.stream; - mutable locals : Scope.t; + mutable fields : Fields.t; } and client = { @@ -223,29 +220,28 @@ let close_stream message = let is_websocket response = response.specific.websocket -let fold_scope f initial scope = - Scope.fold (fun (B (key, value)) accumulator -> - match Scope.Key.info key with - | Some name, Some show_value -> f name (show_value value) accumulator - | _ -> accumulator) - scope - initial -type 'a local = 'a Scope.key -let new_local ?name ?show_value () = - Scope.Key.create (name, show_value) +type 'a field = 'a Fields.key + +let new_field ?name ?show_value () = + Fields.Key.create (name, show_value) + +let field message key = + Fields.find key message.fields -(* TODO Tension between "t-first" and not, because typically, for a getter, the - "index" parameter could be partially applied. *) -let local message key = - Scope.find key message.locals +let set_field message key value = + message.fields <- Fields.add key value message.fields + +let fold_fields f initial message = + Fields.fold (fun (B (key, value)) accumulator -> + match Fields.Key.info key with + | Some name, Some show_value -> f name (show_value value) accumulator + | _ -> accumulator) + message.fields + initial -let set_local message key value = - message.locals <- Scope.add key value message.locals -let fold_locals f initial message = - fold_scope f initial message.locals let request ?method_ @@ -275,7 +271,7 @@ let request headers; client_stream; server_stream; - locals = Scope.empty; + fields = Fields.empty; } in request @@ -299,7 +295,7 @@ let response client_stream; server_stream; (* TODO This fully dead stream should be preallocated. *) - locals = Scope.empty; + fields = Fields.empty; } in response diff --git a/src/pure/inmost.mli b/src/pure/inmost.mli index 56cae5f3..d57b0b9b 100644 --- a/src/pure/inmost.mli +++ b/src/pure/inmost.mli @@ -111,8 +111,8 @@ val is_websocket : response -> (websocket -> unit promise) option -type 'a local -val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a local -val local : 'b message -> 'a local -> 'a option -val set_local : 'b message -> 'a local -> 'a -> unit -val fold_locals : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a +type 'a field +val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field +val field : 'b message -> 'a field -> 'a option +val set_field : 'b message -> 'a field -> 'a -> unit +val fold_fields : (string -> string -> 'a -> 'a) -> 'a -> 'b message -> 'a diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 69a667ad..af20da00 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -13,8 +13,8 @@ let log = Dream__middleware.Log.sub_log "dream.sql" (* TODO Debug metadata for the pools. *) -let pool_variable : (_, Caqti_error.t) Caqti_lwt.Pool.t Dream.local = - Dream.new_local () +let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Dream.field = + Dream.new_field () let foreign_keys_on = Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON" @@ -30,7 +30,7 @@ let sql_pool ?size uri = begin match !pool_cell with | Some pool -> - Dream.set_local request pool_variable pool; + Dream.set_field request pool_field pool; inner_handler request | None -> (* The correctness of this code is subtle. There is no race condition with @@ -46,7 +46,7 @@ let sql_pool ?size uri = match pool with | Ok pool -> pool_cell := Some pool; - Dream.set_local request pool_variable pool; + Dream.set_field request pool_field pool; inner_handler request | Error error -> (* Deliberately raise an exception so that it can be communicated to any @@ -59,7 +59,7 @@ let sql_pool ?size uri = end let sql request callback = - match Dream.local request pool_variable with + match Dream.field request pool_field with | None -> let message = "Dream.sql: no pool; did you apply Dream.sql_pool?" in log.error (fun log -> log ~request "%s" message); From 9e8bc2fb8ef689724529c3b46cb3ecd1212f112b Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Dec 2021 07:31:52 +0300 Subject: [PATCH 094/312] mv src/middleware src/server --- src/{middleware => server}/catch.ml | 0 src/{middleware => server}/content_length.ml | 0 src/{middleware => server}/cookie.ml | 0 src/{middleware => server}/csrf.ml | 0 src/{middleware => server}/dune | 0 src/{middleware => server}/echo.ml | 0 src/{middleware => server}/error_template.eml.ml | 0 src/{middleware => server}/flash.ml | 0 src/{middleware => server}/form.ml | 0 src/{middleware => server}/log.ml | 0 src/{middleware => server}/lowercase_headers.ml | 0 src/{middleware => server}/origin_referrer_check.ml | 0 src/{middleware => server}/query.ml | 0 src/{middleware => server}/router.ml | 0 src/{middleware => server}/router.mli | 0 src/{middleware => server}/server.ml | 0 src/{middleware => server}/session.ml | 0 src/{middleware => server}/site_prefix.ml | 0 src/{middleware => server}/tag.eml.ml | 0 src/{middleware => server}/upload.ml | 0 20 files changed, 0 insertions(+), 0 deletions(-) rename src/{middleware => server}/catch.ml (100%) rename src/{middleware => server}/content_length.ml (100%) rename src/{middleware => server}/cookie.ml (100%) rename src/{middleware => server}/csrf.ml (100%) rename src/{middleware => server}/dune (100%) rename src/{middleware => server}/echo.ml (100%) rename src/{middleware => server}/error_template.eml.ml (100%) rename src/{middleware => server}/flash.ml (100%) rename src/{middleware => server}/form.ml (100%) rename src/{middleware => server}/log.ml (100%) rename src/{middleware => server}/lowercase_headers.ml (100%) rename src/{middleware => server}/origin_referrer_check.ml (100%) rename src/{middleware => server}/query.ml (100%) rename src/{middleware => server}/router.ml (100%) rename src/{middleware => server}/router.mli (100%) rename src/{middleware => server}/server.ml (100%) rename src/{middleware => server}/session.ml (100%) rename src/{middleware => server}/site_prefix.ml (100%) rename src/{middleware => server}/tag.eml.ml (100%) rename src/{middleware => server}/upload.ml (100%) diff --git a/src/middleware/catch.ml b/src/server/catch.ml similarity index 100% rename from src/middleware/catch.ml rename to src/server/catch.ml diff --git a/src/middleware/content_length.ml b/src/server/content_length.ml similarity index 100% rename from src/middleware/content_length.ml rename to src/server/content_length.ml diff --git a/src/middleware/cookie.ml b/src/server/cookie.ml similarity index 100% rename from src/middleware/cookie.ml rename to src/server/cookie.ml diff --git a/src/middleware/csrf.ml b/src/server/csrf.ml similarity index 100% rename from src/middleware/csrf.ml rename to src/server/csrf.ml diff --git a/src/middleware/dune b/src/server/dune similarity index 100% rename from src/middleware/dune rename to src/server/dune diff --git a/src/middleware/echo.ml b/src/server/echo.ml similarity index 100% rename from src/middleware/echo.ml rename to src/server/echo.ml diff --git a/src/middleware/error_template.eml.ml b/src/server/error_template.eml.ml similarity index 100% rename from src/middleware/error_template.eml.ml rename to src/server/error_template.eml.ml diff --git a/src/middleware/flash.ml b/src/server/flash.ml similarity index 100% rename from src/middleware/flash.ml rename to src/server/flash.ml diff --git a/src/middleware/form.ml b/src/server/form.ml similarity index 100% rename from src/middleware/form.ml rename to src/server/form.ml diff --git a/src/middleware/log.ml b/src/server/log.ml similarity index 100% rename from src/middleware/log.ml rename to src/server/log.ml diff --git a/src/middleware/lowercase_headers.ml b/src/server/lowercase_headers.ml similarity index 100% rename from src/middleware/lowercase_headers.ml rename to src/server/lowercase_headers.ml diff --git a/src/middleware/origin_referrer_check.ml b/src/server/origin_referrer_check.ml similarity index 100% rename from src/middleware/origin_referrer_check.ml rename to src/server/origin_referrer_check.ml diff --git a/src/middleware/query.ml b/src/server/query.ml similarity index 100% rename from src/middleware/query.ml rename to src/server/query.ml diff --git a/src/middleware/router.ml b/src/server/router.ml similarity index 100% rename from src/middleware/router.ml rename to src/server/router.ml diff --git a/src/middleware/router.mli b/src/server/router.mli similarity index 100% rename from src/middleware/router.mli rename to src/server/router.mli diff --git a/src/middleware/server.ml b/src/server/server.ml similarity index 100% rename from src/middleware/server.ml rename to src/server/server.ml diff --git a/src/middleware/session.ml b/src/server/session.ml similarity index 100% rename from src/middleware/session.ml rename to src/server/session.ml diff --git a/src/middleware/site_prefix.ml b/src/server/site_prefix.ml similarity index 100% rename from src/middleware/site_prefix.ml rename to src/server/site_prefix.ml diff --git a/src/middleware/tag.eml.ml b/src/server/tag.eml.ml similarity index 100% rename from src/middleware/tag.eml.ml rename to src/server/tag.eml.ml diff --git a/src/middleware/upload.ml b/src/server/upload.ml similarity index 100% rename from src/middleware/upload.ml rename to src/server/upload.ml From 2335f69fbdcd504242c92ea58f48dbeafc026838 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Dec 2021 07:47:29 +0300 Subject: [PATCH 095/312] Rename dream.middleware to dream.server --- src/dream.ml | 54 ++++++++++++++-------------- src/dream.mli | 2 +- src/dune | 2 +- src/graphql/dune | 2 +- src/graphql/graphql.ml | 15 ++++---- src/http/dune | 2 +- src/http/error_handler.ml | 21 +++++------ src/http/error_handler.mli | 5 +-- src/http/http.ml | 31 ++++++++-------- src/server/catch.ml | 4 +-- src/server/cookie.ml | 4 +-- src/server/dune | 4 +-- src/server/{server.ml => helpers.ml} | 0 src/server/log.ml | 2 +- src/server/origin_referrer_check.ml | 4 +-- src/sql/dune | 2 +- src/sql/session.ml | 4 +-- src/sql/sql.ml | 3 +- src/unix/dune | 2 +- src/unix/static.ml | 6 ++-- 20 files changed, 89 insertions(+), 80 deletions(-) rename src/server/{server.ml => helpers.ml} (100%) diff --git a/src/dream.ml b/src/dream.ml index 0cb5be04..ef94ce98 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -11,51 +11,51 @@ include Dream_pure.Method include Dream_pure.Inmost include Dream_pure.Formats -include Dream__middleware.Log -include Dream__middleware.Log.Make (Ptime_clock) +include Dream__server.Log +include Dream__server.Log.Make (Ptime_clock) (* Initalize logs with the default reporter which uses [Ptime_clock], this - function is a part of [Dream__middleware.Log.Make], it's why it is not - prepended by a module name. *) + function is a part of [Dream__server.Log.Make], it's why it is not prepended + by a module name. *) let () = initialize ~setup_outputs:Fmt_tty.setup_std_outputs -include Dream__middleware.Echo +include Dream__server.Echo let default_log = - Dream__middleware.Log.sub_log (Logs.Src.name Logs.default) + Dream__server.Log.sub_log (Logs.Src.name Logs.default) let error = default_log.error let warning = default_log.warning let info = default_log.info let debug = default_log.debug -include Dream__middleware.Router +include Dream__server.Router include Dream__unix.Static include Dream__cipher.Cipher -include Dream__middleware.Cookie +include Dream__server.Cookie -include Dream__middleware.Session -include Dream__middleware.Session.Make (Ptime_clock) +include Dream__server.Session +include Dream__server.Session.Make (Ptime_clock) let sql_sessions = Dream__sql.Session.middleware -include Dream__middleware.Flash +include Dream__server.Flash -include Dream__middleware.Origin_referrer_check -include Dream__middleware.Form -include Dream__middleware.Upload -include Dream__middleware.Csrf +include Dream__server.Origin_referrer_check +include Dream__server.Form +include Dream__server.Upload +include Dream__server.Csrf let content_length = - Dream__middleware.Content_length.content_length + Dream__server.Content_length.content_length include Dream__graphql.Graphql include Dream__sql.Sql include Dream__http.Http -include Dream__middleware.Lowercase_headers -include Dream__middleware.Catch -include Dream__middleware.Site_prefix +include Dream__server.Lowercase_headers +include Dream__server.Catch +include Dream__server.Site_prefix let debug_error_handler = Dream__http.Error_handler.debug_error_handler @@ -79,9 +79,9 @@ let test ?(prefix = "") handler request = Lwt_main.run (app request) let log = - Dream__middleware.Log.convenience_log + Dream__server.Log.convenience_log -include Dream__middleware.Tag +include Dream__server.Tag let respond ?status ?code ?headers body = let client_stream = stream (string body) no_writer @@ -130,17 +130,17 @@ let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request let client = - Dream__middleware.Server.client + Dream__server.Helpers.client let set_client = - Dream__middleware.Server.set_client + Dream__server.Helpers.set_client let https = - Dream__middleware.Server.https + Dream__server.Helpers.https let html = - Dream__middleware.Server.html + Dream__server.Helpers.html let json = - Dream__middleware.Server.json + Dream__server.Helpers.json -include Dream__middleware.Query +include Dream__server.Query let request ?method_ ?target ?version ?headers body = (* TODO Streams. *) diff --git a/src/dream.mli b/src/dream.mli index cfb8101e..7330168c 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2384,7 +2384,7 @@ val set_field : 'b message -> 'a field -> 'a -> unit (**/**) (**/**) -val with_local : 'a local -> 'a -> 'b message -> 'b message +val with_local : 'a field -> 'a -> 'b message -> 'b message [@@ocaml.deprecated " Use Dream.set_local instead. See https://aantron.github.io/dream/#val-set_local"] diff --git a/src/dune b/src/dune index ca4934a6..053e23f9 100644 --- a/src/dune +++ b/src/dune @@ -7,7 +7,7 @@ dream.cipher dream.graphql dream.http - dream.middleware + dream.server dream.unix dream-pure dream.sql diff --git a/src/graphql/dune b/src/graphql/dune index 20eab391..7397ce17 100644 --- a/src/graphql/dune +++ b/src/graphql/dune @@ -3,8 +3,8 @@ (name dream__graphql) (libraries dream.graphiql - dream.middleware dream-pure + dream.server graphql_parser graphql-lwt lwt diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index fc776826..b8f6b89c 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -6,8 +6,9 @@ module Dream = Dream_pure.Inmost +module Helpers = Dream__server.Helpers +module Log = Dream__server.Log module Method = Dream_pure.Method -module Server = Dream__middleware.Server module Stream = Dream_pure.Stream @@ -24,7 +25,7 @@ module Stream = Dream_pure.Stream https://github.com/enisdenjo/graphql-ws/blob/master/PROTOCOL.md *) let log = - Dream__middleware.Log.sub_log "dream.graphql" + Log.sub_log "dream.graphql" @@ -238,7 +239,7 @@ let handle_over_websocket make_context schema subscriptions request websocket = log.error (fun log -> log ~request "%s" (Printexc.to_string exn)); backtrace - |> Dream__middleware.Log.iter_backtrace (fun line -> + |> Log.iter_backtrace (fun line -> log.error (fun log -> log ~request "%s" line)); try%lwt @@ -302,16 +303,16 @@ let graphql make_context schema = fun request -> begin match%lwt run_query make_context schema request json with | Error json -> Yojson.Basic.to_string json - |> Server.json + |> Helpers.json | Ok (`Response json) -> Yojson.Basic.to_string json - |> Server.json + |> Helpers.json | Ok (`Stream _) -> make_error "Subscriptions and streaming should use WebSocket transport" |> Yojson.Basic.to_string - |> Server.json + |> Helpers.json end | _ -> @@ -354,4 +355,4 @@ let graphiql ?(default_query = "") graphql_endpoint = in fun _request -> - Server.html (Lazy.force html) + Helpers.html (Lazy.force html) diff --git a/src/http/dune b/src/http/dune index 78693aca..9280e5c6 100644 --- a/src/http/dune +++ b/src/http/dune @@ -7,8 +7,8 @@ digestif dream.cipher dream.localhost - dream.middleware dream-pure + dream.server dream-httpaf.gluten dream-httpaf.gluten-lwt-unix dream-httpaf.h2 diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index d1ed9611..4089bbad 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -5,10 +5,12 @@ -module Catch = Dream__middleware.Catch +module Catch = Dream__server.Catch module Dream = Dream_pure.Inmost +module Error_template = Dream__server.Error_template module Method = Dream_pure.Method -module Server = Dream__middleware.Server +module Helpers = Dream__server.Helpers +module Log = Dream__server.Log module Status = Dream_pure.Status module Stream = Dream_pure.Stream @@ -20,7 +22,7 @@ module Stream = Dream_pure.Stream an app. *) let log = - Dream__middleware.Log.sub_log "dream.http" + Log.sub_log "dream.http" let select_log = function | `Error -> log.error @@ -48,7 +50,7 @@ let dump (error : Catch.error) = | `Exn exn -> let backtrace = Printexc.get_backtrace () in p "%s\n" (Printexc.to_string exn); - backtrace |> Dream__middleware.Log.iter_backtrace (p "%s\n") + backtrace |> Log.iter_backtrace (p "%s\n") end; p "\n"; @@ -147,7 +149,7 @@ let customize template (error : Catch.error) = select_log error.severity (fun log -> log ?request:error.request "%s" message); - backtrace |> Dream__middleware.Log.iter_backtrace (fun line -> + backtrace |> Log.iter_backtrace (fun line -> select_log error.severity (fun log -> log ?request:error.request "%s" line)) end; @@ -194,8 +196,7 @@ let debug_template _error debug_dump response = let code = Status.status_to_int status and reason = Status.status_to_string status in Dream.set_header response "Content-Type" Dream_pure.Formats.text_html; - Dream.set_body response - (Dream__middleware.Error_template.render ~debug_dump ~code ~reason); + Dream.set_body response (Error_template.render ~debug_dump ~code ~reason); Lwt.return response let default = @@ -218,7 +219,7 @@ let double_faults f default = log "Error handler raised: %s" (Printexc.to_string exn)); backtrace - |> Dream__middleware.Log.iter_backtrace (fun line -> + |> Log.iter_backtrace (fun line -> log.error (fun log -> log "%s" line)); default () @@ -442,7 +443,7 @@ let websocket caused_by = `Server; request = Some request; response = Some response; - client = Some (Server.client request); + client = Some (Helpers.client request); severity = `Warning; (* Not sure what these errors are, yet. *) will_send_response = false; } in @@ -464,7 +465,7 @@ let websocket_handshake caused_by = `Client; request = Some request; response = Some response; - client = Some (Server.client request); + client = Some (Helpers.client request); severity = `Warning; will_send_response = true; } in diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index 6e1854f9..5e96f6fe 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -5,8 +5,9 @@ +module Catch = Dream__server.Catch module Dream = Dream_pure.Inmost -module Catch = Dream__middleware.Catch +module Log = Dream__server.Log @@ -62,4 +63,4 @@ val websocket_handshake : (* Logger also used by elsewhere in the HTTP integration. *) -val log : Dream__middleware.Log.sub_log +val log : Log.sub_log diff --git a/src/http/http.ml b/src/http/http.ml index 09dd274f..20d6f354 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -5,10 +5,13 @@ -module Catch = Dream__middleware.Catch +module Catch = Dream__server.Catch +module Content_length = Dream__server.Content_length module Dream = Dream_pure.Inmost +module Helpers = Dream__server.Helpers +module Log = Dream__server.Log +module Lowercase_headers = Dream__server.Lowercase_headers module Method = Dream_pure.Method -module Server = Dream__middleware.Server module Status = Dream_pure.Status module Stream = Dream_pure.Stream @@ -33,7 +36,7 @@ let sha1 s = |> Digestif.SHA1.to_raw_string let websocket_log = - Dream__middleware.Log.sub_log "dream.websocket" + Log.sub_log "dream.websocket" let websocket_handler user's_websocket_handler socket = @@ -302,7 +305,7 @@ let wrap_handler (user's_dream_handler : Dream.handler) = let httpaf_request_handler = fun client_address (conn : _ Gluten.Reqd.t) -> - Dream__middleware.Log.set_up_exception_hook (); + Log.set_up_exception_hook (); let conn, upgrade = conn.reqd, conn.upgrade in @@ -341,7 +344,7 @@ let wrap_handler Stream.stream body Stream.no_writer in let request : Dream.request = - Server.request ~client ~method_ ~target ~https ~version ~headers body in + Helpers.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -406,8 +409,8 @@ let wrap_handler request_id field in requests. *) let user's_websocket_handler websocket = Lwt.with_value - Dream__middleware.Log.id_lwt_key - (Dream__middleware.Log.get_request_id ~request ()) + Log.id_lwt_key + (Log.get_request_id ~request ()) (fun () -> user's_websocket_handler websocket) in @@ -451,7 +454,7 @@ let wrap_handler_h2 (user's_dream_handler : Dream.handler) = let httpaf_request_handler = fun client_address (conn : H2.Reqd.t) -> - Dream__middleware.Log.set_up_exception_hook (); + Log.set_up_exception_hook (); (* Covert the h2 request to a Dream request. *) let httpaf_request : H2.Request.t = @@ -484,7 +487,7 @@ let wrap_handler_h2 Stream.stream body Stream.no_writer in let request : Dream.request = - Server.request ~client ~method_ ~target ~https ~version ~headers body in + Helpers.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise that rejects with an exception, pass the exception up to Httpaf. This @@ -645,9 +648,9 @@ let ocaml_tls = { let built_in_middleware error_handler = Dream.pipeline [ - Dream__middleware.Lowercase_headers.lowercase_headers; - Dream__middleware.Content_length.content_length; - Dream__middleware.Catch.catch (Error_handler.app error_handler); + Lowercase_headers.lowercase_headers; + Content_length.content_length; + Catch.catch (Error_handler.app error_handler); ] @@ -871,7 +874,7 @@ let serve_with_maybe_https log.error (fun log -> log "Dream.%s: exception %s" caller_function_for_error_messages (Printexc.to_string exn)); - backtrace |> Dream__middleware.Log.iter_backtrace (fun line -> + backtrace |> Log.iter_backtrace (fun line -> log.error (fun log -> log "%s" line)); raise exn @@ -965,7 +968,7 @@ let run create_handler Sys.sigint; create_handler Sys.sigterm; - let log = Dream__middleware.Log.convenience_log in + let log = Log.convenience_log in if greeting then begin let scheme = diff --git a/src/server/catch.ml b/src/server/catch.ml index 7e29d8bc..8922c062 100644 --- a/src/server/catch.ml +++ b/src/server/catch.ml @@ -66,7 +66,7 @@ let catch error_handler next_handler request = caused_by; request = Some request; response = Some response; - client = Some (Server.client request); + client = Some (Helpers.client request); severity = severity; will_send_response = true; } in @@ -87,7 +87,7 @@ let catch error_handler next_handler request = caused_by = `Server; request = Some request; response = None; - client = Some (Server.client request); + client = Some (Helpers.client request); severity = `Error; will_send_response = true; } in diff --git a/src/server/cookie.ml b/src/server/cookie.ml index dfe24375..84742f08 100644 --- a/src/server/cookie.ml +++ b/src/server/cookie.ml @@ -56,7 +56,7 @@ let cookie let secure = match secure with | Some secure -> secure - | None -> Server.https request + | None -> Helpers.https request in let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in @@ -100,7 +100,7 @@ let set_cookie let secure = match secure with | Some secure -> secure - | None -> Server.https request + | None -> Helpers.https request in let cookie_prefix = infer_cookie_prefix cookie_prefix domain path secure in diff --git a/src/server/dune b/src/server/dune index 77a2f0b5..9afd04a3 100644 --- a/src/server/dune +++ b/src/server/dune @@ -1,6 +1,6 @@ (library - (public_name dream.middleware) - (name dream__middleware) + (public_name dream.server) + (name dream__server) (libraries digestif dream.cipher diff --git a/src/server/server.ml b/src/server/helpers.ml similarity index 100% rename from src/server/server.ml rename to src/server/helpers.ml diff --git a/src/server/log.ml b/src/server/log.ml index f488e9ab..ff5cebd7 100644 --- a/src/server/log.ml +++ b/src/server/log.ml @@ -489,7 +489,7 @@ struct log ~request "%s %s %s %s" (Method.method_to_string (Dream.method_ request)) (Dream.target request) - (Server.client request) + (Helpers.client request) user_agent); (* Call the rest of the app. *) diff --git a/src/server/origin_referrer_check.ml b/src/server/origin_referrer_check.ml index 9cccfe9f..93d5c415 100644 --- a/src/server/origin_referrer_check.ml +++ b/src/server/origin_referrer_check.ml @@ -55,8 +55,8 @@ let origin_referrer_check inner_handler request = let schemes_match = match Uri.scheme origin_uri with - | Some "http" -> not (Server.https request) - | Some "https" -> Server.https request + | Some "http" -> not (Helpers.https request) + | Some "https" -> Helpers.https request | _ -> false in diff --git a/src/sql/dune b/src/sql/dune index 7966abac..e4244f42 100644 --- a/src/sql/dune +++ b/src/sql/dune @@ -5,8 +5,8 @@ caqti caqti-lwt dream.cipher - dream.middleware dream-pure + dream.server uri yojson) (preprocess (pps lwt_ppx)) diff --git a/src/sql/session.ml b/src/sql/session.ml index fd868afa..5bf01527 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -6,8 +6,8 @@ module Dream = Dream_pure -module Cookie = Dream__middleware.Cookie -module Session = Dream__middleware.Session +module Cookie = Dream__server.Cookie +module Session = Dream__server.Session diff --git a/src/sql/sql.ml b/src/sql/sql.ml index af20da00..234343f8 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -6,11 +6,12 @@ module Dream = Dream_pure.Inmost +module Log = Dream__server.Log let log = - Dream__middleware.Log.sub_log "dream.sql" + Log.sub_log "dream.sql" (* TODO Debug metadata for the pools. *) let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Dream.field = diff --git a/src/unix/dune b/src/unix/dune index 7cc1e262..170fa3a8 100644 --- a/src/unix/dune +++ b/src/unix/dune @@ -3,8 +3,8 @@ (name dream__unix) (libraries digestif - dream.middleware dream-pure + dream.server lwt.unix magic-mime ) diff --git a/src/unix/static.ml b/src/unix/static.ml index 0c89e21f..7a163bbf 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -6,7 +6,9 @@ module Dream = Dream_pure.Inmost +module Formats = Dream_pure.Formats module Method = Dream_pure.Method +module Router = Dream__server.Router module Stream = Dream_pure.Stream @@ -19,7 +21,7 @@ module Stream = Dream_pure.Stream let mime_lookup filename = let content_type = match Magic_mime.lookup filename with - | "text/html" -> Dream_pure.Formats.text_html + | "text/html" -> Formats.text_html | content_type -> content_type in ["Content-Type", content_type] @@ -49,7 +51,7 @@ let from_filesystem local_root path _ = (* TODO On Windows, should we also check for \ and drive letters? *) (* TODO Not an efficient implementation at the moment. *) let validate_path request = - let path = Dream__middleware.Router.path request in + let path = Router.path request in let has_slash component = String.contains component '/' in let has_backslash component = String.contains component '\\' in From ed4c24f6a826a8d2808bbaebbd1986f4d0fdf226 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Dec 2021 08:01:07 +0300 Subject: [PATCH 096/312] Move helpers --- src/dream.ml | 66 +++++++++++++------------------------------ src/server/helpers.ml | 52 ++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 47 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index ef94ce98..6e7efd7c 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -83,42 +83,20 @@ let log = include Dream__server.Tag -let respond ?status ?code ?headers body = - let client_stream = stream (string body) no_writer - and server_stream = stream no_reader no_writer in - response ?status ?code ?headers client_stream server_stream - |> Lwt.return - -(* TODO Actually use the request and extract the site prefix. *) -let redirect ?status ?code ?headers _request location = - let status = (status :> redirection option) in - let status = - match status, code with - | None, None -> Some (`See_Other) - | _ -> status - in - (* TODO The streams. *) - let client_stream = stream empty no_writer - and server_stream = stream no_reader no_writer in - let response = response ?status ?code ?headers client_stream server_stream in - set_header response "Location" location; - Lwt.return response - -let stream ?status ?code ?headers f = - (* TODO Streams. *) - let client_stream = stream empty no_writer - and server_stream = stream no_reader no_writer in - let response = response ?status ?code ?headers client_stream server_stream in - set_stream response; - (* TODO Should set up an error handler for this. *) - Lwt.async (fun () -> f response); - Lwt.return response - -let empty ?headers status = - respond ?headers ~status "" - -let not_found _ = - respond ~status:`Not_Found "" +let respond = + Dream__server.Helpers.respond + +let redirect = + Dream__server.Helpers.redirect + +let stream = + Dream__server.Helpers.stream + +let empty = + Dream__server.Helpers.empty + +let not_found = + Dream__server.Helpers.not_found let now () = Ptime.to_float_s (Ptime.v (Ptime_clock.now_d_ps ())) @@ -142,17 +120,11 @@ let json = include Dream__server.Query -let request ?method_ ?target ?version ?headers body = - (* TODO Streams. *) - let client_stream = Dream_pure.Stream.stream no_reader no_writer - and server_stream = Dream_pure.Stream.stream (string body) no_writer in - request ?method_ ?target ?version ?headers client_stream server_stream - -let response ?status ?code ?headers body = - (* TODO Streams. *) - let client_stream = Dream_pure.Stream.stream (string body) no_writer - and server_stream = Dream_pure.Stream.stream no_reader no_writer in - response ?status ?code ?headers client_stream server_stream +let request = + Dream__server.Helpers.request_with_body + +let response = + Dream__server.Helpers.response_with_body let with_client client message = set_client message client; diff --git a/src/server/helpers.ml b/src/server/helpers.ml index 89a4977d..e62ccf40 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -7,6 +7,7 @@ module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Status = Dream_pure.Status module Stream = Dream_pure.Stream @@ -55,6 +56,12 @@ let request ~client ~method_ ~target ~https ~version ~headers server_stream = set_https request https; request +let request_with_body ?method_ ?target ?version ?headers body = + (* TODO Streams. *) + let client_stream = Stream.(stream no_reader no_writer) + and server_stream = Stream.(stream (string body) no_writer) in + Dream.request ?method_ ?target ?version ?headers client_stream server_stream + let html ?status ?code ?headers body = @@ -74,3 +81,48 @@ let json ?status ?code ?headers body = Dream.response ?status ?code ?headers client_stream server_stream in Dream.set_header response "Content-Type" Formats.application_json; Lwt.return response + +let response_with_body ?status ?code ?headers body = + (* TODO Streams. *) + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + Dream.response ?status ?code ?headers client_stream server_stream + +let respond ?status ?code ?headers body = + let client_stream = Stream.(stream (string body) no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + Dream.response ?status ?code ?headers client_stream server_stream + |> Lwt.return + +(* TODO Actually use the request and extract the site prefix. *) +let redirect ?status ?code ?headers _request location = + let status = (status :> Status.redirection option) in + let status = + match status, code with + | None, None -> Some (`See_Other) + | _ -> status + in + (* TODO The streams. *) + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + let response = + Dream.response ?status ?code ?headers client_stream server_stream in + Dream.set_header response "Location" location; + Lwt.return response + +let stream ?status ?code ?headers f = + (* TODO Streams. *) + let client_stream = Stream.(stream empty no_writer) + and server_stream = Stream.(stream no_reader no_writer) in + let response = + Dream.response ?status ?code ?headers client_stream server_stream in + Dream.set_stream response; + (* TODO Should set up an error handler for this. *) + Lwt.async (fun () -> f response); + Lwt.return response + +let empty ?headers status = + respond ?headers ~status "" + +let not_found _ = + respond ~status:`Not_Found "" From 1da1452bfc735ea0f9bb381c4532142ad7b44640 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Dec 2021 08:59:48 +0300 Subject: [PATCH 097/312] Compose dream.ml explicitly (delete most includes) --- src/dream.ml | 451 +++++++++++++++++++++++++++++++++++---------- src/dream.mli | 4 +- src/sql/session.ml | 2 +- 3 files changed, 358 insertions(+), 99 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 6e7efd7c..a81bf0f9 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -5,161 +5,418 @@ -include Dream_pure.Status -include Dream_pure.Stream -include Dream_pure.Method -include Dream_pure.Inmost -include Dream_pure.Formats - -include Dream__server.Log -include Dream__server.Log.Make (Ptime_clock) -(* Initalize logs with the default reporter which uses [Ptime_clock], this - function is a part of [Dream__server.Log.Make], it's why it is not prepended - by a module name. *) -let () = - initialize ~setup_outputs:Fmt_tty.setup_std_outputs -include Dream__server.Echo +module Catch = Dream__server.Catch +module Cipher = Dream__cipher.Cipher +module Cookie = Dream__server.Cookie +module Content_length = Dream__server.Content_length +module Csrf = Dream__server.Csrf +module Dream = Dream_pure.Inmost +module Echo = Dream__server.Echo +module Error_handler = Dream__http.Error_handler +module Flash = Dream__server.Flash +module Form = Dream__server.Form +module Formats = Dream_pure.Formats +module Graphql = Dream__graphql.Graphql +module Helpers = Dream__server.Helpers +module Http = Dream__http.Http +module Lowercase_headers = Dream__server.Lowercase_headers +module Method = Dream_pure.Method +module Origin_referrer_check = Dream__server.Origin_referrer_check +module Query = Dream__server.Query +module Random = Dream__cipher.Random +module Router = Dream__server.Router +module Site_prefix = Dream__server.Site_prefix +module Sql = Dream__sql.Sql +module Sql_session = Dream__sql.Session +module Static = Dream__unix.Static +module Status = Dream_pure.Status +module Stream = Dream_pure.Stream +module Tag = Dream__server.Tag +module Upload = Dream__server.Upload + + + +(* Initialize clock handling and random number generator. These are + platform-specific, differing between Unix and Mirage. This is the Unix + initialization. *) + +module Log = +struct + include Dream__server.Log + include Dream__server.Log.Make (Ptime_clock) +end let default_log = - Dream__server.Log.sub_log (Logs.Src.name Logs.default) + Log.sub_log (Logs.Src.name Logs.default) + +let () = + Log.initialize ~setup_outputs:Fmt_tty.setup_std_outputs + +let now () = + Ptime.to_float_s (Ptime.v (Ptime_clock.now_d_ps ())) + +let () = + Random.initialize Mirage_crypto_rng_lwt.initialize + +module Session = +struct + include Dream__server.Session + include Dream__server.Session.Make (Ptime_clock) +end + + + +(* Types *) + +type request = Dream.request +type response = Dream.response +type handler = Dream.handler +type middleware = Dream.middleware +type route = Router.route + +type 'a message = 'a Dream.message +type client = Dream.client +type server = Dream.server +type 'a promise = 'a Dream.promise + + + +(* Methods *) + +include Method + + + +(* Status codes *) + +include Status + + + +(* Requests *) + +let client = Helpers.client +let https = Helpers.https +let method_ = Dream.method_ +let target = Dream.target +let prefix = Router.prefix +let path = Router.path +let version = Dream.version +let set_client = Helpers.set_client +let set_method_ = Dream.set_method_ +let query = Query.query +let queries = Query.queries +let all_queries = Query.all_queries + + + +(* Responses *) + +let response = Helpers.response_with_body +let respond = Helpers.respond +let html = Helpers.html +let json = Helpers.json +let redirect = Helpers.redirect +let empty = Helpers.empty +let stream = Helpers.stream +let status = Dream.status + + + +(* Headers *) + +let header = Dream.header +let headers = Dream.headers +let all_headers = Dream.all_headers +let has_header = Dream.has_header +let add_header = Dream.add_header +let drop_header = Dream.drop_header +let set_header = Dream.set_header + + + +(* Cookies *) + +let set_cookie = Cookie.set_cookie +let drop_cookie = Cookie.drop_cookie +let cookie = Cookie.cookie +let all_cookies = Cookie.all_cookies + + + +(* Bodies *) + +let body = Dream.body +let set_body = Dream.set_body +let read = Dream.read +let set_stream = Dream.set_stream +let write = Dream.write +let flush = Dream.flush +let close_stream = Dream.close_stream +type buffer = Stream.buffer +type stream = Stream.stream +let client_stream = Dream.client_stream +let server_stream = Dream.server_stream +let set_client_stream = Dream.set_client_stream +let next = Dream.next +let write_buffer = Dream.write_buffer + + + +(* JSON *) + +let origin_referrer_check = Origin_referrer_check.origin_referrer_check + + + +(* Forms *) + +type 'a form_result = 'a Form.form_result +let form = Form.form ~now +type multipart_form = Upload.multipart_form +let multipart = Upload.multipart ~now +type part = Upload.part +let upload = Upload.upload +let upload_part = Upload.upload_part +type csrf_result = Csrf.csrf_result +let csrf_token = Csrf.csrf_token ~now +let verify_csrf_token = Csrf.verify_csrf_token ~now + + + +(* Templates *) + +let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = + Tag.form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request + + +(* Middleware *) + +let no_middleware = Dream.no_middleware +let pipeline = Dream.pipeline + + + +(* Routing *) + +let router = Router.router +let get = Router.get +let post = Router.post +let put = Router.put +let delete = Router.delete +let head = Router.head +let connect = Router.connect +let options = Router.options +let trace = Router.trace +let patch = Router.patch +let any = Router.any +let not_found = Helpers.not_found +let param = Router.param +let scope = Router.scope +let no_route = Router.no_route + + + +(* Static files *) + +let static = Static.static +let from_filesystem = Static.from_filesystem +let mime_lookup = Static.mime_lookup + + + +(* Sessions *) + +let session = Session.session +let put_session = Session.put_session +let all_session_values = Session.all_session_values +let invalidate_session = Session.invalidate_session +let memory_sessions = Session.memory_sessions +let cookie_sessions = Session.cookie_sessions +let sql_sessions = Sql_session.sql_sessions +let session_id = Session.session_id +let session_label = Session.session_label +let session_expires_at = Session.session_expires_at + + + +(* Flash messages *) + +let flash_messages = Flash.flash_messages +let flash = Flash.flash +let put_flash = Flash.put_flash + + + +(* WebSockets *) + +type websocket = Dream.websocket +let websocket = Dream.websocket +let send = Dream.send +let receive = Dream.receive +let close_websocket = Dream.close_websocket + + + +(* GraphQL *) + +let graphql = Graphql.graphql +let graphiql = Graphql.graphiql + + + +(* SQL *) + +let sql_pool = Sql.sql_pool +let sql = Sql.sql + + + +(* Logging *) + +let logger = Log.logger +let log = Log.convenience_log +type ('a, 'b) conditional_log = ('a, 'b) Log.conditional_log +type log_level = Log.log_level let error = default_log.error let warning = default_log.warning let info = default_log.info let debug = default_log.debug +type sub_log = Log.sub_log = { + error : 'a. ('a, unit) conditional_log; + warning : 'a. ('a, unit) conditional_log; + info : 'a. ('a, unit) conditional_log; + debug : 'a. ('a, unit) conditional_log; +} +let sub_log = Log.sub_log +let initialize_log = Log.initialize_log +let set_log_level = Log.set_log_level -include Dream__server.Router -include Dream__unix.Static -include Dream__cipher.Cipher -include Dream__server.Cookie -include Dream__server.Session -include Dream__server.Session.Make (Ptime_clock) -let sql_sessions = Dream__sql.Session.middleware +(* Errors *) -include Dream__server.Flash +type error = Catch.error = { + condition : [ + | `Response of Dream.response + | `String of string + | `Exn of exn + ]; + layer : [ + | `App + | `HTTP + | `HTTP2 + | `TLS + | `WebSocket + ]; + caused_by : [ + | `Server + | `Client + ]; + request : Dream.request option; + response : Dream.response option; + client : string option; + severity : Log.log_level; + will_send_response : bool; +} +type error_handler = Catch.error_handler +let error_template = Error_handler.customize +let debug_error_handler = Error_handler.debug_error_handler +let catch = Catch.catch -include Dream__server.Origin_referrer_check -include Dream__server.Form -include Dream__server.Upload -include Dream__server.Csrf -let content_length = - Dream__server.Content_length.content_length -include Dream__graphql.Graphql -include Dream__sql.Sql +(* Servers *) -include Dream__http.Http +let run = Http.run +let serve = Http.serve +let lowercase_headers = Lowercase_headers.lowercase_headers +let content_length = Content_length.content_length +let with_site_prefix = Site_prefix.with_site_prefix -include Dream__server.Lowercase_headers -include Dream__server.Catch -include Dream__server.Site_prefix -let debug_error_handler = - Dream__http.Error_handler.debug_error_handler -let error_template = - Dream__http.Error_handler.customize -let () = Dream__cipher.Random.initialize Mirage_crypto_rng_lwt.initialize +(* Web formats *) -let random = - Dream__cipher.Random.random +include Formats -(* TODO Restore the ability to test with a prefix and re-enable the - corresponding tests. *) -let test ?(prefix = "") handler request = - let app = - content_length - @@ with_site_prefix prefix - @@ handler - in - Lwt_main.run (app request) -let log = - Dream__server.Log.convenience_log +(* Cryptography *) -include Dream__server.Tag +let set_secret = Cipher.set_secret +let random = Random.random +let encrypt = Cipher.encrypt +let decrypt = Cipher.decrypt -let respond = - Dream__server.Helpers.respond -let redirect = - Dream__server.Helpers.redirect -let stream = - Dream__server.Helpers.stream +(* Custom fields *) -let empty = - Dream__server.Helpers.empty +type 'a field = 'a Dream.field +let new_field = Dream.new_field +let field = Dream.field +let set_field = Dream.set_field -let not_found = - Dream__server.Helpers.not_found -let now () = Ptime.to_float_s (Ptime.v (Ptime_clock.now_d_ps ())) -let form = form ~now -let multipart = multipart ~now -let csrf_token = csrf_token ~now -let verify_csrf_token = verify_csrf_token ~now -let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = - form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request +(* Testing. *) + +let request = Helpers.request_with_body + +(* TODO Restore the ability to test with a prefix and re-enable the + corresponding tests. *) +let test ?(prefix = "") handler request = + let app = + Content_length.content_length + @@ Site_prefix.with_site_prefix prefix + @@ handler + in + + Lwt_main.run (app request) -let client = - Dream__server.Helpers.client -let set_client = - Dream__server.Helpers.set_client -let https = - Dream__server.Helpers.https -let html = - Dream__server.Helpers.html -let json = - Dream__server.Helpers.json +let sort_headers = Dream.sort_headers +let echo = Echo.echo -include Dream__server.Query -let request = - Dream__server.Helpers.request_with_body -let response = - Dream__server.Helpers.response_with_body +(* Deprecated helpers. *) let with_client client message = - set_client message client; + Helpers.set_client message client; message let with_method_ method_ message = - set_method_ message method_; + Dream.set_method_ message method_; message let with_version version message = - set_version message version; + Dream.set_version message version; message let with_path path message = - set_path message path; + Router.set_path message path; message let with_header name value message = - set_header message name value; + Dream.set_header message name value; message let with_body body message = - set_body message body; + Dream.set_body message body; message let with_stream message = - set_stream message; + Dream.set_stream message; message -type 'a local = 'a field -let new_local = new_field -let local = field +type 'a local = 'a Dream.field +let new_local = Dream.new_field +let local = Dream.field let with_local key value message = - set_field message key value; + Dream.set_field message key value; message let first message = diff --git a/src/dream.mli b/src/dream.mli index 7330168c..37b65814 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -176,6 +176,8 @@ val normalize_method : [< method_ ] -> method_ Dream.normalize_method (`Method "GET") = `GET ]} *) + + (** {1:status_codes Status codes} *) type informational = [ @@ -786,8 +788,8 @@ type buffer = streaming" should be promoted to a top-level section, Streaming. *) type stream -val server_stream : 'a message -> stream val client_stream : 'a message -> stream +val server_stream : 'a message -> stream (* TODO Document that this is for middlewares that are transforming a response stream or a WebSocket. *) val set_client_stream : 'a message -> stream -> unit diff --git a/src/sql/session.ml b/src/sql/session.ml index 5bf01527..57b44929 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -198,5 +198,5 @@ let back_end lifetime = { send; } -let middleware ?(lifetime = Session.two_weeks) = +let sql_sessions ?(lifetime = Session.two_weeks) = Session.middleware (back_end lifetime) From d1ba236f1d66bb5549ace53a92b11b10dbd36713 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 18:12:18 +0300 Subject: [PATCH 098/312] Expose Stream API and reinterpret WebSockets --- src/dream.ml | 39 ++++++---- src/dream.mli | 132 +++++++++++++++++++++------------ src/graphql/graphql.ml | 58 +++++++-------- src/http/http.ml | 161 ++++++++++++++++------------------------- src/pure/inmost.ml | 107 +++++---------------------- src/pure/inmost.mli | 33 +-------- src/pure/stream.ml | 22 +++++- src/pure/stream.mli | 9 +-- src/server/helpers.ml | 41 +++++++++-- 9 files changed, 273 insertions(+), 329 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index a81bf0f9..0254ac88 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -119,6 +119,7 @@ let json = Helpers.json let redirect = Helpers.redirect let empty = Helpers.empty let stream = Helpers.stream +let websocket = Helpers.websocket let status = Dream.status @@ -149,17 +150,22 @@ let all_cookies = Cookie.all_cookies let body = Dream.body let set_body = Dream.set_body let read = Dream.read -let set_stream = Dream.set_stream let write = Dream.write let flush = Dream.flush -let close_stream = Dream.close_stream +let close = Dream.close type buffer = Stream.buffer type stream = Stream.stream let client_stream = Dream.client_stream let server_stream = Dream.server_stream let set_client_stream = Dream.set_client_stream -let next = Dream.next -let write_buffer = Dream.write_buffer +let set_server_stream = Dream.set_server_stream +let read_stream = Stream.read +let ready_stream = Stream.ready +let write_stream = Stream.write +let flush_stream = Stream.flush +let ping_stream = Stream.ping +let pong_stream = Stream.pong +let close_stream = Stream.close @@ -249,16 +255,6 @@ let put_flash = Flash.put_flash -(* WebSockets *) - -type websocket = Dream.websocket -let websocket = Dream.websocket -let send = Dream.send -let receive = Dream.receive -let close_websocket = Dream.close_websocket - - - (* GraphQL *) let graphql = Graphql.graphql @@ -408,9 +404,22 @@ let with_body body message = message let with_stream message = - Dream.set_stream message; message +let write_buffer ?(offset = 0) ?length message chunk = + let length = + match length with + | Some length -> length + | None -> Bigstringaf.length chunk - offset + in + let string = Bigstringaf.substring chunk ~off:offset ~len:length in + write ~kind:`Binary message string + +type websocket = Dream.response +let send = write +let receive = read +let close_websocket = close + type 'a local = 'a Dream.field let new_local = Dream.new_field let local = Dream.field diff --git a/src/dream.mli b/src/dream.mli index 37b65814..af2448dc 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -528,6 +528,22 @@ val stream : Dream.close_stream response) ]} *) +val websocket : + ?headers:(string * string) list -> + (response -> unit promise) -> response promise +(** Creates a fresh [101 Switching Protocols] response. Once this response is + returned to Dream's HTTP layer, the callback is passed a new + {!type-websocket}, and the application can begin using it. See example + {{:https://github.com/aantron/dream/tree/master/example/k-websocket#files} + [k-websocket]} \[{{:http://dream.as/k-websocket} playground}\]. + + {[ + let my_handler = fun request -> + Dream.websocket (fun websocket -> + let%lwt () = Dream.send websocket "Hello, world!" in + Dream.close_websocket websocket); + ]} *) + val status : response -> status (** Response {!type-status}. For example, [`OK]. *) @@ -721,7 +737,7 @@ val all_cookies : request -> (string * string) list (** {1 Bodies} *) -val body : 'a message -> string promise +val body : request -> string promise (** Retrieves the entire body. See example {{:https://github.com/aantron/dream/tree/master/example/6-echo#files} [6-echo]}. *) @@ -738,34 +754,32 @@ val with_body : string -> response -> response (** {2 Streaming} *) -val read : request -> string option promise +val read : 'a message -> string option promise (** Retrieves a body chunk. The chunk is not buffered, thus it can only be read once. See example {{:https://github.com/aantron/dream/tree/master/example/j-stream#files} [j-stream]}. *) - -val set_stream : response -> unit -(** Makes the {!type-response} ready for stream writing with {!Dream.write}. You - should return it from your handler soon after — only one call to - {!Dream.write} will be accepted before then. See {!Dream.stream} for a more - convenient wrapper. *) +(* TODO Document difference between receiving a request and receiving on a + WebSocket. *) (**/**) val with_stream : response -> response [@@ocaml.deprecated -" Use Dream.set_stream instead. See +" Use Dream.stream instead. See https://aantron.github.io/dream/#val-set_stream"] (**/**) -val write : response -> string -> unit promise +val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise (** Streams out the string. The promise is fulfilled when the response can accept more writes. *) +(* TODO Document clearly which of the writing functions can raise exceptions. *) val flush : response -> unit promise (** Flushes write buffers. Data is sent to the client. *) -val close_stream : response -> unit promise +val close : ?code:int -> 'a message -> unit promise (** Finishes the response stream. *) +(* TODO Fix comment. *) (** {2 Low-level streaming} *) @@ -794,10 +808,11 @@ val server_stream : 'a message -> stream stream or a WebSocket. *) val set_client_stream : 'a message -> stream -> unit (* TODO Normalize with with_stream, or add a separate with_server_stream. *) +val set_server_stream : 'a message -> stream -> unit (* TODO Probably even close can be made optional. exn can be made optional. *) (* TODO Argument order? *) -val next : +val read_stream : stream -> data:(buffer -> int -> int -> bool -> bool -> unit) -> close:(int -> unit) -> @@ -811,10 +826,33 @@ val next : - [~close] if close is requested, and - [~exn] to report an exception. *) +val ready_stream : + stream -> close:(int -> unit) -> (unit -> unit) -> unit + +val write_stream : + stream -> buffer -> int -> int -> bool -> bool -> close:(int -> unit) -> (unit -> unit) -> unit + +val flush_stream : + stream -> close:(int -> unit) -> (unit -> unit) -> unit + +val ping_stream : + stream -> buffer -> int -> int -> close:(int -> unit) -> (unit -> unit) -> unit + +val pong_stream : + stream -> buffer -> int -> int -> close:(int -> unit) -> (unit -> unit) -> unit + +val close_stream : + stream -> int -> unit + +(**/**) val write_buffer : ?offset:int -> ?length:int -> response -> buffer -> unit promise -(** Streams out the {!buffer} slice. [~offset] defaults to zero. [~length] - defaults to the length of the {!buffer}, minus [~offset]. *) +[@@ocaml.deprecated +" Use Dream.write_stream. See + https://aantron.github.io/dream/#val-write_stream"] +(**/**) + +(* TODO Ergonomics of this stream surface API. *) @@ -1517,31 +1555,21 @@ val put_flash : request -> string -> string -> unit -(** {1 WebSockets} *) - -type websocket +(**/**) +type websocket = response +[@@ocaml.deprecated +" Use Dream.stream. See + https://aantron.github.io/dream/#type-stream"] (** A WebSocket connection. See {{:https://tools.ietf.org/html/rfc6455} RFC 6455} and {{:https://developer.mozilla.org/en-US/docs/Web/API/WebSockets_API} MDN}. *) +(**/**) -val websocket : - ?headers:(string * string) list -> - (websocket -> unit promise) -> - response promise -(** Creates a fresh [101 Switching Protocols] response. Once this response is - returned to Dream's HTTP layer, the callback is passed a new - {!type-websocket}, and the application can begin using it. See example - {{:https://github.com/aantron/dream/tree/master/example/k-websocket#files} - [k-websocket]} \[{{:http://dream.as/k-websocket} playground}\]. - - {[ - let my_handler = fun request -> - Dream.websocket (fun websocket -> - let%lwt () = Dream.send websocket "Hello, world!" in - Dream.close_websocket websocket); - ]} *) - -val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise +(**/**) +val send : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise +[@@ocaml.deprecated +" Use Dream.write. See + https://aantron.github.io/dream/#val-write"] (** Sends a single message. The WebSocket is ready another message when the promise resolves. @@ -1554,14 +1582,23 @@ val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise {{:https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/binaryType} MDN, [WebSocket.binaryType]}. *) -val receive : websocket -> string option promise +val receive : response -> string option promise +[@@ocaml.deprecated +" Use Dream.read. See + https://aantron.github.io/dream/#val-read"] (** Retrieves a message. If the WebSocket is closed before a complete message arrives, the result is [None]. *) +(**/**) -val close_websocket : ?code:int -> websocket -> unit promise +(**/**) +val close_websocket : ?code:int -> response -> unit promise +[@@ocaml.deprecated +" Use Dream.close. See + https://aantron.github.io/dream/#val-close"] (** Closes the WebSocket. [~code] is usually not necessary, but is needed for some protocols based on WebSockets. See {{:https://tools.ietf.org/html/rfc6455#section-7.4} RFC 6455 §7.4}. *) +(**/**) @@ -2356,7 +2393,9 @@ type 'a field (**/**) type 'a local = 'a field -[@@ocaml.deprecated " Renamed to type Dream.field."] +[@@ocaml.deprecated +" Renamed to type Dream.field. See + https://aantron.github.io/dream/#type-field"] (**/**) val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field @@ -2366,7 +2405,9 @@ val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field (**/**) val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field -[@@ocaml.deprecated " Renamed to Dream.new_field."] +[@@ocaml.deprecated +" Renamed to Dream.new_field. See + https://aantron.github.io/dream/#val-new_field"] (**/**) val field : 'b message -> 'a field -> 'a option @@ -2374,22 +2415,19 @@ val field : 'b message -> 'a field -> 'a option (**/**) val local : 'b message -> 'a field -> 'a option -[@@ocaml.deprecated " Renamed to Dream.field."] +[@@ocaml.deprecated +" Renamed to Dream.field. See + https://aantron.github.io/dream/#val-field"] (**/**) val set_field : 'b message -> 'a field -> 'a -> unit (** Sets the per-message variable to the value. *) -(**/**) -val set_field : 'b message -> 'a field -> 'a -> unit -[@@ocaml.deprecated " Renamed to Dream.set_field."] -(**/**) - (**/**) val with_local : 'a field -> 'a -> 'b message -> 'b message [@@ocaml.deprecated -" Use Dream.set_local instead. See - https://aantron.github.io/dream/#val-set_local"] +" Use Dream.set_field instead. See + https://aantron.github.io/dream/#val-set_field"] (**/**) diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index b8f6b89c..8f1014b3 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -78,14 +78,10 @@ let run_query make_context schema request json = let operation_id json = Yojson.Basic.Util.(json |> member "id" |> to_string_option) -let close_and_clean ?code subscriptions websocket = - match%lwt Dream.close_websocket ?code websocket with - | _ -> - Hashtbl.iter (fun _ close -> close ()) subscriptions; - Lwt.return_unit - | exception _ -> - Hashtbl.iter (fun _ close -> close ()) subscriptions; - Lwt.return_unit +let close_and_clean ?code subscriptions response = + let%lwt () = Dream.close ?code response in + Hashtbl.iter (fun _ close -> close ()) subscriptions; + Lwt.return_unit let ack_message = `Assoc [ @@ -118,12 +114,12 @@ let complete_message id = (* TODO Take care to pass around the request Lwt.key in async, etc. *) (* TODO Test client complete racing against a stream. *) -let handle_over_websocket make_context schema subscriptions request websocket = +let handle_over_websocket make_context schema subscriptions request response = let rec loop inited = - match%lwt Dream.receive websocket with + match%lwt Dream.read response with | None -> log.info (fun log -> log ~request "GraphQL WebSocket closed by client"); - close_and_clean subscriptions websocket + close_and_clean subscriptions response | Some message -> log.debug (fun log -> log ~request "Message '%s'" message); @@ -132,13 +128,13 @@ let handle_over_websocket make_context schema subscriptions request websocket = match Yojson.Basic.from_string message with | exception _ -> log.warning (fun log -> log ~request "GraphQL message is not JSON"); - close_and_clean subscriptions websocket ~code:4400 + close_and_clean subscriptions response ~code:4400 | json -> match Yojson.Basic.Util.(json |> member "type" |> to_string_option) with | None -> log.warning (fun log -> log ~request "GraphQL message lacks a type"); - close_and_clean subscriptions websocket ~code:4400 + close_and_clean subscriptions response ~code:4400 | Some message_type -> match message_type with @@ -146,24 +142,24 @@ let handle_over_websocket make_context schema subscriptions request websocket = | "connection_init" -> if inited then begin log.warning (fun log -> log ~request "Duplicate connection_init"); - close_and_clean subscriptions websocket ~code:4429 + close_and_clean subscriptions response ~code:4429 end else begin - let%lwt () = Dream.send websocket ack_message in + let%lwt () = Dream.write response ack_message in loop true end | "complete" -> if not inited then begin log.warning (fun log -> log ~request "complete before connection_init"); - close_and_clean subscriptions websocket ~code:4401 + close_and_clean subscriptions response ~code:4401 end else begin match operation_id json with | None -> log.warning (fun log -> log ~request "client complete: operation id missing"); - close_and_clean subscriptions websocket ~code:4400 + close_and_clean subscriptions response ~code:4400 | Some id -> begin match Hashtbl.find_opt subscriptions id with | None -> () @@ -176,14 +172,14 @@ let handle_over_websocket make_context schema subscriptions request websocket = if not inited then begin log.warning (fun log -> log ~request "subscribe before connection_init"); - close_and_clean subscriptions websocket ~code:4401 + close_and_clean subscriptions response ~code:4401 end else begin match operation_id json with | None -> log.warning (fun log -> log ~request "subscribe: operation id missing"); - close_and_clean subscriptions websocket ~code:4400 + close_and_clean subscriptions response ~code:4400 | Some id -> let payload = json |> Yojson.Basic.Util.member "payload" in @@ -197,13 +193,13 @@ let handle_over_websocket make_context schema subscriptions request websocket = log.warning (fun log -> log ~request "subscribe: error %s" (Yojson.Basic.to_string json)); - Dream.send websocket (error_message id json) + Dream.write response (error_message id json) (* It's not clear that this case ever occurs, because graphql-ws is only used for subscriptions, at the protocol level. *) | Ok (`Response json) -> - let%lwt () = Dream.send websocket (data_message id json) in - let%lwt () = Dream.send websocket (complete_message id) in + let%lwt () = Dream.write response (data_message id json) in + let%lwt () = Dream.write response (complete_message id) in Lwt.return_unit | Ok (`Stream (stream, close)) -> @@ -211,7 +207,7 @@ let handle_over_websocket make_context schema subscriptions request websocket = | true -> log.warning (fun log -> log ~request "subscribe: duplicate operation id"); - close_and_clean subscriptions websocket ~code:4409 + close_and_clean subscriptions response ~code:4409 | false -> Hashtbl.replace subscriptions id close; @@ -220,15 +216,15 @@ let handle_over_websocket make_context schema subscriptions request websocket = let%lwt () = stream |> Lwt_stream.iter_s (function | Ok json -> - Dream.send websocket (data_message id json) + Dream.write response (data_message id json) | Error json -> log.warning (fun log -> log ~request "Subscription: error %s" (Yojson.Basic.to_string json)); - Dream.send websocket (error_message id json)) + Dream.write response (error_message id json)) in - let%lwt () = Dream.send websocket (complete_message id) in + let%lwt () = Dream.write response (complete_message id) in Hashtbl.remove subscriptions id; Lwt.return_unit @@ -244,12 +240,12 @@ let handle_over_websocket make_context schema subscriptions request websocket = try%lwt let%lwt () = - Dream.send - websocket + Dream.write + response (error_message id (make_error "Internal Server Error")) in if !subscribed then - Dream.send websocket (complete_message id) + Dream.write response (complete_message id) else Lwt.return_unit with _ -> @@ -262,7 +258,7 @@ let handle_over_websocket make_context schema subscriptions request websocket = | message_type -> log.warning (fun log -> log ~request "Unknown WebSocket message type '%s'" message_type); - close_and_clean subscriptions websocket ~code:4400 + close_and_clean subscriptions response ~code:4400 in loop false @@ -281,7 +277,7 @@ let graphql make_context schema = fun request -> and protocol = Dream.header request "Sec-WebSocket-Protocol" in begin match upgrade, protocol with | Some "websocket", Some "graphql-transport-ws" -> - Dream.websocket + Helpers.websocket ~headers:["Sec-WebSocket-Protocol", "graphql-transport-ws"] (handle_over_websocket make_context schema (Hashtbl.create 16) request) | _ -> diff --git a/src/http/http.ml b/src/http/http.ml index 20d6f354..f6384c07 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -38,7 +38,7 @@ let sha1 s = let websocket_log = Log.sub_log "dream.websocket" -let websocket_handler user's_websocket_handler socket = +let websocket_handler response socket = (* Queue of received frames. There doesn't appear to be a nice way to achieve backpressure with the current API of websocket/af, so that will have to be @@ -187,21 +187,6 @@ let websocket_handler user's_websocket_handler socket = let bytes_since_flush = ref 0 in - (* TODO Not a correct implementation. Need to test moving the flush logic - from [write] to [ready], essentially. Alternatively, can use a pipe and its - logic for turning a writer into a reader. The memory impact is probably the - same. However, this is best done after the duplex stream clarification - commit, since that will change which streams do what in responses. It will - probably force usage of pipes anyway, so that will make piggy-backing on - pipes the natural solution. *) - (* TODO Can probably also remove val Stream.writer at that point. *) - let ready ~close ok = - if !closed then - close !close_code - else - ok () - in - let flush ~close ok = bytes_since_flush := 0; if !closed then @@ -210,56 +195,6 @@ let websocket_handler user's_websocket_handler socket = Websocketaf.Wsd.flushed socket ok in - let write buffer offset length binary fin ~close ok = - (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) - if not fin then - websocket_log.error (fun log -> - log "Non-FIN frames not yet supported"); - let kind = if binary then `Binary else `Text in - if !closed then - close !close_code - else begin - Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; - bytes_since_flush := !bytes_since_flush + length; - if !bytes_since_flush >= 4096 then - flush ~close ok - else - ok () - end - in - - let ping _buffer _offset length ~close ok = - if length > 125 then - raise (Failure "Ping payload cannot exceed 125 bytes"); - (* See https://github.com/anmonteiro/websocketaf/issues/36. *) - if length > 0 then - websocket_log.warning (fun log -> - log "Ping with non-empty payload not yet supported"); - if !closed then - close !close_code - else begin - Websocketaf.Wsd.send_ping socket; - ok () - end - in - - let pong _buffer _offset length ~close ok = - (* TODO Is there any way for the peer to send a ping payload with more than - 125 bytes, forcing a too-large pong and an exception? *) - if length > 125 then - raise (Failure "Pong payload cannot exceed 125 bytes"); - (* See https://github.com/anmonteiro/websocketaf/issues/36. *) - if length > 0 then - websocket_log.warning (fun log -> - log "Pong with non-empty payload not yet supported"); - if !closed then - close !close_code - else begin - Websocketaf.Wsd.send_pong socket; - ok () - end - in - let close code = if not !closed then begin (* TODO Really need to work out the "close handshake" and how it is @@ -269,20 +204,60 @@ let websocket_handler user's_websocket_handler socket = end in - let reader = Stream.reader ~read ~close - and writer = Stream.writer ~ready ~write ~flush ~ping ~pong ~close in - let websocket = Stream.stream reader writer in - (* TODO Change WebSockets to use two pipes in the response body, rather than - a weird stream hanging out in the heap. That way, a client and server can - immediately communicate with each other if they are in process, without the - need to interpet the WebSocket response with an HTTP layer. This will also - simplify the WebSocket writing code, as this HTTP adapter code will read - from a pipe rather than implement a writer from scratch. At that point, - Stream.writer can be removed from stream.mli. *) - - (* TODO Needs error handling like the top-level app has! *) - Lwt.async (fun () -> - user's_websocket_handler websocket); + let reader = Stream.reader ~read ~close in + Stream.forward reader (Dream.client_stream response); + + let rec outgoing_loop () = + Stream.read + (Dream.client_stream response) + ~data:(fun buffer offset length binary fin -> + (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) + if not fin then + websocket_log.error (fun log -> + log "Non-FIN frames not yet supported"); + let kind = if binary then `Binary else `Text in + if !closed then + close !close_code + else begin + Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; + bytes_since_flush := !bytes_since_flush + length; + if !bytes_since_flush >= 4096 then + flush ~close outgoing_loop + else + outgoing_loop () + end) + ~close + ~flush:(fun () -> flush ~close outgoing_loop) + ~ping:(fun _buffer _offset length -> + if length > 125 then + raise (Failure "Ping payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + if length > 0 then + websocket_log.warning (fun log -> + log "Ping with non-empty payload not yet supported"); + if !closed then + close !close_code + else begin + Websocketaf.Wsd.send_ping socket; + outgoing_loop () + end) + ~pong:(fun _buffer _offset length -> + (* TODO Is there any way for the peer to send a ping payload with more + than 125 bytes, forcing a too-large pong and an exception? *) + if length > 125 then + raise (Failure "Pong payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + if length > 0 then + websocket_log.warning (fun log -> + log "Pong with non-empty payload not yet supported"); + if !closed then + close !close_code + else begin + Websocketaf.Wsd.send_pong socket; + outgoing_loop () + end) + in + outgoing_loop (); Websocketaf.Server_connection.{frame; eof} @@ -394,29 +369,15 @@ let wrap_handler Lwt.return_unit in - match Dream.is_websocket response with - | None -> - + if not (Helpers.is_websocket response) then forward_response response - - | Some user's_websocket_handler -> - + else begin let error_handler = Error_handler.websocket user's_error_handler request response in - (* TODO This needs to be done in a more disciplined fashion. *) - (* TODO This could be considerably simplified using just a mutable - request_id field in requests. *) - let user's_websocket_handler websocket = - Lwt.with_value - Log.id_lwt_key - (Log.get_request_id ~request ()) - (fun () -> user's_websocket_handler websocket) - in - let proceed () = Websocketaf.Server_connection.create_websocket - ~error_handler (websocket_handler user's_websocket_handler) + ~error_handler (websocket_handler response) |> Gluten.make (module Websocketaf.Server_connection) |> upgrade in @@ -433,6 +394,7 @@ let wrap_handler user's_error_handler request response error_string in forward_response response + end end @@ fun exn -> @@ -521,15 +483,14 @@ let wrap_handler_h2 Lwt.return_unit in - match Dream.is_websocket response with - | None -> + if not (Helpers.is_websocket response) then forward_response response (* TODO DOC H2 appears not to support WebSocket upgrade at present. RFC 8441. *) (* TODO DOC Do we need a CONNECT method? Do users need to be informed of this? *) - | Some _user's_websocket_handler -> + else Lwt.return_unit end diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 24ef3019..9441f2d2 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -17,8 +17,6 @@ struct end module Fields = Hmap.Make (Custom_field_metadata) -type websocket = Stream.stream - type request = client message and response = server message @@ -43,7 +41,6 @@ and client = { and server = { status : status; - websocket : (websocket -> unit Lwt.t) option; } type 'a promise = 'a Lwt.t @@ -131,10 +128,8 @@ let server_stream message = let set_client_stream message client_stream = message.client_stream <- client_stream -(* TODO Pending the dream.mli interface reorganization for the new stream - API. *) -let next = - Stream.read +let set_server_stream message server_stream = + message.server_stream <- server_stream (* Create a fresh ref. The reason this field has a ref is because it might get replaced when a body is forced read. That's not what's happening here - we @@ -160,46 +155,25 @@ let set_body message body = in message.server_stream <- body -(* TODO The critical piece: the pipe should be split between the client and - server streams. adapt.ml should be reading from the client stream. *) -let set_stream message = - let reader, writer = Stream.pipe () in - let client_stream = Stream.stream reader Stream.no_writer in - let server_stream = Stream.stream Stream.no_reader writer in - message.client_stream <- client_stream; - message.server_stream <- server_stream - (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It is hardcoded to true. *) -(* TODO Also expose binary/text. *) -let write message chunk = +(* TODO Also expose binary/text. What should be the default? *) +let write ?kind message chunk = + let binary = + match kind with + | None | Some `Text -> false + | Some `Binary -> true + in let promise, resolver = Lwt.wait () in let length = String.length chunk in let buffer = Bigstringaf.of_string ~off:0 ~len:length chunk in (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write message.server_stream - buffer 0 length true false + buffer 0 length binary false ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) - (Lwt.wakeup_later resolver); - promise - -let write_buffer ?(offset = 0) ?length message chunk = - let promise, resolver = Lwt.wait () in - let length = - match length with - | Some length -> length - | None -> Bigstringaf.length chunk - offset - in - (* TODO Proper handling of close. *) - (* TODO As above, properly expose FIN. *) - (* TODO Also expose binary/text. *) - Stream.write - message.server_stream - chunk offset length true false - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) - (Lwt.wakeup_later resolver); + (fun () -> Lwt.wakeup_later resolver ()); promise (* TODO How are remote closes actually handled? There is no way for http/af to @@ -212,14 +186,11 @@ let flush message = (Lwt.wakeup_later resolver); promise -let close_stream message = - Stream.close message.server_stream 1000; +(* TODO Should close even be promise-valued? *) +let close ?(code = 1000) message = + Stream.close message.server_stream code; Lwt.return_unit -(* TODO Rename. *) -let is_websocket response = - response.specific.websocket - type 'a field = 'a Fields.key @@ -260,7 +231,7 @@ let request (* This function is used for debugging, so it's fine to allocate a fake body and then immediately replace it. *) - let request = { + { specific = { (* TODO Is there a better fake error handler? Maybe this function should come after the response constructors? *) @@ -272,9 +243,7 @@ let request client_stream; server_stream; fields = Fields.empty; - } in - - request + } let response ?status ?code ?(headers = []) client_stream server_stream = @@ -286,56 +255,16 @@ let response | None, Some code -> Status.int_to_status code in - let response = { + { specific = { status; - websocket = None; }; headers; client_stream; server_stream; (* TODO This fully dead stream should be preallocated. *) fields = Fields.empty; - } in - - response - -let websocket ?headers handler = - (* TODO Simplify stream creation. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - let response = - response - ?headers ~status:`Switching_Protocols client_stream server_stream in - let response = - {response with specific = - {response.specific with websocket = Some handler}} - in - Lwt.return response - -let send ?kind websocket message = - let binary = - match kind with - | None | Some `Text -> false - | Some `Binary -> true - in - let promise, resolver = Lwt.wait () in - let length = String.length message in - Stream.write - websocket - (Bigstringaf.of_string ~off:0 ~len:length message) 0 length - binary true - ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) - (Lwt.wakeup_later resolver); - (* TODO The API will likely have to change to report closing. *) - promise - -let receive websocket = - Stream.read_convenience websocket - -let close_websocket ?(code = 1000) websocket = - Stream.close websocket code; - Lwt.return_unit + } let no_middleware handler request = handler request diff --git a/src/pure/inmost.mli b/src/pure/inmost.mli index d57b0b9b..e6089e82 100644 --- a/src/pure/inmost.mli +++ b/src/pure/inmost.mli @@ -70,27 +70,14 @@ val sort_headers : (string * string) list -> (string * string) list val body : 'a message -> string promise val set_body : response -> string -> unit -val read : request -> string option promise -val set_stream : 'a message -> unit -(* TODO Rename set_stream, it makes kind of no sense now. *) -val write : response -> string -> unit promise +val read : 'a message -> string option promise +val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise val flush : response -> unit promise -val close_stream : response -> unit promise -(* TODO This will need to read different streams depending on whether it is - passed a request or a response. *) +val close : ?code:int -> 'a message -> unit promise val client_stream : 'a message -> stream val server_stream : 'a message -> stream val set_client_stream : 'a message -> stream -> unit -val next : - stream -> - data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> - flush:(unit -> unit) -> - ping:(buffer -> int -> int -> unit) -> - pong:(buffer -> int -> int -> unit) -> - unit -val write_buffer : - ?offset:int -> ?length:int -> response -> buffer -> unit promise +val set_server_stream : 'a message -> stream -> unit @@ -99,18 +86,6 @@ val pipeline : middleware list -> middleware -type websocket = stream -val websocket : - ?headers:(string * string) list -> - (websocket -> unit promise) -> - response promise -val send : ?kind:[< `Text | `Binary ] -> websocket -> string -> unit promise -val receive : websocket -> string option promise -val close_websocket : ?code:int -> websocket -> unit promise -val is_websocket : response -> (websocket -> unit promise) option - - - type 'a field val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field val field : 'b message -> 'a field -> 'a option diff --git a/src/pure/stream.ml b/src/pure/stream.ml index ee76347a..89a38501 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -77,9 +77,6 @@ let no_writer = { let reader ~read ~close = {read; close} -let writer ~ready ~write ~flush ~ping ~pong ~close = - {ready; write; flush; ping; pong; close} - let empty = reader ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close 1000) @@ -304,6 +301,25 @@ let pipe () = (reader, writer) +let forward (reader : reader) stream = + let rec loop () = + stream.writer.ready + ~close:reader.close + (fun () -> + reader.read + ~data:(fun buffer offset length binary fin -> + stream.writer.write + buffer offset length binary fin ~close:reader.close loop) + ~close:stream.writer.close + ~flush:(fun () -> + stream.writer.flush ~close:reader.close loop) + ~ping:(fun buffer offset length -> + stream.writer.ping buffer offset length ~close:reader.close loop) + ~pong:(fun buffer offset length -> + stream.writer.pong buffer offset length ~close:reader.close loop)) + in + loop () + let read_convenience stream = let promise, resolver = Lwt.wait () in let close _code = Lwt.wakeup_later resolver None in diff --git a/src/pure/stream.mli b/src/pure/stream.mli index a525f9dc..19fdcf0f 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -54,14 +54,7 @@ val pipe : unit -> reader * writer writing functions. For example, calling {!Stream.flush} on a pipe will cause the reader to call its [~flush] callback. *) -val writer : - ready:write -> - write:(buffer -> int -> int -> bool -> bool -> write) -> - flush:write -> - ping:(buffer -> int -> int -> write) -> - pong:(buffer -> int -> int -> write) -> - close:(int -> unit) -> - writer +val forward : reader -> stream -> unit val no_reader : reader diff --git a/src/server/helpers.ml b/src/server/helpers.ml index e62ccf40..27c48c4f 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -110,15 +110,42 @@ let redirect ?status ?code ?headers _request location = Dream.set_header response "Location" location; Lwt.return response -let stream ?status ?code ?headers f = - (* TODO Streams. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in +let stream ?status ?code ?headers callback = + let reader, writer = Stream.pipe () in + let client_stream = Stream.stream reader Stream.no_writer + and server_stream = Stream.stream Stream.no_reader writer in let response = Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_stream response; - (* TODO Should set up an error handler for this. *) - Lwt.async (fun () -> f response); + (* TODO Should set up an error handler for this. YES. *) + (* TODO Make sure the request id is propagated to the callback. *) + let wrapped_callback _ = Lwt.async (fun () -> callback response) in + Stream.ready server_stream ~close:wrapped_callback wrapped_callback; + Lwt.return response + +let websocket_field = + Dream.new_field + ~name:"dream.websocket" + ~show_value:(Printf.sprintf "%b") + () + +let is_websocket response = + match Dream.field response websocket_field with + | Some true -> true + | _ -> false + +(* TODO Mark the request as a WebSocket request for HTTP. *) +let websocket ?headers callback = + let in_reader, in_writer = Stream.pipe () + and out_reader, out_writer = Stream.pipe () in + let client_stream = Stream.stream out_reader in_writer + and server_stream = Stream.stream in_reader out_writer in + let response = + Dream.response + ~status:`Switching_Protocols ?headers client_stream server_stream in + Dream.set_field response websocket_field true; + (* TODO Make sure the request id is propagated to the callback. *) + let wrapped_callback _ = Lwt.async (fun () -> callback response) in + Stream.ready server_stream ~close:wrapped_callback wrapped_callback; Lwt.return response let empty ?headers status = From a680f4be417ea4d6f085a4d6e0baadba31adad7d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:20:15 +0300 Subject: [PATCH 099/312] Catch up most of the examples --- example/3-router/router.ml | 2 +- example/7-template/template.eml.ml | 2 +- example/8-debug/debug.ml | 2 +- example/9-error/error.eml.ml | 17 +++++------------ example/c-cookie/cookie.ml | 13 +++++++------ example/j-stream/stream.ml | 2 +- example/k-websocket/websocket.eml.ml | 10 +++++----- example/r-advanced-template/template.eml.re | 6 +++--- example/r-template-files/server.re | 2 +- .../r-template-stream/template_stream.eml.re | 2 +- example/w-advanced-template/template.eml.ml | 12 ++++++------ example/w-chat/chat.eml.ml | 18 +++++++++--------- example/w-flash/flash.eml.ml | 2 +- example/w-live-reload/live_reload.ml | 7 +++---- example/w-stress-response/stress_response.ml | 2 +- .../stress_websocket_send.eml.ml | 6 +++--- example/w-template-files/server.ml | 2 +- .../w-template-stream/template_stream.eml.ml | 2 +- example/z-playground/server/playground.ml | 14 +++++++------- 19 files changed, 58 insertions(+), 65 deletions(-) diff --git a/example/3-router/router.ml b/example/3-router/router.ml index f2d45dae..0c0c410f 100644 --- a/example/3-router/router.ml +++ b/example/3-router/router.ml @@ -9,7 +9,7 @@ let () = Dream.get "/echo/:word" (fun request -> - Dream.html (Dream.param "word" request)); + Dream.html (Dream.param request "word")); ] @@ Dream.not_found diff --git a/example/7-template/template.eml.ml b/example/7-template/template.eml.ml index f70a1129..27e7e351 100644 --- a/example/7-template/template.eml.ml +++ b/example/7-template/template.eml.ml @@ -12,7 +12,7 @@ let () = Dream.get "/:word" (fun request -> - Dream.param "word" request + Dream.param request "word" |> render |> Dream.html); diff --git a/example/8-debug/debug.ml b/example/8-debug/debug.ml index 24bd25c3..b1aed12e 100644 --- a/example/8-debug/debug.ml +++ b/example/8-debug/debug.ml @@ -1,5 +1,5 @@ let () = - Dream.run ~debug:true + Dream.run ~error_handler:Dream.debug_error_handler @@ Dream.logger @@ Dream.router [ diff --git a/example/9-error/error.eml.ml b/example/9-error/error.eml.ml index f3565c1e..515091cf 100644 --- a/example/9-error/error.eml.ml +++ b/example/9-error/error.eml.ml @@ -3,23 +3,16 @@ let my_error_template _error debug_info suggested_response = let code = Dream.status_to_int status and reason = Dream.status_to_string status in - suggested_response - |> Dream.with_header "Content-Type" Dream.text_html - |> Dream.with_body begin + Dream.set_header suggested_response "Content-Type" Dream.text_html; + Dream.set_body suggested_response begin

<%i code %> <%s reason %>

- -% begin match debug_info with -% | None -> () -% | Some debug_info -> -
<%s debug_info %>
-% end; - +
<%s debug_info %>
- end - |> Lwt.return + end; + Lwt.return suggested_response let () = Dream.run ~error_handler:(Dream.error_template my_error_template) diff --git a/example/c-cookie/cookie.ml b/example/c-cookie/cookie.ml index 197ef757..73435ada 100644 --- a/example/c-cookie/cookie.ml +++ b/example/c-cookie/cookie.ml @@ -1,15 +1,16 @@ let () = - Dream.run ~secret:"foo" + Dream.run + @@ Dream.set_secret "foo" @@ Dream.logger @@ fun request -> - match Dream.cookie "ui.language" request with + match Dream.cookie request "ui.language" with | Some value -> Printf.ksprintf Dream.html "Your preferred language is %s!" (Dream.html_escape value) | None -> - Dream.response "Set language preference; come again!" - |> Dream.add_header "Content-Type" Dream.text_html - |> Dream.set_cookie "ui.language" "ut-OP" request - |> Lwt.return + let response = Dream.response "Set language preference; come again!" in + Dream.add_header response "Content-Type" Dream.text_html; + Dream.set_cookie response "ui.language" "ut-OP" request; + Lwt.return response diff --git a/example/j-stream/stream.ml b/example/j-stream/stream.ml index e16d30d6..3f9c2477 100644 --- a/example/j-stream/stream.ml +++ b/example/j-stream/stream.ml @@ -2,7 +2,7 @@ let echo request response = let rec loop () = match%lwt Dream.read request with | None -> - Dream.close_stream response + Dream.close response | Some chunk -> let%lwt () = Dream.write response chunk in let%lwt () = Dream.flush response in diff --git a/example/k-websocket/websocket.eml.ml b/example/k-websocket/websocket.eml.ml index 3fdff498..1166c93e 100644 --- a/example/k-websocket/websocket.eml.ml +++ b/example/k-websocket/websocket.eml.ml @@ -28,13 +28,13 @@ let () = Dream.get "/websocket" (fun _ -> - Dream.websocket (fun websocket -> - match%lwt Dream.receive websocket with + Dream.websocket (fun response -> + match%lwt Dream.read response with | Some "Hello?" -> - let%lwt () = Dream.send websocket "Good-bye!" in - Dream.close_websocket websocket + let%lwt () = Dream.write response "Good-bye!" in + Dream.close response | _ -> - Dream.close_websocket websocket)); + Dream.close response)); ] @@ Dream.not_found diff --git a/example/r-advanced-template/template.eml.re b/example/r-advanced-template/template.eml.re index 66715bab..94ad8e49 100644 --- a/example/r-advanced-template/template.eml.re +++ b/example/r-advanced-template/template.eml.re @@ -7,7 +7,7 @@ let render_home = tasks => { <% if (complete) { %> complete! <% } else { %> - not complete + not complete <% }; %>

<% }); %> @@ -21,7 +21,7 @@ let render_task = (tasks, task) => { % (switch (List.find_opt(((task_, _)) => task == task_, tasks)) { -% | Some((name, complete)) => +% | Some((name, complete)) =>

TODO task: <%s name %>, complete: <%B complete %>

% | None =>

Task not found!

@@ -43,7 +43,7 @@ let () = @@ Dream.router([ Dream.get("/", _ => render_home(tasks) |> Dream.html), Dream.get("/:task", request => - Dream.param("task", request) |> render_task(tasks) |> Dream.html + Dream.param(request, "task") |> render_task(tasks) |> Dream.html ), ]) @@ Dream.not_found; diff --git a/example/r-template-files/server.re b/example/r-template-files/server.re index 21bd77f9..656b6c13 100644 --- a/example/r-template-files/server.re +++ b/example/r-template-files/server.re @@ -3,7 +3,7 @@ let () = Dream.logger @@ Dream.router([ Dream.get("/:word", request => - Dream.param("word", request) |> Template.render |> Dream.html + Dream.param(request, "word") |> Template.render |> Dream.html ), ]) @@ Dream.not_found; diff --git a/example/r-template-stream/template_stream.eml.re b/example/r-template-stream/template_stream.eml.re index cf86b796..e51238b3 100644 --- a/example/r-template-stream/template_stream.eml.re +++ b/example/r-template-stream/template_stream.eml.re @@ -15,7 +15,7 @@ let render = response => { }; - Dream.close_stream(response) + Dream.close(response) }; let () = diff --git a/example/w-advanced-template/template.eml.ml b/example/w-advanced-template/template.eml.ml index 45713efa..6d17bd81 100644 --- a/example/w-advanced-template/template.eml.ml +++ b/example/w-advanced-template/template.eml.ml @@ -8,7 +8,7 @@ let render_home tasks = <% if complete then ( %> complete! <% ) else ( %> - not complete + not complete <% ); %>

<% end; %> @@ -20,8 +20,8 @@ let render_home tasks = let render_task tasks task = -% (match List.find_opt (fun (task_, _) -> task = task_) tasks with -% | Some (name, complete) -> +% (match List.find_opt (fun (task_, _) -> task = task_) tasks with +% | Some (name, complete) ->

TODO task: <%s name %>, complete: <%B complete %>

% | None -> begin

Task not found!

@@ -34,7 +34,7 @@ let tasks = [ ("create examples", true); ("publish website", true); ("profit", false); -] +] let () = Dream.run @@ -44,11 +44,11 @@ let () = (fun _ -> render_home tasks |> Dream.html); - + Dream.get "/:task" (fun request -> - Dream.param "task" request + Dream.param request "task" |> render_task tasks |> Dream.html); diff --git a/example/w-chat/chat.eml.ml b/example/w-chat/chat.eml.ml index 3a462b2a..28d15b52 100644 --- a/example/w-chat/chat.eml.ml +++ b/example/w-chat/chat.eml.ml @@ -30,34 +30,34 @@ let home = -let clients = +let clients : (int, Dream.response) Hashtbl.t = Hashtbl.create 5 -let connect = +let track = let last_client_id = ref 0 in fun websocket -> last_client_id := !last_client_id + 1; Hashtbl.replace clients !last_client_id websocket; !last_client_id -let disconnect client_id = +let forget client_id = Hashtbl.remove clients client_id let send message = Hashtbl.to_seq_values clients |> List.of_seq - |> Lwt_list.iter_p (fun client -> Dream.send client message) + |> Lwt_list.iter_p (fun client -> Dream.write client message) -let handle_client websocket = - let client_id = connect websocket in +let handle_client client = + let client_id = track client in let rec loop () = - match%lwt Dream.receive websocket with + match%lwt Dream.read client with | Some message -> let%lwt () = send message in loop () | None -> - disconnect client_id; - Dream.close_websocket websocket + forget client_id; + Dream.close client in loop () diff --git a/example/w-flash/flash.eml.ml b/example/w-flash/flash.eml.ml index b1f4fe4b..1b9cd121 100644 --- a/example/w-flash/flash.eml.ml +++ b/example/w-flash/flash.eml.ml @@ -33,7 +33,7 @@ let () = (fun request -> match%lwt Dream.form request with | `Ok ["text", text] -> - let () = Dream.put_flash "Info" text request in + let () = Dream.put_flash request "Info" text in Dream.redirect request "/result" | _ -> Dream.redirect request "/"); diff --git a/example/w-live-reload/live_reload.ml b/example/w-live-reload/live_reload.ml index 9bfd450b..b5df2343 100644 --- a/example/w-live-reload/live_reload.ml +++ b/example/w-live-reload/live_reload.ml @@ -35,7 +35,7 @@ socket.onclose = function(event) { let inject_live_reload_script inner_handler request = let%lwt response = inner_handler request in - match Dream.header "Content-Type" response with + match Dream.header response "Content-Type" with | Some "text/html; charset=utf-8" -> let%lwt body = Dream.body response in let soup = @@ -51,9 +51,8 @@ let inject_live_reload_script inner_handler request = | Some head -> Soup.create_element "script" ~inner_text:live_reload_script |> Soup.append_child head; - response - |> Dream.with_body (Soup.to_string soup) - |> Lwt.return + Dream.set_body response (Soup.to_string soup); + Lwt.return response end | _ -> diff --git a/example/w-stress-response/stress_response.ml b/example/w-stress-response/stress_response.ml index 553d22ed..29854159 100644 --- a/example/w-stress-response/stress_response.ml +++ b/example/w-stress-response/stress_response.ml @@ -16,7 +16,7 @@ let stress ?(megabytes = 1024) ?(chunk = 64) response = let rec loop sent = if sent >= limit then let%lwt () = Dream.flush response in - let%lwt () = Dream.close_stream response in + let%lwt () = Dream.close response in Lwt.return (Unix.gettimeofday () -. start) else let%lwt () = Dream.write response chunk_a in diff --git a/example/w-stress-websocket-send/stress_websocket_send.eml.ml b/example/w-stress-websocket-send/stress_websocket_send.eml.ml index e9a89ca9..9e17de31 100644 --- a/example/w-stress-websocket-send/stress_websocket_send.eml.ml +++ b/example/w-stress-websocket-send/stress_websocket_send.eml.ml @@ -42,11 +42,11 @@ let stress websocket = let start = Unix.gettimeofday () in let rec loop sent = if sent >= limit then - let%lwt () = Dream.close_websocket websocket in + let%lwt () = Dream.close websocket in Lwt.return (Unix.gettimeofday () -. start) else - let%lwt () = Dream.send websocket frame_a ~kind:`Binary in - let%lwt () = Dream.send websocket frame_b ~kind:`Binary in + let%lwt () = Dream.write websocket frame_a ~kind:`Binary in + let%lwt () = Dream.write websocket frame_b ~kind:`Binary in let%lwt () = Lwt.pause () in loop (sent + frame + frame) in diff --git a/example/w-template-files/server.ml b/example/w-template-files/server.ml index 07cbdb3e..0f56c2f8 100644 --- a/example/w-template-files/server.ml +++ b/example/w-template-files/server.ml @@ -5,7 +5,7 @@ let () = Dream.get "/:word" (fun request -> - Dream.param "word" request + Dream.param request "word" |> Template.render |> Dream.html); diff --git a/example/w-template-stream/template_stream.eml.ml b/example/w-template-stream/template_stream.eml.ml index c617963f..c8033744 100644 --- a/example/w-template-stream/template_stream.eml.ml +++ b/example/w-template-stream/template_stream.eml.ml @@ -15,7 +15,7 @@ let render response = in - Dream.close_stream response + Dream.close response let () = Dream.run diff --git a/example/z-playground/server/playground.ml b/example/z-playground/server/playground.ml index f2918ca3..39f3c111 100644 --- a/example/z-playground/server/playground.ml +++ b/example/z-playground/server/playground.ml @@ -125,7 +125,7 @@ let init_client socket content = "payload", `String content; ] |> Yojson.Basic.to_string - |> Dream.send socket + |> Dream.write socket let validate_id sandbox = String.length sandbox > 0 && Dream.from_base64url sandbox <> None @@ -144,7 +144,7 @@ type session = { mutable sandbox : string; syntax : syntax; eml : bool; - socket : Dream.websocket; + socket : Dream.response; } let allocated_ports = @@ -198,7 +198,7 @@ let client_log ?(add_newline = false) session message = "payload", `String message; ] |> Yojson.Basic.to_string - |> Dream.send session.socket + |> Dream.write session.socket let build_sandbox sandbox syntax eml = let dune = @@ -268,7 +268,7 @@ let started session port = "port", `Int port; ] |> Yojson.Basic.to_string - |> Dream.send session.socket + |> Dream.write session.socket let rec make_container_id () = let candidate = Dream.random 9 |> Dream.to_base64url in @@ -308,7 +308,7 @@ let run session = let kill session = let%lwt () = kill_container session in - Dream.close_websocket session.socket + Dream.close session.socket @@ -350,7 +350,7 @@ let lock_sandbox sandbox f = Lwt.return_unit) let rec listen session = - match%lwt Dream.receive session.socket with + match%lwt Dream.read session.socket with | None -> Dream.info (fun log -> log "WebSocket closed by client"); kill session @@ -500,7 +500,7 @@ let () = (* Start the Web server. *) let playground_handler request = - let sandbox = Dream.param "id" request in + let sandbox = Dream.param request "id" in match validate_id sandbox with | false -> Dream.empty `Not_Found | true -> From 64d7df3538b1fef10f3fb6dd1a3328f259203440 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:25:45 +0300 Subject: [PATCH 100/312] mv test/expect/middleware test/expect/server --- test/expect/{middleware => server}/dune | 0 test/expect/{middleware => server}/initialize.ml | 0 test/expect/{middleware => server}/router.ml | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename test/expect/{middleware => server}/dune (100%) rename test/expect/{middleware => server}/initialize.ml (100%) rename test/expect/{middleware => server}/router.ml (100%) diff --git a/test/expect/middleware/dune b/test/expect/server/dune similarity index 100% rename from test/expect/middleware/dune rename to test/expect/server/dune diff --git a/test/expect/middleware/initialize.ml b/test/expect/server/initialize.ml similarity index 100% rename from test/expect/middleware/initialize.ml rename to test/expect/server/initialize.ml diff --git a/test/expect/middleware/router.ml b/test/expect/server/router.ml similarity index 100% rename from test/expect/middleware/router.ml rename to test/expect/server/router.ml From bfa5ab1c5c158947ae21853a901ef4534854f188 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:31:36 +0300 Subject: [PATCH 101/312] Tweak deprecation message formatting --- src/dream.mli | 94 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 56 insertions(+), 38 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index af2448dc..ffe12c6b 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -375,16 +375,18 @@ val prefix : request -> string (**/**) val path : request -> string list [@@ocaml.deprecated -" Router path access is being removed from the API. Comment at - https://github.com/aantron/dream/issues"] +"Router path access is being removed from the API. Comment at +https://github.com/aantron/dream/issues +"] (** Parsed request path. For example, ["foo"; "bar"]. *) (**/**) (**/**) val version : request -> int * int [@@ocaml.deprecated -" Protocol version access is being removed from the API. Comment at - https://github.com/aantron/dream/issues"] +"Protocol version access is being removed from the API. Comment at +https://github.com/aantron/dream/issues +"] (** Protocol version. [(1, 1)] for HTTP/1.1 and [(2, 0)] for HTTP/2. *) (**/**) @@ -394,8 +396,9 @@ val set_client : request -> string -> unit (**/**) val with_client : string -> request -> request [@@ocaml.deprecated -" Use Dream.set_client. See - https://aantron.github.io/dream/#val-set_client"] +"Use Dream.set_client. See +https://aantron.github.io/dream/#val-set_client +"] (**/**) val set_method_ : request -> [< method_ ] -> unit @@ -404,23 +407,26 @@ val set_method_ : request -> [< method_ ] -> unit (**/**) val with_method_ : [< method_ ] -> request -> request [@@ocaml.deprecated -" Use Dream.set_method_. See - https://aantron.github.io/dream/#val-set_method_"] +"Use Dream.set_method_. See +https://aantron.github.io/dream/#val-set_method_ +"] (**/**) (**/**) val with_path : string list -> request -> request [@@ocaml.deprecated -" Router path access is being removed from the API. Comment at - https://github.com/aantron/dream/issues"] +"Router path access is being removed from the API. Comment at +https://github.com/aantron/dream/issues +"] (** Replaces the path. See {!Dream.val-path}. *) (**/**) (**/**) val with_version : int * int -> request -> request [@@ocaml.deprecated -" Protocol version access is being removed from the API. Comment at - https://github.com/aantron/dream/issues"] +"Protocol version access is being removed from the API. Comment at +https://github.com/aantron/dream/issues +"] (** Replaces the version. See {!Dream.version}. *) (**/**) @@ -578,8 +584,9 @@ val set_header : 'a message -> string -> string -> unit (**/**) val with_header : string -> string -> 'a message -> 'a message [@@ocaml.deprecated -" Use Dream.set_header. See - https://aantron.github.io/dream/#val-with_header"] +"Use Dream.set_header. See +https://aantron.github.io/dream/#val-with_header +"] (**/**) @@ -748,8 +755,9 @@ val set_body : response -> string -> unit (**/**) val with_body : string -> response -> response [@@ocaml.deprecated -" Use Dream.set_body. See - https://aantron.github.io/dream/#val-set_body"] +"Use Dream.set_body. See +https://aantron.github.io/dream/#val-set_body +"] (**/**) (** {2 Streaming} *) @@ -765,8 +773,9 @@ val read : 'a message -> string option promise (**/**) val with_stream : response -> response [@@ocaml.deprecated -" Use Dream.stream instead. See - https://aantron.github.io/dream/#val-set_stream"] +"Use Dream.stream instead. See +https://aantron.github.io/dream/#val-set_stream +"] (**/**) val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise @@ -848,8 +857,9 @@ val close_stream : val write_buffer : ?offset:int -> ?length:int -> response -> buffer -> unit promise [@@ocaml.deprecated -" Use Dream.write_stream. See - https://aantron.github.io/dream/#val-write_stream"] +"Use Dream.write_stream. See +https://aantron.github.io/dream/#val-write_stream +"] (**/**) (* TODO Ergonomics of this stream surface API. *) @@ -1558,8 +1568,9 @@ val put_flash : request -> string -> string -> unit (**/**) type websocket = response [@@ocaml.deprecated -" Use Dream.stream. See - https://aantron.github.io/dream/#type-stream"] +"Use Dream.stream. See +https://aantron.github.io/dream/#type-stream +"] (** A WebSocket connection. See {{:https://tools.ietf.org/html/rfc6455} RFC 6455} and {{:https://developer.mozilla.org/en-US/docs/Web/API/WebSockets_API} MDN}. *) @@ -1568,8 +1579,9 @@ type websocket = response (**/**) val send : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise [@@ocaml.deprecated -" Use Dream.write. See - https://aantron.github.io/dream/#val-write"] +"Use Dream.write. See +https://aantron.github.io/dream/#val-write +"] (** Sends a single message. The WebSocket is ready another message when the promise resolves. @@ -1584,8 +1596,9 @@ val send : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise val receive : response -> string option promise [@@ocaml.deprecated -" Use Dream.read. See - https://aantron.github.io/dream/#val-read"] +"Use Dream.read. See +https://aantron.github.io/dream/#val-read +"] (** Retrieves a message. If the WebSocket is closed before a complete message arrives, the result is [None]. *) (**/**) @@ -1593,8 +1606,9 @@ val receive : response -> string option promise (**/**) val close_websocket : ?code:int -> response -> unit promise [@@ocaml.deprecated -" Use Dream.close. See - https://aantron.github.io/dream/#val-close"] +"Use Dream.close. See +https://aantron.github.io/dream/#val-close +"] (** Closes the WebSocket. [~code] is usually not necessary, but is needed for some protocols based on WebSockets. See {{:https://tools.ietf.org/html/rfc6455#section-7.4} RFC 6455 §7.4}. *) @@ -2394,8 +2408,9 @@ type 'a field (**/**) type 'a local = 'a field [@@ocaml.deprecated -" Renamed to type Dream.field. See - https://aantron.github.io/dream/#type-field"] +"Renamed to type Dream.field. See +https://aantron.github.io/dream/#type-field +"] (**/**) val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field @@ -2406,8 +2421,9 @@ val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field (**/**) val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field [@@ocaml.deprecated -" Renamed to Dream.new_field. See - https://aantron.github.io/dream/#val-new_field"] +"Renamed to Dream.new_field. See +https://aantron.github.io/dream/#val-new_field +"] (**/**) val field : 'b message -> 'a field -> 'a option @@ -2416,8 +2432,9 @@ val field : 'b message -> 'a field -> 'a option (**/**) val local : 'b message -> 'a field -> 'a option [@@ocaml.deprecated -" Renamed to Dream.field. See - https://aantron.github.io/dream/#val-field"] +"Renamed to Dream.field. See +https://aantron.github.io/dream/#val-field +"] (**/**) val set_field : 'b message -> 'a field -> 'a -> unit @@ -2426,8 +2443,9 @@ val set_field : 'b message -> 'a field -> 'a -> unit (**/**) val with_local : 'a field -> 'a -> 'b message -> 'b message [@@ocaml.deprecated -" Use Dream.set_field instead. See - https://aantron.github.io/dream/#val-set_field"] +"Use Dream.set_field instead. See +https://aantron.github.io/dream/#val-set_field +"] (**/**) @@ -2455,14 +2473,14 @@ val test : ?prefix:string -> handler -> (request -> response) (**/**) val first : 'a message -> 'a message -[@@ocaml.deprecated " Simply returns its own argument."] +[@@ocaml.deprecated "Simply returns its own argument."] (** [Dream.first message] evaluates to the original request or response that [message] is immutably derived from. This is useful for getting the original state of requests especially, when they were first created inside the HTTP server ({!Dream.run}). *) val last : 'a message -> 'a message -[@@ocaml.deprecated " Simply returns its own argument."] +[@@ocaml.deprecated "Simply returns its own argument."] (** [Dream.last message] evaluates to the latest request or response that was derived from [message]. This is most useful for obtaining the state of requests at the time an exception was raised, without having to instrument From 71e06b78eb11377e414cba2b547b388450f7bc67 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:45:32 +0300 Subject: [PATCH 102/312] Catch up the tests --- src/dream.mli | 1 + test/expect/pure/dune | 1 - test/expect/server/dune | 4 +- test/expect/server/router.ml | 41 ++++--- test/unit/headers.ml | 203 ++++++---------------------------- test/unit/request.ml | 207 +---------------------------------- 6 files changed, 69 insertions(+), 388 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index ffe12c6b..ba6a754a 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -379,6 +379,7 @@ val path : request -> string list https://github.com/aantron/dream/issues "] (** Parsed request path. For example, ["foo"; "bar"]. *) +(* TODO If not removing this, move it to section Routing. *) (**/**) (**/**) diff --git a/test/expect/pure/dune b/test/expect/pure/dune index 8e509ce2..8a27fd6c 100644 --- a/test/expect/pure/dune +++ b/test/expect/pure/dune @@ -4,7 +4,6 @@ base dream dream.cipher - dream.middleware dream-pure lwt lwt.unix diff --git a/test/expect/server/dune b/test/expect/server/dune index fb43c9d0..cf730005 100644 --- a/test/expect/server/dune +++ b/test/expect/server/dune @@ -1,10 +1,10 @@ (library - (name test_expect_middleware) + (name test_expect_server) (libraries base dream - dream.middleware dream-pure + dream.server lwt lwt.unix ppx_expect.common diff --git a/test/expect/server/router.ml b/test/expect/server/router.ml index a4c380a7..d6e6c6c5 100644 --- a/test/expect/server/router.ml +++ b/test/expect/server/router.ml @@ -5,6 +5,15 @@ +(* TODO Decide what to do this based on the deprecation (or not) of val path. *) +module Dream = +struct + include Dream + let path = path [@ocaml.warning "-3"] +end + + + let () = ignore Initialize.require @@ -16,11 +25,11 @@ let path request = let show_tokens route = try - Dream__middleware.Router.parse route + Dream__server.Router.parse route |> List.map (function - | Dream__middleware.Router.Literal s -> Printf.sprintf "%S" s - | Dream__middleware.Router.Param s -> Printf.sprintf ":%S" s - | Dream__middleware.Router.Wildcard s -> Printf.sprintf "*%S" s) + | Dream__server.Router.Literal s -> Printf.sprintf "%S" s + | Dream__server.Router.Param s -> Printf.sprintf ":%S" s + | Dream__server.Router.Wildcard s -> Printf.sprintf "*%S" s) |> String.concat "; " |> Printf.printf "[%s]\n" with Failure message -> @@ -309,7 +318,7 @@ let%expect_test _ = let%expect_test _ = show "/abc/def" @@ Dream.router [ Dream.get "/abc/:x" (fun request -> - Dream.respond (Dream.param "x" request)); + Dream.respond (Dream.param request "x")); ]; [%expect {| Response: 200 OK @@ -318,7 +327,7 @@ let%expect_test _ = let%expect_test _ = show "/abc/def/ghi" @@ Dream.router [ Dream.get "/abc/:x/:y" (fun request -> - Dream.respond (Dream.param "x" request ^ Dream.param "y" request)); + Dream.respond (Dream.param request "x" ^ Dream.param request "y")); ]; [%expect {| Response: 200 OK @@ -334,14 +343,14 @@ let%expect_test _ = let%expect_test _ = show "/abc/def" @@ Dream.router [ Dream.get "/abc/def" (fun request -> - Dream.respond (Dream.param "x" request)); + Dream.respond (Dream.param request "x")); ]; [%expect {| Dream.param: missing path parameter "x" |}] let%expect_test _ = show "/" @@ (fun next_handler request -> - ignore (Dream.param "x" request); + ignore (Dream.param request "x"); next_handler request); [%expect {| Dream.param: missing path parameter "x" |}] @@ -422,7 +431,7 @@ let%expect_test _ = show "/abc/def" @@ Dream.router [ Dream.scope "/:x" [] [ Dream.get "/def" (fun request -> - Dream.respond (Dream.param "x" request)); + Dream.respond (Dream.param request "x")); ]; ]; [%expect {| @@ -433,7 +442,7 @@ let%expect_test _ = show "/abc/def" @@ Dream.router [ Dream.scope "/:x" [] [ Dream.get "/:x" (fun request -> - Dream.respond (Dream.param "x" request)); + Dream.respond (Dream.param request "x")); ]; ]; [%expect {| @@ -650,7 +659,7 @@ let%expect_test _ = Dream.get "/:x/**" (fun request -> Printf.ksprintf Dream.respond "%s %s %s" (Dream.prefix request) - (Dream.param "x" request) + (Dream.param request "x") (path request)); ]; [%expect {| @@ -662,7 +671,7 @@ let%expect_test _ = Dream.get "/abc/:x/**" (fun request -> Printf.ksprintf Dream.respond "%s %s %s" (Dream.prefix request) - (Dream.param "x" request) + (Dream.param request "x") (path request)); ]; [%expect {| @@ -675,7 +684,7 @@ let%expect_test _ = Dream.get "/:x/**" (fun request -> Printf.ksprintf Dream.respond "%s %s %s" (Dream.prefix request) - (Dream.param "x" request) + (Dream.param request "x") (path request)); ]; ]; @@ -707,8 +716,8 @@ let%expect_test _ = Dream.get "/:y" (fun request -> Printf.ksprintf Dream.respond "%s %s %s %s" (Dream.prefix request) - (Dream.param "x" request) - (Dream.param "y" request) + (Dream.param request "x") + (Dream.param request "y") (path request)); ] @@ (fun _ -> Dream.respond ~status:`Not_Found "")) @@ -725,7 +734,7 @@ let%expect_test _ = Dream.get "/:x" (fun request -> Printf.ksprintf Dream.respond "%s %s %s" (Dream.prefix request) - (Dream.param "x" request) + (Dream.param request "x") (path request)); ] @@ (fun _ -> Dream.respond ~status:`Not_Found "")) diff --git a/test/unit/headers.ml b/test/unit/headers.ml index 8d559461..03988eb6 100644 --- a/test/unit/headers.ml +++ b/test/unit/headers.ml @@ -11,240 +11,107 @@ let (-:) name f = Alcotest.test_case name `Quick f let tests = "headers", [ - "header" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.header "C" + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.header request "C" |> Alcotest.(check (option string)) "header" (Some "d") - end; - "header none" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.header "E" + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.header request "E" |> Alcotest.(check (option string)) "header" None - end; - "headers" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" - |> Dream.headers "C" + let request = Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" in + Dream.headers request "C" |> Alcotest.(check (list string)) "headers" ["d"; "e"] - end; - "headers empty" -: begin fun () -> - Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" - |> Dream.headers "F" + let request = Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" in + Dream.headers request "F" |> Alcotest.(check (list string)) "headers" [] - end; - "has_header" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.has_header "C" + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.has_header request "C" |> Alcotest.(check bool) "has_header" true - end; - "has_header false" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.has_header "E" + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.has_header request "E" |> Alcotest.(check bool) "has_header" false - end; - "all_headers" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" in + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"; "C", "d"; "C", "e"] - end; - "add_header" -: begin fun () -> - - Dream.request ~headers:["A", "b"] "" - |> Dream.add_header "C" "d" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"] "" in + Dream.add_header request "C" "d"; + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"; "C", "d"] - end; - "add_header duplicate" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.add_header "A" "e" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.add_header request "A" "e"; + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"; "A", "e"; "C", "d"] - end; - "add_header compares less" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"] "" - |> Dream.add_header "A" "a" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"; "C", "d"] "" in + Dream.add_header request "A" "a"; + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"; "A", "a"; "C", "d"] - end; - - "add_header immutable" -: begin fun () -> - - let first = Dream.request ~headers:["A", "b"] "" in - let last = Dream.add_header "C" "d" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check (list (pair string string))) "all_headers" - ["A", "b"] (Dream.sort_headers (Dream.all_headers first)) - - end; - - - "add_header update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.add_header "A" "b" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - - end; - - "drop_header" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" - |> Dream.drop_header "C" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"; "C", "d"; "C", "e"] "" in + Dream.drop_header request "C"; + Dream.all_headers request |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"] - end; - "drop_header absent" -: begin fun () -> - - Dream.request ~headers:["C", "d"] "" - |> Dream.drop_header "A" - |> Dream.all_headers + let request = Dream.request ~headers:["C", "d"] "" in + Dream.drop_header request "A"; + Dream.all_headers request |> Alcotest.(check (list (pair string string))) "all_headers" ["C", "d"] - - end; - - - "drop_header immutable" -: begin fun () -> - - let first = Dream.request ~headers:["A", "b"; "C", "d"] "" in - let last = Dream.drop_header "A" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check (list (pair string string))) "all_headers" - ["A", "b"; "C", "d"] (Dream.sort_headers (Dream.all_headers first)) - - end; - - - (* If the optimization to return the same request upon missing headers is - implemented, this test will rightly fail, and will need inversion of the - check "different." *) - "drop_header absent reuse" -: begin fun () -> - - let first = Dream.request ~headers:["C", "d"] "" in - let last = Dream.drop_header "A" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check (list (pair string string))) "all_headers" - ["C", "d"] (Dream.sort_headers (Dream.all_headers first)) - - end; - - - "drop_header update" -: begin fun () -> - - let first = Dream.request ~headers:["A", "b"] "" in - let last = Dream.drop_header "A" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - end; - "with_header" -: begin fun () -> - - Dream.request ~headers:["C", "d"] "" - |> Dream.with_header "A" "b" - |> Dream.all_headers + let request = Dream.request ~headers:["C", "d"] "" in + Dream.set_header request "A" "b"; + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "b"; "C", "d"] - end; - "with_header present" -: begin fun () -> - - Dream.request ~headers:["A", "b"; "A", "c"; "D", "e"] "" - |> Dream.with_header "A" "f" - |> Dream.all_headers + let request = Dream.request ~headers:["A", "b"; "A", "c"; "D", "e"] "" in + Dream.set_header request "A" "f"; + Dream.all_headers request |> Dream.sort_headers |> Alcotest.(check (list (pair string string))) "all_headers" ["A", "f"; "D", "e"] - end; - - "with_header immutable" -: begin fun () -> - - let first = Dream.request ~headers:["A", "b"; "C", "d"] "" in - let last = Dream.with_header "A" "e" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check (list (pair string string))) "all_headers" - ["A", "b"; "C", "d"] (Dream.sort_headers (Dream.all_headers first)) - - end; - - - "with_header update" -: begin fun () -> - - let first = Dream.request ~headers:["A", "b"] "" in - let last = Dream.with_header "A" "c" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - - end; ] diff --git a/test/unit/request.ml b/test/unit/request.ml index 11a6578b..fdbc2e60 100644 --- a/test/unit/request.ml +++ b/test/unit/request.ml @@ -11,227 +11,32 @@ let (-:) name f = Alcotest.test_case name `Quick f let tests = "request", [ - - "client" -: begin fun () -> - - Dream.request ~client:"1.2.3.4:23456" "" - |> Dream.client - |> Alcotest.(check string) "client" "1.2.3.4:23456" - - end; - - "with_client" -: begin fun () -> - - Dream.request "" - |> Dream.with_client "2.3.4.5:34567" - |> Dream.client + let request = Dream.request "" in + Dream.set_client request "2.3.4.5:34567"; + Dream.client request |> Alcotest.(check string) "client" "2.3.4.5:34567" - - end; - - - "with_client immutable" -: begin fun () -> - - let first = Dream.request ~client:"1.2.3.4:23456" "" in - let last = Dream.with_client "2.3.4.5:34567" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check string) "client" "1.2.3.4:23456" (Dream.client first); - end; - - "with_client update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.with_client "1.2.3.4:23456" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - - end; - - "method_" -: begin fun () -> - Dream.request ~method_:`POST "" |> Dream.method_ |> Dream.method_to_string |> Alcotest.(check string) "method_" "POST" - end; - "with_method_" -: begin fun () -> - - Dream.request "" - |> Dream.with_method_ `PUT - |> Dream.method_ + let request = Dream.request "" in + Dream.set_method_ request `PUT; + Dream.method_ request |> Dream.method_to_string |> Alcotest.(check string) "method_" "PUT"; - - end; - - - "with_method_ immutable" -: begin fun () -> - - let first = Dream.request ~method_:`DELETE "" in - let last = Dream.with_method_ `HEAD first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check string) "method_" "DELETE" - (Dream.method_to_string (Dream.method_ first)) - - end; - - - "with_method_ update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.with_method_ `TRACE first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - end; - "target" -: begin fun () -> - Dream.request ~target:"/foo" "" |> Dream.target |> Alcotest.(check string) "target" "/foo" - - end; - - - (* "with_target" -: begin fun () -> - - Dream.request "" - |> Dream.with_target "/bar" - |> Dream.target - |> Alcotest.(check string) "target" "/bar"; - - end; - - - "with_target immutable" -: begin fun () -> - - let first = Dream.request ~target:"/bar" "" in - let last = Dream.with_target "/foo" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check string) "target" "/bar" (Dream.target first) - - end; - - - "with_target update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.with_target "/foo" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - - end; *) - - - (* "prefix" -: begin fun () -> - - Dream.request ~prefix:"/foo" "" - |> Dream.prefix - |> Alcotest.(check string) "prefix" "/foo" - - end; - - - "with_prefix" -: begin fun () -> - - Dream.request "" - |> Dream.with_prefix "/bar" - |> Dream.prefix - |> Alcotest.(check string) "prefix" "/bar"; - - end; - - - "with_prefix immutable" -: begin fun () -> - - let first = Dream.request ~prefix:"/bar" "" in - let last = Dream.with_prefix "/foo" first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check string) "prefix" "/bar" (Dream.prefix first) - - end; - - - "with_prefix update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.with_prefix "/foo" first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - - end; *) - - - "version" -: begin fun () -> - - Dream.request ~version:(0, 5) "" - |> Dream.version - |> Alcotest.(check (pair int int)) "version" (0, 5) - - end; - - - "with_version" -: begin fun () -> - - Dream.request "" - |> Dream.with_version (0, 6) - |> Dream.version - |> Alcotest.(check (pair int int)) "version" (0, 6); - - end; - - - "with_version immutable" -: begin fun () -> - - let first = Dream.request ~version:(0, 7) "" in - let last = Dream.with_version (0, 8) first in - - Alcotest.(check bool) "different" true (last != first); - Alcotest.(check (pair int int)) "version" (0, 7) (Dream.version first) - - end; - - - "with_version update" -: begin fun () -> - - let first = Dream.request "" in - let last = Dream.with_version (0, 9) first in - - Alcotest.(check bool) "last" true (Dream.last first == last); - Alcotest.(check bool) "last" true (Dream.last last == last); - - Alcotest.(check bool) "first" true (Dream.first first == first); - Alcotest.(check bool) "first" true (Dream.first last == first); - end; ] From 773c3464168171f906708ecaa157fa374fe4cbe3 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:47:33 +0300 Subject: [PATCH 103/312] Move cipher tests from pure to server tests --- test/expect/pure/cipher/dune | 5 ----- test/expect/pure/dune | 1 - test/expect/{pure => server}/cipher/cipher.ml | 0 test/expect/server/cipher/dune | 5 +++++ 4 files changed, 5 insertions(+), 6 deletions(-) delete mode 100644 test/expect/pure/cipher/dune rename test/expect/{pure => server}/cipher/cipher.ml (100%) create mode 100644 test/expect/server/cipher/dune diff --git a/test/expect/pure/cipher/dune b/test/expect/pure/cipher/dune deleted file mode 100644 index f6cf5ed5..00000000 --- a/test/expect/pure/cipher/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (name test_expect_pure_cipher) - (libraries test_expect_pure) - (inline_tests) - (preprocess (pps lwt_ppx ppx_expect))) diff --git a/test/expect/pure/dune b/test/expect/pure/dune index 8a27fd6c..9e218564 100644 --- a/test/expect/pure/dune +++ b/test/expect/pure/dune @@ -3,7 +3,6 @@ (libraries base dream - dream.cipher dream-pure lwt lwt.unix diff --git a/test/expect/pure/cipher/cipher.ml b/test/expect/server/cipher/cipher.ml similarity index 100% rename from test/expect/pure/cipher/cipher.ml rename to test/expect/server/cipher/cipher.ml diff --git a/test/expect/server/cipher/dune b/test/expect/server/cipher/dune new file mode 100644 index 00000000..b34a9cc5 --- /dev/null +++ b/test/expect/server/cipher/dune @@ -0,0 +1,5 @@ +(library + (name test_expect_server_cipher) + (libraries test_expect_server) + (inline_tests) + (preprocess (pps lwt_ppx ppx_expect))) From 85f3aec86e0a2a6a9f1b085562011b1900324b0d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Dec 2021 22:58:53 +0300 Subject: [PATCH 104/312] WebSocket write: set FIN bit by default --- src/pure/inmost.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 9441f2d2..8b9fe414 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -171,7 +171,7 @@ let write ?kind message chunk = (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write message.server_stream - buffer 0 length binary false + buffer 0 length binary true ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) (fun () -> Lwt.wakeup_later resolver ()); promise From d2b8e0f7a0939e689148664a8f6a3a994b291737 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 19 Dec 2021 14:28:29 +0300 Subject: [PATCH 105/312] Rename Dream__localhost to match its directory --- src/certificate/dune | 10 +++++----- src/http/dune | 2 +- src/http/http.ml | 6 +++++- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/certificate/dune b/src/certificate/dune index a75f8585..5b1642ce 100644 --- a/src/certificate/dune +++ b/src/certificate/dune @@ -1,9 +1,9 @@ (library - (public_name dream.localhost) - (name dream__localhost)) + (public_name dream.certificate) + (name dream__certificate)) (rule - (target dream__localhost.ml) + (target dream__certificate.ml) (deps (:certificate localhost.crt) (:key localhost.key)) @@ -11,10 +11,10 @@ (with-stdout-to %{target} (progn - (echo "let certificate = {ssl|") + (echo "let localhost_certificate = {ssl|") (cat %{certificate}) (echo "|ssl}\n\n") - (echo "let key = {key|") + (echo "let localhost_certificate_key = {key|") (cat %{key}) (echo "|key}\n") )))) diff --git a/src/http/dune b/src/http/dune index 9280e5c6..386935c7 100644 --- a/src/http/dune +++ b/src/http/dune @@ -5,8 +5,8 @@ bigarray-compat bigstringaf digestif + dream.certificate dream.cipher - dream.localhost dream-pure dream.server dream-httpaf.gluten diff --git a/src/http/http.ml b/src/http/http.ml index f6384c07..c910ae82 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -755,7 +755,11 @@ let serve_with_maybe_https log "See arguments ~certificate_file and ~key_file"); end; - `Memory (Dream__localhost.certificate, Dream__localhost.key, `Silent) + `Memory ( + Dream__certificate.localhost_certificate, + Dream__certificate.localhost_certificate_key, + `Silent + ) | Some certificate_file, Some key_file, None, None -> `File (certificate_file, key_file) From 553567f2d80648cb4fbdee37bf456a091fe463e1 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 19 Dec 2021 14:41:17 +0300 Subject: [PATCH 106/312] Sort inmost.ml to match all the .mli files --- src/pure/inmost.ml | 239 ++++++++++++++++++++++++--------------------- 1 file changed, 127 insertions(+), 112 deletions(-) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 8b9fe414..6c0528a5 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -5,30 +5,27 @@ +(* Type abbreviations and modules used in defining the primary types *) + type method_ = Method.method_ type status = Status.status type stream = Stream.stream type buffer = Stream.buffer -module Custom_field_metadata = -struct - type 'a t = string option * ('a -> string) option -end -module Fields = Hmap.Make (Custom_field_metadata) +type 'a promise = 'a Lwt.t + +module Fields = + Hmap.Make (struct + type 'a t = string option * ('a -> string) option + end) +(* TODO Use a record to self-document the meaning of this type. *) -type request = client message -and response = server message -and 'a message = { - specific : 'a; - mutable headers : (string * string) list; - mutable client_stream : Stream.stream; - mutable server_stream : Stream.stream; - mutable fields : Fields.t; -} -and client = { +(* Messages (requests and responses) *) + +type client = { mutable method_ : method_; target : string; mutable request_version : int * int; @@ -39,15 +36,57 @@ and client = { middleware and into transport so that the version field is not necessary for some middleware to decide which headers to add. *) -and server = { +type server = { status : status; } -type 'a promise = 'a Lwt.t +type 'a message = { + specific : 'a; + mutable headers : (string * string) list; + mutable client_stream : Stream.stream; + mutable server_stream : Stream.stream; + mutable fields : Fields.t; +} + +type request = client message +type response = server message + + + +(* Functions of messages *) type handler = request -> response Lwt.t type middleware = handler -> handler + + +(* Requests *) + +let request + ?method_ + ?(target = "/") + ?(version = 1, 1) + ?(headers = []) + client_stream + server_stream = + + let method_ = + match (method_ :> method_ option) with + | None -> `GET + | Some method_ -> method_ + in + { + specific = { + method_; + target; + request_version = version; + }; + headers; + client_stream; + server_stream; + fields = Fields.empty; + } + let method_ request = request.specific.method_ @@ -63,14 +102,43 @@ let set_method_ request method_ = let set_version request version = request.specific.request_version <- version + + +(* Responses *) + +let response ?status ?code ?(headers = []) client_stream server_stream = + let status = + match status, code with + | None, None -> `OK + | Some status, _ -> (status :> status) + | None, Some code -> Status.int_to_status code + in + { + specific = { + status; + }; + headers; + client_stream; + server_stream; + fields = Fields.empty; + } + let status response = response.specific.status -let all_headers message = + + +(* Headers *) + +let header_basic name message = + let name = String.lowercase_ascii name in message.headers + |> List.find (fun (name', _) -> String.lowercase_ascii name' = name) + |> snd -let set_all_headers message headers = - message.headers <- headers +let header message name = + try Some (header_basic name message) + with Not_found -> None let headers message name = let name = String.lowercase_ascii name in @@ -84,15 +152,8 @@ let headers message name = [] |> List.rev -let header_basic name message = - let name = String.lowercase_ascii name in +let all_headers message = message.headers - |> List.find (fun (name', _) -> String.lowercase_ascii name' = name) - |> snd - -let header message name = - try Some (header_basic name message) - with Not_found -> None let has_header message name = try ignore (header_basic name message); true @@ -112,30 +173,20 @@ let set_header message name value = drop_header message name; add_header message name value -(* TODO NOTE On the client, this will read the client stream until close. *) -let body message = - Stream.read_until_close message.server_stream +let set_all_headers message headers = + message.headers <- headers -let read message = - Stream.read_convenience message.server_stream +let sort_headers headers = + List.stable_sort (fun (name, _) (name', _) -> compare name name') headers -let client_stream message = - message.client_stream -let server_stream message = - message.server_stream -let set_client_stream message client_stream = - message.client_stream <- client_stream +(* Streams *) -let set_server_stream message server_stream = - message.server_stream <- server_stream +(* TODO NOTE On the client, this will read the client stream until close. *) +let body message = + Stream.read_until_close message.server_stream -(* Create a fresh ref. The reason this field has a ref is because it might get - replaced when a body is forced read. That's not what's happening here - we - are setting a new body. Indeed, there might be a concurrent read going on. - That read should not override the new body. So let it mutate the old - request's ref; we generate a new request with a new body ref. *) (* TODO NOTE In Dream, this should operate on response server_streams. In Hyper, it should operate on request client_streams, although there is no very good reason why it can't operate on general messages, which might be useful in @@ -155,6 +206,9 @@ let set_body message body = in message.server_stream <- body +let read message = + Stream.read_convenience message.server_stream + (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It is hardcoded to true. *) @@ -191,8 +245,35 @@ let close ?(code = 1000) message = Stream.close message.server_stream code; Lwt.return_unit +let client_stream message = + message.client_stream + +let server_stream message = + message.server_stream + +let set_client_stream message client_stream = + message.client_stream <- client_stream + +let set_server_stream message server_stream = + message.server_stream <- server_stream + + + +(* Middleware *) + +let no_middleware handler request = + handler request + +let rec pipeline middlewares handler = + match middlewares with + | [] -> handler + | middleware::more -> middleware (pipeline more handler) +(* TODO Test pipelien after the List.rev fiasco. *) + +(* Custom fields *) + type 'a field = 'a Fields.key let new_field ?name ?show_value () = @@ -211,69 +292,3 @@ let fold_fields f initial message = | _ -> accumulator) message.fields initial - - - -let request - ?method_ - ?(target = "/") - ?(version = 1, 1) - ?(headers = []) - client_stream - server_stream = - - let method_ = - match (method_ :> method_ option) with - | None -> `GET - | Some method_ -> method_ - in - - (* This function is used for debugging, so it's fine to allocate a fake body - and then immediately replace it. *) - - { - specific = { - (* TODO Is there a better fake error handler? Maybe this function should - come after the response constructors? *) - method_; - target; - request_version = version; - }; - headers; - client_stream; - server_stream; - fields = Fields.empty; - } - -let response - ?status ?code ?(headers = []) client_stream server_stream = - - let status = - match status, code with - | None, None -> `OK - | Some status, _ -> (status :> status) - | None, Some code -> Status.int_to_status code - in - - { - specific = { - status; - }; - headers; - client_stream; - server_stream; - (* TODO This fully dead stream should be preallocated. *) - fields = Fields.empty; - } - -let no_middleware handler request = - handler request - -let rec pipeline middlewares handler = - match middlewares with - | [] -> handler - | middleware::more -> middleware (pipeline more handler) -(* TODO Test pipelien after the List.rev fiasco. *) - -let sort_headers headers = - List.stable_sort (fun (name, _) (name', _) -> compare name name') headers From 9df46cb32989c853f2280e4ef78d574532e7a48e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 19 Dec 2021 14:44:57 +0300 Subject: [PATCH 107/312] inmost.ml: clarify some record fields --- src/pure/inmost.ml | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index 6c0528a5..6620e29a 100644 --- a/src/pure/inmost.ml +++ b/src/pure/inmost.ml @@ -15,11 +15,11 @@ type buffer = Stream.buffer type 'a promise = 'a Lwt.t -module Fields = - Hmap.Make (struct - type 'a t = string option * ('a -> string) option - end) -(* TODO Use a record to self-document the meaning of this type. *) +type 'a field_metadata = { + name : string option; + show_value : ('a -> string) option; +} +module Fields = Hmap.Make (struct type 'a t = 'a field_metadata end) @@ -28,7 +28,7 @@ module Fields = type client = { mutable method_ : method_; target : string; - mutable request_version : int * int; + mutable version : int * int; } (* TODO Get rid of the version field completely? At least don't expose it in Dream. It is only used internally on the server side to add the right @@ -79,7 +79,7 @@ let request specific = { method_; target; - request_version = version; + version; }; headers; client_stream; @@ -94,13 +94,13 @@ let target request = request.specific.target let version request = - request.specific.request_version + request.specific.version let set_method_ request method_ = request.specific.method_ <- (method_ :> method_) let set_version request version = - request.specific.request_version <- version + request.specific.version <- version @@ -277,7 +277,7 @@ let rec pipeline middlewares handler = type 'a field = 'a Fields.key let new_field ?name ?show_value () = - Fields.Key.create (name, show_value) + Fields.Key.create {name; show_value} let field message key = Fields.find key message.fields @@ -288,7 +288,8 @@ let set_field message key value = let fold_fields f initial message = Fields.fold (fun (B (key, value)) accumulator -> match Fields.Key.info key with - | Some name, Some show_value -> f name (show_value value) accumulator + | {name = Some name; show_value = Some show_value} -> + f name (show_value value) accumulator | _ -> accumulator) message.fields initial From 6f3b2a235a66db418af62334015f868bb89d7c57 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 21 Dec 2021 13:32:44 +0300 Subject: [PATCH 108/312] mv inmost.ml message.ml --- src/cipher/cipher.ml | 10 +-- src/dream.ml | 100 +++++++++++++-------------- src/graphql/graphql.ml | 40 +++++------ src/http/adapt.ml | 12 ++-- src/http/error_handler.ml | 34 ++++----- src/http/error_handler.mli | 12 ++-- src/http/http.ml | 28 ++++---- src/pure/{inmost.ml => message.ml} | 0 src/pure/{inmost.mli => message.mli} | 0 src/server/catch.ml | 12 ++-- src/server/content_length.ml | 10 +-- src/server/cookie.ml | 6 +- src/server/echo.ml | 6 +- src/server/flash.ml | 8 +-- src/server/form.ml | 6 +- src/server/helpers.ml | 44 ++++++------ src/server/log.ml | 26 +++---- src/server/lowercase_headers.ml | 8 +-- src/server/origin_referrer_check.ml | 16 ++--- src/server/query.ml | 4 +- src/server/router.ml | 37 +++++----- src/server/router.mli | 36 +++++----- src/server/session.ml | 16 ++--- src/server/site_prefix.ml | 4 +- src/server/upload.ml | 22 +++--- src/sql/sql.ml | 12 ++-- src/unix/static.ml | 18 ++--- 27 files changed, 264 insertions(+), 263 deletions(-) rename src/pure/{inmost.ml => message.ml} (100%) rename src/pure/{inmost.mli => message.mli} (100%) diff --git a/src/cipher/cipher.ml b/src/cipher/cipher.ml index 75577d3f..9eaaabca 100644 --- a/src/cipher/cipher.ml +++ b/src/cipher/cipher.ml @@ -13,7 +13,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -119,7 +119,7 @@ struct end let secrets_field = - Dream.new_field + Message.new_field ~name:"dream.secret" ~show_value:(fun _secrets -> "[redacted]") () @@ -131,19 +131,19 @@ let secrets_field = let set_secret ?(old_secrets = []) secret = let value = secret::old_secrets in fun next_handler request -> - Dream.set_field request secrets_field value; + Message.set_field request secrets_field value; next_handler request let fallback_secrets = lazy [Random.random 32] let encryption_secret request = - match Dream.field request secrets_field with + match Message.field request secrets_field with | Some secrets -> List.hd secrets | None -> List.hd (Lazy.force fallback_secrets) let decryption_secrets request = - match Dream.field request secrets_field with + match Message.field request secrets_field with | Some secrets -> secrets | None -> Lazy.force fallback_secrets diff --git a/src/dream.ml b/src/dream.ml index 0254ac88..72d291cb 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -10,7 +10,6 @@ module Cipher = Dream__cipher.Cipher module Cookie = Dream__server.Cookie module Content_length = Dream__server.Content_length module Csrf = Dream__server.Csrf -module Dream = Dream_pure.Inmost module Echo = Dream__server.Echo module Error_handler = Dream__http.Error_handler module Flash = Dream__server.Flash @@ -20,6 +19,7 @@ module Graphql = Dream__graphql.Graphql module Helpers = Dream__server.Helpers module Http = Dream__http.Http module Lowercase_headers = Dream__server.Lowercase_headers +module Message = Dream_pure.Message module Method = Dream_pure.Method module Origin_referrer_check = Dream__server.Origin_referrer_check module Query = Dream__server.Query @@ -68,16 +68,16 @@ end (* Types *) -type request = Dream.request -type response = Dream.response -type handler = Dream.handler -type middleware = Dream.middleware +type request = Message.request +type response = Message.response +type handler = Message.handler +type middleware = Message.middleware type route = Router.route -type 'a message = 'a Dream.message -type client = Dream.client -type server = Dream.server -type 'a promise = 'a Dream.promise +type 'a message = 'a Message.message +type client = Message.client +type server = Message.server +type 'a promise = 'a Message.promise @@ -97,13 +97,13 @@ include Status let client = Helpers.client let https = Helpers.https -let method_ = Dream.method_ -let target = Dream.target +let method_ = Message.method_ +let target = Message.target let prefix = Router.prefix let path = Router.path -let version = Dream.version +let version = Message.version let set_client = Helpers.set_client -let set_method_ = Dream.set_method_ +let set_method_ = Message.set_method_ let query = Query.query let queries = Query.queries let all_queries = Query.all_queries @@ -120,19 +120,19 @@ let redirect = Helpers.redirect let empty = Helpers.empty let stream = Helpers.stream let websocket = Helpers.websocket -let status = Dream.status +let status = Message.status (* Headers *) -let header = Dream.header -let headers = Dream.headers -let all_headers = Dream.all_headers -let has_header = Dream.has_header -let add_header = Dream.add_header -let drop_header = Dream.drop_header -let set_header = Dream.set_header +let header = Message.header +let headers = Message.headers +let all_headers = Message.all_headers +let has_header = Message.has_header +let add_header = Message.add_header +let drop_header = Message.drop_header +let set_header = Message.set_header @@ -147,18 +147,18 @@ let all_cookies = Cookie.all_cookies (* Bodies *) -let body = Dream.body -let set_body = Dream.set_body -let read = Dream.read -let write = Dream.write -let flush = Dream.flush -let close = Dream.close +let body = Message.body +let set_body = Message.set_body +let read = Message.read +let write = Message.write +let flush = Message.flush +let close = Message.close type buffer = Stream.buffer type stream = Stream.stream -let client_stream = Dream.client_stream -let server_stream = Dream.server_stream -let set_client_stream = Dream.set_client_stream -let set_server_stream = Dream.set_server_stream +let client_stream = Message.client_stream +let server_stream = Message.server_stream +let set_client_stream = Message.set_client_stream +let set_server_stream = Message.set_server_stream let read_stream = Stream.read let ready_stream = Stream.ready let write_stream = Stream.write @@ -199,8 +199,8 @@ let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = (* Middleware *) -let no_middleware = Dream.no_middleware -let pipeline = Dream.pipeline +let no_middleware = Message.no_middleware +let pipeline = Message.pipeline @@ -295,7 +295,7 @@ let set_log_level = Log.set_log_level type error = Catch.error = { condition : [ - | `Response of Dream.response + | `Response of Message.response | `String of string | `Exn of exn ]; @@ -310,8 +310,8 @@ type error = Catch.error = { | `Server | `Client ]; - request : Dream.request option; - response : Dream.response option; + request : Message.request option; + response : Message.response option; client : string option; severity : Log.log_level; will_send_response : bool; @@ -350,10 +350,10 @@ let decrypt = Cipher.decrypt (* Custom fields *) -type 'a field = 'a Dream.field -let new_field = Dream.new_field -let field = Dream.field -let set_field = Dream.set_field +type 'a field = 'a Message.field +let new_field = Message.new_field +let field = Message.field +let set_field = Message.set_field @@ -372,7 +372,7 @@ let test ?(prefix = "") handler request = Lwt_main.run (app request) -let sort_headers = Dream.sort_headers +let sort_headers = Message.sort_headers let echo = Echo.echo @@ -384,11 +384,11 @@ let with_client client message = message let with_method_ method_ message = - Dream.set_method_ message method_; + Message.set_method_ message method_; message let with_version version message = - Dream.set_version message version; + Message.set_version message version; message let with_path path message = @@ -396,11 +396,11 @@ let with_path path message = message let with_header name value message = - Dream.set_header message name value; + Message.set_header message name value; message let with_body body message = - Dream.set_body message body; + Message.set_body message body; message let with_stream message = @@ -415,17 +415,17 @@ let write_buffer ?(offset = 0) ?length message chunk = let string = Bigstringaf.substring chunk ~off:offset ~len:length in write ~kind:`Binary message string -type websocket = Dream.response +type websocket = Message.response let send = write let receive = read let close_websocket = close -type 'a local = 'a Dream.field -let new_local = Dream.new_field -let local = Dream.field +type 'a local = 'a Message.field +let new_local = Message.new_field +let local = Message.field let with_local key value message = - Dream.set_field message key value; + Message.set_field message key value; message let first message = diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index 8f1014b3..d338e480 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -5,9 +5,9 @@ -module Dream = Dream_pure.Inmost module Helpers = Dream__server.Helpers module Log = Dream__server.Log +module Message = Dream_pure.Message module Method = Dream_pure.Method module Stream = Dream_pure.Stream @@ -79,7 +79,7 @@ let operation_id json = Yojson.Basic.Util.(json |> member "id" |> to_string_option) let close_and_clean ?code subscriptions response = - let%lwt () = Dream.close ?code response in + let%lwt () = Message.close ?code response in Hashtbl.iter (fun _ close -> close ()) subscriptions; Lwt.return_unit @@ -116,7 +116,7 @@ let complete_message id = (* TODO Test client complete racing against a stream. *) let handle_over_websocket make_context schema subscriptions request response = let rec loop inited = - match%lwt Dream.read response with + match%lwt Message.read response with | None -> log.info (fun log -> log ~request "GraphQL WebSocket closed by client"); close_and_clean subscriptions response @@ -145,7 +145,7 @@ let handle_over_websocket make_context schema subscriptions request response = close_and_clean subscriptions response ~code:4429 end else begin - let%lwt () = Dream.write response ack_message in + let%lwt () = Message.write response ack_message in loop true end @@ -193,13 +193,13 @@ let handle_over_websocket make_context schema subscriptions request response = log.warning (fun log -> log ~request "subscribe: error %s" (Yojson.Basic.to_string json)); - Dream.write response (error_message id json) + Message.write response (error_message id json) (* It's not clear that this case ever occurs, because graphql-ws is only used for subscriptions, at the protocol level. *) | Ok (`Response json) -> - let%lwt () = Dream.write response (data_message id json) in - let%lwt () = Dream.write response (complete_message id) in + let%lwt () = Message.write response (data_message id json) in + let%lwt () = Message.write response (complete_message id) in Lwt.return_unit | Ok (`Stream (stream, close)) -> @@ -216,15 +216,15 @@ let handle_over_websocket make_context schema subscriptions request response = let%lwt () = stream |> Lwt_stream.iter_s (function | Ok json -> - Dream.write response (data_message id json) + Message.write response (data_message id json) | Error json -> log.warning (fun log -> log ~request "Subscription: error %s" (Yojson.Basic.to_string json)); - Dream.write response (error_message id json)) + Message.write response (error_message id json)) in - let%lwt () = Dream.write response (complete_message id) in + let%lwt () = Message.write response (complete_message id) in Hashtbl.remove subscriptions id; Lwt.return_unit @@ -240,12 +240,12 @@ let handle_over_websocket make_context schema subscriptions request response = try%lwt let%lwt () = - Dream.write + Message.write response (error_message id (make_error "Internal Server Error")) in if !subscribed then - Dream.write response (complete_message id) + Message.write response (complete_message id) else Lwt.return_unit with _ -> @@ -271,10 +271,10 @@ let handle_over_websocket make_context schema subscriptions request response = carrying WebSocket upgrade headers. *) let graphql make_context schema = fun request -> - match Dream.method_ request with + match Message.method_ request with | `GET -> - let upgrade = Dream.header request "Upgrade" - and protocol = Dream.header request "Sec-WebSocket-Protocol" in + let upgrade = Message.header request "Upgrade" + and protocol = Message.header request "Sec-WebSocket-Protocol" in begin match upgrade, protocol with | Some "websocket", Some "graphql-transport-ws" -> Helpers.websocket @@ -285,14 +285,14 @@ let graphql make_context schema = fun request -> (* TODO Simplify stream creation. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found client_stream server_stream |> Lwt.return end | `POST -> - begin match Dream.header request "Content-Type" with + begin match Message.header request "Content-Type" with | Some "application/json" -> - let%lwt body = Dream.body request in + let%lwt body = Message.body request in (* TODO This almost certainly raises exceptions... *) let json = Yojson.Basic.from_string body in @@ -316,7 +316,7 @@ let graphql make_context schema = fun request -> "Content-Type not 'application/json'"); let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request client_stream server_stream |> Lwt.return end @@ -325,7 +325,7 @@ let graphql make_context schema = fun request -> "Method %s; must be GET or POST" (Method.method_to_string method_)); let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found client_stream server_stream |> Lwt.return diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 3613b379..045a970f 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -5,8 +5,8 @@ -module Dream = Dream_pure.Inmost module Stream = Dream_pure.Stream +module Message = Dream_pure.Message @@ -20,16 +20,16 @@ let address_to_string : Unix.sockaddr -> string = function (* TODO Write a test simulating client exit during SSE; this was killing the server at some point. *) let forward_body_general - (response : Dream.response) + (response : Message.response) (_write_string : ?off:int -> ?len:int -> string -> unit) - (write_buffer : ?off:int -> ?len:int -> Dream.buffer -> unit) + (write_buffer : ?off:int -> ?len:int -> Message.buffer -> unit) http_flush close = let bytes_since_flush = ref 0 in let rec send () = - Dream.client_stream response + Message.client_stream response |> fun stream -> Stream.read stream @@ -64,7 +64,7 @@ let forward_body_general send () let forward_body - (response : Dream.response) + (response : Message.response) (body : Httpaf.Body.Writer.t) = forward_body_general @@ -75,7 +75,7 @@ let forward_body (fun _code -> Httpaf.Body.Writer.close body) let forward_body_h2 - (response : Dream.response) + (response : Message.response) (body : [ `write ] H2.Body.t) = forward_body_general diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 4089bbad..4b14ecfa 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -6,11 +6,11 @@ module Catch = Dream__server.Catch -module Dream = Dream_pure.Inmost module Error_template = Dream__server.Error_template module Method = Dream_pure.Method module Helpers = Dream__server.Helpers module Log = Dream__server.Log +module Message = Dream_pure.Message module Status = Dream_pure.Status module Stream = Dream_pure.Stream @@ -38,7 +38,7 @@ let dump (error : Catch.error) = begin match error.condition with | `Response response -> - let status = Dream.status response in + let status = Message.status response in p "%i %s\n" (Status.status_to_int status) (Status.status_to_string status) | `String "" -> @@ -90,16 +90,16 @@ let dump (error : Catch.error) = begin match error.request with | None -> () | Some request -> - let major, minor = Dream.version request in + let major, minor = Message.version request in p "\n\n%s %s HTTP/%i.%i" - (Method.method_to_string (Dream.method_ request)) - (Dream.target request) + (Method.method_to_string (Message.method_ request)) + (Message.target request) major minor; - Dream.all_headers request + Message.all_headers request |> List.iter (fun (name, value) -> p "\n%s: %s" name value); - Dream.fold_fields (fun name value first -> + Message.fold_fields (fun name value first -> if first then p "\n"; p "\n%s: %s" name value; @@ -176,7 +176,7 @@ let customize template (error : Catch.error) = (* TODO Simplify the streams creation. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status client_stream server_stream + Message.response ~status client_stream server_stream in (* No need to catch errors when calling the template, because every call @@ -192,11 +192,11 @@ let default_template _error _debug_dump response = Lwt.return response let debug_template _error debug_dump response = - let status = Dream.status response in + let status = Message.status response in let code = Status.status_to_int status and reason = Status.status_to_string status in - Dream.set_header response "Content-Type" Dream_pure.Formats.text_html; - Dream.set_body response (Error_template.render ~debug_dump ~code ~reason); + Message.set_header response "Content-Type" Dream_pure.Formats.text_html; + Message.set_body response (Error_template.render ~debug_dump ~code ~reason); Lwt.return response let default = @@ -241,13 +241,13 @@ let respond_with_option f = (* TODO Simplify streams. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response + Message.response ~status:`Internal_Server_Error client_stream server_stream)) (fun () -> (* TODO Simplify streams. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response + Message.response ~status:`Internal_Server_Error client_stream server_stream |> Lwt.return) @@ -274,11 +274,11 @@ let default_response = function | `Server -> let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Internal_Server_Error client_stream server_stream + Message.response ~status:`Internal_Server_Error client_stream server_stream | `Client -> let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request client_stream server_stream let httpaf user's_error_handler = @@ -328,7 +328,7 @@ let httpaf | None -> default_response caused_by in - let headers = Httpaf.Headers.of_list (Dream.all_headers response) in + let headers = Httpaf.Headers.of_list (Message.all_headers response) in let body = start_response headers in Adapt.forward_body response body; @@ -386,7 +386,7 @@ let h2 | None -> default_response caused_by in - let headers = H2.Headers.of_list (Dream.all_headers response) in + let headers = H2.Headers.of_list (Message.all_headers response) in let body = start_response headers in Adapt.forward_body_h2 response body; diff --git a/src/http/error_handler.mli b/src/http/error_handler.mli index 5e96f6fe..285469b5 100644 --- a/src/http/error_handler.mli +++ b/src/http/error_handler.mli @@ -6,8 +6,8 @@ module Catch = Dream__server.Catch -module Dream = Dream_pure.Inmost module Log = Dream__server.Log +module Message = Dream_pure.Message @@ -17,7 +17,7 @@ module Log = Dream__server.Log val default : Catch.error_handler val debug_error_handler : Catch.error_handler val customize : - (Catch.error -> string -> Dream.response -> Dream.response Lwt.t) -> + (Catch.error -> string -> Message.response -> Message.response Lwt.t) -> Catch.error_handler @@ -35,7 +35,7 @@ val customize : val app : Catch.error_handler -> - (Catch.error -> Dream.response Lwt.t) + (Catch.error -> Message.response Lwt.t) val httpaf : Catch.error_handler -> @@ -51,13 +51,13 @@ val tls : val websocket : Catch.error_handler -> - Dream.request -> - Dream.response -> + Message.request -> + Message.response -> (Websocketaf.Wsd.t -> [ `Exn of exn ] -> unit) val websocket_handshake : Catch.error_handler -> - (Dream.request -> Dream.response -> string -> Dream.response Lwt.t) + (Message.request -> Message.response -> string -> Message.response Lwt.t) diff --git a/src/http/http.ml b/src/http/http.ml index c910ae82..df0e9660 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -7,10 +7,10 @@ module Catch = Dream__server.Catch module Content_length = Dream__server.Content_length -module Dream = Dream_pure.Inmost module Helpers = Dream__server.Helpers module Log = Dream__server.Log module Lowercase_headers = Dream__server.Lowercase_headers +module Message = Dream_pure.Message module Method = Dream_pure.Method module Status = Dream_pure.Status module Stream = Dream_pure.Stream @@ -205,11 +205,11 @@ let websocket_handler response socket = in let reader = Stream.reader ~read ~close in - Stream.forward reader (Dream.client_stream response); + Stream.forward reader (Message.client_stream response); let rec outgoing_loop () = Stream.read - (Dream.client_stream response) + (Message.client_stream response) ~data:(fun buffer offset length binary fin -> (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) if not fin then @@ -277,7 +277,7 @@ let websocket_handler response socket = let wrap_handler https (user's_error_handler : Catch.error_handler) - (user's_dream_handler : Dream.handler) = + (user's_dream_handler : Message.handler) = let httpaf_request_handler = fun client_address (conn : _ Gluten.Reqd.t) -> Log.set_up_exception_hook (); @@ -318,7 +318,7 @@ let wrap_handler let body = Stream.stream body Stream.no_writer in - let request : Dream.request = + let request : Message.request = Helpers.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise @@ -347,7 +347,7 @@ let wrap_handler transmit the resulting error response. *) let forward_response response = let headers = - Httpaf.Headers.of_list (Dream.all_headers response) in + Httpaf.Headers.of_list (Message.all_headers response) in (* let version = match Dream.version_override response with @@ -355,7 +355,7 @@ let wrap_handler | Some (major, minor) -> Some Httpaf.Version.{major; minor} in *) let status = - to_httpaf_status (Dream.status response) in + to_httpaf_status (Message.status response) in (* let reason = Dream.reason_override response in *) @@ -383,7 +383,7 @@ let wrap_handler in let headers = - Httpaf.Headers.of_list (Dream.all_headers response) in + Httpaf.Headers.of_list (Message.all_headers response) in Websocketaf.Handshake.respond_with_upgrade ~headers ~sha1 conn proceed |> function @@ -413,7 +413,7 @@ let wrap_handler let wrap_handler_h2 https (_user's_error_handler : Catch.error_handler) - (user's_dream_handler : Dream.handler) = + (user's_dream_handler : Message.handler) = let httpaf_request_handler = fun client_address (conn : H2.Reqd.t) -> Log.set_up_exception_hook (); @@ -448,7 +448,7 @@ let wrap_handler_h2 let body = Stream.stream body Stream.no_writer in - let request : Dream.request = + let request : Message.request = Helpers.request ~client ~method_ ~target ~https ~version ~headers body in (* Call the user's handler. If it raises an exception or returns a promise @@ -470,9 +470,9 @@ let wrap_handler_h2 let forward_response response = let headers = - H2.Headers.of_list (Dream.all_headers response) in + H2.Headers.of_list (Message.all_headers response) in let status = - to_h2_status (Dream.status response) in + to_h2_status (Message.status response) in let h2_response = H2.Response.create ~headers status in let body = @@ -515,7 +515,7 @@ type tls_library = { create_handler : certificate_file:string -> key_file:string -> - handler:Dream.handler -> + handler:Message.handler -> error_handler:Catch.error_handler -> Unix.sockaddr -> Lwt_unix.file_descr -> @@ -608,7 +608,7 @@ let ocaml_tls = { let built_in_middleware error_handler = - Dream.pipeline [ + Message.pipeline [ Lowercase_headers.lowercase_headers; Content_length.content_length; Catch.catch (Error_handler.app error_handler); diff --git a/src/pure/inmost.ml b/src/pure/message.ml similarity index 100% rename from src/pure/inmost.ml rename to src/pure/message.ml diff --git a/src/pure/inmost.mli b/src/pure/message.mli similarity index 100% rename from src/pure/inmost.mli rename to src/pure/message.mli diff --git a/src/server/catch.ml b/src/server/catch.ml index 8922c062..da550b78 100644 --- a/src/server/catch.ml +++ b/src/server/catch.ml @@ -5,14 +5,14 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message module Status = Dream_pure.Status type error = { condition : [ - | `Response of Dream.response + | `Response of Message.response | `String of string | `Exn of exn ]; @@ -27,14 +27,14 @@ type error = { | `Server | `Client ]; - request : Dream.request option; - response : Dream.response option; + request : Message.request option; + response : Message.response option; client : string option; severity : Log.log_level; will_send_response : bool; } -type error_handler = error -> Dream.response option Dream.promise +type error_handler = error -> Message.response option Message.promise (* This error handler actually *is* a middleware, but it is just one pathway for reaching the centralized error handler provided by the user, so it is built @@ -49,7 +49,7 @@ let catch error_handler next_handler request = next_handler request) (fun response -> - let status = Dream.status response in + let status = Message.status response in (* TODO Overfull hbox. *) if Status.is_client_error status || Status.is_server_error status then begin diff --git a/src/server/content_length.ml b/src/server/content_length.ml index ba7a6338..4c411ea8 100644 --- a/src/server/content_length.ml +++ b/src/server/content_length.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -15,10 +15,10 @@ module Dream = Dream_pure.Inmost (* Add a Content-Length header to HTTP 1.x responses that have a fixed body but don't yet have the header. *) let content_length next_handler request = - if fst (Dream.version request) <> 1 then + if fst (Message.version request) <> 1 then next_handler request else - let%lwt (response : Dream.response) = next_handler request in - if not (Dream.has_header response "Transfer-Encoding") then - Dream.add_header response "Transfer-Encoding" "chunked"; + let%lwt (response : Message.response) = next_handler request in + if not (Message.has_header response "Transfer-Encoding") then + Message.add_header response "Transfer-Encoding" "chunked"; Lwt.return response diff --git a/src/server/cookie.ml b/src/server/cookie.ml index 84742f08..fdb9e450 100644 --- a/src/server/cookie.ml +++ b/src/server/cookie.ml @@ -6,8 +6,8 @@ module Cipher = Dream__cipher.Cipher -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message @@ -24,7 +24,7 @@ module Formats = Dream_pure.Formats (* TODO DOC We allow multiple headers sent by the client, to support HTTP/2. What is this about? *) let all_cookies request = - Dream.headers request "Cookie" + Message.headers request "Cookie" |> List.map Formats.from_cookie |> List.flatten @@ -132,7 +132,7 @@ let set_cookie ?expires ?max_age ?domain ?path ~secure ~http_only ?same_site name value in - Dream.add_header response "Set-Cookie" set_cookie + Message.add_header response "Set-Cookie" set_cookie let drop_cookie ?prefix ?domain ?path ?secure ?http_only ?same_site name request response = diff --git a/src/server/echo.ml b/src/server/echo.ml index 2a9fb8b0..3e5f076f 100644 --- a/src/server/echo.ml +++ b/src/server/echo.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message module Stream = Dream_pure.Stream @@ -14,7 +14,7 @@ module Stream = Dream_pure.Stream let echo request = (* TODO Simplfy this code. Can in fact just pass the request's server stream as the response's client stream. *) - let client_stream = Dream.server_stream request in + let client_stream = Message.server_stream request in let server_stream = Stream.(stream no_reader no_writer) in - Dream.response client_stream server_stream + Message.response client_stream server_stream |> Lwt.return diff --git a/src/server/flash.ml b/src/server/flash.ml index 17e0640c..254c2567 100644 --- a/src/server/flash.ml +++ b/src/server/flash.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -16,7 +16,7 @@ let five_minutes = 5. *. 60. let storage_field = - Dream.new_field ~name:"dream.flash" () + Message.new_field ~name:"dream.flash" () let flash_cookie = "dream.flash" @@ -53,7 +53,7 @@ let flash request = let put_flash request category message = let outbox = - match Dream.field request storage_field with + match Message.field request storage_field with | Some outbox -> outbox | None -> let message = "Missing flash message middleware" in @@ -75,7 +75,7 @@ let flash_messages inner_handler request = else log ~request "%s" "No flash messages."); let outbox = ref [] in - Dream.set_field request storage_field outbox; + Message.set_field request storage_field outbox; let existing = Cookie.cookie request flash_cookie in let%lwt response = inner_handler request in let entries = List.rev !outbox in diff --git a/src/server/form.ml b/src/server/form.ml index 98871168..d9f4284b 100644 --- a/src/server/form.ml +++ b/src/server/form.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -55,9 +55,9 @@ let sort_and_check_form ~now to_value form request = Lwt.return (`Many_tokens form) let form ?(csrf = true) ~now request = - match Dream.header request "Content-Type" with + match Message.header request "Content-Type" with | Some "application/x-www-form-urlencoded" -> - let%lwt body = Dream.body request in + let%lwt body = Message.body request in let form = Dream_pure.Formats.from_form_urlencoded body in if csrf then sort_and_check_form ~now (fun string -> string) form request diff --git a/src/server/helpers.ml b/src/server/helpers.ml index 27c48c4f..7f7975af 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -5,15 +5,15 @@ -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message module Status = Dream_pure.Status module Stream = Dream_pure.Stream let client_field = - Dream.new_field + Message.new_field ~name:"dream.client" ~show_value:(fun client -> client) () @@ -21,28 +21,28 @@ let client_field = (* TODO What should be reported when the client address is missing? This is a sign of local testing. *) let client request = - match Dream.field request client_field with + match Message.field request client_field with | None -> "127.0.0.1:0" | Some client -> client let set_client request client = - Dream.set_field request client_field client + Message.set_field request client_field client let https_field = - Dream.new_field + Message.new_field ~name:"dream.https" ~show_value:string_of_bool () let https request = - match Dream.field request https_field with + match Message.field request https_field with | Some true -> true | _ -> false let set_https request https = - Dream.set_field request https_field https + Message.set_field request https_field https @@ -50,7 +50,7 @@ let request ~client ~method_ ~target ~https ~version ~headers server_stream = (* TODO Use pre-allocated streams. *) let client_stream = Stream.(stream no_reader no_writer) in let request = - Dream.request + Message.request ~method_ ~target ~version ~headers client_stream server_stream in set_client request client; set_https request https; @@ -60,7 +60,7 @@ let request_with_body ?method_ ?target ?version ?headers body = (* TODO Streams. *) let client_stream = Stream.(stream no_reader no_writer) and server_stream = Stream.(stream (string body) no_writer) in - Dream.request ?method_ ?target ?version ?headers client_stream server_stream + Message.request ?method_ ?target ?version ?headers client_stream server_stream @@ -69,8 +69,8 @@ let html ?status ?code ?headers body = let client_stream = Stream.(stream (string body) no_writer) and server_stream = Stream.(stream no_reader no_writer) in let response = - Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_header response "Content-Type" Formats.text_html; + Message.response ?status ?code ?headers client_stream server_stream in + Message.set_header response "Content-Type" Formats.text_html; Lwt.return response let json ?status ?code ?headers body = @@ -78,20 +78,20 @@ let json ?status ?code ?headers body = let client_stream = Stream.(stream (string body) no_writer) and server_stream = Stream.(stream no_reader no_writer) in let response = - Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_header response "Content-Type" Formats.application_json; + Message.response ?status ?code ?headers client_stream server_stream in + Message.set_header response "Content-Type" Formats.application_json; Lwt.return response let response_with_body ?status ?code ?headers body = (* TODO Streams. *) let client_stream = Stream.(stream (string body) no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ?status ?code ?headers client_stream server_stream + Message.response ?status ?code ?headers client_stream server_stream let respond ?status ?code ?headers body = let client_stream = Stream.(stream (string body) no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ?status ?code ?headers client_stream server_stream + Message.response ?status ?code ?headers client_stream server_stream |> Lwt.return (* TODO Actually use the request and extract the site prefix. *) @@ -106,8 +106,8 @@ let redirect ?status ?code ?headers _request location = let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in let response = - Dream.response ?status ?code ?headers client_stream server_stream in - Dream.set_header response "Location" location; + Message.response ?status ?code ?headers client_stream server_stream in + Message.set_header response "Location" location; Lwt.return response let stream ?status ?code ?headers callback = @@ -115,7 +115,7 @@ let stream ?status ?code ?headers callback = let client_stream = Stream.stream reader Stream.no_writer and server_stream = Stream.stream Stream.no_reader writer in let response = - Dream.response ?status ?code ?headers client_stream server_stream in + Message.response ?status ?code ?headers client_stream server_stream in (* TODO Should set up an error handler for this. YES. *) (* TODO Make sure the request id is propagated to the callback. *) let wrapped_callback _ = Lwt.async (fun () -> callback response) in @@ -123,13 +123,13 @@ let stream ?status ?code ?headers callback = Lwt.return response let websocket_field = - Dream.new_field + Message.new_field ~name:"dream.websocket" ~show_value:(Printf.sprintf "%b") () let is_websocket response = - match Dream.field response websocket_field with + match Message.field response websocket_field with | Some true -> true | _ -> false @@ -140,9 +140,9 @@ let websocket ?headers callback = let client_stream = Stream.stream out_reader in_writer and server_stream = Stream.stream in_reader out_writer in let response = - Dream.response + Message.response ~status:`Switching_Protocols ?headers client_stream server_stream in - Dream.set_field response websocket_field true; + Message.set_field response websocket_field true; (* TODO Make sure the request id is propagated to the callback. *) let wrapped_callback _ = Lwt.async (fun () -> callback response) in Stream.ready server_stream ~close:wrapped_callback wrapped_callback; diff --git a/src/server/log.ml b/src/server/log.ml index ff5cebd7..f2a664f2 100644 --- a/src/server/log.ml +++ b/src/server/log.ml @@ -27,7 +27,7 @@ This is sufficient for attaching a request id to most log messages, in practice. *) -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message module Method = Dream_pure.Method module Status = Dream_pure.Status @@ -76,7 +76,7 @@ let id_lwt_key : string Lwt.key = (* The actual request id "field" associated with each request by the logger. If this field is missing, the logger assigns the request a fresh id. *) let id_field = - Dream.new_field + Message.new_field ~name:request_id_label ~show_value:(fun id -> id) () @@ -86,7 +86,7 @@ let get_request_id ?request () = let request_id = match request with | None -> None - | Some request -> Dream.field request id_field + | Some request -> Message.field request id_field in match request_id with | Some _ -> request_id @@ -294,7 +294,7 @@ let initialized () : [ `Initialized ] = (* The "front end." *) type ('a, 'b) conditional_log = - ((?request:Dream.request -> + ((?request:Message.request -> ('a, Stdlib.Format.formatter, unit, 'b) Stdlib.format4 -> 'a) -> 'b) -> unit @@ -470,25 +470,25 @@ struct (* Get the requwst's id or assign a new one. *) let id = - match Dream.field request id_field with + match Message.field request id_field with | Some id -> id | None -> last_id := !last_id + 1; let id = string_of_int !last_id in - Dream.set_field request id_field id; + Message.set_field request id_field id; id in (* Identify the request in the log. *) let user_agent = - Dream.headers request "User-Agent" + Message.headers request "User-Agent" |> String.concat " " in log.info (fun log -> log ~request "%s %s %s %s" - (Method.method_to_string (Dream.method_ request)) - (Dream.target request) + (Method.method_to_string (Message.method_ request)) + (Message.target request) (Helpers.client request) user_agent); @@ -501,17 +501,17 @@ struct (* Log the elapsed time. If the response is a redirection, log the target. *) let location = - if Status.is_redirection (Dream.status response) then - match Dream.header response "Location" with + if Status.is_redirection (Message.status response) then + match Message.header response "Location" with | Some location -> " " ^ location | None -> "" else "" in - let status = Dream.status response in + let status = Message.status response in let report : - (?request:Dream.request -> + (?request:Message.request -> ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b = fun log -> let elapsed = now () -. start in diff --git a/src/server/lowercase_headers.ml b/src/server/lowercase_headers.ml index 590f52bc..b3ff584f 100644 --- a/src/server/lowercase_headers.ml +++ b/src/server/lowercase_headers.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -16,8 +16,8 @@ module Dream = Dream_pure.Inmost lowercase. Another option is to use memoization to reduce GC pressure. *) let lowercase_headers inner_handler request = let%lwt response = inner_handler request in - if fst (Dream.version request) <> 1 then - Dream.all_headers response + if fst (Message.version request) <> 1 then + Message.all_headers response |> List.map (fun (name, value) -> String.lowercase_ascii name, value) - |> Dream.set_all_headers response; + |> Message.set_all_headers response; Lwt.return response diff --git a/src/server/origin_referrer_check.ml b/src/server/origin_referrer_check.ml index 93d5c415..edba9856 100644 --- a/src/server/origin_referrer_check.ml +++ b/src/server/origin_referrer_check.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message module Stream = Dream_pure.Stream @@ -16,14 +16,14 @@ let log = (* TODO Rename all next_handler to inner_handler. *) let origin_referrer_check inner_handler request = - match Dream.method_ request with + match Message.method_ request with | `GET | `HEAD -> inner_handler request | _ -> let origin = - match Dream.header request "Origin" with - | Some "null" | None -> Dream.header request "Referer" + match Message.header request "Origin" with + | Some "null" | None -> Message.header request "Referer" | Some _ as origin -> origin in @@ -34,19 +34,19 @@ let origin_referrer_check inner_handler request = (* TODO Simplify. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request client_stream server_stream |> Lwt.return (* TODO Also recommend Uri to users. *) | Some origin -> - match Dream.header request "Host" with + match Message.header request "Host" with | None -> log.warning (fun log -> log ~request "Host header missing"); (* TODO Simplify. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request client_stream server_stream |> Lwt.return | Some host -> @@ -84,6 +84,6 @@ let origin_referrer_check inner_handler request = (* TODO Simplify. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request client_stream server_stream |> Lwt.return end diff --git a/src/server/query.ml b/src/server/query.ml index cba19087..be91420a 100644 --- a/src/server/query.ml +++ b/src/server/query.ml @@ -8,8 +8,8 @@ (* TODO Long-term, query string handler is likely to become part of the router. *) -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message @@ -23,7 +23,7 @@ module Formats = Dream_pure.Formats |> String.concat ", ") *) let all_queries request = - Dream.target request + Message.target request |> Formats.split_target |> snd |> Formats.from_form_urlencoded diff --git a/src/server/router.ml b/src/server/router.ml index 108837ea..a5170a72 100644 --- a/src/server/router.ml +++ b/src/server/router.ml @@ -5,8 +5,8 @@ -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message module Method = Dream_pure.Method @@ -93,7 +93,7 @@ let rec strip_empty_trailing_token = function type method_set = [ - | Dream.method_ + | Method.method_ | `Any ] @@ -103,7 +103,7 @@ let method_matches method_set method_ = | `Any -> true type node = - | Handler of method_set * Dream.handler + | Handler of method_set * Message.handler | Scope of route and route = (token list * node) list @@ -165,8 +165,8 @@ let scope prefix middlewares routes = -let path_field : string list Dream.field = - Dream.new_field +let path_field : string list Message.field = + Message.new_field ~name:"dream.path" ~show_value:(fun path -> String.concat "/" path) () @@ -175,24 +175,25 @@ let path_field : string list Dream.field = string. *) (* TODO Remove this from the API. *) let path the_request = - match Dream.field the_request path_field with + match Message.field the_request path_field with | Some path -> path | None -> - Dream.(Formats.(the_request |> target |> split_target |> fst |> from_path)) + Message.(Formats.( + the_request |> target |> split_target |> fst |> from_path)) (* TODO Move site_prefix into this file and remove with_path from the API. *) let set_path request path = - Dream.set_field request path_field path + Message.set_field request path_field path (* Prefix is stored backwards. *) -let prefix_field : string list Dream.field = - Dream.new_field +let prefix_field : string list Message.field = + Message.new_field ~name:"dream.prefix" ~show_value:(fun prefix -> String.concat "/" (List.rev prefix)) () let internal_prefix request = - match Dream.field request prefix_field with + match Message.field request prefix_field with | Some prefix -> prefix | None -> [] @@ -200,10 +201,10 @@ let prefix request = Formats.make_path (List.rev (internal_prefix request)) let set_prefix request prefix = - Dream.set_field request prefix_field prefix + Message.set_field request prefix_field prefix -let params_field : (string * string) list Dream.field = - Dream.new_field +let params_field : (string * string) list Message.field = + Message.new_field ~name:"dream.params" ~show_value:(fun params -> params @@ -222,7 +223,7 @@ let missing_param request name = failwith message let param request name = - match Dream.field request params_field with + match Message.field request params_field with | None -> missing_param request name | Some params -> try List.assoc name params @@ -260,8 +261,8 @@ let router routes = and try_node bindings prefix path node is_wildcard ok fail = match node with | Handler (method_, handler) - when method_matches method_ (Dream.method_ request) -> - Dream.set_field request params_field bindings; + when method_matches method_ (Message.method_ request) -> + Message.set_field request params_field bindings; if is_wildcard then begin set_prefix request prefix; set_path request path; @@ -279,7 +280,7 @@ let router routes = in let params = - match Dream.field request params_field with + match Message.field request params_field with | Some params -> params | None -> [] in diff --git a/src/server/router.mli b/src/server/router.mli index 4d71e769..e94855c2 100644 --- a/src/server/router.mli +++ b/src/server/router.mli @@ -5,37 +5,37 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message type route (* Leaf routes. *) -val get : string -> Dream.handler -> route -val post : string -> Dream.handler -> route -val put : string -> Dream.handler -> route -val delete : string -> Dream.handler -> route -val head : string -> Dream.handler -> route -val connect : string -> Dream.handler -> route -val options : string -> Dream.handler -> route -val trace : string -> Dream.handler -> route -val patch : string -> Dream.handler -> route -val any : string -> Dream.handler -> route +val get : string -> Message.handler -> route +val post : string -> Message.handler -> route +val put : string -> Message.handler -> route +val delete : string -> Message.handler -> route +val head : string -> Message.handler -> route +val connect : string -> Message.handler -> route +val options : string -> Message.handler -> route +val trace : string -> Message.handler -> route +val patch : string -> Message.handler -> route +val any : string -> Message.handler -> route val no_route : route (* Route groups. *) -val scope : string -> Dream.middleware list -> route list -> route +val scope : string -> Message.middleware list -> route list -> route (* The middleware and the path parameter retriever. With respect to path parameters, the middleware is the setter, and the retriever is, of course, the getter. *) -val router : route list -> Dream.middleware -val param : Dream.request -> string -> string +val router : route list -> Message.middleware +val param : Message.request -> string -> string (* Variables used by the router. *) -val path : Dream.request -> string list -val prefix : Dream.request -> string -val set_path : Dream.request -> string list -> unit -val set_prefix : Dream.request -> string list -> unit +val path : Message.request -> string list +val prefix : Message.request -> string +val set_path : Message.request -> string list -> unit +val set_prefix : Message.request -> string list -> unit (**/**) diff --git a/src/server/session.ml b/src/server/session.ml index d7169597..a8e092c6 100644 --- a/src/server/session.ml +++ b/src/server/session.ml @@ -7,7 +7,7 @@ (* https://cheatsheetseries.owasp.org/cheatsheets/Session_Management_Cheat_Sheet.html *) -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -15,18 +15,18 @@ let log = Log.sub_log "dream.session" type 'a back_end = { - load : Dream.request -> 'a Lwt.t; - send : 'a -> Dream.request -> Dream.response -> Dream.response Lwt.t; + load : Message.request -> 'a Lwt.t; + send : 'a -> Message.request -> Message.response -> Message.response Lwt.t; } let middleware field back_end = fun inner_handler request -> let%lwt session = back_end.load request in - Dream.set_field request field session; + Message.set_field request field session; let%lwt response = inner_handler request in back_end.send session request response let getter field request = - match Dream.field request field with + match Message.field request field with | Some session -> session | None -> @@ -35,12 +35,12 @@ let getter field request = failwith message type 'a typed_middleware = { - middleware : 'a back_end -> Dream.middleware; - getter : Dream.request -> 'a; + middleware : 'a back_end -> Message.middleware; + getter : Message.request -> 'a; } let typed_middleware ?show_value () = - let field = Dream.new_field ~name:"dream.session" ?show_value () in + let field = Message.new_field ~name:"dream.session" ?show_value () in { middleware = middleware field; getter = getter field; diff --git a/src/server/site_prefix.ml b/src/server/site_prefix.ml index cb64e463..210c0993 100644 --- a/src/server/site_prefix.ml +++ b/src/server/site_prefix.ml @@ -5,8 +5,8 @@ -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message module Stream = Dream_pure.Stream @@ -38,7 +38,7 @@ let with_site_prefix prefix = (* TODO Streams. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Bad_Gateway client_stream server_stream + Message.response ~status:`Bad_Gateway client_stream server_stream |> Lwt.return | Some path -> (* TODO This doesn't need to be recomputed on each request - can cache the diff --git a/src/server/upload.ml b/src/server/upload.ml index 9417c255..0b983c61 100644 --- a/src/server/upload.ml +++ b/src/server/upload.ml @@ -5,7 +5,7 @@ -module Dream = Dream_pure.Inmost +module Message = Dream_pure.Message @@ -30,8 +30,8 @@ let initial_multipart_state () = { } (* TODO Dump the value of the multipart state somehow? *) -let multipart_state_field : multipart_state Dream.field = - Dream.new_field +let multipart_state_field : multipart_state Message.field = + Message.new_field ~name:"dream.multipart" () @@ -40,7 +40,7 @@ let multipart_state_field : multipart_state Dream.field = let multipart_state _request = assert false -let field_to_string (request : Dream.request) field = +let field_to_string (request : Message.request) field = let open Multipart_form in match field with | Field.Field (field_name, Field.Content_type, v) -> @@ -57,7 +57,7 @@ let field_to_string (request : Dream.request) field = let log = Log.sub_log "dream.upload" -let upload_part (request : Dream.request) = +let upload_part (request : Message.request) = let state = multipart_state request in match%lwt Lwt_stream.peek state.stream with | None -> Lwt.return_none @@ -74,7 +74,7 @@ let identify _ = object end type part = string option * string option * ((string * string) list) -let rec state (request : Dream.request) = +let rec state (request : Message.request) = let state' = multipart_state request in let stream = state'.stream in match%lwt Lwt_stream.peek stream with @@ -89,14 +89,14 @@ let rec state (request : Dream.request) = state'.name, state'.filename, headers in Lwt.return (Some part) -and upload (request : Dream.request) = +and upload (request : Message.request) = let state' = multipart_state request in match state'.state_init with | false -> state request | true -> - let content_type = match Dream.header request "Content-Type" with + let content_type = match Message.header request "Content-Type" with | Some content_type -> Result.to_option (Multipart_form.Content_type.of_string (content_type ^ "\r\n")) @@ -112,7 +112,7 @@ and upload (request : Dream.request) = failwith message | Some content_type -> - let body = Lwt_stream.from (fun () -> Dream.read request) in + let body = Lwt_stream.from (fun () -> Message.read request) in let `Parse th, stream = Multipart_form_lwt.stream ~identify body content_type in Lwt.async (fun () -> let%lwt _ = th in Lwt.return_unit); @@ -125,14 +125,14 @@ type multipart_form = module Map = Map.Make (String) let multipart ?(csrf=true) ~now request = - let content_type = match Dream.header request "Content-Type" with + let content_type = match Message.header request "Content-Type" with | Some content_type -> Result.to_option (Multipart_form.Content_type.of_string (content_type ^ "\r\n")) | None -> None in match content_type with | None -> Lwt.return `Wrong_content_type | Some content_type -> - let body = Lwt_stream.from (fun () -> Dream.read request) in + let body = Lwt_stream.from (fun () -> Message.read request) in match%lwt Multipart_form_lwt.of_stream_to_list body content_type with | Error (`Msg _err) -> Lwt.return `Wrong_content_type (* XXX(dinosaure): better error? *) diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 234343f8..a46d763c 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -5,8 +5,8 @@ -module Dream = Dream_pure.Inmost module Log = Dream__server.Log +module Message = Dream_pure.Message @@ -14,8 +14,8 @@ let log = Log.sub_log "dream.sql" (* TODO Debug metadata for the pools. *) -let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Dream.field = - Dream.new_field () +let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Message.field = + Message.new_field () let foreign_keys_on = Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON" @@ -31,7 +31,7 @@ let sql_pool ?size uri = begin match !pool_cell with | Some pool -> - Dream.set_field request pool_field pool; + Message.set_field request pool_field pool; inner_handler request | None -> (* The correctness of this code is subtle. There is no race condition with @@ -47,7 +47,7 @@ let sql_pool ?size uri = match pool with | Ok pool -> pool_cell := Some pool; - Dream.set_field request pool_field pool; + Message.set_field request pool_field pool; inner_handler request | Error error -> (* Deliberately raise an exception so that it can be communicated to any @@ -60,7 +60,7 @@ let sql_pool ?size uri = end let sql request callback = - match Dream.field request pool_field with + match Message.field request pool_field with | None -> let message = "Dream.sql: no pool; did you apply Dream.sql_pool?" in log.error (fun log -> log ~request "%s" message); diff --git a/src/unix/static.ml b/src/unix/static.ml index 7a163bbf..6353d1ec 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -5,8 +5,8 @@ -module Dream = Dream_pure.Inmost module Formats = Dream_pure.Formats +module Message = Dream_pure.Message module Method = Dream_pure.Method module Router = Dream__server.Router module Stream = Dream_pure.Stream @@ -35,13 +35,13 @@ let from_filesystem local_root path _ = (* TODO Can use some pre-allocated streams or helpers here and below. *) let client_stream = Stream.(stream (string content) no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~headers:(mime_lookup path) client_stream server_stream + Message.response ~headers:(mime_lookup path) client_stream server_stream |> Lwt.return)) (fun _exn -> (* TODO Improve the two-stream code using some helper. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found client_stream server_stream |> Lwt.return) (* TODO Add ETag handling. *) @@ -79,11 +79,11 @@ let validate_path request = let static ?(loader = from_filesystem) local_root = fun request -> - if not @@ Method.methods_equal (Dream.method_ request) `GET then + if not @@ Method.methods_equal (Message.method_ request) `GET then (* TODO Simplify this code and reduce allocations. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found client_stream server_stream |> Lwt.return else @@ -92,19 +92,19 @@ let static ?(loader = from_filesystem) local_root = fun request -> (* TODO Improve with helpers. *) let client_stream = Stream.(stream empty no_writer) and server_stream = Stream.(stream no_reader no_writer) in - Dream.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found client_stream server_stream |> Lwt.return | Some path -> let%lwt response = loader local_root path request in - if not (Dream.has_header response "Content-Type") then begin - match Dream.status response with + if not (Message.has_header response "Content-Type") then begin + match Message.status response with | `OK | `Non_Authoritative_Information | `No_Content | `Reset_Content | `Partial_Content -> - Dream.add_header response "Content-Type" (Magic_mime.lookup path) + Message.add_header response "Content-Type" (Magic_mime.lookup path) | _ -> () end; From 812bcad8c4a5bf1ef6c739ed76b56bbf09874250 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 21 Dec 2021 13:41:33 +0300 Subject: [PATCH 109/312] message.mli: prune type abbreviations --- src/http/adapt.ml | 2 +- src/pure/message.ml | 16 +++++----------- src/pure/message.mli | 32 +++++++++++++------------------- 3 files changed, 19 insertions(+), 31 deletions(-) diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 045a970f..8d23af2a 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -22,7 +22,7 @@ let address_to_string : Unix.sockaddr -> string = function let forward_body_general (response : Message.response) (_write_string : ?off:int -> ?len:int -> string -> unit) - (write_buffer : ?off:int -> ?len:int -> Message.buffer -> unit) + (write_buffer : ?off:int -> ?len:int -> Stream.buffer -> unit) http_flush close = diff --git a/src/pure/message.ml b/src/pure/message.ml index 6620e29a..a53c4427 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -7,12 +7,6 @@ (* Type abbreviations and modules used in defining the primary types *) -type method_ = Method.method_ -type status = Status.status - -type stream = Stream.stream -type buffer = Stream.buffer - type 'a promise = 'a Lwt.t type 'a field_metadata = { @@ -26,7 +20,7 @@ module Fields = Hmap.Make (struct type 'a t = 'a field_metadata end) (* Messages (requests and responses) *) type client = { - mutable method_ : method_; + mutable method_ : Method.method_; target : string; mutable version : int * int; } @@ -37,7 +31,7 @@ type client = { some middleware to decide which headers to add. *) type server = { - status : status; + status : Status.status; } type 'a message = { @@ -71,7 +65,7 @@ let request server_stream = let method_ = - match (method_ :> method_ option) with + match (method_ :> Method.method_ option) with | None -> `GET | Some method_ -> method_ in @@ -97,7 +91,7 @@ let version request = request.specific.version let set_method_ request method_ = - request.specific.method_ <- (method_ :> method_) + request.specific.method_ <- (method_ :> Method.method_) let set_version request version = request.specific.version <- version @@ -110,7 +104,7 @@ let response ?status ?code ?(headers = []) client_stream server_stream = let status = match status, code with | None, None -> `OK - | Some status, _ -> (status :> status) + | Some status, _ -> (status :> Status.status) | None, Some code -> Status.int_to_status code in { diff --git a/src/pure/message.mli b/src/pure/message.mli index e6089e82..9865a988 100644 --- a/src/pure/message.mli +++ b/src/pure/message.mli @@ -19,40 +19,34 @@ type 'a promise = 'a Lwt.t type handler = request -> response promise type middleware = handler -> handler -type method_ = Method.method_ -type status = Status.status - -type stream = Stream.stream -type buffer = Stream.buffer - val request : - ?method_:[< method_ ] -> + ?method_:[< Method.method_ ] -> ?target:string -> ?version:int * int -> ?headers:(string * string) list -> - stream -> - stream -> + Stream.stream -> + Stream.stream -> request -val method_ : request -> method_ +val method_ : request -> Method.method_ val target : request -> string val version : request -> int * int -val set_method_ : request -> [< method_ ] -> unit +val set_method_ : request -> [< Method.method_ ] -> unit val set_version : request -> int * int -> unit val response : - ?status:[< status ] -> + ?status:[< Status.status ] -> ?code:int -> ?headers:(string * string) list -> - stream -> - stream -> + Stream.stream -> + Stream.stream -> response -val status : response -> status +val status : response -> Status.status @@ -74,10 +68,10 @@ val read : 'a message -> string option promise val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise val flush : response -> unit promise val close : ?code:int -> 'a message -> unit promise -val client_stream : 'a message -> stream -val server_stream : 'a message -> stream -val set_client_stream : 'a message -> stream -> unit -val set_server_stream : 'a message -> stream -> unit +val client_stream : 'a message -> Stream.stream +val server_stream : 'a message -> Stream.stream +val set_client_stream : 'a message -> Stream.stream -> unit +val set_server_stream : 'a message -> Stream.stream -> unit From 4fbb0c56f4e64ff83d41324e7720ef4d3effc039 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 00:10:44 +0300 Subject: [PATCH 110/312] dream-pure does not depend on multipart_form --- src/pure/dune | 1 - 1 file changed, 1 deletion(-) diff --git a/src/pure/dune b/src/pure/dune index 093a25cf..76415568 100644 --- a/src/pure/dune +++ b/src/pure/dune @@ -4,7 +4,6 @@ (libraries base64 bigstringaf - multipart_form hmap lwt uri From a8357030aa4ea8d6ae0e1996dfd8fd258facc857 Mon Sep 17 00:00:00 2001 From: Felix Krull Date: Tue, 21 Dec 2021 22:26:16 +0100 Subject: [PATCH 111/312] dream-pure depends on lwt_ppx (#186) --- dream-pure.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/dream-pure.opam b/dream-pure.opam index 19c3b80c..6f6b7f26 100644 --- a/dream-pure.opam +++ b/dream-pure.opam @@ -18,6 +18,7 @@ depends: [ "dune" {>= "2.7.0"} # --instrument-with. "hmap" "lwt" + "lwt_ppx" {>= "1.2.2"} "ocaml" {>= "4.08.0"} "ptime" {>= "0.8.1"} # Ptime.weekday. "uri" {>= "4.2.0"} From fe537f4aa9382f0198f193f1704beb71366977aa Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 00:28:19 +0300 Subject: [PATCH 112/312] dream-httpaf uses lwt_ppx --- dream-httpaf.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/dream-httpaf.opam b/dream-httpaf.opam index 40c1509d..443479ee 100644 --- a/dream-httpaf.opam +++ b/dream-httpaf.opam @@ -15,6 +15,7 @@ maintainer: "Anton Bachin " depends: [ "dune" {>= "2.7.0"} # --instrument-with. "lwt" + "lwt_ppx" {>= "1.2.2"} "lwt_ssl" "ocaml" {>= "4.08.0"} "ssl" {>= "0.5.8"} # Ssl.get_negotiated_alpn_protocol. From 8e7c711dda728382f8b6903efc48c6d2771d2008 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 01:04:33 +0300 Subject: [PATCH 113/312] Fix memory sessions (silly typo during refactor) --- src/server/session.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/server/session.ml b/src/server/session.ml index a8e092c6..45289987 100644 --- a/src/server/session.ml +++ b/src/server/session.ml @@ -176,8 +176,7 @@ struct Lwt.return (operations ~now:gettimeofday hash_table lifetime session dirty, session) let send ~now (operations, session) request response = - if operations.dirty then - if not operations.dirty then begin + if operations.dirty then begin let id = version_session_id !session.id in let max_age = !session.expires_at -. now () in Cookie.set_cookie From 95f6a6f895050a9d3191d5d10715b09a034f415a Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 01:00:21 +0300 Subject: [PATCH 114/312] Restore multipart upload state --- src/server/upload.ml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/server/upload.ml b/src/server/upload.ml index 0b983c61..b8009069 100644 --- a/src/server/upload.ml +++ b/src/server/upload.ml @@ -35,10 +35,13 @@ let multipart_state_field : multipart_state Message.field = ~name:"dream.multipart" () -(* TODO This would be MUCH easier if requests were mutable. It's probably best - to just break multipart until then, and have the branch be "unstable." *) -let multipart_state _request = - assert false +let multipart_state request = + match Message.field request multipart_state_field with + | Some state -> state + | None -> + let state = initial_multipart_state () in + Message.set_field request multipart_state_field state; + state let field_to_string (request : Message.request) field = let open Multipart_form in From 56504439b67bb74195ba9ff0fc86eefadac5a1fe Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 01:26:04 +0300 Subject: [PATCH 115/312] Fix Dream.set_body --- src/dream.mli | 1 + src/http/error_handler.ml | 5 ++--- src/pure/message.ml | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index ba6a754a..225eade2 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2018,6 +2018,7 @@ type error_handler = error -> response option promise The behavior of Dream's default error handler is described at {!Dream.type-error}. *) +(* TODO Get rid of the option? *) val error_template : (error -> string -> response -> response promise) -> error_handler diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 4b14ecfa..6b952ee4 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -182,9 +182,8 @@ let customize template (error : Catch.error) = (* No need to catch errors when calling the template, because every call site of the error handler already has error handlers for catching double faults. *) - response - |> template error debug_dump - |> Lwt.map (fun response -> Some response) + let%lwt response = template error debug_dump response in + Lwt.return (Some response) diff --git a/src/pure/message.ml b/src/pure/message.ml index a53c4427..3eb6588f 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -198,7 +198,7 @@ let set_body message body = else Stream.(stream (string body) no_writer) in - message.server_stream <- body + message.client_stream <- body let read message = Stream.read_convenience message.server_stream From 3acb3cc79923e8d8ff426cbc6ef91b7d7cd292b6 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 01:35:45 +0300 Subject: [PATCH 116/312] Cache body promises when using Dream.body Fixes #185. --- src/pure/message.ml | 62 ++++++++++++++++++++++++++++----------------- 1 file changed, 39 insertions(+), 23 deletions(-) diff --git a/src/pure/message.ml b/src/pure/message.ml index 3eb6588f..4ae6b884 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -177,29 +177,6 @@ let sort_headers headers = (* Streams *) -(* TODO NOTE On the client, this will read the client stream until close. *) -let body message = - Stream.read_until_close message.server_stream - -(* TODO NOTE In Dream, this should operate on response server_streams. In Hyper, - it should operate on request client_streams, although there is no very good - reason why it can't operate on general messages, which might be useful in - middlewares that preprocess requests on the server and postprocess responses - on the client. Or.... shouldn't this affect the client stream on the server, - replacing its read end? *) -let set_body message body = - (* TODO This is partially redundant with a length check in Stream.string, but - that check is no longer useful as it prevents allocation of only a reader, - rather than a complete stream. *) - let body = - if String.length body = 0 then - (* TODO Should probably preallocate this as a stream. *) - Stream.(stream empty no_writer) - else - Stream.(stream (string body) no_writer) - in - message.client_stream <- body - let read message = Stream.read_convenience message.server_stream @@ -287,3 +264,42 @@ let fold_fields f initial message = | _ -> accumulator) message.fields initial + + + +(* Whole-body access *) + +(* TODO Show the value somehow. *) +let body_field : string promise field = + new_field + ~name:"dream.body" + () + +(* TODO NOTE On the client, this will read the client stream until close. *) +let body message = + match field message body_field with + | Some body_promise -> body_promise + | None -> + let body_promise = Stream.read_until_close message.server_stream in + set_field message body_field body_promise; + body_promise + +(* TODO Should usage of this function affect the body field? *) +(* TODO NOTE In Dream, this should operate on response server_streams. In Hyper, + it should operate on request client_streams, although there is no very good + reason why it can't operate on general messages, which might be useful in + middlewares that preprocess requests on the server and postprocess responses + on the client. Or.... shouldn't this affect the client stream on the server, + replacing its read end? *) +let set_body message body = + (* TODO This is partially redundant with a length check in Stream.string, but + that check is no longer useful as it prevents allocation of only a reader, + rather than a complete stream. *) + let body = + if String.length body = 0 then + (* TODO Should probably preallocate this as a stream. *) + Stream.(stream empty no_writer) + else + Stream.(stream (string body) no_writer) + in + message.client_stream <- body From 2ecfc044d47433bc48808298f8fb9d6cc48affd5 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 07:47:28 +0300 Subject: [PATCH 117/312] Package dream requires Alcotest for testing --- dream.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/dream.opam b/dream.opam index f1d3f0f5..198b9bcd 100644 --- a/dream.opam +++ b/dream.opam @@ -75,6 +75,7 @@ depends: [ "yojson" # ... # Testing, development. + "alcotest" {with-test} "bisect_ppx" {with-test & >= "2.5.0"} # --instrument-with. "caqti-driver-postgresql" {with-test} "caqti-driver-sqlite3" {with-test} From 536c4a41db5f1735f8832d2735234e27bcd68702 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 22 Dec 2021 16:10:20 +0300 Subject: [PATCH 118/312] Provide some common pre-allocated streams --- src/graphql/graphql.ml | 13 +++-------- src/http/error_handler.ml | 25 +++++---------------- src/pure/message.ml | 12 +--------- src/pure/stream.ml | 27 ++++++++++++++++++----- src/pure/stream.mli | 19 +++++++++------- src/server/echo.ml | 7 +----- src/server/helpers.ml | 34 +++++++---------------------- src/server/origin_referrer_check.ml | 15 +++---------- src/server/site_prefix.ml | 5 +---- src/unix/static.ml | 21 +++++------------- 10 files changed, 59 insertions(+), 119 deletions(-) diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index d338e480..c09b3f46 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -282,10 +282,7 @@ let graphql make_context schema = fun request -> (handle_over_websocket make_context schema (Hashtbl.create 16) request) | _ -> log.warning (fun log -> log ~request "Upgrade: websocket header missing"); - (* TODO Simplify stream creation. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found Stream.empty Stream.null |> Lwt.return end @@ -314,18 +311,14 @@ let graphql make_context schema = fun request -> | _ -> log.warning (fun log -> log ~request "Content-Type not 'application/json'"); - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request Stream.empty Stream.null |> Lwt.return end | method_ -> log.error (fun log -> log ~request "Method %s; must be GET or POST" (Method.method_to_string method_)); - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found Stream.empty Stream.null |> Lwt.return diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 6b952ee4..f9c49efb 100644 --- a/src/http/error_handler.ml +++ b/src/http/error_handler.ml @@ -173,10 +173,7 @@ let customize template (error : Catch.error) = | `Server -> `Internal_Server_Error | `Client -> `Bad_Request in - (* TODO Simplify the streams creation. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status client_stream server_stream + Message.response ~status Stream.empty Stream.null in (* No need to catch errors when calling the template, because every call @@ -237,17 +234,10 @@ let respond_with_option f = |> Lwt.map (function | Some response -> response | None -> - (* TODO Simplify streams. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in Message.response - ~status:`Internal_Server_Error client_stream server_stream)) + ~status:`Internal_Server_Error Stream.empty Stream.null)) (fun () -> - (* TODO Simplify streams. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response - ~status:`Internal_Server_Error client_stream server_stream + Message.response ~status:`Internal_Server_Error Stream.empty Stream.null |> Lwt.return) @@ -268,16 +258,11 @@ let app -(* TODO Simplify streams. *) let default_response = function | `Server -> - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Internal_Server_Error client_stream server_stream + Message.response ~status:`Internal_Server_Error Stream.empty Stream.null | `Client -> - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request Stream.empty Stream.null let httpaf user's_error_handler = diff --git a/src/pure/message.ml b/src/pure/message.ml index 4ae6b884..1701d4ef 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -292,14 +292,4 @@ let body message = on the client. Or.... shouldn't this affect the client stream on the server, replacing its read end? *) let set_body message body = - (* TODO This is partially redundant with a length check in Stream.string, but - that check is no longer useful as it prevents allocation of only a reader, - rather than a complete stream. *) - let body = - if String.length body = 0 then - (* TODO Should probably preallocate this as a stream. *) - Stream.(stream empty no_writer) - else - Stream.(stream (string body) no_writer) - in - message.client_stream <- body + message.client_stream <- Stream.string body diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 89a38501..f9443322 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -77,16 +77,23 @@ let no_writer = { let reader ~read ~close = {read; close} -let empty = +let null = { + reader = no_reader; + writer = no_writer; +} + +let empty_reader = reader ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close 1000) ~close:ignore +let empty = { + reader = empty_reader; + writer = no_writer; +} + (* TODO This shows the awkwardness in string-to-string body reading. *) -let string the_string = - if String.length the_string = 0 then - empty - else begin +let string_reader the_string = (* Storing the string in a ref here so that we can "lose" it eagerly once the stream is closed, making the memory available to the GC. *) let string_ref = ref (Some the_string) in @@ -108,7 +115,15 @@ let string the_string = in reader ~read ~close - end + +let string the_string = + if String.length the_string = 0 then + empty + else + { + reader = string_reader the_string; + writer = no_writer; + } let read stream ~data ~close ~flush = stream.reader.read ~data ~close ~flush diff --git a/src/pure/stream.mli b/src/pure/stream.mli index 19fdcf0f..be9f534f 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -41,14 +41,6 @@ val reader : read:read -> close:(int -> unit) -> reader response to {!Stream.close}. It doesn't need to call {!Stream.close} again on the stream. It should be used to free any underlying resources. *) -val empty : reader -(** A read-only stream whose reading function always calls its [~close] - callback. *) - -val string : string -> reader -(** A read-only stream which calls its [~data] callback once with the contents - of the given string, and then always calls [~close]. *) - val pipe : unit -> reader * writer (** A stream which matches each call of the reading function to one call of its writing functions. For example, calling {!Stream.flush} on a pipe will cause @@ -64,6 +56,17 @@ val stream : reader -> writer -> stream (* TODO Consider tupling the arguments, as that will make it easier to pass the result of Stream.pipe. *) +val null : stream +(** A stream which is neither readable nor writable. *) + +val empty : stream +(** A read-only stream whose reading function always calls its [~close] + callback. *) + +val string : string -> stream +(** A read-only stream which calls its [~data] callback once with the contents + of the given string, and then always calls [~close]. *) + val close : stream -> int -> unit (** Closes the given stream. Causes a pending reader or writer to call its [~close] callback. *) diff --git a/src/server/echo.ml b/src/server/echo.ml index 3e5f076f..093c652d 100644 --- a/src/server/echo.ml +++ b/src/server/echo.ml @@ -10,11 +10,6 @@ module Stream = Dream_pure.Stream -(* TODO Convert to streaming later. *) let echo request = - (* TODO Simplfy this code. Can in fact just pass the request's server stream - as the response's client stream. *) - let client_stream = Message.server_stream request in - let server_stream = Stream.(stream no_reader no_writer) in - Message.response client_stream server_stream + Message.response (Message.server_stream request) Stream.null |> Lwt.return diff --git a/src/server/helpers.ml b/src/server/helpers.ml index 7f7975af..dae6cfdd 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -47,51 +47,36 @@ let set_https request https = let request ~client ~method_ ~target ~https ~version ~headers server_stream = - (* TODO Use pre-allocated streams. *) - let client_stream = Stream.(stream no_reader no_writer) in let request = Message.request - ~method_ ~target ~version ~headers client_stream server_stream in + ~method_ ~target ~version ~headers Stream.null server_stream in set_client request client; set_https request https; request let request_with_body ?method_ ?target ?version ?headers body = - (* TODO Streams. *) - let client_stream = Stream.(stream no_reader no_writer) - and server_stream = Stream.(stream (string body) no_writer) in - Message.request ?method_ ?target ?version ?headers client_stream server_stream + Message.request + ?method_ ?target ?version ?headers Stream.null (Stream.string body) let html ?status ?code ?headers body = - (* TODO The streams. *) - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in let response = - Message.response ?status ?code ?headers client_stream server_stream in + Message.response ?status ?code ?headers (Stream.string body) Stream.null in Message.set_header response "Content-Type" Formats.text_html; Lwt.return response let json ?status ?code ?headers body = - (* TODO The streams. *) - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in let response = - Message.response ?status ?code ?headers client_stream server_stream in + Message.response ?status ?code ?headers (Stream.string body) Stream.null in Message.set_header response "Content-Type" Formats.application_json; Lwt.return response let response_with_body ?status ?code ?headers body = - (* TODO Streams. *) - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ?status ?code ?headers client_stream server_stream + Message.response ?status ?code ?headers (Stream.string body) Stream.null let respond ?status ?code ?headers body = - let client_stream = Stream.(stream (string body) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ?status ?code ?headers client_stream server_stream + Message.response ?status ?code ?headers (Stream.string body) Stream.null |> Lwt.return (* TODO Actually use the request and extract the site prefix. *) @@ -102,11 +87,8 @@ let redirect ?status ?code ?headers _request location = | None, None -> Some (`See_Other) | _ -> status in - (* TODO The streams. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in let response = - Message.response ?status ?code ?headers client_stream server_stream in + Message.response ?status ?code ?headers Stream.empty Stream.null in Message.set_header response "Location" location; Lwt.return response diff --git a/src/server/origin_referrer_check.ml b/src/server/origin_referrer_check.ml index edba9856..beb9fd55 100644 --- a/src/server/origin_referrer_check.ml +++ b/src/server/origin_referrer_check.ml @@ -31,10 +31,7 @@ let origin_referrer_check inner_handler request = | None -> log.warning (fun log -> log ~request "Origin and Referer headers both missing"); - (* TODO Simplify. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request Stream.empty Stream.null |> Lwt.return (* TODO Also recommend Uri to users. *) @@ -43,10 +40,7 @@ let origin_referrer_check inner_handler request = match Message.header request "Host" with | None -> log.warning (fun log -> log ~request "Host header missing"); - (* TODO Simplify. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request Stream.empty Stream.null |> Lwt.return | Some host -> @@ -81,9 +75,6 @@ let origin_referrer_check inner_handler request = else begin log.warning (fun log -> log ~request "Origin-Host mismatch: '%s' vs. '%s'" origin host); - (* TODO Simplify. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Request client_stream server_stream + Message.response ~status:`Bad_Request Stream.empty Stream.null |> Lwt.return end diff --git a/src/server/site_prefix.ml b/src/server/site_prefix.ml index 210c0993..6a41d2f6 100644 --- a/src/server/site_prefix.ml +++ b/src/server/site_prefix.ml @@ -35,10 +35,7 @@ let with_site_prefix prefix = fun next_handler request -> match match_site_prefix prefix (Router.path request) with | None -> - (* TODO Streams. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Bad_Gateway client_stream server_stream + Message.response ~status:`Bad_Gateway Stream.empty Stream.null |> Lwt.return | Some path -> (* TODO This doesn't need to be recomputed on each request - can cache the diff --git a/src/unix/static.ml b/src/unix/static.ml index 6353d1ec..c3c0470c 100644 --- a/src/unix/static.ml +++ b/src/unix/static.ml @@ -32,16 +32,11 @@ let from_filesystem local_root path _ = (fun () -> Lwt_io.(with_file ~mode:Input file) (fun channel -> let%lwt content = Lwt_io.read channel in - (* TODO Can use some pre-allocated streams or helpers here and below. *) - let client_stream = Stream.(stream (string content) no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~headers:(mime_lookup path) client_stream server_stream + Message.response + ~headers:(mime_lookup path) (Stream.string content) Stream.null |> Lwt.return)) (fun _exn -> - (* TODO Improve the two-stream code using some helper. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found Stream.empty Stream.null |> Lwt.return) (* TODO Add ETag handling. *) @@ -80,19 +75,13 @@ let validate_path request = let static ?(loader = from_filesystem) local_root = fun request -> if not @@ Method.methods_equal (Message.method_ request) `GET then - (* TODO Simplify this code and reduce allocations. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found Stream.empty Stream.null |> Lwt.return else match validate_path request with | None -> - (* TODO Improve with helpers. *) - let client_stream = Stream.(stream empty no_writer) - and server_stream = Stream.(stream no_reader no_writer) in - Message.response ~status:`Not_Found client_stream server_stream + Message.response ~status:`Not_Found Stream.empty Stream.null |> Lwt.return | Some path -> From fa815c0259101e8201458956e18f872eecfe2dee Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 29 Dec 2021 15:05:38 +0300 Subject: [PATCH 119/312] Add Message.set_target --- src/pure/message.ml | 5 ++++- src/pure/message.mli | 1 + 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/pure/message.ml b/src/pure/message.ml index 1701d4ef..279c6706 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -21,7 +21,7 @@ module Fields = Hmap.Make (struct type 'a t = 'a field_metadata end) type client = { mutable method_ : Method.method_; - target : string; + mutable target : string; mutable version : int * int; } (* TODO Get rid of the version field completely? At least don't expose it in @@ -93,6 +93,9 @@ let version request = let set_method_ request method_ = request.specific.method_ <- (method_ :> Method.method_) +let set_target request target = + request.specific.target <- target + let set_version request version = request.specific.version <- version diff --git a/src/pure/message.mli b/src/pure/message.mli index 9865a988..051be49b 100644 --- a/src/pure/message.mli +++ b/src/pure/message.mli @@ -34,6 +34,7 @@ val method_ : request -> Method.method_ val target : request -> string val version : request -> int * int val set_method_ : request -> [< Method.method_ ] -> unit +val set_target : request -> string -> unit val set_version : request -> int * int -> unit From 0664abd9337bfde492b8eca7e872be276372ae0a Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 29 Dec 2021 15:55:57 +0300 Subject: [PATCH 120/312] Body caching for both requests and responses --- src/dream.mli | 4 ++-- src/pure/message.ml | 27 +++++++++++++++++---------- src/pure/message.mli | 2 +- 3 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 225eade2..8c9f4fd8 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -745,12 +745,12 @@ val all_cookies : request -> (string * string) list (** {1 Bodies} *) -val body : request -> string promise +val body : 'a message -> string promise (** Retrieves the entire body. See example {{:https://github.com/aantron/dream/tree/master/example/6-echo#files} [6-echo]}. *) -val set_body : response -> string -> unit +val set_body : 'a message -> string -> unit (** Replaces the body. *) (**/**) diff --git a/src/pure/message.ml b/src/pure/message.ml index 279c6706..24debd91 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -34,7 +34,12 @@ type server = { status : Status.status; } +type kind = + | Request + | Response + type 'a message = { + kind : kind; specific : 'a; mutable headers : (string * string) list; mutable client_stream : Stream.stream; @@ -70,6 +75,7 @@ let request | Some method_ -> method_ in { + kind = Request; specific = { method_; target; @@ -111,6 +117,7 @@ let response ?status ?code ?(headers = []) client_stream server_stream = | None, Some code -> Status.int_to_status code in { + kind = Response; specific = { status; }; @@ -278,21 +285,21 @@ let body_field : string promise field = ~name:"dream.body" () -(* TODO NOTE On the client, this will read the client stream until close. *) let body message = match field message body_field with | Some body_promise -> body_promise | None -> - let body_promise = Stream.read_until_close message.server_stream in + let stream = + match message.kind with + | Request -> message.server_stream + | Response -> message.client_stream + in + let body_promise = Stream.read_until_close stream in set_field message body_field body_promise; body_promise -(* TODO Should usage of this function affect the body field? *) -(* TODO NOTE In Dream, this should operate on response server_streams. In Hyper, - it should operate on request client_streams, although there is no very good - reason why it can't operate on general messages, which might be useful in - middlewares that preprocess requests on the server and postprocess responses - on the client. Or.... shouldn't this affect the client stream on the server, - replacing its read end? *) let set_body message body = - message.client_stream <- Stream.string body + set_field message body_field (Lwt.return body); + match message.kind with + | Request -> message.server_stream <- Stream.string body + | Response -> message.client_stream <- Stream.string body diff --git a/src/pure/message.mli b/src/pure/message.mli index 051be49b..330d1270 100644 --- a/src/pure/message.mli +++ b/src/pure/message.mli @@ -64,7 +64,7 @@ val sort_headers : (string * string) list -> (string * string) list val body : 'a message -> string promise -val set_body : response -> string -> unit +val set_body : 'a message -> string -> unit val read : 'a message -> string option promise val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise val flush : response -> unit promise From 84128adee6f2a382ff068b31300fe836978161cf Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 29 Dec 2021 20:29:06 +0300 Subject: [PATCH 121/312] Expose dream-pure type equalities --- src/dream.mli | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 8c9f4fd8..24ca0863 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -100,7 +100,7 @@ and route (** {2 Helpers} *) -and 'a message +and 'a message = 'a Dream_pure.Message.message (** ['a message], pronounced “any message,” allows some functions to take either {!type-request} or {!type-response} as arguments, because both are defined in terms of ['a message]. For example, in {!section-headers}: @@ -109,14 +109,15 @@ and 'a message val Dream.header : string -> 'a message -> string option ]} *) -and client -and server +and client = Dream_pure.Message.client +and server = Dream_pure.Message.server (** Type parameters for {!message} for {!type-request} and {!type-response}, respectively. These are “phantom” types. They have no meaning other than they are different from each other. Dream only ever creates [client message] and [server message]. [client] and [server] are never mentioned again in the docs. *) (* TODO These docs need to be clarified. *) +(* TODO Hide all the Dream_pure type equalities. *) and 'a promise = 'a Lwt.t (** Dream uses {{:https://github.com/ocsigen/lwt} Lwt} for promises and From 024131b0eba09b8f306dbe9e7549427a61bdaea0 Mon Sep 17 00:00:00 2001 From: Glenn Slotte Date: Sat, 1 Jan 2022 03:53:08 +0100 Subject: [PATCH 122/312] bs-platform, bs-webapi -> rescript, rescript-webapi (#188) --- example/w-fullstack-rescript/bsconfig.json | 2 +- example/w-fullstack-rescript/client/client.res | 6 +++--- example/w-fullstack-rescript/package.json | 8 ++++---- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/example/w-fullstack-rescript/bsconfig.json b/example/w-fullstack-rescript/bsconfig.json index 4fbdcdc7..77f0cb38 100644 --- a/example/w-fullstack-rescript/bsconfig.json +++ b/example/w-fullstack-rescript/bsconfig.json @@ -1,7 +1,7 @@ { "name": "fullstack-rescript", "bs-dependencies": [ - "bs-webapi" + "rescript-webapi" ], "sources": [ "common", diff --git a/example/w-fullstack-rescript/client/client.res b/example/w-fullstack-rescript/client/client.res index 3ff56fef..b2270b6f 100644 --- a/example/w-fullstack-rescript/client/client.res +++ b/example/w-fullstack-rescript/client/client.res @@ -1,7 +1,7 @@ open Webapi.Dom let () = { - let body = document |> Document.querySelector("body") + let body = document->Document.querySelector("body") switch (body) { | None => () @@ -9,8 +9,8 @@ let () = { let text = Common.greet(#Client) - let p = document |> Document.createElement("p") + let p = document->Document.createElement("p") p->Element.setInnerText(text) - body |> Element.appendChild(p) + body->Element.appendChild(p) } } diff --git a/example/w-fullstack-rescript/package.json b/example/w-fullstack-rescript/package.json index 4443fbcc..f673477f 100644 --- a/example/w-fullstack-rescript/package.json +++ b/example/w-fullstack-rescript/package.json @@ -1,13 +1,13 @@ { "name": "fullstack-rescript", "dependencies": { - "bs-platform": "*", - "bs-webapi": "*", "esbuild": "*", - "esy": "*" + "esy": "*", + "rescript": "*", + "rescript-webapi": "*" }, "scripts": { - "build": "bsb -make-world", + "build": "rescript", "pack": "esbuild lib/js/client/client.js --bundle --outfile=static/client.js", "start": "npm run build && npm run pack && npx esy start" } From 03e4d37cb5f5f638707479cd46105e2ee2b1df0e Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 1 Jan 2022 05:58:41 +0300 Subject: [PATCH 123/312] ReScript example: needs an esy install --- example/w-fullstack-rescript/package.json | 1 + 1 file changed, 1 insertion(+) diff --git a/example/w-fullstack-rescript/package.json b/example/w-fullstack-rescript/package.json index f673477f..449f91cc 100644 --- a/example/w-fullstack-rescript/package.json +++ b/example/w-fullstack-rescript/package.json @@ -7,6 +7,7 @@ "rescript-webapi": "*" }, "scripts": { + "postinstall": "npx esy install", "build": "rescript", "pack": "esbuild lib/js/client/client.js --bundle --outfile=static/client.js", "start": "npm run build && npm run pack && npx esy start" From d418a791656be8f78de06748da4b523c511c7b35 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 5 Jan 2022 00:42:06 +0300 Subject: [PATCH 124/312] Update example esy.jsons --- example/3-router/esy.json | 4 +++- example/7-template/esy.json | 4 +++- example/8-debug/esy.json | 4 +++- example/9-error/esy.json | 4 +++- example/c-cookie/esy.json | 4 +++- example/e-json/esy.json | 4 +++- example/i-graphql/esy.json | 4 +++- example/j-stream/esy.json | 4 +++- example/k-websocket/esy.json | 4 +++- example/r-advanced-template/esy.json | 4 +++- example/r-graphql/esy.json | 4 +++- example/r-template-files/esy.json | 4 +++- example/r-template-stream/esy.json | 4 +++- example/w-advanced-template/esy.json | 4 +++- example/w-chat/esy.json | 4 +++- example/w-flash/esy.json | 4 +++- example/w-graphql-subscription/esy.json | 4 +++- example/w-live-reload/esy.json | 4 +++- example/w-live-reload/live_reload.ml | 4 ++-- example/w-stress-response/esy.json | 4 +++- example/w-stress-websocket-send/esy.json | 4 +++- example/w-template-files/esy.json | 4 +++- example/w-template-stream/esy.json | 4 +++- 23 files changed, 68 insertions(+), 24 deletions(-) diff --git a/example/3-router/esy.json b/example/3-router/esy.json index 94efa7b9..64f209e2 100644 --- a/example/3-router/esy.json +++ b/example/3-router/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/7-template/esy.json b/example/7-template/esy.json index 7fa24238..79337c98 100644 --- a/example/7-template/esy.json +++ b/example/7-template/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/8-debug/esy.json b/example/8-debug/esy.json index c42b6512..b0e30611 100644 --- a/example/8-debug/esy.json +++ b/example/8-debug/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/9-error/esy.json b/example/9-error/esy.json index 62f66784..802229ad 100644 --- a/example/9-error/esy.json +++ b/example/9-error/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/c-cookie/esy.json b/example/c-cookie/esy.json index c5b5c72a..f10067c5 100644 --- a/example/c-cookie/esy.json +++ b/example/c-cookie/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/e-json/esy.json b/example/e-json/esy.json index bb18141f..6b432173 100644 --- a/example/e-json/esy.json +++ b/example/e-json/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "@opam/ppx_yojson_conv": "*", "ocaml": "4.12.x" @@ -10,6 +10,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/i-graphql/esy.json b/example/i-graphql/esy.json index da7d0e49..dbef1520 100644 --- a/example/i-graphql/esy.json +++ b/example/i-graphql/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/j-stream/esy.json b/example/j-stream/esy.json index b493821a..68662d91 100644 --- a/example/j-stream/esy.json +++ b/example/j-stream/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/k-websocket/esy.json b/example/k-websocket/esy.json index e327d40e..cfb3b451 100644 --- a/example/k-websocket/esy.json +++ b/example/k-websocket/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/r-advanced-template/esy.json b/example/r-advanced-template/esy.json index 7d418fb4..2223089e 100644 --- a/example/r-advanced-template/esy.json +++ b/example/r-advanced-template/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "@opam/reason": "^3.7.0", "ocaml": "4.12.x" @@ -10,6 +10,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/r-graphql/esy.json b/example/r-graphql/esy.json index d5b1351d..766b219b 100644 --- a/example/r-graphql/esy.json +++ b/example/r-graphql/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "@opam/reason": "^3.7.0", "ocaml": "4.12.x" @@ -10,6 +10,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/r-template-files/esy.json b/example/r-template-files/esy.json index d78cda78..112f0596 100644 --- a/example/r-template-files/esy.json +++ b/example/r-template-files/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/r-template-stream/esy.json b/example/r-template-stream/esy.json index 8c080144..33fef61f 100644 --- a/example/r-template-stream/esy.json +++ b/example/r-template-stream/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "@opam/reason": "^3.7.0", "ocaml": "4.12.x" @@ -10,6 +10,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-advanced-template/esy.json b/example/w-advanced-template/esy.json index 7fa24238..79337c98 100644 --- a/example/w-advanced-template/esy.json +++ b/example/w-advanced-template/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-chat/esy.json b/example/w-chat/esy.json index 03c0de5e..cb117b9c 100644 --- a/example/w-chat/esy.json +++ b/example/w-chat/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-flash/esy.json b/example/w-flash/esy.json index 1981835d..c58a68d3 100644 --- a/example/w-flash/esy.json +++ b/example/w-flash/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-graphql-subscription/esy.json b/example/w-graphql-subscription/esy.json index 640af0e9..9330db58 100644 --- a/example/w-graphql-subscription/esy.json +++ b/example/w-graphql-subscription/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-live-reload/esy.json b/example/w-live-reload/esy.json index d9b6cdfb..498544e0 100644 --- a/example/w-live-reload/esy.json +++ b/example/w-live-reload/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "@opam/lambdasoup": "*", "ocaml": "4.12.x" @@ -10,6 +10,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-live-reload/live_reload.ml b/example/w-live-reload/live_reload.ml index b5df2343..9750d90f 100644 --- a/example/w-live-reload/live_reload.ml +++ b/example/w-live-reload/live_reload.ml @@ -72,8 +72,8 @@ let () = Dream.get "/_live-reload" (fun _ -> Dream.websocket (fun socket -> - let%lwt _ = Dream.receive socket in - Dream.close_websocket socket)); + let%lwt _ = Dream.read socket in + Dream.close socket)); ] @@ Dream.not_found diff --git a/example/w-stress-response/esy.json b/example/w-stress-response/esy.json index a66e71da..38883279 100644 --- a/example/w-stress-response/esy.json +++ b/example/w-stress-response/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-stress-websocket-send/esy.json b/example/w-stress-websocket-send/esy.json index 2915cbe8..869673bc 100644 --- a/example/w-stress-websocket-send/esy.json +++ b/example/w-stress-websocket-send/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-template-files/esy.json b/example/w-template-files/esy.json index d78cda78..112f0596 100644 --- a/example/w-template-files/esy.json +++ b/example/w-template-files/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { diff --git a/example/w-template-stream/esy.json b/example/w-template-stream/esy.json index d463fd73..c1ecc1a5 100644 --- a/example/w-template-stream/esy.json +++ b/example/w-template-stream/esy.json @@ -1,6 +1,6 @@ { "dependencies": { - "@opam/dream": "1.0.0~alpha2", + "@opam/dream": "aantron/dream:dream.opam", "@opam/dune": "^2.0", "ocaml": "4.12.x" }, @@ -9,6 +9,8 @@ }, "resolutions": { "@opam/conf-libev": "esy-packages/libev:package.json#0b5eb6685b688649045aceac55dc559f6f21b829", + "@opam/dream-httpaf": "aantron/dream:dream-httpaf.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", + "@opam/dream-pure": "aantron/dream:dream-pure.opam#03e4d37cb5f5f638707479cd46105e2ee2b1df0e", "esy-openssl": "esy-packages/esy-openssl#619ae2d46ca981ec26ab3287487ad98b157a01d1" }, "scripts": { From 4dce6a7a4d89de3c60e5656c8cbcca6a0fbd2708 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 11 Jan 2022 19:54:52 +0300 Subject: [PATCH 125/312] Tweak indentation --- src/pure/stream.ml | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index f9443322..a5269351 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -94,27 +94,27 @@ let empty = { (* TODO This shows the awkwardness in string-to-string body reading. *) let string_reader the_string = - (* Storing the string in a ref here so that we can "lose" it eagerly once - the stream is closed, making the memory available to the GC. *) - let string_ref = ref (Some the_string) in - - let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = - match !string_ref with - | Some stored_string -> - string_ref := None; - let length = String.length stored_string in - data - (Bigstringaf.of_string ~off:0 ~len:length stored_string) - 0 length true true - | None -> - close 1000 - in - - let close _code = + (* Storing the string in a ref here so that we can "lose" it eagerly once + the stream is closed, making the memory available to the GC. *) + let string_ref = ref (Some the_string) in + + let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + match !string_ref with + | Some stored_string -> string_ref := None; - in + let length = String.length stored_string in + data + (Bigstringaf.of_string ~off:0 ~len:length stored_string) + 0 length true true + | None -> + close 1000 + in + + let close _code = + string_ref := None; + in - reader ~read ~close + reader ~read ~close let string the_string = if String.length the_string = 0 then From 5cd57e1ea1c18becfb2609db320046b70f274503 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 15 Jan 2022 19:45:34 +0300 Subject: [PATCH 126/312] Forward exceptions across streams --- src/dream.ml | 1 + src/dream.mli | 17 ++- src/http/adapt.ml | 5 +- src/http/http.ml | 25 ++-- src/pure/message.ml | 2 + src/pure/stream.ml | 212 ++++++++++++++++++++---------- src/pure/stream.mli | 8 +- src/server/helpers.ml | 8 +- test/expect/pure/stream/stream.ml | 26 ++-- 9 files changed, 206 insertions(+), 98 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 72d291cb..d2455e86 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -166,6 +166,7 @@ let flush_stream = Stream.flush let ping_stream = Stream.ping let pong_stream = Stream.pong let close_stream = Stream.close +let abort_stream = Stream.abort diff --git a/src/dream.mli b/src/dream.mli index 24ca0863..46f59c45 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -826,10 +826,11 @@ val set_server_stream : 'a message -> stream -> unit val read_stream : stream -> data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> flush:(unit -> unit) -> ping:(buffer -> int -> int -> unit) -> pong:(buffer -> int -> int -> unit) -> + close:(int -> unit) -> + exn:(exn -> unit) -> unit (** Waits for the next stream event, and calls: @@ -838,23 +839,27 @@ val read_stream : - [~exn] to report an exception. *) val ready_stream : - stream -> close:(int -> unit) -> (unit -> unit) -> unit + stream -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit val write_stream : - stream -> buffer -> int -> int -> bool -> bool -> close:(int -> unit) -> (unit -> unit) -> unit + stream -> buffer -> int -> int -> bool -> bool -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit val flush_stream : - stream -> close:(int -> unit) -> (unit -> unit) -> unit + stream -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit val ping_stream : - stream -> buffer -> int -> int -> close:(int -> unit) -> (unit -> unit) -> unit + stream -> buffer -> int -> int -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit val pong_stream : - stream -> buffer -> int -> int -> close:(int -> unit) -> (unit -> unit) -> unit + stream -> buffer -> int -> int -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit val close_stream : stream -> int -> unit +val abort_stream : + stream -> exn -> unit +(* TODO Line widths above. *) + (**/**) val write_buffer : ?offset:int -> ?length:int -> response -> buffer -> unit promise diff --git a/src/http/adapt.ml b/src/http/adapt.ml index 8d23af2a..fd5f737f 100644 --- a/src/http/adapt.ml +++ b/src/http/adapt.ml @@ -26,6 +26,8 @@ let forward_body_general http_flush close = + let abort _exn = close 1000 in + let bytes_since_flush = ref 0 in let rec send () = @@ -34,10 +36,11 @@ let forward_body_general Stream.read stream ~data - ~close ~flush ~ping ~pong + ~close + ~exn:abort and data chunk off len _binary _fin = write_buffer ~off ~len chunk; diff --git a/src/http/http.ml b/src/http/http.ml index df0e9660..d370ad5d 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -120,7 +120,7 @@ let websocket_handler response socket = (* TODO Can this be canceled by a user's close? i.e. will that eventually cause a call to eof above? *) - let rec read ~data ~close ~flush ~ping ~pong = + let rec read ~data ~flush ~ping ~pong ~close ~exn = if !closed then close !close_code else @@ -157,10 +157,10 @@ let websocket_handler response socket = drain_payload payload @@ fun _buffer _offset length -> websocket_log.warning (fun log -> log "Unknown frame type with length %i" length); - read ~data ~close ~flush ~ping ~pong + read ~data ~flush ~ping ~pong ~close ~exn | Some (`Data properties, payload) -> current_payload := Some (properties, payload); - read ~data ~close ~flush ~ping ~pong + read ~data ~flush ~ping ~pong ~close ~exn end | Some ((binary, fin), payload) -> Websocketaf.Payload.schedule_read @@ -169,7 +169,7 @@ let websocket_handler response socket = match !last_chunk with | None -> last_chunk := Some (buffer, off, len); - read ~data ~close ~flush ~ping ~pong + read ~data ~flush ~ping ~pong ~close ~exn | Some (last_buffer, last_offset, last_length) -> last_chunk := Some (buffer, off, len); let binary = binary = `Binary in @@ -178,7 +178,7 @@ let websocket_handler response socket = current_payload := None; match !last_chunk with | None -> - read ~data ~close ~flush ~ping ~pong + read ~data ~flush ~ping ~pong ~close ~exn | Some (last_buffer, last_offset, last_length) -> last_chunk := None; let binary = binary = `Binary in @@ -204,7 +204,9 @@ let websocket_handler response socket = end in - let reader = Stream.reader ~read ~close in + let abort _exn = close 1005 in + + let reader = Stream.reader ~read ~close ~abort in Stream.forward reader (Message.client_stream response); let rec outgoing_loop () = @@ -226,7 +228,6 @@ let websocket_handler response socket = else outgoing_loop () end) - ~close ~flush:(fun () -> flush ~close outgoing_loop) ~ping:(fun _buffer _offset length -> if length > 125 then @@ -256,6 +257,8 @@ let websocket_handler response socket = Websocketaf.Wsd.send_pong socket; outgoing_loop () end) + ~close + ~exn:abort in outgoing_loop (); @@ -305,7 +308,7 @@ let wrap_handler (* TODO Should the stream be auto-closed? It doesn't even have a closed state. The whole thing is just a wrapper for whatever the http/af behavior is. *) - let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ = Httpaf.Body.Reader.schedule_read body ~on_eof:(fun () -> close 1000) @@ -314,7 +317,7 @@ let wrap_handler let close _code = Httpaf.Body.Reader.close body in let body = - Stream.reader ~read ~close in + Stream.reader ~read ~close ~abort:close in let body = Stream.stream body Stream.no_writer in @@ -435,7 +438,7 @@ let wrap_handler_h2 let body = H2.Reqd.request_body conn in - let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ = H2.Body.schedule_read body ~on_eof:(fun () -> close 1000) @@ -444,7 +447,7 @@ let wrap_handler_h2 let close _code = H2.Body.close_reader body in let body = - Stream.reader ~read ~close in + Stream.reader ~read ~close ~abort:close in let body = Stream.stream body Stream.no_writer in diff --git a/src/pure/message.ml b/src/pure/message.ml index 24debd91..19b02a50 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -208,6 +208,7 @@ let write ?kind message chunk = message.server_stream buffer 0 length binary true ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + ~exn:(fun exn -> Lwt.wakeup_later_exn resolver exn) (fun () -> Lwt.wakeup_later resolver ()); promise @@ -218,6 +219,7 @@ let flush message = Stream.flush message.server_stream ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) + ~exn:(fun exn -> Lwt.wakeup_later_exn resolver exn) (Lwt.wakeup_later resolver); promise diff --git a/src/pure/stream.ml b/src/pure/stream.ml index a5269351..5c454858 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -13,29 +13,33 @@ type 'a promise = type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> flush:(unit -> unit) -> ping:(buffer -> int -> int -> unit) -> pong:(buffer -> int -> int -> unit) -> + close:(int -> unit) -> + exn:(exn -> unit) -> unit type write = close:(int -> unit) -> + exn:(exn -> unit) -> (unit -> unit) -> unit type reader = { read : read; close : int -> unit; + abort : exn -> unit; } type writer = { ready : write; - write : buffer -> int -> int -> bool -> bool -> write; + data : buffer -> int -> int -> bool -> bool -> write; flush : write; ping : buffer -> int -> int -> write; pong : buffer -> int -> int -> write; close : int -> unit; + abort : exn -> unit; } type stream = { @@ -48,34 +52,41 @@ let stream reader writer = let no_reader = { read = - (fun ~data:_ ~close:_ ~flush:_ ~ping:_ ~pong:_ -> + (fun ~data:_ ~flush:_ ~ping:_ ~pong:_ ~close:_ ~exn:_ -> raise (Failure "read from a non-readable stream")); close = ignore; + abort = + ignore; } let no_writer = { ready = - (fun ~close:_ _ok -> + (fun ~close:_ ~exn:_ _ok -> raise (Failure "ready called on a read-only stream")); - write = - (fun _buffer _offset _length _binary _fin ~close:_ _ok -> + data = + (fun _buffer _offset _length _binary _fin ~close:_ ~exn:_ _ok -> raise (Failure "write to a read-only stream")); flush = - (fun ~close:_ _ok -> + (fun ~close:_ ~exn:_ _ok -> raise (Failure "flush of a read-only stream")); ping = - (fun _buffer _offset _length ~close:_ _ok -> + (fun _buffer _offset _length ~close:_ ~exn:_ _ok -> raise (Failure "ping on a read-only stream")); pong = - (fun _buffer _offset _length ~close:_ _ok -> + (fun _buffer _offset _length ~close:_ ~exn:_ _ok -> raise (Failure "pong on a read-only stream")); close = ignore; + abort = + ignore; } -let reader ~read ~close = - {read; close} +let reader ~read ~close ~abort = { + read; + close; + abort; +} let null = { reader = no_reader; @@ -84,8 +95,9 @@ let null = { let empty_reader = reader - ~read:(fun ~data:_ ~close ~flush:_ ~ping:_ ~pong:_ -> close 1000) + ~read:(fun ~data:_ ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ -> close 1000) ~close:ignore + ~abort:ignore let empty = { reader = empty_reader; @@ -98,7 +110,7 @@ let string_reader the_string = the stream is closed, making the memory available to the GC. *) let string_ref = ref (Some the_string) in - let read ~data ~close ~flush:_ ~ping:_ ~pong:_ = + let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ = match !string_ref with | Some stored_string -> string_ref := None; @@ -114,7 +126,7 @@ let string_reader the_string = string_ref := None; in - reader ~read ~close + reader ~read ~close ~abort:close let string the_string = if String.length the_string = 0 then @@ -125,44 +137,51 @@ let string the_string = writer = no_writer; } -let read stream ~data ~close ~flush = - stream.reader.read ~data ~close ~flush +let read stream ~data ~flush ~ping ~pong ~close ~exn = + stream.reader.read ~data ~flush ~ping ~pong ~close ~exn let close stream code = stream.reader.close code; stream.writer.close code +let abort stream exn = + stream.reader.abort exn; + stream.writer.abort exn + (* TODO Test this somehow with guards for early writing on a pipe. *) -let ready stream ~close ok = - stream.writer.ready ~close ok +let ready stream ~close ~exn ok = + stream.writer.ready ~close ~exn ok -let write stream buffer offset length binary fin ~close ok = - stream.writer.write buffer offset length binary fin ~close ok +let write stream buffer offset length binary fin ~close ~exn ok = + stream.writer.data buffer offset length binary fin ~close ~exn ok -let flush stream ~close ok = - stream.writer.flush ~close ok +let flush stream ~close ~exn ok = + stream.writer.flush ~close ~exn ok -let ping stream buffer offset length ~close ok = - stream.writer.ping buffer offset length ~close ok +let ping stream buffer offset length ~close ~exn ok = + stream.writer.ping buffer offset length ~close ~exn ok -let pong stream buffer offset length ~close ok = - stream.writer.pong buffer offset length ~close ok +let pong stream buffer offset length ~close ~exn ok = + stream.writer.pong buffer offset length ~close ~exn ok type pipe = { mutable state : [ | `Idle | `Reader_waiting | `Closed of int + | `Aborted of exn ]; mutable read_data_callback : buffer -> int -> int -> bool -> bool -> unit; - mutable read_close_callback : int -> unit; mutable read_flush_callback : unit -> unit; mutable read_ping_callback : buffer -> int -> int -> unit; mutable read_pong_callback : buffer -> int -> int -> unit; + mutable read_close_callback : int -> unit; + mutable read_abort_callback : exn -> unit; mutable write_ok_callback : unit -> unit; mutable write_close_callback : int -> unit; + mutable write_abort_callback : exn -> unit; } let dummy_read_data_callback _buffer _offset _length _binary _fin = @@ -173,38 +192,43 @@ let dummy_ping_pong_callback _buffer _offset _length = let clean_up_reader_fields pipe = pipe.read_data_callback <- dummy_read_data_callback; - pipe.read_close_callback <- ignore; pipe.read_flush_callback <- ignore; pipe.read_ping_callback <- dummy_ping_pong_callback; - pipe.read_pong_callback <- dummy_ping_pong_callback + pipe.read_pong_callback <- dummy_ping_pong_callback; + pipe.read_close_callback <- ignore; + pipe.read_abort_callback <- ignore let clean_up_writer_fields pipe = pipe.write_ok_callback <- ignore; - pipe.write_close_callback <- ignore + pipe.write_close_callback <- ignore; + pipe.write_abort_callback <- ignore let pipe () = let internal = { state = `Idle; read_data_callback = dummy_read_data_callback; - read_close_callback = ignore; read_flush_callback = ignore; read_ping_callback = dummy_ping_pong_callback; read_pong_callback = dummy_ping_pong_callback; + read_close_callback = ignore; + read_abort_callback = ignore; write_ok_callback = ignore; write_close_callback = ignore; + write_abort_callback = ignore; } in - let read ~data ~close ~flush ~ping ~pong = + let read ~data ~flush ~ping ~pong ~close ~exn = match internal.state with | `Idle -> internal.state <- `Reader_waiting; internal.read_data_callback <- data; - internal.read_close_callback <- close; internal.read_flush_callback <- flush; internal.read_ping_callback <- ping; internal.read_pong_callback <- pong; + internal.read_close_callback <- close; + internal.read_abort_callback <- exn; let write_ok_callback = internal.write_ok_callback in clean_up_writer_fields internal; write_ok_callback () @@ -212,20 +236,25 @@ let pipe () = raise (Failure "stream read: the previous read has not completed") | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn in - let ready ~close ok = + let ready ~close ~exn ok = match internal.state with | `Idle -> internal.write_ok_callback <- ok; - internal.write_close_callback <- close + internal.write_close_callback <- close; + internal.write_abort_callback <- exn; | `Reader_waiting -> ok () | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn in - let write buffer offset length binary fin ~close ok = + let data buffer offset length binary fin ~close ~exn ok = match internal.state with | `Idle -> raise (Failure "stream write: the stream is not ready") @@ -235,28 +264,15 @@ let pipe () = clean_up_reader_fields internal; internal.write_ok_callback <- ok; internal.write_close_callback <- close; + internal.write_abort_callback <- exn; read_data_callback buffer offset length binary fin; | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn in - let close code = - match internal.state with - | `Idle -> - internal.state <- `Closed code; - let write_close_callback = internal.write_close_callback in - clean_up_writer_fields internal; - write_close_callback code - | `Reader_waiting -> - internal.state <- `Closed code; - let read_close_callback = internal.read_close_callback in - clean_up_reader_fields internal; - read_close_callback code - | `Closed _code -> - () - in - - let flush ~close ok = + let flush ~close ~exn ok = match internal.state with | `Idle -> raise (Failure "stream flush: the previous write has not completed") @@ -266,12 +282,15 @@ let pipe () = clean_up_reader_fields internal; internal.write_ok_callback <- ok; internal.write_close_callback <- close; + internal.write_abort_callback <- exn; read_flush_callback () | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn in - let ping buffer offset length ~close ok = + let ping buffer offset length ~close ~exn ok = match internal.state with | `Idle -> raise (Failure "stream ping: the previous write has not completed") @@ -281,12 +300,15 @@ let pipe () = clean_up_reader_fields internal; internal.write_ok_callback <- ok; internal.write_close_callback <- close; + internal.write_abort_callback <- exn; read_ping_callback buffer offset length | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn in - let pong buffer offset length ~close ok = + let pong buffer offset length ~close ~exn ok = match internal.state with | `Idle -> raise (Failure "stream pong: the previous write has not completed") @@ -296,22 +318,63 @@ let pipe () = clean_up_reader_fields internal; internal.write_ok_callback <- ok; internal.write_close_callback <- close; + internal.write_abort_callback <- exn; read_pong_callback buffer offset length | `Closed code -> close code + | `Aborted the_exn -> + exn the_exn + in + + let close code = + match internal.state with + | `Idle -> + internal.state <- `Closed code; + let write_close_callback = internal.write_close_callback in + clean_up_writer_fields internal; + write_close_callback code + | `Reader_waiting -> + internal.state <- `Closed code; + let read_close_callback = internal.read_close_callback in + clean_up_reader_fields internal; + read_close_callback code + | `Closed _code -> + () + | `Aborted _the_exn -> + () + in + + let abort exn = + match internal.state with + | `Idle -> + internal.state <- `Aborted exn; + let write_abort_callback = internal.write_abort_callback in + clean_up_writer_fields internal; + write_abort_callback exn + | `Reader_waiting -> + internal.state <- `Aborted exn; + let read_abort_callback = internal.read_abort_callback in + clean_up_reader_fields internal; + read_abort_callback exn + | `Closed _code -> + () + | `Aborted _the_exn -> + () in let reader = { read; close; + abort; } and writer = { ready; - write; + data; flush; ping; pong; close; + abort; } in (reader, writer) @@ -320,24 +383,32 @@ let forward (reader : reader) stream = let rec loop () = stream.writer.ready ~close:reader.close + ~exn:reader.abort (fun () -> reader.read ~data:(fun buffer offset length binary fin -> - stream.writer.write - buffer offset length binary fin ~close:reader.close loop) - ~close:stream.writer.close + stream.writer.data + buffer offset length + binary fin + ~close:reader.close ~exn:reader.abort + loop) ~flush:(fun () -> - stream.writer.flush ~close:reader.close loop) + stream.writer.flush ~close:reader.close ~exn:reader.abort loop) ~ping:(fun buffer offset length -> - stream.writer.ping buffer offset length ~close:reader.close loop) + stream.writer.ping + buffer offset length ~close:reader.close ~exn:reader.abort loop) ~pong:(fun buffer offset length -> - stream.writer.pong buffer offset length ~close:reader.close loop)) + stream.writer.pong + buffer offset length ~close:reader.close ~exn:reader.abort loop) + ~close:stream.writer.close + ~exn:stream.writer.abort) in loop () let read_convenience stream = let promise, resolver = Lwt.wait () in let close _code = Lwt.wakeup_later resolver None in + let abort exn = Lwt.wakeup_later_exn resolver exn in let rec loop () = stream.reader.read @@ -347,15 +418,17 @@ let read_convenience stream = |> Option.some |> Lwt.wakeup_later resolver) - ~close - ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong buffer offset length ~close loop) + stream.writer.pong buffer offset length ~close ~exn:abort loop) ~pong:(fun _buffer _offset _length -> ()) + + ~close + + ~exn:abort in loop (); @@ -370,6 +443,7 @@ let read_until_close stream = |> Bigstringaf.to_string |> Lwt.wakeup_later resolver in + let abort exn = Lwt.wakeup_later_exn resolver exn in let rec loop () = stream.reader.read @@ -389,15 +463,17 @@ let read_until_close stream = loop ()) - ~close - ~flush:loop ~ping:(fun buffer offset length -> - stream.writer.pong buffer offset length ~close loop) + stream.writer.pong buffer offset length ~close ~exn:abort loop) ~pong:(fun _buffer _offset _length -> ()) + + ~close + + ~exn:abort in loop (); diff --git a/src/pure/stream.mli b/src/pure/stream.mli index be9f534f..ccdb16b8 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -20,10 +20,11 @@ type 'a promise = type read = data:(buffer -> int -> int -> bool -> bool -> unit) -> - close:(int -> unit) -> flush:(unit -> unit) -> ping:(buffer -> int -> int -> unit) -> pong:(buffer -> int -> int -> unit) -> + close:(int -> unit) -> + exn:(exn -> unit) -> unit (** A reading function. Awaits the next event on the stream. For each call of a reading function, one of the callbacks will eventually be called, according @@ -31,12 +32,13 @@ type read = type write = close:(int -> unit) -> + exn:(exn -> unit) -> (unit -> unit) -> unit (** A writing function. Pushes an event into a stream. May take additional arguments before [~ok]. *) -val reader : read:read -> close:(int -> unit) -> reader +val reader : read:read -> close:(int -> unit) -> abort:(exn -> unit) -> reader (** Creates a read-only stream from the given reader. [~close] is called in response to {!Stream.close}. It doesn't need to call {!Stream.close} again on the stream. It should be used to free any underlying resources. *) @@ -71,6 +73,8 @@ val close : stream -> int -> unit (** Closes the given stream. Causes a pending reader or writer to call its [~close] callback. *) +val abort : stream -> exn -> unit + val read : stream -> read (** Awaits the next stream event. See {!Stream.type-read}. *) diff --git a/src/server/helpers.ml b/src/server/helpers.ml index dae6cfdd..f4fa16f1 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -101,7 +101,9 @@ let stream ?status ?code ?headers callback = (* TODO Should set up an error handler for this. YES. *) (* TODO Make sure the request id is propagated to the callback. *) let wrapped_callback _ = Lwt.async (fun () -> callback response) in - Stream.ready server_stream ~close:wrapped_callback wrapped_callback; + Stream.ready + server_stream + ~close:wrapped_callback ~exn:wrapped_callback wrapped_callback; Lwt.return response let websocket_field = @@ -127,7 +129,9 @@ let websocket ?headers callback = Message.set_field response websocket_field true; (* TODO Make sure the request id is propagated to the callback. *) let wrapped_callback _ = Lwt.async (fun () -> callback response) in - Stream.ready server_stream ~close:wrapped_callback wrapped_callback; + Stream.ready + server_stream + ~close:wrapped_callback ~exn:wrapped_callback wrapped_callback; Lwt.return response let empty ?headers status = diff --git a/test/expect/pure/stream/stream.ml b/test/expect/pure/stream/stream.ml index 90a89410..bd4a2df0 100644 --- a/test/expect/pure/stream/stream.ml +++ b/test/expect/pure/stream/stream.ml @@ -14,8 +14,6 @@ let read_and_dump stream = ~data:(fun buffer offset length binary fin -> Printf.printf "read: data: BINARY=%b FIN=%b %s\n" binary fin (Bigstringaf.substring buffer ~off:offset ~len:length)) - ~close:(fun code -> - Printf.printf "read: close: CODE=%i\n" code) ~flush:(fun () -> print_endline "read: flush") ~ping:(fun buffer offset length -> @@ -24,11 +22,17 @@ let read_and_dump stream = ~pong:(fun buffer offset length -> Printf.printf "read: pong: %s\n" (Bigstringaf.substring buffer ~off:offset ~len:length)) + ~close:(fun code -> + Printf.printf "read: close: CODE=%i\n" code) + ~exn:(fun exn -> + Printf.printf "read: exn: %s\n" (Printexc.to_string exn)) let flush_and_dump stream = Stream.flush stream ~close:(fun code -> Printf.printf "flush: close: CODE=%i\n" code) + ~exn:(fun exn -> + Printf.printf "flush: exn: %s\n" (Printexc.to_string exn)) (fun () -> print_endline "flush: ok") @@ -36,6 +40,8 @@ let write_and_dump stream buffer offset length binary fin = Stream.write stream buffer offset length binary fin ~close:(fun code -> Printf.printf "write: close: CODE=%i\n" code) + ~exn:(fun exn -> + Printf.printf "write: exn: %s\n" (Printexc.to_string exn)) (fun () -> print_endline "write: ok") @@ -44,6 +50,8 @@ let ping_and_dump payload stream = Stream.ping stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length ~close:(fun code -> Printf.printf "ping: close: CODE=%i\n" code) + ~exn:(fun exn -> + Printf.printf "ping: exn: %s\n" (Printexc.to_string exn)) (fun () -> print_endline "ping: ok") @@ -52,6 +60,8 @@ let pong_and_dump payload stream = Stream.pong stream (Bigstringaf.of_string ~off:0 ~len:length payload) 0 length ~close:(fun code -> Printf.printf "pong: close: CODE=%i\n" code) + ~exn:(fun exn -> + Printf.printf "pong: exn: %s\n" (Printexc.to_string exn)) (fun () -> print_endline "pong: ok") @@ -60,7 +70,7 @@ let pong_and_dump payload stream = (* Read-only streams. *) let%expect_test _ = - let stream = Stream.(stream empty no_writer) in + let stream = Stream.empty in read_and_dump stream; read_and_dump stream; Stream.close stream 1005; @@ -71,13 +81,13 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.(stream empty no_writer) in + let stream = Stream.empty in Stream.close stream 1005; read_and_dump stream; [%expect {| read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.(stream (string "foo") no_writer) in + let stream = Stream.string "foo" in read_and_dump stream; read_and_dump stream; read_and_dump stream; @@ -90,7 +100,7 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.(stream (string "") no_writer) in + let stream = Stream.string "" in read_and_dump stream; read_and_dump stream; [%expect {| @@ -98,13 +108,13 @@ let%expect_test _ = read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.(stream (string "foo") no_writer) in + let stream = Stream.string "foo" in Stream.close stream 1005; read_and_dump stream; [%expect {| read: close: CODE=1000 |}] let%expect_test _ = - let stream = Stream.(stream empty no_writer) in + let stream = Stream.empty in (try write_and_dump stream Bigstringaf.empty 0 0 false false with Failure _ as exn -> print_endline (Printexc.to_string exn)); (try flush_and_dump stream From a8d6e5c06de48fcd55c72dfc49f026a35f25c875 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 19 Jan 2022 15:42:44 +0300 Subject: [PATCH 127/312] WebSocket adapter should use bare stream ...so that it can be used on both the client and the server. --- src/http/http.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/http/http.ml b/src/http/http.ml index d370ad5d..fd51f19e 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -38,8 +38,7 @@ let sha1 s = let websocket_log = Log.sub_log "dream.websocket" -let websocket_handler response socket = - +let websocket_handler stream socket = (* Queue of received frames. There doesn't appear to be a nice way to achieve backpressure with the current API of websocket/af, so that will have to be added later. The user-facing API of Dream does support backpressure. *) @@ -207,11 +206,11 @@ let websocket_handler response socket = let abort _exn = close 1005 in let reader = Stream.reader ~read ~close ~abort in - Stream.forward reader (Message.client_stream response); + Stream.forward reader stream; let rec outgoing_loop () = Stream.read - (Message.client_stream response) + stream ~data:(fun buffer offset length binary fin -> (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) if not fin then @@ -380,7 +379,8 @@ let wrap_handler let proceed () = Websocketaf.Server_connection.create_websocket - ~error_handler (websocket_handler response) + ~error_handler + (websocket_handler (Message.client_stream response)) |> Gluten.make (module Websocketaf.Server_connection) |> upgrade in From acc2efc8fef921f653b0ab6c44e1c527ba5fe79f Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 19 Jan 2022 16:21:05 +0300 Subject: [PATCH 128/312] Move WebSocket adapter to package dream-httpaf It is needed by both the client and the server. --- src/http/dune | 3 +- src/http/http.ml | 228 +-------------------------------- src/http/shared/dune | 10 ++ src/http/shared/websocket.ml | 238 +++++++++++++++++++++++++++++++++++ 4 files changed, 251 insertions(+), 228 deletions(-) create mode 100644 src/http/shared/dune create mode 100644 src/http/shared/websocket.ml diff --git a/src/http/dune b/src/http/dune index 386935c7..cac581f3 100644 --- a/src/http/dune +++ b/src/http/dune @@ -2,13 +2,12 @@ (public_name dream.http) (name dream__http) (libraries - bigarray-compat - bigstringaf digestif dream.certificate dream.cipher dream-pure dream.server + dream-httpaf dream-httpaf.gluten dream-httpaf.gluten-lwt-unix dream-httpaf.h2 diff --git a/src/http/http.ml b/src/http/http.ml index fd51f19e..2836da65 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -38,231 +38,6 @@ let sha1 s = let websocket_log = Log.sub_log "dream.websocket" -let websocket_handler stream socket = - (* Queue of received frames. There doesn't appear to be a nice way to achieve - backpressure with the current API of websocket/af, so that will have to be - added later. The user-facing API of Dream does support backpressure. *) - let frames, push_frame = Lwt_stream.create () in - let message_is_binary = ref `Binary in - - (* Frame reader called by websocket/af on each frame received. There is no - good way to truly throttle this, hence this frame reader pushes frame - objects into the above frame queue for the reader to take from later. See - https://github.com/anmonteiro/websocketaf/issues/34. *) - let frame ~opcode ~is_fin ~len:_ payload = - match opcode with - | `Connection_close -> - push_frame (Some (`Close, payload)) - | `Ping -> - push_frame (Some (`Ping, payload)) - | `Pong -> - push_frame (Some (`Pong, payload)) - | `Other _ -> - push_frame (Some (`Other, payload)) - | `Text -> - message_is_binary := `Text; - push_frame (Some (`Data (`Text, is_fin), payload)) - | `Binary -> - message_is_binary := `Binary; - push_frame (Some (`Data (`Binary, is_fin), payload)) - | `Continuation -> - push_frame (Some (`Data (!message_is_binary, is_fin), payload)) - in - - let eof () = - push_frame None in - - (* The reader retrieves the next frame. If it is a data frame, it keeps a - reference to the payload across multiple reader calls, until the payload is - exhausted. *) - let closed = ref false in - let close_code = ref 1005 in - let current_payload = ref None in - - (* Used to convert the separate on_eof payload reading callback into a FIN bit - on the last chunk read. See - https://github.com/anmonteiro/websocketaf/issues/35. *) - let last_chunk = ref None in - (* TODO Review per-chunk allocations, including current_payload contents. *) - - (* For control frames, the payload can be at most 125 bytes long. We assume - that the first chunk will contain the whole payload, and discard any other - chunks that may be reported by websocket/af. *) - let first_chunk_received = ref false in - let first_chunk = ref Bigstringaf.empty in - let first_chunk_offset = ref 0 in - let first_chunk_length = ref 0 in - let rec drain_payload payload continuation = - Websocketaf.Payload.schedule_read - payload - ~on_read:(fun buffer ~off ~len -> - if not !first_chunk_received then begin - first_chunk := buffer; - first_chunk_offset := off; - first_chunk_length := len; - first_chunk_received := true - end - else - websocket_log.warning (fun log -> - log "Received fragmented control frame"); - drain_payload payload continuation) - ~on_eof:(fun () -> - let payload = !first_chunk in - let offset = !first_chunk_offset in - let length = !first_chunk_length in - first_chunk_received := false; - first_chunk := Bigstringaf.empty; - first_chunk_offset := 0; - first_chunk_length := 0; - continuation payload offset length) - in - - (* TODO Can this be canceled by a user's close? i.e. will that eventually - cause a call to eof above? *) - let rec read ~data ~flush ~ping ~pong ~close ~exn = - if !closed then - close !close_code - else - match !current_payload with - | None -> - Lwt.on_success (Lwt_stream.get frames) begin function - | None -> - if not !closed then begin - closed := true; - close_code := 1005 - end; - Websocketaf.Wsd.close socket; - close !close_code - | Some (`Close, payload) -> - drain_payload payload @@ fun buffer offset length -> - let code = - if length < 2 then - 1005 - else - let high_byte = Char.code buffer.{offset} - and low_byte = Char.code buffer.{offset + 1} in - high_byte lsl 8 lor low_byte - in - if not !closed then - close_code := code; - close !close_code - | Some (`Ping, payload) -> - drain_payload payload @@ - ping - | Some (`Pong, payload) -> - drain_payload payload @@ - pong - | Some (`Other, payload) -> - drain_payload payload @@ fun _buffer _offset length -> - websocket_log.warning (fun log -> - log "Unknown frame type with length %i" length); - read ~data ~flush ~ping ~pong ~close ~exn - | Some (`Data properties, payload) -> - current_payload := Some (properties, payload); - read ~data ~flush ~ping ~pong ~close ~exn - end - | Some ((binary, fin), payload) -> - Websocketaf.Payload.schedule_read - payload - ~on_read:(fun buffer ~off ~len -> - match !last_chunk with - | None -> - last_chunk := Some (buffer, off, len); - read ~data ~flush ~ping ~pong ~close ~exn - | Some (last_buffer, last_offset, last_length) -> - last_chunk := Some (buffer, off, len); - let binary = binary = `Binary in - data last_buffer last_offset last_length binary false) - ~on_eof:(fun () -> - current_payload := None; - match !last_chunk with - | None -> - read ~data ~flush ~ping ~pong ~close ~exn - | Some (last_buffer, last_offset, last_length) -> - last_chunk := None; - let binary = binary = `Binary in - data last_buffer last_offset last_length binary fin) - in - - let bytes_since_flush = ref 0 in - - let flush ~close ok = - bytes_since_flush := 0; - if !closed then - close !close_code - else - Websocketaf.Wsd.flushed socket ok - in - - let close code = - if not !closed then begin - (* TODO Really need to work out the "close handshake" and how it is - exposed in the Stream API. *) - (* closed := true; *) - Websocketaf.Wsd.close ~code:(`Other code) socket - end - in - - let abort _exn = close 1005 in - - let reader = Stream.reader ~read ~close ~abort in - Stream.forward reader stream; - - let rec outgoing_loop () = - Stream.read - stream - ~data:(fun buffer offset length binary fin -> - (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) - if not fin then - websocket_log.error (fun log -> - log "Non-FIN frames not yet supported"); - let kind = if binary then `Binary else `Text in - if !closed then - close !close_code - else begin - Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; - bytes_since_flush := !bytes_since_flush + length; - if !bytes_since_flush >= 4096 then - flush ~close outgoing_loop - else - outgoing_loop () - end) - ~flush:(fun () -> flush ~close outgoing_loop) - ~ping:(fun _buffer _offset length -> - if length > 125 then - raise (Failure "Ping payload cannot exceed 125 bytes"); - (* See https://github.com/anmonteiro/websocketaf/issues/36. *) - if length > 0 then - websocket_log.warning (fun log -> - log "Ping with non-empty payload not yet supported"); - if !closed then - close !close_code - else begin - Websocketaf.Wsd.send_ping socket; - outgoing_loop () - end) - ~pong:(fun _buffer _offset length -> - (* TODO Is there any way for the peer to send a ping payload with more - than 125 bytes, forcing a too-large pong and an exception? *) - if length > 125 then - raise (Failure "Pong payload cannot exceed 125 bytes"); - (* See https://github.com/anmonteiro/websocketaf/issues/36. *) - if length > 0 then - websocket_log.warning (fun log -> - log "Pong with non-empty payload not yet supported"); - if !closed then - close !close_code - else begin - Websocketaf.Wsd.send_pong socket; - outgoing_loop () - end) - ~close - ~exn:abort - in - outgoing_loop (); - - Websocketaf.Server_connection.{frame; eof} - (* Wraps the user's Dream handler in the kind of handler expected by http/af. @@ -380,7 +155,8 @@ let wrap_handler let proceed () = Websocketaf.Server_connection.create_websocket ~error_handler - (websocket_handler (Message.client_stream response)) + (Dream_httpaf.Websocket.websocket_handler + (Message.client_stream response)) |> Gluten.make (module Websocketaf.Server_connection) |> upgrade in diff --git a/src/http/shared/dune b/src/http/shared/dune new file mode 100644 index 00000000..07668721 --- /dev/null +++ b/src/http/shared/dune @@ -0,0 +1,10 @@ +(library + (public_name dream-httpaf) + (name dream_httpaf) + (libraries + bigstringaf + dream-pure + dream-httpaf.websocketaf + ) + (preprocess (pps lwt_ppx)) + (instrumentation (backend bisect_ppx))) diff --git a/src/http/shared/websocket.ml b/src/http/shared/websocket.ml new file mode 100644 index 00000000..6c972ce0 --- /dev/null +++ b/src/http/shared/websocket.ml @@ -0,0 +1,238 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2022 Anton Bachin *) + + + +module Stream = Dream_pure.Stream + + + +let websocket_handler stream socket = + (* Queue of received frames. There doesn't appear to be a nice way to achieve + backpressure with the current API of websocket/af, so that will have to be + added later. The user-facing API of Dream does support backpressure. *) + let frames, push_frame = Lwt_stream.create () in + let message_is_binary = ref `Binary in + + (* Frame reader called by websocket/af on each frame received. There is no + good way to truly throttle this, hence this frame reader pushes frame + objects into the above frame queue for the reader to take from later. See + https://github.com/anmonteiro/websocketaf/issues/34. *) + let frame ~opcode ~is_fin ~len:_ payload = + match opcode with + | `Connection_close -> + push_frame (Some (`Close, payload)) + | `Ping -> + push_frame (Some (`Ping, payload)) + | `Pong -> + push_frame (Some (`Pong, payload)) + | `Other _ -> + push_frame (Some (`Other, payload)) + | `Text -> + message_is_binary := `Text; + push_frame (Some (`Data (`Text, is_fin), payload)) + | `Binary -> + message_is_binary := `Binary; + push_frame (Some (`Data (`Binary, is_fin), payload)) + | `Continuation -> + push_frame (Some (`Data (!message_is_binary, is_fin), payload)) + in + + let eof () = + push_frame None in + + (* The reader retrieves the next frame. If it is a data frame, it keeps a + reference to the payload across multiple reader calls, until the payload is + exhausted. *) + let closed = ref false in + let close_code = ref 1005 in + let current_payload = ref None in + + (* Used to convert the separate on_eof payload reading callback into a FIN bit + on the last chunk read. See + https://github.com/anmonteiro/websocketaf/issues/35. *) + let last_chunk = ref None in + (* TODO Review per-chunk allocations, including current_payload contents. *) + + (* For control frames, the payload can be at most 125 bytes long. We assume + that the first chunk will contain the whole payload, and discard any other + chunks that may be reported by websocket/af. *) + let first_chunk_received = ref false in + let first_chunk = ref Bigstringaf.empty in + let first_chunk_offset = ref 0 in + let first_chunk_length = ref 0 in + let rec drain_payload payload continuation = + Websocketaf.Payload.schedule_read + payload + ~on_read:(fun buffer ~off ~len -> + if not !first_chunk_received then begin + first_chunk := buffer; + first_chunk_offset := off; + first_chunk_length := len; + first_chunk_received := true + end + else + (* TODO How to integrate this thing with logging? *) + (* websocket_log.warning (fun log -> + log "Received fragmented control frame"); *) + (); + drain_payload payload continuation) + ~on_eof:(fun () -> + let payload = !first_chunk in + let offset = !first_chunk_offset in + let length = !first_chunk_length in + first_chunk_received := false; + first_chunk := Bigstringaf.empty; + first_chunk_offset := 0; + first_chunk_length := 0; + continuation payload offset length) + in + + (* TODO Can this be canceled by a user's close? i.e. will that eventually + cause a call to eof above? *) + let rec read ~data ~flush ~ping ~pong ~close ~exn = + if !closed then + close !close_code + else + match !current_payload with + | None -> + Lwt.on_success (Lwt_stream.get frames) begin function + | None -> + if not !closed then begin + closed := true; + close_code := 1005 + end; + Websocketaf.Wsd.close socket; + close !close_code + | Some (`Close, payload) -> + drain_payload payload @@ fun buffer offset length -> + let code = + if length < 2 then + 1005 + else + let high_byte = Char.code buffer.{offset} + and low_byte = Char.code buffer.{offset + 1} in + high_byte lsl 8 lor low_byte + in + if not !closed then + close_code := code; + close !close_code + | Some (`Ping, payload) -> + drain_payload payload @@ + ping + | Some (`Pong, payload) -> + drain_payload payload @@ + pong + | Some (`Other, payload) -> + drain_payload payload @@ fun _buffer _offset length -> + ignore length; (* TODO log instead *) + (* websocket_log.warning (fun log -> + log "Unknown frame type with length %i" length); *) + read ~data ~flush ~ping ~pong ~close ~exn + | Some (`Data properties, payload) -> + current_payload := Some (properties, payload); + read ~data ~flush ~ping ~pong ~close ~exn + end + | Some ((binary, fin), payload) -> + Websocketaf.Payload.schedule_read + payload + ~on_read:(fun buffer ~off ~len -> + match !last_chunk with + | None -> + last_chunk := Some (buffer, off, len); + read ~data ~flush ~ping ~pong ~close ~exn + | Some (last_buffer, last_offset, last_length) -> + last_chunk := Some (buffer, off, len); + let binary = binary = `Binary in + data last_buffer last_offset last_length binary false) + ~on_eof:(fun () -> + current_payload := None; + match !last_chunk with + | None -> + read ~data ~flush ~ping ~pong ~close ~exn + | Some (last_buffer, last_offset, last_length) -> + last_chunk := None; + let binary = binary = `Binary in + data last_buffer last_offset last_length binary fin) + in + + let bytes_since_flush = ref 0 in + + let flush ~close ok = + bytes_since_flush := 0; + if !closed then + close !close_code + else + Websocketaf.Wsd.flushed socket ok + in + + let close code = + if not !closed then begin + (* TODO Really need to work out the "close handshake" and how it is + exposed in the Stream API. *) + (* closed := true; *) + Websocketaf.Wsd.close ~code:(`Other code) socket + end + in + + let abort _exn = close 1005 in + + let reader = Stream.reader ~read ~close ~abort in + Stream.forward reader stream; + + let rec outgoing_loop () = + Stream.read + stream + ~data:(fun buffer offset length binary _fin -> + (* Until https://github.com/anmonteiro/websocketaf/issues/33. *) + (* if not fin then + websocket_log.error (fun log -> + log "Non-FIN frames not yet supported"); *) + let kind = if binary then `Binary else `Text in + if !closed then + close !close_code + else begin + Websocketaf.Wsd.schedule socket ~kind buffer ~off:offset ~len:length; + bytes_since_flush := !bytes_since_flush + length; + if !bytes_since_flush >= 4096 then + flush ~close outgoing_loop + else + outgoing_loop () + end) + ~flush:(fun () -> flush ~close outgoing_loop) + ~ping:(fun _buffer _offset length -> + if length > 125 then + raise (Failure "Ping payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + (* if length > 0 then + websocket_log.warning (fun log -> + log "Ping with non-empty payload not yet supported"); *) + if !closed then + close !close_code + else begin + Websocketaf.Wsd.send_ping socket; + outgoing_loop () + end) + ~pong:(fun _buffer _offset length -> + (* TODO Is there any way for the peer to send a ping payload with more + than 125 bytes, forcing a too-large pong and an exception? *) + if length > 125 then + raise (Failure "Pong payload cannot exceed 125 bytes"); + (* See https://github.com/anmonteiro/websocketaf/issues/36. *) + (* if length > 0 then + websocket_log.warning (fun log -> + log "Pong with non-empty payload not yet supported"); *) + if !closed then + close !close_code + else begin + Websocketaf.Wsd.send_pong socket; + outgoing_loop () + end) + ~close + ~exn:abort + in + outgoing_loop (); + + Websocketaf.Server_connection.{frame; eof} From 5896c5a6413667477d93cc7f04e2d96f21e0e812 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 21 Jan 2022 10:48:51 +0300 Subject: [PATCH 129/312] dream-pure: generalize higher-level stream I/O ...so that it can be used to perform operations on either the server's stream or the client's stream. --- src/dream.ml | 6 +++--- src/graphql/graphql.ml | 20 ++++++++++---------- src/pure/message.ml | 12 ++++++------ src/pure/message.mli | 7 ++++--- src/server/helpers.ml | 11 +++++++++++ src/server/upload.ml | 4 ++-- 6 files changed, 36 insertions(+), 24 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index d2455e86..abd1e548 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -149,9 +149,9 @@ let all_cookies = Cookie.all_cookies let body = Message.body let set_body = Message.set_body -let read = Message.read -let write = Message.write -let flush = Message.flush +let read = Helpers.read +let write = Helpers.write +let flush = Helpers.flush let close = Message.close type buffer = Stream.buffer type stream = Stream.stream diff --git a/src/graphql/graphql.ml b/src/graphql/graphql.ml index c09b3f46..73c93b99 100644 --- a/src/graphql/graphql.ml +++ b/src/graphql/graphql.ml @@ -116,7 +116,7 @@ let complete_message id = (* TODO Test client complete racing against a stream. *) let handle_over_websocket make_context schema subscriptions request response = let rec loop inited = - match%lwt Message.read response with + match%lwt Helpers.read response with | None -> log.info (fun log -> log ~request "GraphQL WebSocket closed by client"); close_and_clean subscriptions response @@ -145,7 +145,7 @@ let handle_over_websocket make_context schema subscriptions request response = close_and_clean subscriptions response ~code:4429 end else begin - let%lwt () = Message.write response ack_message in + let%lwt () = Helpers.write response ack_message in loop true end @@ -193,13 +193,13 @@ let handle_over_websocket make_context schema subscriptions request response = log.warning (fun log -> log ~request "subscribe: error %s" (Yojson.Basic.to_string json)); - Message.write response (error_message id json) + Helpers.write response (error_message id json) (* It's not clear that this case ever occurs, because graphql-ws is only used for subscriptions, at the protocol level. *) | Ok (`Response json) -> - let%lwt () = Message.write response (data_message id json) in - let%lwt () = Message.write response (complete_message id) in + let%lwt () = Helpers.write response (data_message id json) in + let%lwt () = Helpers.write response (complete_message id) in Lwt.return_unit | Ok (`Stream (stream, close)) -> @@ -216,15 +216,15 @@ let handle_over_websocket make_context schema subscriptions request response = let%lwt () = stream |> Lwt_stream.iter_s (function | Ok json -> - Message.write response (data_message id json) + Helpers.write response (data_message id json) | Error json -> log.warning (fun log -> log ~request "Subscription: error %s" (Yojson.Basic.to_string json)); - Message.write response (error_message id json)) + Helpers.write response (error_message id json)) in - let%lwt () = Message.write response (complete_message id) in + let%lwt () = Helpers.write response (complete_message id) in Hashtbl.remove subscriptions id; Lwt.return_unit @@ -240,12 +240,12 @@ let handle_over_websocket make_context schema subscriptions request response = try%lwt let%lwt () = - Message.write + Helpers.write response (error_message id (make_error "Internal Server Error")) in if !subscribed then - Message.write response (complete_message id) + Helpers.write response (complete_message id) else Lwt.return_unit with _ -> diff --git a/src/pure/message.ml b/src/pure/message.ml index 19b02a50..cd08da95 100644 --- a/src/pure/message.ml +++ b/src/pure/message.ml @@ -187,14 +187,14 @@ let sort_headers headers = (* Streams *) -let read message = - Stream.read_convenience message.server_stream +let read stream = + Stream.read_convenience stream (* TODO Need to expose FIN. However, it can't have any effect even on WebSockets, because websocket/af does not offer the ability to pass FIN. It is hardcoded to true. *) (* TODO Also expose binary/text. What should be the default? *) -let write ?kind message chunk = +let write ?kind stream chunk = let binary = match kind with | None | Some `Text -> false @@ -205,7 +205,7 @@ let write ?kind message chunk = let buffer = Bigstringaf.of_string ~off:0 ~len:length chunk in (* TODO Better handling of close? But it can't even occur with http/af. *) Stream.write - message.server_stream + stream buffer 0 length binary true ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) ~exn:(fun exn -> Lwt.wakeup_later_exn resolver exn) @@ -214,10 +214,10 @@ let write ?kind message chunk = (* TODO How are remote closes actually handled? There is no way for http/af to report them to the user application through the writer. *) -let flush message = +let flush stream = let promise, resolver = Lwt.wait () in Stream.flush - message.server_stream + stream ~close:(fun _code -> Lwt.wakeup_later_exn resolver End_of_file) ~exn:(fun exn -> Lwt.wakeup_later_exn resolver exn) (Lwt.wakeup_later resolver); diff --git a/src/pure/message.mli b/src/pure/message.mli index 330d1270..e7dbeb53 100644 --- a/src/pure/message.mli +++ b/src/pure/message.mli @@ -65,9 +65,10 @@ val sort_headers : (string * string) list -> (string * string) list val body : 'a message -> string promise val set_body : 'a message -> string -> unit -val read : 'a message -> string option promise -val write : ?kind:[< `Text | `Binary ] -> response -> string -> unit promise -val flush : response -> unit promise +val read : Stream.stream -> string option promise +val write : + ?kind:[< `Text | `Binary ] -> Stream.stream -> string -> unit promise +val flush : Stream.stream -> unit promise val close : ?code:int -> 'a message -> unit promise val client_stream : 'a message -> Stream.stream val server_stream : 'a message -> Stream.stream diff --git a/src/server/helpers.ml b/src/server/helpers.ml index f4fa16f1..3f2188c6 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -139,3 +139,14 @@ let empty ?headers status = let not_found _ = respond ~status:`Not_Found "" + + + +let read message = + Message.read (Message.server_stream message) + +let write ?kind message chunk = + Message.write ?kind (Message.server_stream message) chunk + +let flush message = + Message.flush (Message.server_stream message) diff --git a/src/server/upload.ml b/src/server/upload.ml index b8009069..886ed1fe 100644 --- a/src/server/upload.ml +++ b/src/server/upload.ml @@ -115,7 +115,7 @@ and upload (request : Message.request) = failwith message | Some content_type -> - let body = Lwt_stream.from (fun () -> Message.read request) in + let body = Lwt_stream.from (fun () -> Helpers.read request) in let `Parse th, stream = Multipart_form_lwt.stream ~identify body content_type in Lwt.async (fun () -> let%lwt _ = th in Lwt.return_unit); @@ -135,7 +135,7 @@ let multipart ?(csrf=true) ~now request = match content_type with | None -> Lwt.return `Wrong_content_type | Some content_type -> - let body = Lwt_stream.from (fun () -> Message.read request) in + let body = Lwt_stream.from (fun () -> Helpers.read request) in match%lwt Multipart_form_lwt.of_stream_to_list body content_type with | Error (`Msg _err) -> Lwt.return `Wrong_content_type (* XXX(dinosaure): better error? *) From e20b0b4e183cab242a88f311f37621445aa9ba7d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 21 Jan 2022 11:31:03 +0300 Subject: [PATCH 130/312] Get rid of Stream.ready --- src/dream.ml | 1 - src/dream.mli | 3 -- src/pure/stream.ml | 71 ++++++++++++++----------------------------- src/pure/stream.mli | 2 -- src/server/helpers.ml | 11 ++----- 5 files changed, 26 insertions(+), 62 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index abd1e548..426a64cc 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -160,7 +160,6 @@ let server_stream = Message.server_stream let set_client_stream = Message.set_client_stream let set_server_stream = Message.set_server_stream let read_stream = Stream.read -let ready_stream = Stream.ready let write_stream = Stream.write let flush_stream = Stream.flush let ping_stream = Stream.ping diff --git a/src/dream.mli b/src/dream.mli index 46f59c45..504853ba 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -838,9 +838,6 @@ val read_stream : - [~close] if close is requested, and - [~exn] to report an exception. *) -val ready_stream : - stream -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit - val write_stream : stream -> buffer -> int -> int -> bool -> bool -> close:(int -> unit) -> exn:(exn -> unit) -> (unit -> unit) -> unit diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 5c454858..cbd04ffe 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -33,7 +33,6 @@ type reader = { } type writer = { - ready : write; data : buffer -> int -> int -> bool -> bool -> write; flush : write; ping : buffer -> int -> int -> write; @@ -61,9 +60,6 @@ let no_reader = { } let no_writer = { - ready = - (fun ~close:_ ~exn:_ _ok -> - raise (Failure "ready called on a read-only stream")); data = (fun _buffer _offset _length _binary _fin ~close:_ ~exn:_ _ok -> raise (Failure "write to a read-only stream")); @@ -148,10 +144,6 @@ let abort stream exn = stream.reader.abort exn; stream.writer.abort exn -(* TODO Test this somehow with guards for early writing on a pipe. *) -let ready stream ~close ~exn ok = - stream.writer.ready ~close ~exn ok - let write stream buffer offset length binary fin ~close ~exn ok = stream.writer.data buffer offset length binary fin ~close ~exn ok @@ -240,67 +232,55 @@ let pipe () = exn the_exn in - let ready ~close ~exn ok = + let rec data buffer offset length binary fin ~close ~exn ok = match internal.state with | `Idle -> - internal.write_ok_callback <- ok; + internal.write_ok_callback <- (fun () -> + data buffer offset length binary fin ~close ~exn ok); internal.write_close_callback <- close; - internal.write_abort_callback <- exn; - | `Reader_waiting -> - ok () - | `Closed code -> - close code - | `Aborted the_exn -> - exn the_exn - in - - let data buffer offset length binary fin ~close ~exn ok = - match internal.state with - | `Idle -> - raise (Failure "stream write: the stream is not ready") + internal.write_abort_callback <- exn | `Reader_waiting -> internal.state <- `Idle; let read_data_callback = internal.read_data_callback in clean_up_reader_fields internal; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close; - internal.write_abort_callback <- exn; read_data_callback buffer offset length binary fin; + ok () | `Closed code -> close code | `Aborted the_exn -> exn the_exn in - let flush ~close ~exn ok = + let rec flush ~close ~exn ok = match internal.state with | `Idle -> - raise (Failure "stream flush: the previous write has not completed") + internal.write_ok_callback <- (fun () -> + flush ~close ~exn ok); + internal.write_close_callback <- close; + internal.write_abort_callback <- exn | `Reader_waiting -> internal.state <- `Idle; let read_flush_callback = internal.read_flush_callback in clean_up_reader_fields internal; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close; - internal.write_abort_callback <- exn; - read_flush_callback () + read_flush_callback (); + ok () | `Closed code -> close code | `Aborted the_exn -> exn the_exn in - let ping buffer offset length ~close ~exn ok = + let rec ping buffer offset length ~close ~exn ok = match internal.state with | `Idle -> - raise (Failure "stream ping: the previous write has not completed") + internal.write_ok_callback <- (fun () -> + ping buffer offset length ~close ~exn ok); + internal.write_close_callback <- close; + internal.write_abort_callback <- exn | `Reader_waiting -> internal.state <- `Idle; let read_ping_callback = internal.read_ping_callback in clean_up_reader_fields internal; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close; - internal.write_abort_callback <- exn; read_ping_callback buffer offset length | `Closed code -> close code @@ -308,17 +288,17 @@ let pipe () = exn the_exn in - let pong buffer offset length ~close ~exn ok = + let rec pong buffer offset length ~close ~exn ok = match internal.state with | `Idle -> - raise (Failure "stream pong: the previous write has not completed") + internal.write_ok_callback <- (fun () -> + pong buffer offset length ~close ~exn ok); + internal.write_close_callback <- close; + internal.write_abort_callback <- exn | `Reader_waiting -> internal.state <- `Idle; let read_pong_callback = internal.read_pong_callback in clean_up_reader_fields internal; - internal.write_ok_callback <- ok; - internal.write_close_callback <- close; - internal.write_abort_callback <- exn; read_pong_callback buffer offset length | `Closed code -> close code @@ -368,7 +348,6 @@ let pipe () = abort; } and writer = { - ready; data; flush; ping; @@ -381,10 +360,6 @@ let pipe () = let forward (reader : reader) stream = let rec loop () = - stream.writer.ready - ~close:reader.close - ~exn:reader.abort - (fun () -> reader.read ~data:(fun buffer offset length binary fin -> stream.writer.data @@ -401,7 +376,7 @@ let forward (reader : reader) stream = stream.writer.pong buffer offset length ~close:reader.close ~exn:reader.abort loop) ~close:stream.writer.close - ~exn:stream.writer.abort) + ~exn:stream.writer.abort in loop () diff --git a/src/pure/stream.mli b/src/pure/stream.mli index ccdb16b8..fa4814ef 100644 --- a/src/pure/stream.mli +++ b/src/pure/stream.mli @@ -87,8 +87,6 @@ val read_until_close : stream -> string promise (** Reads a stream completely until [~close], and accumulates the data into a string. *) -val ready : stream -> write - val write : stream -> buffer -> int -> int -> bool -> bool -> write (** A writing function that sends a data buffer on the given stream. No more writing functions should be called on the stream until this function calls diff --git a/src/server/helpers.ml b/src/server/helpers.ml index 3f2188c6..ea38ebec 100644 --- a/src/server/helpers.ml +++ b/src/server/helpers.ml @@ -100,10 +100,7 @@ let stream ?status ?code ?headers callback = Message.response ?status ?code ?headers client_stream server_stream in (* TODO Should set up an error handler for this. YES. *) (* TODO Make sure the request id is propagated to the callback. *) - let wrapped_callback _ = Lwt.async (fun () -> callback response) in - Stream.ready - server_stream - ~close:wrapped_callback ~exn:wrapped_callback wrapped_callback; + Lwt.async (fun () -> callback response); Lwt.return response let websocket_field = @@ -128,10 +125,8 @@ let websocket ?headers callback = ~status:`Switching_Protocols ?headers client_stream server_stream in Message.set_field response websocket_field true; (* TODO Make sure the request id is propagated to the callback. *) - let wrapped_callback _ = Lwt.async (fun () -> callback response) in - Stream.ready - server_stream - ~close:wrapped_callback ~exn:wrapped_callback wrapped_callback; + (* TODO Close the WwbSocket on leaked exceptions, etc. *) + Lwt.async (fun () -> callback response); Lwt.return response let empty ?headers status = From 9ee3e04481bfb631a3c9502a4d8c0a267614ab92 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 22 Jan 2022 22:04:43 +0300 Subject: [PATCH 131/312] Allow pushing exceptions into string streams --- src/pure/stream.ml | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index cbd04ffe..856b4acf 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -105,24 +105,34 @@ let string_reader the_string = (* Storing the string in a ref here so that we can "lose" it eagerly once the stream is closed, making the memory available to the GC. *) let string_ref = ref (Some the_string) in + let exn_ref = ref None in - let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ = - match !string_ref with - | Some stored_string -> - string_ref := None; - let length = String.length stored_string in - data - (Bigstringaf.of_string ~off:0 ~len:length stored_string) - 0 length true true + let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn = + match !exn_ref with + | Some the_exn -> + exn the_exn | None -> - close 1000 + match !string_ref with + | Some stored_string -> + string_ref := None; + let length = String.length stored_string in + data + (Bigstringaf.of_string ~off:0 ~len:length stored_string) + 0 length true true + | None -> + close 1000 in let close _code = + string_ref := None + in + + let abort exn = string_ref := None; + exn_ref := Some exn in - reader ~read ~close ~abort:close + reader ~read ~close ~abort let string the_string = if String.length the_string = 0 then From 3705621262ab9a2751a160f8e8e9f3984760de3c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 22 Jan 2022 22:05:55 +0300 Subject: [PATCH 132/312] Don't terminate convenience readers on pong events --- src/pure/stream.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 856b4acf..cbc31ca5 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -409,7 +409,7 @@ let read_convenience stream = stream.writer.pong buffer offset length ~close ~exn:abort loop) ~pong:(fun _buffer _offset _length -> - ()) + loop ()) ~close @@ -454,7 +454,7 @@ let read_until_close stream = stream.writer.pong buffer offset length ~close ~exn:abort loop) ~pong:(fun _buffer _offset _length -> - ()) + loop ()) ~close From 7e18c4d2f4c3c9b69ac2963e5d25e9e5a131de80 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 22 Jan 2022 22:14:22 +0300 Subject: [PATCH 133/312] stream.ml: fix whitespace from previous change --- src/pure/stream.ml | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index cbc31ca5..4e25c179 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -370,23 +370,23 @@ let pipe () = let forward (reader : reader) stream = let rec loop () = - reader.read - ~data:(fun buffer offset length binary fin -> - stream.writer.data - buffer offset length - binary fin - ~close:reader.close ~exn:reader.abort - loop) - ~flush:(fun () -> - stream.writer.flush ~close:reader.close ~exn:reader.abort loop) - ~ping:(fun buffer offset length -> - stream.writer.ping - buffer offset length ~close:reader.close ~exn:reader.abort loop) - ~pong:(fun buffer offset length -> - stream.writer.pong - buffer offset length ~close:reader.close ~exn:reader.abort loop) - ~close:stream.writer.close - ~exn:stream.writer.abort + reader.read + ~data:(fun buffer offset length binary fin -> + stream.writer.data + buffer offset length + binary fin + ~close:reader.close ~exn:reader.abort + loop) + ~flush:(fun () -> + stream.writer.flush ~close:reader.close ~exn:reader.abort loop) + ~ping:(fun buffer offset length -> + stream.writer.ping + buffer offset length ~close:reader.close ~exn:reader.abort loop) + ~pong:(fun buffer offset length -> + stream.writer.pong + buffer offset length ~close:reader.close ~exn:reader.abort loop) + ~close:stream.writer.close + ~exn:stream.writer.abort in loop () From 3d05ac6ed7a09afc9a1cd150bcba7d28ad057f7c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 25 Jan 2022 12:17:30 +0300 Subject: [PATCH 134/312] Stream: resume writer after ping, pong --- src/pure/stream.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 4e25c179..6909f7e3 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -291,7 +291,8 @@ let pipe () = internal.state <- `Idle; let read_ping_callback = internal.read_ping_callback in clean_up_reader_fields internal; - read_ping_callback buffer offset length + read_ping_callback buffer offset length; + ok () | `Closed code -> close code | `Aborted the_exn -> @@ -309,7 +310,8 @@ let pipe () = internal.state <- `Idle; let read_pong_callback = internal.read_pong_callback in clean_up_reader_fields internal; - read_pong_callback buffer offset length + read_pong_callback buffer offset length; + ok () | `Closed code -> close code | `Aborted the_exn -> From b76ac67cba4bd399a306c61b05cc994fce8d5c2f Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 27 Jan 2022 14:34:38 +0300 Subject: [PATCH 135/312] Transfer-Encoding: check for Content-Length --- src/pure/stream.ml | 2 ++ src/server/content_length.ml | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/pure/stream.ml b/src/pure/stream.ml index 6909f7e3..8b11b333 100644 --- a/src/pure/stream.ml +++ b/src/pure/stream.ml @@ -421,6 +421,8 @@ let read_convenience stream = promise +(* TODO It's probably best to protect "wakeups" of the promise to prevent + Invalid_argument from Lwt. *) let read_until_close stream = let promise, resolver = Lwt.wait () in let length = ref 0 in diff --git a/src/server/content_length.ml b/src/server/content_length.ml index 4c411ea8..dc33bd4b 100644 --- a/src/server/content_length.ml +++ b/src/server/content_length.ml @@ -20,5 +20,6 @@ let content_length next_handler request = else let%lwt (response : Message.response) = next_handler request in if not (Message.has_header response "Transfer-Encoding") then - Message.add_header response "Transfer-Encoding" "chunked"; + if not (Message.has_header response "Content-Length") then + Message.add_header response "Transfer-Encoding" "chunked"; Lwt.return response From 264e37d7fcd982e1ceacf4fb4b1ba8e9f0010562 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Wed, 2 Feb 2022 13:51:05 +0300 Subject: [PATCH 136/312] Adapt to recent changes in multipart_form Fixes #193. Fixes #197. --- dream.opam | 3 ++- src/server/dune | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/dream.opam b/dream.opam index 198b9bcd..1e59ef25 100644 --- a/dream.opam +++ b/dream.opam @@ -67,7 +67,8 @@ depends: [ "mirage-clock" "mirage-crypto" {>= "0.8.1"} # AES-256-GCM. "mirage-crypto-rng" {>= "0.8.0"} # Signature of initialize. - "multipart_form" {>= "0.3.0"} + "multipart_form" {>= "0.4.0"} + "multipart_form-lwt" "ocaml" {>= "4.08.0"} "ptime" {>= "0.8.1"} # Ptime.v. "ssl" {>= "0.5.8"} # Ssl.get_negotiated_alpn_protocol. diff --git a/src/server/dune b/src/server/dune index 9afd04a3..d7dd67b7 100644 --- a/src/server/dune +++ b/src/server/dune @@ -11,7 +11,7 @@ magic-mime mirage-clock multipart_form - multipart_form.lwt + multipart_form-lwt ptime unstrctrd uri From 257f0e0d41828d7eefa1e41f2de05dbb8ef9ed7b Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 4 Feb 2022 11:10:13 +0300 Subject: [PATCH 137/312] Makefile: respect workspace root in test targets --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index fe0f7ad4..3ebc946f 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ test : .PHONY : test-watch test-watch : - @dune build --no-print-directory -w --root . @$(TEST)/runtest + @dune build --no-print-directory -w @$(TEST)/runtest .PHONY : coverage-serve coverage-serve : @@ -27,7 +27,7 @@ coverage-serve : .PHONY : promote promote : - dune promote --root . + dune promote @make --no-print-directory test .PHONY : docs From acc2a1695effa5810a32bc3c0cdeda72cff6bd2d Mon Sep 17 00:00:00 2001 From: Yawar Amin Date: Tue, 8 Feb 2022 00:45:18 -0500 Subject: [PATCH 138/312] Add Dream.csrf_tag (#201) This lets us easily inject a hidden field containing a CSRF token into a form, while manually controlling all attributes of the form, e.g. `name`, `id`, etc. Fixes #199. --- example/d-form/README.md | 13 ++--- example/d-form/form.eml.ml | 3 +- example/g-upload/README.md | 13 ++--- example/g-upload/upload.eml.ml | 3 +- example/h-sql/README.md | 3 +- example/h-sql/sql.eml.ml | 3 +- example/w-flash/README.md | 3 +- example/w-flash/flash.eml.ml | 3 +- .../w-multipart-dump/multipart_dump.eml.ml | 3 +- example/w-postgres/postgres.eml.ml | 3 +- example/w-upload-stream/README.md | 5 +- example/w-upload-stream/upload_stream.eml.ml | 3 +- src/dream.ml | 1 + src/dream.mli | 54 +++++++++++++------ src/mirage/mirage.ml | 15 +++--- src/mirage/mirage.mli | 2 + src/server/tag.eml.ml | 6 ++- 17 files changed, 89 insertions(+), 47 deletions(-) diff --git a/example/d-form/README.md b/example/d-form/README.md index 8a80c227..0e7327bf 100644 --- a/example/d-form/README.md +++ b/example/d-form/README.md @@ -16,7 +16,8 @@ let show_form ?message request =

You entered: <%s message %>!

% end; - <%s! Dream.form_tag ~action:"/" request %> + + <%s! Dream.csrf_tag request %> @@ -53,13 +54,13 @@ Try it in the [playground](http://dream.as/d-form).
-We didn't write a literal `
` tag in the template. Instead, we used -[`Dream.form_tag`](https://aantron.github.io/dream/#val-form_tag) to generate -the tag. [`Dream.form_tag`](https://aantron.github.io/dream/#val-form_tag) also -snuck in a hidden `` field containing a CSRF token: +We wrote a literal `` tag in the template, and injected a field containing +a CSRF token into it using the +[`Dream.csrf_tag`](https://aantron.github.io/dream/#val-csrf_tag) helper to +generate the `` tag. ```html - + diff --git a/example/d-form/form.eml.ml b/example/d-form/form.eml.ml index 7ee950b5..16ac8131 100644 --- a/example/d-form/form.eml.ml +++ b/example/d-form/form.eml.ml @@ -8,7 +8,8 @@ let show_form ?message request =

You entered: <%s message %>!

% end; - <%s! Dream.form_tag ~action:"/" request %> + + <%s! Dream.csrf_tag request %>
diff --git a/example/g-upload/README.md b/example/g-upload/README.md index b9f94ef9..de859551 100644 --- a/example/g-upload/README.md +++ b/example/g-upload/README.md @@ -11,7 +11,8 @@ sizes: let home request = - <%s! Dream.form_tag ~action:"/" ~enctype:`Multipart_form_data request %> +
+ <%s! Dream.csrf_tag request %>
@@ -85,13 +86,13 @@ streaming file uploads. [`Dream.multipart`](https://aantron.github.io/dream/#val-multipart) behaves just like [`Dream.form`](https://aantron.github.io/dream/#val-form) when it comes to [CSRF protection](https://cheatsheetseries.owasp.org/cheatsheets/Cross-Site_Request_Forgery_Prevention_Cheat_Sheet.html). -See example [**`d-form`**](../d-form#files). We still use -[`Dream.form_tag`](https://aantron.github.io/dream/#val-form_tag) to generate -the form in the template. The only difference is that we now pass it -``~enctype:`Multipart_form_data`` to make its output look like this: +See example [**`d-form`**](../d-form#files). We use +[`Dream.csrf_tag`](https://aantron.github.io/dream/#val-csrf_tag) to generate +the CSRF token in the template, and pass the `enctype="multipart/form-data"` +attribute as needed for forms to upload files: ```html -
+ diff --git a/example/g-upload/upload.eml.ml b/example/g-upload/upload.eml.ml index 5c2a1752..e40cbc1e 100644 --- a/example/g-upload/upload.eml.ml +++ b/example/g-upload/upload.eml.ml @@ -1,7 +1,8 @@ let home request = - <%s! Dream.form_tag ~action:"/" ~enctype:`Multipart_form_data request %> + + <%s! Dream.csrf_tag request %>
diff --git a/example/h-sql/README.md b/example/h-sql/README.md index bf85abb1..4bd9bbea 100644 --- a/example/h-sql/README.md +++ b/example/h-sql/README.md @@ -35,7 +35,8 @@ let render comments request = % comments |> List.iter (fun (_id, comment) ->

<%s comment %>

<% ); %> - <%s! Dream.form_tag ~action:"/" request %> +
+ <%s! Dream.csrf_tag request %>
diff --git a/example/h-sql/sql.eml.ml b/example/h-sql/sql.eml.ml index fe406b97..582ad660 100644 --- a/example/h-sql/sql.eml.ml +++ b/example/h-sql/sql.eml.ml @@ -25,7 +25,8 @@ let render comments request = % comments |> List.iter (fun (_id, comment) ->

<%s comment %>

<% ); %> - <%s! Dream.form_tag ~action:"/" request %> +
+ <%s! Dream.csrf_tag request %>
diff --git a/example/w-flash/README.md b/example/w-flash/README.md index 515a547d..d25a1f0d 100644 --- a/example/w-flash/README.md +++ b/example/w-flash/README.md @@ -13,7 +13,8 @@ absolutely primitive form with just one field: let form request = - <%s! Dream.form_tag ~action:"/" request %> +
+ <%s! Dream.csrf_tag request %>
diff --git a/example/w-flash/flash.eml.ml b/example/w-flash/flash.eml.ml index 1b9cd121..8bba6415 100644 --- a/example/w-flash/flash.eml.ml +++ b/example/w-flash/flash.eml.ml @@ -1,7 +1,8 @@ let form request = - <%s! Dream.form_tag ~action:"/" request %> +
+ <%s! Dream.csrf_tag request %>
diff --git a/example/w-multipart-dump/multipart_dump.eml.ml b/example/w-multipart-dump/multipart_dump.eml.ml index 6521436c..879112fe 100644 --- a/example/w-multipart-dump/multipart_dump.eml.ml +++ b/example/w-multipart-dump/multipart_dump.eml.ml @@ -1,7 +1,8 @@ let home request = - <%s! Dream.form_tag ~action:"/" ~enctype:`Multipart_form_data request %> +
+ <%s! Dream.csrf_tag request %>

diff --git a/example/w-postgres/postgres.eml.ml b/example/w-postgres/postgres.eml.ml index 52ecd53c..b7d3b037 100644 --- a/example/w-postgres/postgres.eml.ml +++ b/example/w-postgres/postgres.eml.ml @@ -25,7 +25,8 @@ let render comments request = % comments |> List.iter (fun (_id, comment) ->

<%s comment %>

<% ); %> - <%s! Dream.form_tag ~action:"/" request %> + + <%s! Dream.csrf_tag request %>
diff --git a/example/w-upload-stream/README.md b/example/w-upload-stream/README.md index ac03a22d..9105ec1c 100644 --- a/example/w-upload-stream/README.md +++ b/example/w-upload-stream/README.md @@ -11,7 +11,8 @@ the total size of each uploaded file: let home request = - <%s! Dream.form_tag ~action:"/" ~enctype:`Multipart_form_data request %> +
+ <%s! Dream.csrf_tag request %>
@@ -70,7 +71,7 @@ Try it in the [playground](http://dream.as/w-upload-stream). The report page shows one file without a name ("None"). This is, in fact, the CSRF token generated by -[`Dream.form_tag`](https://aantron.github.io/dream/#val-form_tag) inside the +[`Dream.csrf_tag`](https://aantron.github.io/dream/#val-csrf_tag) inside the template. To keep the example simple, we didn't check the CSRF token, nor filter out the `dream.csrf` field that it appears in. If you'd like to do so in your code, see diff --git a/example/w-upload-stream/upload_stream.eml.ml b/example/w-upload-stream/upload_stream.eml.ml index 743f5960..a0e35d7e 100644 --- a/example/w-upload-stream/upload_stream.eml.ml +++ b/example/w-upload-stream/upload_stream.eml.ml @@ -1,7 +1,8 @@ let home request = - <%s! Dream.form_tag ~action:"/" ~enctype:`Multipart_form_data request %> +
+ <%s! Dream.csrf_tag request %>
diff --git a/src/dream.ml b/src/dream.ml index 426a64cc..b5525c90 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -195,6 +195,7 @@ let verify_csrf_token = Csrf.verify_csrf_token ~now let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = Tag.form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request +let csrf_tag = Tag.csrf_tag ~now (* Middleware *) diff --git a/src/dream.mli b/src/dream.mli index 504853ba..ed7a6e87 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -910,12 +910,13 @@ val origin_referrer_check : middleware (** {1 Forms} - {!Dream.form_tag} and {!Dream.val-form} round-trip secure forms. - {!Dream.form_tag} is used inside a template to generate a form header with a - CSRF token: + {!Dream.csrf_tag} and {!Dream.val-form} round-trip secure forms. + {!Dream.csrf_tag} is used inside a form template to generate a hidden field + with a CSRF token: {[ - <%s! Dream.form_tag ~action:"/" request %> +
+ <%s! Dream.csrf_tag request %>
]} @@ -956,13 +957,13 @@ type 'a form_result = [ val form : ?csrf:bool -> request -> (string * string) list form_result promise (** Parses the request body as a form. Performs CSRF checks. Use - {!Dream.form_tag} in a template to transparently generate forms that will - pass these checks. See {!section-templates} and example + {!Dream.csrf_tag} in a form template to transparently generate forms that + will pass these checks. See {!section-templates} and example {{:https://github.com/aantron/dream/tree/master/example/d-form#readme} [d-form]}. - [Content-Type:] must be [application/x-www-form-urlencoded]. - - The form must have a field named [dream.csrf]. {!Dream.form_tag} adds such + - The form must have a field named [dream.csrf]. {!Dream.csrf_tag} adds such a field. - {!Dream.form} calls {!Dream.verify_csrf_token} to check the token in [dream.csrf]. @@ -1047,15 +1048,14 @@ type multipart_form = val multipart : ?csrf:bool -> request -> multipart_form form_result promise (** Like {!Dream.form}, but also reads files, and [Content-Type:] must be - [multipart/form-data]. The [
] tag and CSRF token can be generated in a - template with + [multipart/form-data]. The CSRF token can be generated in a template with {[ - <%s! Dream.form_tag ~action:"/" - ~enctype:`Multipart_form_data request %> + + <%s! Dream.csrf_tag request %> ]} - See {!Dream.form_tag}, section {!section-templates}, and example + See section {!section-templates}, and example {{:https://github.com/aantron/dream/tree/master/example/g-upload#files} [g-upload]}. @@ -1090,7 +1090,7 @@ val upload : request -> part option promise {!Dream.upload} does not verify a CSRF token. There are several ways to add CSRF protection for an upload stream, including: - - Generate the form with {!Dream.form_tag}. Check for + - Generate a CSRF token with {!Dream.csrf_tag}. Check for [`Field ("dream.csrf", token)] during upload and call {!Dream.verify_csrf_token}. - Use {{:https://developer.mozilla.org/en-US/docs/Web/API/FormData} @@ -1104,8 +1104,9 @@ val upload_part : request -> string option promise It's usually not necessary to handle CSRF tokens directly. - - Form tag generator {!Dream.form_tag} generates and inserts a CSRF token - that {!Dream.val-form} and {!Dream.val-multipart} transparently verify. + - CSRF token field generator {!Dream.csrf_tag} generates and inserts a CSRF + token that {!Dream.val-form} and {!Dream.val-multipart} transparently + verify. - AJAX can be protected from CSRF by {!Dream.origin_referrer_check}. CSRF functions are exposed for creating custom schemes, and for @@ -1228,6 +1229,29 @@ let render message = unquoted attribute values, CSS in [
+
diff --git a/src/graphiql/index.html b/src/graphiql/index.html index 009fb820..a2600b63 100644 --- a/src/graphiql/index.html +++ b/src/graphiql/index.html @@ -23,7 +23,7 @@ - +
@@ -31,10 +31,9 @@ var endpoint = "%%ENDPOINT%%"; var wsSchema = location.protocol === "https:" ? "wss:" : "ws:"; var wsEndpoint = wsSchema + "//" + window.location.host + endpoint; - var fetcher = GraphiQL.createFetcher({ url: endpoint, - subscriptionUrl: wsEndpoint + subscriptionUrl: wsEndpoint, }); var defaultQuery = "%%DEFAULT_QUERY%%"; @@ -43,9 +42,10 @@ React.createElement(GraphiQL, { fetcher: fetcher, defaultQuery: defaultQuery, - defaultSecondaryEditorOpen: true + defaultSecondaryEditorOpen: true, }), - document.getElementById("graphiql")); + document.getElementById("graphiql") + ); diff --git a/src/graphiql/package-lock.json b/src/graphiql/package-lock.json index e32d13fb..39e9e9d6 100644 --- a/src/graphiql/package-lock.json +++ b/src/graphiql/package-lock.json @@ -1,28 +1,4149 @@ { "name": "dream-graphiql", + "lockfileVersion": 2, "requires": true, - "lockfileVersion": 1, + "packages": { + "": { + "name": "dream-graphiql", + "dependencies": { + "graphiql": "^2.4.1", + "graphql": "^16.6.0", + "inliner": "aantron/inliner#fork", + "react": "^18.2.0", + "react-dom": "^18.2.0" + } + }, + "node_modules/@babel/runtime": { + "version": "7.21.5", + "resolved": "https://registry.npmjs.org/@babel/runtime/-/runtime-7.21.5.tgz", + "integrity": "sha512-8jI69toZqqcsnqGGqwGS4Qb1VwLOEp4hz+CXPywcvjs60u3B4Pom/U/7rm4W8tMOYEB+E9wgD0mW1l3r8qlI9Q==", + "dependencies": { + "regenerator-runtime": "^0.13.11" + }, + "engines": { + "node": ">=6.9.0" + } + }, + "node_modules/@codemirror/language": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/@codemirror/language/-/language-6.0.0.tgz", + "integrity": "sha512-rtjk5ifyMzOna1c7PBu7J1VCt0PvA5wy3o8eMVnxMKb7z8KA7JFecvD04dSn14vj/bBaAbqRsGed5OjtofEnLA==", + "peer": true, + "dependencies": { + "@codemirror/state": "^6.0.0", + "@codemirror/view": "^6.0.0", + "@lezer/common": "^1.0.0", + "@lezer/highlight": "^1.0.0", + "@lezer/lr": "^1.0.0", + "style-mod": "^4.0.0" + } + }, + "node_modules/@codemirror/state": { + "version": "6.2.0", + "resolved": "https://registry.npmjs.org/@codemirror/state/-/state-6.2.0.tgz", + "integrity": "sha512-69QXtcrsc3RYtOtd+GsvczJ319udtBf1PTrr2KbLWM/e2CXUPnh0Nz9AUo8WfhSQ7GeL8dPVNUmhQVgpmuaNGA==", + "peer": true + }, + "node_modules/@codemirror/view": { + "version": "6.11.0", + "resolved": "https://registry.npmjs.org/@codemirror/view/-/view-6.11.0.tgz", + "integrity": "sha512-PRpPRkqMkAKKxEuiUBxapE0YR+wqs9At92ujbJo93PwTZ0jEJDzx9wahrDcXEhQ43Pe0RK9DdZMLWrt+QN80DA==", + "peer": true, + "dependencies": { + "@codemirror/state": "^6.1.4", + "style-mod": "^4.0.0", + "w3c-keyname": "^2.2.4" + } + }, + "node_modules/@graphiql/react": { + "version": "0.17.2", + "resolved": "https://registry.npmjs.org/@graphiql/react/-/react-0.17.2.tgz", + "integrity": "sha512-x8iTeYSq8C520UYGk3f3S+AWOm8nf7x3OuePWg+k0KkMAWJeaeFBLmxBAGQLzK5/8/dPoZfNKblXcLwByeMHew==", + "dependencies": { + "@graphiql/toolkit": "^0.8.4", + "@reach/combobox": "^0.17.0", + "@reach/dialog": "^0.17.0", + "@reach/listbox": "^0.17.0", + "@reach/menu-button": "^0.17.0", + "@reach/tooltip": "^0.17.0", + "@reach/visually-hidden": "^0.17.0", + "clsx": "^1.2.1", + "codemirror": "^5.65.3", + "codemirror-graphql": "^2.0.6", + "copy-to-clipboard": "^3.2.0", + "graphql-language-service": "^5.1.4", + "markdown-it": "^12.2.0", + "set-value": "^4.1.0" + }, + "peerDependencies": { + "graphql": "^15.5.0 || ^16.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react-dom": "^16.8.0 || ^17.0.0 || ^18.0.0" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/combobox/-/combobox-0.17.0.tgz", + "integrity": "sha512-2mYvU5agOBCQBMdlM4cri+P1BbNwp05P1OuDyc33xJSNiBG7BMy4+ZSHJ0X4fyle6rHwSgCAOCLOeWV1XUYjoQ==", + "dependencies": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/portal": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "dependencies": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/popover/node_modules/@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "dependencies": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "dependencies": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/combobox/node_modules/@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "dependencies": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/dialog": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/dialog/-/dialog-0.17.0.tgz", + "integrity": "sha512-AnfKXugqDTGbeG3c8xDcrQDE4h9b/vnc27Sa118oQSquz52fneUeX9MeFb5ZEiBJK8T5NJpv7QUTBIKnFCAH5A==", + "dependencies": { + "@reach/portal": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "react-focus-lock": "^2.5.2", + "react-remove-scroll": "^2.4.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/dialog/node_modules/@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "dependencies": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/dialog/node_modules/@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "dependencies": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/listbox/-/listbox-0.17.0.tgz", + "integrity": "sha512-AMnH1P6/3VKy2V/nPb4Es441arYR+t4YRdh9jdcFVrCOD6y7CQrlmxsYjeg9Ocdz08XpdoEBHM3PKLJqNAUr7A==", + "dependencies": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/machine": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/machine": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/machine/-/machine-0.17.0.tgz", + "integrity": "sha512-9EHnuPgXzkbRENvRUzJvVvYt+C2jp7PGN0xon7ffmKoK8rTO6eA/bb7P0xgloyDDQtu88TBUXKzW0uASqhTXGA==", + "dependencies": { + "@reach/utils": "0.17.0", + "@xstate/fsm": "1.4.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "dependencies": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/popover/node_modules/@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "dependencies": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/popover/node_modules/@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "dependencies": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/listbox/node_modules/@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "dependencies": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/menu-button/-/menu-button-0.17.0.tgz", + "integrity": "sha512-YyuYVyMZKamPtivoEI6D0UEILYH3qZtg4kJzEAuzPmoR/aHN66NZO75Fx0gtjG1S6fZfbiARaCOZJC0VEiDOtQ==", + "dependencies": { + "@reach/dropdown": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x", + "react-is": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/dropdown": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/dropdown/-/dropdown-0.17.0.tgz", + "integrity": "sha512-qBTIGInhxtPHtdj4Pl2XZgZMz3e37liydh0xR3qc48syu7g71sL4nqyKjOzThykyfhA3Pb3/wFgsFJKGTSdaig==", + "dependencies": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/dropdown/node_modules/@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/dropdown/node_modules/@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "dependencies": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/popover/node_modules/@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "dependencies": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/popover/node_modules/@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "dependencies": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/menu-button/node_modules/@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "dependencies": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/tooltip": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/tooltip/-/tooltip-0.17.0.tgz", + "integrity": "sha512-HP8Blordzqb/Cxg+jnhGmWQfKgypamcYLBPlcx6jconyV5iLJ5m93qipr1giK7MqKT2wlsKWy44ZcOrJ+Wrf8w==", + "dependencies": { + "@reach/auto-id": "0.17.0", + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "@reach/visually-hidden": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/tooltip/node_modules/@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "dependencies": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/tooltip/node_modules/@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "dependencies": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/tooltip/node_modules/@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "dependencies": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/tooltip/node_modules/@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "dependencies": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/react/node_modules/@reach/visually-hidden": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/visually-hidden/-/visually-hidden-0.17.0.tgz", + "integrity": "sha512-T6xF3Nv8vVnjVkGU6cm0+kWtvliLqPAo8PcZ+WxkKacZsaHTjaZb4v1PaCcyQHmuTNT/vtTVNOJLG0SjQOIb7g==", + "dependencies": { + "prop-types": "^15.7.2", + "tslib": "^2.3.0" + }, + "peerDependencies": { + "react": "^16.8.0 || 17.x", + "react-dom": "^16.8.0 || 17.x" + } + }, + "node_modules/@graphiql/toolkit": { + "version": "0.8.4", + "resolved": "https://registry.npmjs.org/@graphiql/toolkit/-/toolkit-0.8.4.tgz", + "integrity": "sha512-cFUGqh3Dau+SD3Vq9EFlZrhzYfaHKyOJveFtaCR+U5Cn/S68p7oy+vQBIdwtO6J2J58FncnwBbVRfr+IvVfZqQ==", + "dependencies": { + "@n1ru4l/push-pull-async-iterable-iterator": "^3.1.0", + "meros": "^1.1.4" + }, + "peerDependencies": { + "graphql": "^15.5.0 || ^16.0.0", + "graphql-ws": ">= 4.5.0" + }, + "peerDependenciesMeta": { + "graphql-ws": { + "optional": true + } + } + }, + "node_modules/@lezer/common": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/@lezer/common/-/common-1.0.2.tgz", + "integrity": "sha512-SVgiGtMnMnW3ActR8SXgsDhw7a0w0ChHSYAyAUxxrOiJ1OqYWEKk/xJd84tTSPo1mo6DXLObAJALNnd0Hrv7Ng==", + "peer": true + }, + "node_modules/@lezer/highlight": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/@lezer/highlight/-/highlight-1.1.4.tgz", + "integrity": "sha512-IECkFmw2l7sFcYXrV8iT9GeY4W0fU4CxX0WMwhmhMIVjoDdD1Hr6q3G2NqVtLg/yVe5n7i4menG3tJ2r4eCrPQ==", + "peer": true, + "dependencies": { + "@lezer/common": "^1.0.0" + } + }, + "node_modules/@lezer/lr": { + "version": "1.3.4", + "resolved": "https://registry.npmjs.org/@lezer/lr/-/lr-1.3.4.tgz", + "integrity": "sha512-7o+e4og/QoC/6btozDPJqnzBhUaD1fMfmvnEKQO1wRRiTse1WxaJ3OMEXZJnkgT6HCcTVOctSoXK9jGJw2oe9g==", + "peer": true, + "dependencies": { + "@lezer/common": "^1.0.0" + } + }, + "node_modules/@n1ru4l/push-pull-async-iterable-iterator": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/@n1ru4l/push-pull-async-iterable-iterator/-/push-pull-async-iterable-iterator-3.2.0.tgz", + "integrity": "sha512-3fkKj25kEjsfObL6IlKPAlHYPq/oYwUkkQ03zsTTiDjD7vg/RxjdiLeCydqtxHZP0JgsXL3D/X5oAkMGzuUp/Q==", + "engines": { + "node": ">=12" + } + }, + "node_modules/@reach/observe-rect": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/@reach/observe-rect/-/observe-rect-1.2.0.tgz", + "integrity": "sha512-Ba7HmkFgfQxZqqaeIWWkNK0rEhpxVQHIoVyW1YDSkGsGIXzcaW4deC8B0pZrNSSyLTdIk7y+5olKt5+g0GmFIQ==" + }, + "node_modules/@types/q": { + "version": "1.5.5", + "resolved": "https://registry.npmjs.org/@types/q/-/q-1.5.5.tgz", + "integrity": "sha512-L28j2FcJfSZOnL1WBjDYp2vUHCeIFlyYI/53EwD/rKUBQ7MtUUfbQWiyKJGpcnv4/WgrhWsFKrcPstcAt/J0tQ==" + }, + "node_modules/@xstate/fsm": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/@xstate/fsm/-/fsm-1.4.0.tgz", + "integrity": "sha512-uTHDeu2xI5E1IFwf37JFQM31RrH7mY7877RqPBS4ZqSNUwoLDuct8AhBWaXGnVizBAYyimVwgCyGa9z/NiRhXA==" + }, + "node_modules/ajv": { + "version": "6.12.6", + "resolved": "https://registry.npmjs.org/ajv/-/ajv-6.12.6.tgz", + "integrity": "sha512-j3fVLgvTo527anyYyJOGTYJbG+vnnQYvE0m5mmkc1TK+nxAppkCLMIL0aZ4dblVCNoGShhm+kzE4ZUykBoMg4g==", + "dependencies": { + "fast-deep-equal": "^3.1.1", + "fast-json-stable-stringify": "^2.0.0", + "json-schema-traverse": "^0.4.1", + "uri-js": "^4.2.2" + }, + "funding": { + "type": "github", + "url": "https://github.com/sponsors/epoberezkin" + } + }, + "node_modules/align-text": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/align-text/-/align-text-0.1.4.tgz", + "integrity": "sha512-GrTZLRpmp6wIC2ztrWW9MjjTgSKccffgFagbNDOX95/dcjEcYZibYTeaOntySQLcdw1ztBoFkviiUvTMbb9MYg==", + "dependencies": { + "kind-of": "^3.0.2", + "longest": "^1.0.1", + "repeat-string": "^1.5.2" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/ansi-escapes": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-1.4.0.tgz", + "integrity": "sha512-wiXutNjDUlNEDWHcYH3jtZUhd3c4/VojassD8zHdHCY13xbZy2XbW+NKQwA0tWGBVzDA9qEzYwfoSsWmviidhw==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha512-TIGnTpdo+E3+pCyAluZvtED5p5wCqLdezCyhPZzKPcxvFplEt4i+W7OONCKgeZFT3+y5NZZfOOS/Bdcanm1MYA==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/ansi-styles": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-2.2.1.tgz", + "integrity": "sha512-kmCevFghRiWM7HB5zTPULl4r9bVFSWjz62MhqizDGUrq2NWuNMQyuv4tHHoKJHs69M/MF64lEcHdYIocrdWQYA==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/argparse": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-2.0.1.tgz", + "integrity": "sha512-8+9WqebbFzpX9OR+Wa6O29asIogeRMzcGtAINdpMHHyAg10f05aSFVBbcEqGf/PXw1EjAZ+q2/bEBg3DvurK3Q==" + }, + "node_modules/array-buffer-byte-length": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/array-buffer-byte-length/-/array-buffer-byte-length-1.0.0.tgz", + "integrity": "sha512-LPuwb2P+NrQw3XhxGc36+XSvuBPopovXYTR9Ew++Du9Yb/bx5AzBfrIsBoj0EZUifjQU+sHL21sseZ3jerWO/A==", + "dependencies": { + "call-bind": "^1.0.2", + "is-array-buffer": "^3.0.1" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/array.prototype.reduce": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/array.prototype.reduce/-/array.prototype.reduce-1.0.5.tgz", + "integrity": "sha512-kDdugMl7id9COE8R7MHF5jWk7Dqt/fs4Pv+JXoICnYwqpjjjbUurz6w5fT5IG6brLdJhv6/VoHB0H7oyIBXd+Q==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4", + "es-array-method-boxes-properly": "^1.0.0", + "is-string": "^1.0.7" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/asap": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/asap/-/asap-2.0.6.tgz", + "integrity": "sha512-BSHWgDSAiKs50o2Re8ppvp3seVHXSRM44cdSsT9FfNEUUZLOGWVCsiWaRPWM1Znn+mqZ1OfVZ3z3DWEzSp7hRA==" + }, + "node_modules/asn1": { + "version": "0.2.6", + "resolved": "https://registry.npmjs.org/asn1/-/asn1-0.2.6.tgz", + "integrity": "sha512-ix/FxPn0MDjeyJ7i/yoHGFt/EX6LyNbxSEhPPXODPL+KB0VPk86UYfL0lMdy+KCnv+fmvIzySwaK5COwqVbWTQ==", + "dependencies": { + "safer-buffer": "~2.1.0" + } + }, + "node_modules/assert-plus": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/assert-plus/-/assert-plus-1.0.0.tgz", + "integrity": "sha512-NfJ4UzBCcQGLDlQq7nHxH+tv3kyZ0hHQqF5BO6J7tNJeP5do1llPr8dZ8zHonfhAu0PHAdMkSo+8o0wxg9lZWw==", + "engines": { + "node": ">=0.8" + } + }, + "node_modules/asynckit": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", + "integrity": "sha512-Oei9OH4tRh0YqU3GxhX79dM/mwVgvbZJaSNaRk+bshkj0S5cfHcgYakreBjrHwatXKbz+IoIdYLxrKim2MjW0Q==" + }, + "node_modules/available-typed-arrays": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/available-typed-arrays/-/available-typed-arrays-1.0.5.tgz", + "integrity": "sha512-DMD0KiN46eipeziST1LPP/STfDU0sufISXmjSgvVsoU2tqxctQeASejWcfNtxYKqETM1UxQ8sp2OrSBWpHY6sw==", + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/aws-sign2": { + "version": "0.7.0", + "resolved": "https://registry.npmjs.org/aws-sign2/-/aws-sign2-0.7.0.tgz", + "integrity": "sha512-08kcGqnYf/YmjoRhfxyu+CLxBjUtHLXLXX/vUfx9l2LYzG3c1m61nrpyFUZI6zeS+Li/wWMMidD9KgrqtGq3mA==", + "engines": { + "node": "*" + } + }, + "node_modules/aws4": { + "version": "1.12.0", + "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.12.0.tgz", + "integrity": "sha512-NmWvPnx0F1SfrQbYwOi7OeaNGokp9XhzNioJ/CSBs8Qa4vxug81mhJEAVZwxXuBmYB5KDRfMq/F3RR0BIU7sWg==" + }, + "node_modules/bcrypt-pbkdf": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/bcrypt-pbkdf/-/bcrypt-pbkdf-1.0.2.tgz", + "integrity": "sha512-qeFIXtP4MSoi6NLqO12WfqARWWuCKi2Rn/9hJLEmtB5yTNr9DqFWkJRCf2qShWzPeAMRnOgCrq0sg/KLv5ES9w==", + "dependencies": { + "tweetnacl": "^0.14.3" + } + }, + "node_modules/boolbase": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/boolbase/-/boolbase-1.0.0.tgz", + "integrity": "sha512-JZOSA7Mo9sNGB8+UjSgzdLtokWAky1zbztM3WRLCbZ70/3cTANmQmOdR7y2g+J0e2WXywy1yS468tY+IruqEww==" + }, + "node_modules/call-bind": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/call-bind/-/call-bind-1.0.2.tgz", + "integrity": "sha512-7O+FbCihrB5WGbFYesctwmTKae6rOiIzmz1icreWJ+0aA7LJfuqhEso2T9ncpcFtzMQtzXf2QGGueWJGTYsqrA==", + "dependencies": { + "function-bind": "^1.1.1", + "get-intrinsic": "^1.0.2" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/camelcase": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/camelcase/-/camelcase-1.2.1.tgz", + "integrity": "sha512-wzLkDa4K/mzI1OSITC+DUyjgIl/ETNHE9QvYgy6J6Jvqyyz4C0Xfd+lQhb19sX2jMpZV4IssUn0VDVmglV+s4g==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/caseless": { + "version": "0.12.0", + "resolved": "https://registry.npmjs.org/caseless/-/caseless-0.12.0.tgz", + "integrity": "sha512-4tYFyifaFfGacoiObjJegolkwSU4xQNGbVgUiNYVUxbQ2x2lUsFvY4hVgVzGiIe6WLOPqycWXA40l+PWsxthUw==" + }, + "node_modules/center-align": { + "version": "0.1.3", + "resolved": "https://registry.npmjs.org/center-align/-/center-align-0.1.3.tgz", + "integrity": "sha512-Baz3aNe2gd2LP2qk5U+sDk/m4oSuwSDcBfayTCTBoWpfIGO5XFxPmjILQII4NGiZjD6DoDI6kf7gKaxkf7s3VQ==", + "dependencies": { + "align-text": "^0.1.3", + "lazy-cache": "^1.0.3" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/chalk": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-1.1.3.tgz", + "integrity": "sha512-U3lRVLMSlsCfjqYPbLyVv11M9CPW4I728d6TCKMAOJueEeB9/8o+eSsMnxPJD+Q+K909sdESg7C+tIkoH6on1A==", + "dependencies": { + "ansi-styles": "^2.2.1", + "escape-string-regexp": "^1.0.2", + "has-ansi": "^2.0.0", + "strip-ansi": "^3.0.0", + "supports-color": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/charset": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/charset/-/charset-1.0.1.tgz", + "integrity": "sha512-6dVyOOYjpfFcL1Y4qChrAoQLRHvj2ziyhcm0QJlhOcAhykL/k1kTUPbeo+87MNRTRdk2OIIsIXbuF3x2wi5EXg==", + "engines": { + "node": ">=4.0.0" + } + }, + "node_modules/cheerio": { + "version": "0.22.0", + "resolved": "https://registry.npmjs.org/cheerio/-/cheerio-0.22.0.tgz", + "integrity": "sha512-8/MzidM6G/TgRelkzDG13y3Y9LxBjCb+8yOEZ9+wwq5gVF2w2pV0wmHvjfT0RvuxGyR7UEuK36r+yYMbT4uKgA==", + "dependencies": { + "css-select": "~1.2.0", + "dom-serializer": "~0.1.0", + "entities": "~1.1.1", + "htmlparser2": "^3.9.1", + "lodash.assignin": "^4.0.9", + "lodash.bind": "^4.1.4", + "lodash.defaults": "^4.0.1", + "lodash.filter": "^4.4.0", + "lodash.flatten": "^4.2.0", + "lodash.foreach": "^4.3.0", + "lodash.map": "^4.4.0", + "lodash.merge": "^4.4.0", + "lodash.pick": "^4.2.1", + "lodash.reduce": "^4.4.0", + "lodash.reject": "^4.4.0", + "lodash.some": "^4.4.0" + }, + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/cheerio/node_modules/lodash.defaults": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/lodash.defaults/-/lodash.defaults-4.2.0.tgz", + "integrity": "sha512-qjxPLHd3r5DnsdGacqOMU6pb/avJzdh9tFX2ymgoZE27BmjXrNy/y4LoaiTeAb+O3gL8AfpJGtqfX/ae2leYYQ==" + }, + "node_modules/cheerio/node_modules/lodash.foreach": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.foreach/-/lodash.foreach-4.5.0.tgz", + "integrity": "sha512-aEXTF4d+m05rVOAUG3z4vZZ4xVexLKZGF0lIxuHZ1Hplpk/3B6Z1+/ICICYRLm7c41Z2xiejbkCkJoTlypoXhQ==" + }, + "node_modules/cliui": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/cliui/-/cliui-2.1.0.tgz", + "integrity": "sha512-GIOYRizG+TGoc7Wgc1LiOTLare95R3mzKgoln+Q/lE4ceiYH19gUpl0l0Ffq4lJDEf3FxujMe6IBfOCs7pfqNA==", + "dependencies": { + "center-align": "^0.1.1", + "right-align": "^0.1.1", + "wordwrap": "0.0.2" + } + }, + "node_modules/clsx": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/clsx/-/clsx-1.2.1.tgz", + "integrity": "sha512-EcR6r5a8bj6pu3ycsa/E/cKVGuTgZJZdsyUYHOksG/UHIiKfjxzRxYJpyVBwYaQeOvghal9fcc4PidlgzugAQg==", + "engines": { + "node": ">=6" + } + }, + "node_modules/coa": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/coa/-/coa-2.0.2.tgz", + "integrity": "sha512-q5/jG+YQnSy4nRTV4F7lPepBJZ8qBNJJDBuJdoejDyLXgmL7IEo+Le2JDZudFTFt7mrCqIRaSjws4ygRCTCAXA==", + "dependencies": { + "@types/q": "^1.5.1", + "chalk": "^2.4.1", + "q": "^1.1.2" + }, + "engines": { + "node": ">= 4.0" + } + }, + "node_modules/coa/node_modules/ansi-styles": { + "version": "3.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-3.2.1.tgz", + "integrity": "sha512-VT0ZI6kZRdTh8YyJw3SMbYm/u+NqfsAxEpWO0Pf9sq8/e94WxxOpPKx9FR1FlyCtOVDNOQ+8ntlqFxiRc+r5qA==", + "dependencies": { + "color-convert": "^1.9.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/coa/node_modules/chalk": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-2.4.2.tgz", + "integrity": "sha512-Mti+f9lpJNcwF4tWV8/OrTTtF1gZi+f8FqlyAdouralcFWFQWF2+NgCHShjkCb+IFBLq9buZwE1xckQU4peSuQ==", + "dependencies": { + "ansi-styles": "^3.2.1", + "escape-string-regexp": "^1.0.5", + "supports-color": "^5.3.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/coa/node_modules/supports-color": { + "version": "5.5.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-5.5.0.tgz", + "integrity": "sha512-QjVjwdXIt408MIiAqCX4oUKsgU2EqAGzs2Ppkm4aQYbjm+ZEWEcW4SfFNTr4uMNZma0ey4f5lgLrkB0aX0QMow==", + "dependencies": { + "has-flag": "^3.0.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/codemirror": { + "version": "5.65.13", + "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.65.13.tgz", + "integrity": "sha512-SVWEzKXmbHmTQQWaz03Shrh4nybG0wXx2MEu3FO4ezbPW8IbnZEd5iGHGEffSUaitKYa3i+pHpBsSvw8sPHtzg==" + }, + "node_modules/codemirror-graphql": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/codemirror-graphql/-/codemirror-graphql-2.0.6.tgz", + "integrity": "sha512-ZuvT4+iBYabyLWaqVHdsGyiB2atvu0v1eSnGUuziX7x7tJmo5WziZGvc2j6w6EnL5aUjvYnJU0aCBhTgCdzJVg==", + "dependencies": { + "graphql-language-service": "5.1.4" + }, + "peerDependencies": { + "@codemirror/language": "6.0.0", + "codemirror": "^5.65.3", + "graphql": "^15.5.0 || ^16.0.0" + } + }, + "node_modules/color-convert": { + "version": "1.9.3", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-1.9.3.tgz", + "integrity": "sha512-QfAUtd+vFdAtFQcC8CCyYt1fYWxSqAiK2cSD6zDB8N3cpsEBAvRxp9zOGg6G/SHHJYAT88/az/IuDGALsNVbGg==", + "dependencies": { + "color-name": "1.1.3" + } + }, + "node_modules/color-name": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.3.tgz", + "integrity": "sha512-72fSenhMw2HZMTVHeCA9KCmpEIbzWiQsjN+BHcBbS9vr1mtt+vJjPdksIBNUmKAW8TFUDPJK5SUU3QhE9NEXDw==" + }, + "node_modules/combined-stream": { + "version": "1.0.8", + "resolved": "https://registry.npmjs.org/combined-stream/-/combined-stream-1.0.8.tgz", + "integrity": "sha512-FQN4MRfuJeHf7cBbBMJFXhKSDq+2kAArBlmRBvcvFE5BB1HZKXtSFASDhdlz9zOYwxh8lDdnvmMOe/+5cdoEdg==", + "dependencies": { + "delayed-stream": "~1.0.0" + }, + "engines": { + "node": ">= 0.8" + } + }, + "node_modules/configstore": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/configstore/-/configstore-1.4.0.tgz", + "integrity": "sha512-Zcx2SVdZC06IuRHd2MhkVYFNJBkZBj166LGdsJXRcqNC8Gs5Bwh8mosStNeCBBmtIm4wNii2uarD50qztjKOjw==", + "dependencies": { + "graceful-fs": "^4.1.2", + "mkdirp": "^0.5.0", + "object-assign": "^4.0.1", + "os-tmpdir": "^1.0.0", + "osenv": "^0.1.0", + "uuid": "^2.0.1", + "write-file-atomic": "^1.1.2", + "xdg-basedir": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/configstore/node_modules/uuid": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/uuid/-/uuid-2.0.3.tgz", + "integrity": "sha512-FULf7fayPdpASncVy4DLh3xydlXEJJpvIELjYjNeQWYUZ9pclcpvCZSr2gkmN2FrrGcI7G/cJsIEwk5/8vfXpg==", + "deprecated": "Please upgrade to version 7 or higher. Older versions may use Math.random() in certain circumstances, which is known to be problematic. See https://v8.dev/blog/math-random for details." + }, + "node_modules/copy-to-clipboard": { + "version": "3.3.3", + "resolved": "https://registry.npmjs.org/copy-to-clipboard/-/copy-to-clipboard-3.3.3.tgz", + "integrity": "sha512-2KV8NhB5JqC3ky0r9PMCAZKbUHSwtEo4CwCs0KXgruG43gX5PMqDEBbVU4OUzw2MuAWUfsuFmWvEKG5QRfSnJA==", + "dependencies": { + "toggle-selection": "^1.0.6" + } + }, + "node_modules/core-util-is": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.2.tgz", + "integrity": "sha512-3lqz5YjWTYnW6dlDa5TLaTCcShfar1e40rmcJVwCBJC6mWlFuj0eCHIElmG1g5kyuJ/GD+8Wn4FFCcz4gJPfaQ==" + }, + "node_modules/css-select": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-1.2.0.tgz", + "integrity": "sha512-dUQOBoqdR7QwV90WysXPLXG5LO7nhYBgiWVfxF80DKPF8zx1t/pUd2FYy73emg3zrjtM6dzmYgbHKfV2rxiHQA==", + "dependencies": { + "boolbase": "~1.0.0", + "css-what": "2.1", + "domutils": "1.5.1", + "nth-check": "~1.0.1" + } + }, + "node_modules/css-select-base-adapter": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/css-select-base-adapter/-/css-select-base-adapter-0.1.1.tgz", + "integrity": "sha512-jQVeeRG70QI08vSTwf1jHxp74JoZsr2XSgETae8/xC8ovSnL2WF87GTLO86Sbwdt2lK4Umg4HnnwMO4YF3Ce7w==" + }, + "node_modules/css-tree": { + "version": "1.0.0-alpha.37", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.0.0-alpha.37.tgz", + "integrity": "sha512-DMxWJg0rnz7UgxKT0Q1HU/L9BeJI0M6ksor0OgqOnF+aRCDWg/N2641HmVyU9KVIu0OVVWOb2IpC9A+BJRnejg==", + "dependencies": { + "mdn-data": "2.0.4", + "source-map": "^0.6.1" + }, + "engines": { + "node": ">=8.0.0" + } + }, + "node_modules/css-what": { + "version": "2.1.3", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-2.1.3.tgz", + "integrity": "sha512-a+EPoD+uZiNfh+5fxw2nO9QwFa6nJe2Or35fGY6Ipw1R3R4AGz1d1TEZrCegvw2YTmZ0jXirGYlzxxpYSHwpEg==", + "engines": { + "node": "*" + } + }, + "node_modules/csso": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/csso/-/csso-4.2.0.tgz", + "integrity": "sha512-wvlcdIbf6pwKEk7vHj8/Bkc0B4ylXZruLvOgs9doS5eOsOpuodOV2zJChSpkp+pRpYQLQMeF04nr3Z68Sta9jA==", + "dependencies": { + "css-tree": "^1.1.2" + }, + "engines": { + "node": ">=8.0.0" + } + }, + "node_modules/csso/node_modules/css-tree": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.1.3.tgz", + "integrity": "sha512-tRpdppF7TRazZrjJ6v3stzv93qxRcSsFmW6cX0Zm2NVKpxE1WV1HblnghVv9TreireHkqI/VDEsfolRF1p6y7Q==", + "dependencies": { + "mdn-data": "2.0.14", + "source-map": "^0.6.1" + }, + "engines": { + "node": ">=8.0.0" + } + }, + "node_modules/csso/node_modules/mdn-data": { + "version": "2.0.14", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.14.tgz", + "integrity": "sha512-dn6wd0uw5GsdswPFfsgMp5NSB0/aDe6fK94YJV/AJDYXL6HVLWBsxeq7js7Ad+mU2K9LAlwpk6kN2D5mwCPVow==" + }, + "node_modules/dashdash": { + "version": "1.14.1", + "resolved": "https://registry.npmjs.org/dashdash/-/dashdash-1.14.1.tgz", + "integrity": "sha512-jRFi8UDGo6j+odZiEpjazZaWqEal3w/basFjQHQEwVtZJGDpxbH1MeYluwCS8Xq5wmLJooDlMgvVarmWfGM44g==", + "dependencies": { + "assert-plus": "^1.0.0" + }, + "engines": { + "node": ">=0.10" + } + }, + "node_modules/debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "dependencies": { + "ms": "2.0.0" + } + }, + "node_modules/decamelize": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/decamelize/-/decamelize-1.2.0.tgz", + "integrity": "sha512-z2S+W9X73hAUUki+N+9Za2lBlun89zigOyGrsax+KUQ6wKW4ZoWpEYBkGhQjwAjjDCkWxhY0VKEhk8wzY7F5cA==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/deep-extend": { + "version": "0.6.0", + "resolved": "https://registry.npmjs.org/deep-extend/-/deep-extend-0.6.0.tgz", + "integrity": "sha512-LOHxIOaPYdHlJRtCQfDIVZtfw/ufM8+rVj649RIHzcm/vGwQRXFt6OPqIFWsm2XEMrNIEtWR64sY1LEKD2vAOA==", + "engines": { + "node": ">=4.0.0" + } + }, + "node_modules/define-properties": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.2.0.tgz", + "integrity": "sha512-xvqAVKGfT1+UAvPwKTVw/njhdQ8ZhXK4lI0bCIuCMrp2up9nPnaDftrLtmpTazqd1o+UY4zgzU+avtMbDP+ldA==", + "dependencies": { + "has-property-descriptors": "^1.0.0", + "object-keys": "^1.1.1" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/delayed-stream": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz", + "integrity": "sha512-ZySD7Nf91aLB0RxL4KGrKHBXl7Eds1DAmEdcoVawXnLD7SDhpNgtuII2aAkg7a7QS41jxPSZ17p4VdGnMHk3MQ==", + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/detect-node-es": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/detect-node-es/-/detect-node-es-1.1.0.tgz", + "integrity": "sha512-ypdmJU/TbBby2Dxibuv7ZLW3Bs1QEmM7nHjEANfohJLvE0XVujisn1qPJcZxg+qDucsr+bP6fLD1rPS3AhJ7EQ==" + }, + "node_modules/dom-serializer": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-0.1.1.tgz", + "integrity": "sha512-l0IU0pPzLWSHBcieZbpOKgkIn3ts3vAh7ZuFyXNwJxJXk/c4Gwj9xaTJwIDVQCXawWD0qb3IzMGH5rglQaO0XA==", + "dependencies": { + "domelementtype": "^1.3.0", + "entities": "^1.1.1" + } + }, + "node_modules/domelementtype": { + "version": "1.3.1", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-1.3.1.tgz", + "integrity": "sha512-BSKB+TSpMpFI/HOxCNr1O8aMOTZ8hT3pM3GQ0w/mWRmkhEDSFJkkyzz4XQsBV44BChwGkrDfMyjVD0eA2aFV3w==" + }, + "node_modules/domhandler": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/domhandler/-/domhandler-2.4.2.tgz", + "integrity": "sha512-JiK04h0Ht5u/80fdLMCEmV4zkNh2BcoMFBmZ/91WtYZ8qVXSKjiw7fXMgFPnHcSZgOo3XdinHvmnDUeMf5R4wA==", + "dependencies": { + "domelementtype": "1" + } + }, + "node_modules/domutils": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-1.5.1.tgz", + "integrity": "sha512-gSu5Oi/I+3wDENBsOWBiRK1eoGxcywYSqg3rR960/+EfY0CF4EX1VPkgHOZ3WiS/Jg2DtliF6BhWcHlfpYUcGw==", + "dependencies": { + "dom-serializer": "0", + "domelementtype": "1" + } + }, + "node_modules/duplexify": { + "version": "3.7.1", + "resolved": "https://registry.npmjs.org/duplexify/-/duplexify-3.7.1.tgz", + "integrity": "sha512-07z8uv2wMyS51kKhD1KsdXJg5WQ6t93RneqRxUHnskXVtlYYkLqM0gqStQZ3pj073g687jPCHrqNfCzawLYh5g==", + "dependencies": { + "end-of-stream": "^1.0.0", + "inherits": "^2.0.1", + "readable-stream": "^2.0.0", + "stream-shift": "^1.0.0" + } + }, + "node_modules/duplexify/node_modules/isarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", + "integrity": "sha512-VLghIWNM6ELQzo7zwmcg0NmTVyWKYjvIeM83yjp0wRDTmUnrM678fQbcKBo6n2CJEF0szoG//ytg+TKla89ALQ==" + }, + "node_modules/duplexify/node_modules/readable-stream": { + "version": "2.3.8", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz", + "integrity": "sha512-8p0AUk4XODgIewSi0l8Epjs+EVnWiK7NoDIEGU0HhE7+ZyY8D1IMY7odu5lRrFXGg71L15KG8QrPmum45RTtdA==", + "dependencies": { + "core-util-is": "~1.0.0", + "inherits": "~2.0.3", + "isarray": "~1.0.0", + "process-nextick-args": "~2.0.0", + "safe-buffer": "~5.1.1", + "string_decoder": "~1.1.1", + "util-deprecate": "~1.0.1" + } + }, + "node_modules/duplexify/node_modules/safe-buffer": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz", + "integrity": "sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g==" + }, + "node_modules/duplexify/node_modules/string_decoder": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz", + "integrity": "sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg==", + "dependencies": { + "safe-buffer": "~5.1.0" + } + }, + "node_modules/ecc-jsbn": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/ecc-jsbn/-/ecc-jsbn-0.1.2.tgz", + "integrity": "sha512-eh9O+hwRHNbG4BLTjEl3nw044CkGm5X6LoaCf7LPp7UU8Qrt47JYNi6nPX8xjW97TKGKm1ouctg0QSpZe9qrnw==", + "dependencies": { + "jsbn": "~0.1.0", + "safer-buffer": "^2.1.0" + } + }, + "node_modules/end-of-stream": { + "version": "1.4.4", + "resolved": "https://registry.npmjs.org/end-of-stream/-/end-of-stream-1.4.4.tgz", + "integrity": "sha512-+uw1inIHVPQoaVuHzRyXd21icM+cnt4CzD5rW+NC1wjOUSTOs+Te7FOv7AhN7vS9x/oIyhLP5PR1H+phQAHu5Q==", + "dependencies": { + "once": "^1.4.0" + } + }, + "node_modules/entities": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", + "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" + }, + "node_modules/es-abstract": { + "version": "1.21.2", + "resolved": "https://registry.npmjs.org/es-abstract/-/es-abstract-1.21.2.tgz", + "integrity": "sha512-y/B5POM2iBnIxCiernH1G7rC9qQoM77lLIMQLuob0zhp8C56Po81+2Nj0WFKnd0pNReDTnkYryc+zhOzpEIROg==", + "dependencies": { + "array-buffer-byte-length": "^1.0.0", + "available-typed-arrays": "^1.0.5", + "call-bind": "^1.0.2", + "es-set-tostringtag": "^2.0.1", + "es-to-primitive": "^1.2.1", + "function.prototype.name": "^1.1.5", + "get-intrinsic": "^1.2.0", + "get-symbol-description": "^1.0.0", + "globalthis": "^1.0.3", + "gopd": "^1.0.1", + "has": "^1.0.3", + "has-property-descriptors": "^1.0.0", + "has-proto": "^1.0.1", + "has-symbols": "^1.0.3", + "internal-slot": "^1.0.5", + "is-array-buffer": "^3.0.2", + "is-callable": "^1.2.7", + "is-negative-zero": "^2.0.2", + "is-regex": "^1.1.4", + "is-shared-array-buffer": "^1.0.2", + "is-string": "^1.0.7", + "is-typed-array": "^1.1.10", + "is-weakref": "^1.0.2", + "object-inspect": "^1.12.3", + "object-keys": "^1.1.1", + "object.assign": "^4.1.4", + "regexp.prototype.flags": "^1.4.3", + "safe-regex-test": "^1.0.0", + "string.prototype.trim": "^1.2.7", + "string.prototype.trimend": "^1.0.6", + "string.prototype.trimstart": "^1.0.6", + "typed-array-length": "^1.0.4", + "unbox-primitive": "^1.0.2", + "which-typed-array": "^1.1.9" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/es-array-method-boxes-properly": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/es-array-method-boxes-properly/-/es-array-method-boxes-properly-1.0.0.tgz", + "integrity": "sha512-wd6JXUmyHmt8T5a2xreUwKcGPq6f1f+WwIJkijUqiGcJz1qqnZgP6XIK+QyIWU5lT7imeNxUll48bziG+TSYcA==" + }, + "node_modules/es-set-tostringtag": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/es-set-tostringtag/-/es-set-tostringtag-2.0.1.tgz", + "integrity": "sha512-g3OMbtlwY3QewlqAiMLI47KywjWZoEytKr8pf6iTC8uJq5bIAH52Z9pnQ8pVL6whrCto53JZDuUIsifGeLorTg==", + "dependencies": { + "get-intrinsic": "^1.1.3", + "has": "^1.0.3", + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + } + }, + "node_modules/es-to-primitive": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/es-to-primitive/-/es-to-primitive-1.2.1.tgz", + "integrity": "sha512-QCOllgZJtaUo9miYBcLChTUaHNjJF3PYs1VidD7AwiEj1kYxKeQTctLAezAOH5ZKRH0g2IgPn6KwB4IT8iRpvA==", + "dependencies": { + "is-callable": "^1.1.4", + "is-date-object": "^1.0.1", + "is-symbol": "^1.0.2" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/es6-promise": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/es6-promise/-/es6-promise-2.3.0.tgz", + "integrity": "sha512-oyOjMhyKMLEjOOtvkwg0G4pAzLQ9WdbbeX7WdqKzvYXu+UFgD0Zo/Brq5Q49zNmnGPPzV5rmYvrr0jz1zWx8Iw==" + }, + "node_modules/escape-string-regexp": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-1.0.5.tgz", + "integrity": "sha512-vbRorB5FUQWvla16U8R/qgaFIya2qGzwDrNmCZuYKrbdSUMG6I1ZCGQRefkRVhuOkIGVne7BQ35DSfo1qvJqFg==", + "engines": { + "node": ">=0.8.0" + } + }, + "node_modules/esprima": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", + "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==", + "bin": { + "esparse": "bin/esparse.js", + "esvalidate": "bin/esvalidate.js" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/extend": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/extend/-/extend-3.0.2.tgz", + "integrity": "sha512-fjquC59cD7CyW6urNXK0FBufkZcoiGG80wTuPujX590cB5Ttln20E2UB4S/WARVqhXffZl2LNgS+gQdPIIim/g==" + }, + "node_modules/extsprintf": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/extsprintf/-/extsprintf-1.3.0.tgz", + "integrity": "sha512-11Ndz7Nv+mvAC1j0ktTa7fAb0vLyGGX+rMHNBYQviQDGU0Hw7lhctJANqbPhu9nV9/izT/IntTgZ7Im/9LJs9g==", + "engines": [ + "node >=0.6.0" + ] + }, + "node_modules/fast-deep-equal": { + "version": "3.1.3", + "resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-3.1.3.tgz", + "integrity": "sha512-f3qQ9oQy9j2AhBe/H9VC91wLmKBCCU/gDOnKNAYG5hswO7BLKj09Hc5HYNz9cGI++xlpDCIgDaitVs03ATR84Q==" + }, + "node_modules/fast-json-stable-stringify": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", + "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" + }, + "node_modules/focus-lock": { + "version": "0.11.6", + "resolved": "https://registry.npmjs.org/focus-lock/-/focus-lock-0.11.6.tgz", + "integrity": "sha512-KSuV3ur4gf2KqMNoZx3nXNVhqCkn42GuTYCX4tXPEwf0MjpFQmNMiN6m7dXaUXgIoivL6/65agoUMg4RLS0Vbg==", + "dependencies": { + "tslib": "^2.0.3" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/for-each": { + "version": "0.3.3", + "resolved": "https://registry.npmjs.org/for-each/-/for-each-0.3.3.tgz", + "integrity": "sha512-jqYfLp7mo9vIyQf8ykW2v7A+2N4QjeCeI5+Dz9XraiO1ign81wjiH7Fb9vSOWvQfNtmSa4H2RoQTrrXivdUZmw==", + "dependencies": { + "is-callable": "^1.1.3" + } + }, + "node_modules/forever-agent": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/forever-agent/-/forever-agent-0.6.1.tgz", + "integrity": "sha512-j0KLYPhm6zeac4lz3oJ3o65qvgQCcPubiyotZrXqEaG4hNagNYO8qdlUrX5vwqv9ohqeT/Z3j6+yW067yWWdUw==", + "engines": { + "node": "*" + } + }, + "node_modules/form-data": { + "version": "2.3.3", + "resolved": "https://registry.npmjs.org/form-data/-/form-data-2.3.3.tgz", + "integrity": "sha512-1lLKB2Mu3aGP1Q/2eCOx0fNbRMe7XdwktwOruhfqqd0rIJWwN4Dh+E3hrPSlDCXnSR7UtZ1N38rVXm+6+MEhJQ==", + "dependencies": { + "asynckit": "^0.4.0", + "combined-stream": "^1.0.6", + "mime-types": "^2.1.12" + }, + "engines": { + "node": ">= 0.12" + } + }, + "node_modules/function-bind": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/function-bind/-/function-bind-1.1.1.tgz", + "integrity": "sha512-yIovAzMX49sF8Yl58fSCWJ5svSLuaibPxXQJFLmBObTuCr0Mf1KiPopGM9NiFjiYBCbfaa2Fh6breQ6ANVTI0A==" + }, + "node_modules/function.prototype.name": { + "version": "1.1.5", + "resolved": "https://registry.npmjs.org/function.prototype.name/-/function.prototype.name-1.1.5.tgz", + "integrity": "sha512-uN7m/BzVKQnCUF/iW8jYea67v++2u7m5UgENbHRtdDVclOUP+FMPlCNdmk0h/ysGyo2tavMJEDqJAkJdRa1vMA==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3", + "es-abstract": "^1.19.0", + "functions-have-names": "^1.2.2" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/functions-have-names": { + "version": "1.2.3", + "resolved": "https://registry.npmjs.org/functions-have-names/-/functions-have-names-1.2.3.tgz", + "integrity": "sha512-xckBUXyTIqT97tq2x2AMb+g163b5JFysYk0x4qxNFwbfQkmNZoiRHb6sPzI9/QV33WeuvVYBUIiD4NzNIyqaRQ==", + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/get-intrinsic": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.2.0.tgz", + "integrity": "sha512-L049y6nFOuom5wGyRc3/gdTLO94dySVKRACj1RmJZBQXlbTMhtNIgkWkUHq+jYmZvKf14EW1EoJnnjbmoHij0Q==", + "dependencies": { + "function-bind": "^1.1.1", + "has": "^1.0.3", + "has-symbols": "^1.0.3" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/get-nonce": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/get-nonce/-/get-nonce-1.0.1.tgz", + "integrity": "sha512-FJhYRoDaiatfEkUK8HKlicmu/3SGFD51q3itKDGoSTysQJBnfOcxU5GxnhE1E6soB76MbT0MBtnKJuXyAx+96Q==", + "engines": { + "node": ">=6" + } + }, + "node_modules/get-symbol-description": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/get-symbol-description/-/get-symbol-description-1.0.0.tgz", + "integrity": "sha512-2EmdH1YvIQiZpltCNgkuiUnyukzxM/R6NDJX31Ke3BG1Nq5b0S2PhX59UKi9vZpPDQVdqn+1IcaAwnzTT5vCjw==", + "dependencies": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.1.1" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/getpass": { + "version": "0.1.7", + "resolved": "https://registry.npmjs.org/getpass/-/getpass-0.1.7.tgz", + "integrity": "sha512-0fzj9JxOLfJ+XGLhR8ze3unN0KZCgZwiSSDz168VERjK8Wl8kVSdcu2kspd4s4wtAa1y/qrVRiAA0WclVsu0ng==", + "dependencies": { + "assert-plus": "^1.0.0" + } + }, + "node_modules/globalthis": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/globalthis/-/globalthis-1.0.3.tgz", + "integrity": "sha512-sFdI5LyBiNTHjRd7cGPWapiHWMOXKyuBNX/cWJ3NfzrZQVa8GI/8cofCl74AOVqq9W5kNmguTIzJ/1s2gyI9wA==", + "dependencies": { + "define-properties": "^1.1.3" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/gopd": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/gopd/-/gopd-1.0.1.tgz", + "integrity": "sha512-d65bNlIadxvpb/A2abVdlqKqV563juRnZ1Wtk6s1sIR8uNsXR70xqIzVqxVf1eTqDunwT2MkczEeaezCKTZhwA==", + "dependencies": { + "get-intrinsic": "^1.1.3" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/got": { + "version": "3.3.1", + "resolved": "https://registry.npmjs.org/got/-/got-3.3.1.tgz", + "integrity": "sha512-7chPlc0pWHjvq7B6dEEXz4GphoDupOvBSSl6AwRsAJX7GPTZ+bturaZiIigX4Dp6KrAP67nvzuKkNc0SLA0DKg==", + "dependencies": { + "duplexify": "^3.2.0", + "infinity-agent": "^2.0.0", + "is-redirect": "^1.0.0", + "is-stream": "^1.0.0", + "lowercase-keys": "^1.0.0", + "nested-error-stacks": "^1.0.0", + "object-assign": "^3.0.0", + "prepend-http": "^1.0.0", + "read-all-stream": "^3.0.0", + "timed-out": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/got/node_modules/object-assign": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-3.0.0.tgz", + "integrity": "sha512-jHP15vXVGeVh1HuaA2wY6lxk+whK/x4KBG88VXeRma7CCun7iGD5qPc4eYykQ9sdQvg8jkwFKsSxHln2ybW3xQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/graceful-fs": { + "version": "4.2.11", + "resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.11.tgz", + "integrity": "sha512-RbJ5/jmFcNNCcDV5o9eTnBLJ/HszWV0P73bc+Ff4nS/rJj+YaS6IGyiOL0VoBYX+l1Wrl3k63h/KrH+nhJ0XvQ==" + }, + "node_modules/graphiql": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/graphiql/-/graphiql-2.4.2.tgz", + "integrity": "sha512-oQ1zJAVpOqajKH1oc5WzNIK1FNUI2m8tPgyEeA22ySmR79+/k27FlG4YxRXQOstlWeVcag0FZaqG5VyR6Nc1iw==", + "dependencies": { + "@graphiql/react": "^0.17.2", + "@graphiql/toolkit": "^0.8.4", + "graphql-language-service": "^5.1.4", + "markdown-it": "^12.2.0" + }, + "peerDependencies": { + "graphql": "^15.5.0 || ^16.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react-dom": "^16.8.0 || ^17.0.0 || ^18.0.0" + } + }, + "node_modules/graphql": { + "version": "16.6.0", + "resolved": "https://registry.npmjs.org/graphql/-/graphql-16.6.0.tgz", + "integrity": "sha512-KPIBPDlW7NxrbT/eh4qPXz5FiFdL5UbaA0XUNz2Rp3Z3hqBSkbj0GVjwFDztsWVauZUWsbKHgMg++sk8UX0bkw==", + "engines": { + "node": "^12.22.0 || ^14.16.0 || ^16.0.0 || >=17.0.0" + } + }, + "node_modules/graphql-language-service": { + "version": "5.1.4", + "resolved": "https://registry.npmjs.org/graphql-language-service/-/graphql-language-service-5.1.4.tgz", + "integrity": "sha512-i6cYIDL8dFd6e9LqpRFJRoVa+MZ/egMzUERsZlK65S/M7ra9SxKrZuclKgmPOq0KqHypInsEaI4D7dN5a+yEAA==", + "dependencies": { + "nullthrows": "^1.0.0", + "vscode-languageserver-types": "^3.17.1" + }, + "bin": { + "graphql": "dist/temp-bin.js" + }, + "peerDependencies": { + "graphql": "^15.5.0 || ^16.0.0" + } + }, + "node_modules/har-schema": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/har-schema/-/har-schema-2.0.0.tgz", + "integrity": "sha512-Oqluz6zhGX8cyRaTQlFMPw80bSJVG2x/cFb8ZPhUILGgHka9SsokCCOQgpveePerqidZOrT14ipqfJb7ILcW5Q==", + "engines": { + "node": ">=4" + } + }, + "node_modules/har-validator": { + "version": "5.1.5", + "resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.1.5.tgz", + "integrity": "sha512-nmT2T0lljbxdQZfspsno9hgrG3Uir6Ks5afism62poxqBM6sDnMEuPmzTq8XN0OEwqKLLdh1jQI3qyE66Nzb3w==", + "deprecated": "this library is no longer supported", + "dependencies": { + "ajv": "^6.12.3", + "har-schema": "^2.0.0" + }, + "engines": { + "node": ">=6" + } + }, + "node_modules/has": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/has/-/has-1.0.3.tgz", + "integrity": "sha512-f2dvO0VU6Oej7RkWJGrehjbzMAjFp5/VKPp5tTpWIV4JHHZK1/BxbFRtf/siA2SWTe09caDmVtYYzWEIbBS4zw==", + "dependencies": { + "function-bind": "^1.1.1" + }, + "engines": { + "node": ">= 0.4.0" + } + }, + "node_modules/has-ansi": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/has-ansi/-/has-ansi-2.0.0.tgz", + "integrity": "sha512-C8vBJ8DwUCx19vhm7urhTuUsr4/IyP6l4VzNQDv+ryHQObW3TTTp9yB68WpYgRe2bbaGuZ/se74IqFeVnMnLZg==", + "dependencies": { + "ansi-regex": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/has-bigints": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/has-bigints/-/has-bigints-1.0.2.tgz", + "integrity": "sha512-tSvCKtBr9lkF0Ex0aQiP9N+OpV4zi2r/Nee5VkRDbaqv35RLYMzbwQfFSZZH0kR+Rd6302UJZ2p/bJCEoR3VoQ==", + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/has-flag": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-3.0.0.tgz", + "integrity": "sha512-sKJf1+ceQBr4SMkvQnBDNDtf4TXpVhVGateu0t918bl30FnbE2m4vNLX+VWe/dpjlb+HugGYzW7uQXH98HPEYw==", + "engines": { + "node": ">=4" + } + }, + "node_modules/has-property-descriptors": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-property-descriptors/-/has-property-descriptors-1.0.0.tgz", + "integrity": "sha512-62DVLZGoiEBDHQyqG4w9xCuZ7eJEwNmJRWw2VY84Oedb7WFcA27fiEVe8oUQx9hAUJ4ekurquucTGwsyO1XGdQ==", + "dependencies": { + "get-intrinsic": "^1.1.1" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/has-proto": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/has-proto/-/has-proto-1.0.1.tgz", + "integrity": "sha512-7qE+iP+O+bgF9clE5+UoBFzE65mlBiVj3tKCrlNQ0Ogwm0BjpT/gK4SlLYDMybDh5I3TCTKnPPa0oMG7JDYrhg==", + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/has-symbols": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/has-symbols/-/has-symbols-1.0.3.tgz", + "integrity": "sha512-l3LCuF6MgDNwTDKkdYGEihYjt5pRPbEg46rtlmnSPlUbgmB8LOIrKJbYYFBSbnPaJexMKtiPO8hmeRjRz2Td+A==", + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/has-tostringtag": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-tostringtag/-/has-tostringtag-1.0.0.tgz", + "integrity": "sha512-kFjcSNhnlGV1kyoGk7OXKSawH5JOb/LzUc5w9B02hOTO0dfFRjbHQKvg1d6cf3HbeUmtU9VbbV3qzZ2Teh97WQ==", + "dependencies": { + "has-symbols": "^1.0.2" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/htmlparser2": { + "version": "3.10.1", + "resolved": "https://registry.npmjs.org/htmlparser2/-/htmlparser2-3.10.1.tgz", + "integrity": "sha512-IgieNijUMbkDovyoKObU1DUhm1iwNYE/fuifEoEHfd1oZKZDaONBSkal7Y01shxsM49R4XaMdGez3WnF9UfiCQ==", + "dependencies": { + "domelementtype": "^1.3.1", + "domhandler": "^2.3.0", + "domutils": "^1.5.1", + "entities": "^1.1.1", + "inherits": "^2.0.1", + "readable-stream": "^3.1.1" + } + }, + "node_modules/http-signature": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/http-signature/-/http-signature-1.2.0.tgz", + "integrity": "sha512-CAbnr6Rz4CYQkLYUtSNXxQPUH2gK8f3iWexVlsnMeD+GjlsQ0Xsy1cOX+mN3dtxYomRy21CiOzU8Uhw6OwncEQ==", + "dependencies": { + "assert-plus": "^1.0.0", + "jsprim": "^1.2.2", + "sshpk": "^1.7.0" + }, + "engines": { + "node": ">=0.8", + "npm": ">=1.3.7" + } + }, + "node_modules/iconv-lite": { + "version": "0.4.24", + "resolved": "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.4.24.tgz", + "integrity": "sha512-v3MXnZAcvnywkTUEZomIActle7RXXeedOR31wwl7VlyoXO4Qi9arvSenNQWne1TcRwhCL1HwLI21bEqdpj8/rA==", + "dependencies": { + "safer-buffer": ">= 2.1.2 < 3" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/imurmurhash": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/imurmurhash/-/imurmurhash-0.1.4.tgz", + "integrity": "sha512-JmXMZ6wuvDmLiHEml9ykzqO6lwFbof0GG4IkcGaENdCRDDmMVnny7s5HsIgHCbaq0w2MyPhDqkhTUgS2LU2PHA==", + "engines": { + "node": ">=0.8.19" + } + }, + "node_modules/infinity-agent": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/infinity-agent/-/infinity-agent-2.0.3.tgz", + "integrity": "sha512-CnfUJe5o2S9aAQWXGMhDZI4UL39MAJV3guOTfHHIdos4tuVHkl1j/J+1XLQn+CLIvqcpgQR/p+xXYXzcrhCe5w==" + }, + "node_modules/inherits": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.4.tgz", + "integrity": "sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ==" + }, + "node_modules/ini": { + "version": "1.3.8", + "resolved": "https://registry.npmjs.org/ini/-/ini-1.3.8.tgz", + "integrity": "sha512-JV/yugV2uzW5iMRSiZAyDtQd+nxtUnjeLt0acNdw98kKLrvuRVyB80tsREOE7yvGVgalhZ6RNXCmEHkUKBKxew==" + }, + "node_modules/inliner": { + "resolved": "git+ssh://git@github.com/aantron/inliner.git#7f2efdbe24a6a085f633d456b97c970ac2c0ca8a", + "license": "MIT", + "dependencies": { + "ansi-escapes": "^1.4.0", + "ansi-styles": "^2.2.1", + "chalk": "^1.1.3", + "charset": "^1.0.0", + "cheerio": "^0.22.0", + "debug": "^2.2.0", + "es6-promise": "^2.3.0", + "iconv-lite": "^0.4.11", + "jschardet": "^1.3.0", + "lodash.assign": "^3.2.0", + "lodash.defaults": "^3.1.2", + "lodash.foreach": "^3.0.3", + "mime": "^1.3.4", + "minimist": "^1.1.3", + "request": "^2.74.0", + "svgo": "^1.2.2", + "then-fs": "^2.0.0", + "uglify-js": "^2.8.0", + "update-notifier": "^0.5.0" + }, + "bin": { + "inliner": "cli/index.js" + } + }, + "node_modules/internal-slot": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/internal-slot/-/internal-slot-1.0.5.tgz", + "integrity": "sha512-Y+R5hJrzs52QCG2laLn4udYVnxsfny9CpOhNhUvk/SSSVyF6T27FzRbF0sroPidSu3X8oEAkOn2K804mjpt6UQ==", + "dependencies": { + "get-intrinsic": "^1.2.0", + "has": "^1.0.3", + "side-channel": "^1.0.4" + }, + "engines": { + "node": ">= 0.4" + } + }, + "node_modules/invariant": { + "version": "2.2.4", + "resolved": "https://registry.npmjs.org/invariant/-/invariant-2.2.4.tgz", + "integrity": "sha512-phJfQVBuaJM5raOpJjSfkiD6BpbCE4Ns//LaXl6wGYtUBY83nWS6Rf9tXm2e8VaK60JEjYldbPif/A2B1C2gNA==", + "dependencies": { + "loose-envify": "^1.0.0" + } + }, + "node_modules/is-array-buffer": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/is-array-buffer/-/is-array-buffer-3.0.2.tgz", + "integrity": "sha512-y+FyyR/w8vfIRq4eQcM1EYgSTnmHXPqaF+IgzgraytCFq5Xh8lllDVmAZolPJiZttZLeFSINPYMaEJ7/vWUa1w==", + "dependencies": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.2.0", + "is-typed-array": "^1.1.10" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-bigint": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/is-bigint/-/is-bigint-1.0.4.tgz", + "integrity": "sha512-zB9CruMamjym81i2JZ3UMn54PKGsQzsJeo6xvN3HJJ4CAsQNB6iRutp2To77OfCNuoxspsIhzaPoO1zyCEhFOg==", + "dependencies": { + "has-bigints": "^1.0.1" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-boolean-object": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/is-boolean-object/-/is-boolean-object-1.1.2.tgz", + "integrity": "sha512-gDYaKHJmnj4aWxyj6YHyXVpdQawtVLHU5cb+eztPGczf6cjuTdwve5ZIEfgXqH4e57An1D1AKf8CZ3kYrQRqYA==", + "dependencies": { + "call-bind": "^1.0.2", + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-buffer": { + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/is-buffer/-/is-buffer-1.1.6.tgz", + "integrity": "sha512-NcdALwpXkTm5Zvvbk7owOUSvVvBKDgKP5/ewfXEznmQFfs4ZRmanOeKBTjRVjka3QFoN6XJ+9F3USqfHqTaU5w==" + }, + "node_modules/is-callable": { + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/is-callable/-/is-callable-1.2.7.tgz", + "integrity": "sha512-1BC0BVFhS/p0qtw6enp8e+8OD0UrK0oFLztSjNzhcKA3WDuJxxAPXzPuPtKkjEY9UUoEWlX/8fgKeu2S8i9JTA==", + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-date-object": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/is-date-object/-/is-date-object-1.0.5.tgz", + "integrity": "sha512-9YQaSxsAiSwcvS33MBk3wTCVnWK+HhF8VZR2jRxehM16QcVOdHqPn4VPHmRK4lSr38n9JriurInLcP90xsYNfQ==", + "dependencies": { + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-finite": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-finite/-/is-finite-1.1.0.tgz", + "integrity": "sha512-cdyMtqX/BOqqNBBiKlIVkytNHm49MtMlYyn1zxzvJKWmFMlGzm+ry5BBfYyeY9YmNKbRSo/o7OX9w9ale0wg3w==", + "engines": { + "node": ">=0.10.0" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/is-negative-zero": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/is-negative-zero/-/is-negative-zero-2.0.2.tgz", + "integrity": "sha512-dqJvarLawXsFbNDeJW7zAz8ItJ9cd28YufuuFzh0G8pNHjJMnY08Dv7sYX2uF5UpQOwieAeOExEYAWWfu7ZZUA==", + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-npm": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-npm/-/is-npm-1.0.0.tgz", + "integrity": "sha512-9r39FIr3d+KD9SbX0sfMsHzb5PP3uimOiwr3YupUaUFG4W0l1U57Rx3utpttV7qz5U3jmrO5auUa04LU9pyHsg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-number-object": { + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/is-number-object/-/is-number-object-1.0.7.tgz", + "integrity": "sha512-k1U0IRzLMo7ZlYIfzRu23Oh6MiIFasgpb9X76eqfFZAqwH44UI4KTBvBYIZ1dSL9ZzChTB9ShHfLkR4pdW5krQ==", + "dependencies": { + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-plain-object": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/is-plain-object/-/is-plain-object-2.0.4.tgz", + "integrity": "sha512-h5PpgXkWitc38BBMYawTYMWJHFZJVnBquFE57xFpjB8pJFiF6gZ+bU+WyI/yqXiFR5mdLsgYNaPe8uao6Uv9Og==", + "dependencies": { + "isobject": "^3.0.1" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-primitive": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/is-primitive/-/is-primitive-3.0.1.tgz", + "integrity": "sha512-GljRxhWvlCNRfZyORiH77FwdFwGcMO620o37EOYC0ORWdq+WYNVqW0w2Juzew4M+L81l6/QS3t5gkkihyRqv9w==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-redirect": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-redirect/-/is-redirect-1.0.0.tgz", + "integrity": "sha512-cr/SlUEe5zOGmzvj9bUyC4LVvkNVAXu4GytXLNMr1pny+a65MpQ9IJzFHD5vi7FyJgb4qt27+eS3TuQnqB+RQw==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-regex": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/is-regex/-/is-regex-1.1.4.tgz", + "integrity": "sha512-kvRdxDsxZjhzUX07ZnLydzS1TU/TJlTUHHY4YLL87e37oUA49DfkLqgy+VjFocowy29cKvcSiu+kIv728jTTVg==", + "dependencies": { + "call-bind": "^1.0.2", + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-shared-array-buffer": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-shared-array-buffer/-/is-shared-array-buffer-1.0.2.tgz", + "integrity": "sha512-sqN2UDu1/0y6uvXyStCOzyhAjCSlHceFoMKJW8W9EU9cvic/QdsZ0kEU93HEy3IUEFZIiH/3w+AH/UQbPHNdhA==", + "dependencies": { + "call-bind": "^1.0.2" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-stream": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-stream/-/is-stream-1.1.0.tgz", + "integrity": "sha512-uQPm8kcs47jx38atAcWTVxyltQYoPT68y9aWYdV6yWXSyW8mzSat0TL6CiWdZeCdF3KrAvpVtnHbTv4RN+rqdQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-string": { + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/is-string/-/is-string-1.0.7.tgz", + "integrity": "sha512-tE2UXzivje6ofPW7l23cjDOMa09gb7xlAqG6jG5ej6uPV32TlWP3NKPigtaGeHNu9fohccRYvIiZMfOOnOYUtg==", + "dependencies": { + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-symbol": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/is-symbol/-/is-symbol-1.0.4.tgz", + "integrity": "sha512-C/CPBqKWnvdcxqIARxyOh4v1UUEOCHpgDa0WYgpKDFMszcrPcffg5uhwSgPCLD2WWxmq6isisz87tzT01tuGhg==", + "dependencies": { + "has-symbols": "^1.0.2" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-typed-array": { + "version": "1.1.10", + "resolved": "https://registry.npmjs.org/is-typed-array/-/is-typed-array-1.1.10.tgz", + "integrity": "sha512-PJqgEHiWZvMpaFZ3uTc8kHPM4+4ADTlDniuQL7cU/UDA0Ql7F70yGfHph3cLNe+c9toaigv+DFzTJKhc2CtO6A==", + "dependencies": { + "available-typed-arrays": "^1.0.5", + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "gopd": "^1.0.1", + "has-tostringtag": "^1.0.0" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/is-typedarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", + "integrity": "sha512-cyA56iCMHAh5CdzjJIa4aohJyeO1YbwLi3Jc35MmRU6poroFjIGZzUzupGiRPOjgHg9TLu43xbpwXk523fMxKA==" + }, + "node_modules/is-weakref": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-weakref/-/is-weakref-1.0.2.tgz", + "integrity": "sha512-qctsuLZmIQ0+vSSMfoVvyFe2+GSEvnmZ2ezTup1SBse9+twCCeial6EEi3Nc2KFcf6+qz2FBPnjXsk8xhKSaPQ==", + "dependencies": { + "call-bind": "^1.0.2" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/isarray": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-2.0.5.tgz", + "integrity": "sha512-xHjhDr3cNBK0BzdUJSPXZntQUx/mwMS5Rw4A7lPJ90XGAO6ISP/ePDNuo0vhqOZU+UD5JoodwCAAoZQd3FeAKw==" + }, + "node_modules/isobject": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/isobject/-/isobject-3.0.1.tgz", + "integrity": "sha512-WhB9zCku7EGTj/HQQRz5aUQEUeoQZH2bWcltRErOpymJ4boYE6wL9Tbr23krRPSZ+C5zqNSrSw+Cc7sZZ4b7vg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/isstream": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/isstream/-/isstream-0.1.2.tgz", + "integrity": "sha512-Yljz7ffyPbrLpLngrMtZ7NduUgVvi6wG9RJ9IUcyCd59YQ911PBJphODUcbOVbqYfxe1wuYf/LJ8PauMRwsM/g==" + }, + "node_modules/js-tokens": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/js-tokens/-/js-tokens-4.0.0.tgz", + "integrity": "sha512-RdJUflcE3cUzKiMqQgsCu06FPu9UdIJO0beYbPhHN4k6apgJtifcoCtT9bcxOpYBtpD2kCM6Sbzg4CausW/PKQ==" + }, + "node_modules/js-yaml": { + "version": "3.14.1", + "resolved": "https://registry.npmjs.org/js-yaml/-/js-yaml-3.14.1.tgz", + "integrity": "sha512-okMH7OXXJ7YrN9Ok3/SXrnu4iX9yOk+25nqX4imS2npuvTYDmo/QEZoqwZkYaIDk3jVvBOTOIEgEhaLOynBS9g==", + "dependencies": { + "argparse": "^1.0.7", + "esprima": "^4.0.0" + }, + "bin": { + "js-yaml": "bin/js-yaml.js" + } + }, + "node_modules/js-yaml/node_modules/argparse": { + "version": "1.0.10", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-1.0.10.tgz", + "integrity": "sha512-o5Roy6tNG4SL/FOkCAN6RzjiakZS25RLYFrcMttJqbdd8BWrnA+fGz57iN5Pb06pvBGvl5gQ0B48dJlslXvoTg==", + "dependencies": { + "sprintf-js": "~1.0.2" + } + }, + "node_modules/jsbn": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/jsbn/-/jsbn-0.1.1.tgz", + "integrity": "sha512-UVU9dibq2JcFWxQPA6KCqj5O42VOmAY3zQUfEKxU0KpTGXwNoCjkX1e13eHNvw/xPynt6pU0rZ1htjWTNTSXsg==" + }, + "node_modules/jschardet": { + "version": "1.6.0", + "resolved": "https://registry.npmjs.org/jschardet/-/jschardet-1.6.0.tgz", + "integrity": "sha512-xYuhvQ7I9PDJIGBWev9xm0+SMSed3ZDBAmvVjbFR1ZRLAF+vlXcQu6cRI9uAlj81rzikElRVteehwV7DuX2ZmQ==", + "engines": { + "node": ">=0.1.90" + } + }, + "node_modules/json-schema": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.4.0.tgz", + "integrity": "sha512-es94M3nTIfsEPisRafak+HDLfHXnKBhV3vU5eqPcS3flIWqcxJWgXHXiey3YrpaNsanY5ei1VoYEbOzijuq9BA==" + }, + "node_modules/json-schema-traverse": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.4.1.tgz", + "integrity": "sha512-xbbCH5dCYU5T8LcEhhuh7HJ88HXuW3qsI3Y0zOZFKfZEHcpWiHU/Jxzk629Brsab/mMiHQti9wMP+845RPe3Vg==" + }, + "node_modules/json-stringify-safe": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/json-stringify-safe/-/json-stringify-safe-5.0.1.tgz", + "integrity": "sha512-ZClg6AaYvamvYEE82d3Iyd3vSSIjQ+odgjaTzRuO3s7toCdFKczob2i0zCh7JE8kWn17yvAWhUVxvqGwUalsRA==" + }, + "node_modules/jsprim": { + "version": "1.4.2", + "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.2.tgz", + "integrity": "sha512-P2bSOMAc/ciLz6DzgjVlGJP9+BrJWu5UDGK70C2iweC5QBIeFf0ZXRvGjEj2uYgrY2MkAAhsSWHDWlFtEroZWw==", + "dependencies": { + "assert-plus": "1.0.0", + "extsprintf": "1.3.0", + "json-schema": "0.4.0", + "verror": "1.10.0" + }, + "engines": { + "node": ">=0.6.0" + } + }, + "node_modules/kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha512-NOW9QQXMoZGg/oqnVNoNTTIFEIid1627WCffUBJEdMxYApq7mNE7CpzucIPc+ZQg25Phej7IJSmX3hO+oblOtQ==", + "dependencies": { + "is-buffer": "^1.1.5" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/latest-version": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/latest-version/-/latest-version-1.0.1.tgz", + "integrity": "sha512-HERbxp4SBlmI380+eM0B0u4nxjfTaPeydIMzl9+9UQ4nSu3xMWKlX9WoT34e4wy7VWe67c53Nv9qPVjS8fHKgg==", + "dependencies": { + "package-json": "^1.0.0" + }, + "bin": { + "latest-version": "cli.js" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/lazy-cache": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/lazy-cache/-/lazy-cache-1.0.4.tgz", + "integrity": "sha512-RE2g0b5VGZsOCFOCgP7omTRYFqydmZkBwl5oNnQ1lDYC57uyO9KqNnNVxT7COSHTxrRCWVcAVOcbjk+tvh/rgQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/linkify-it": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/linkify-it/-/linkify-it-3.0.3.tgz", + "integrity": "sha512-ynTsyrFSdE5oZ/O9GEf00kPngmOfVwazR5GKDq6EYfhlpFug3J2zybX56a2PRRpc9P+FuSoGNAwjlbDs9jJBPQ==", + "dependencies": { + "uc.micro": "^1.0.1" + } + }, + "node_modules/lodash._arrayeach": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/lodash._arrayeach/-/lodash._arrayeach-3.0.0.tgz", + "integrity": "sha512-Mn7HidOVcl3mkQtbPsuKR0Fj0N6Q6DQB77CtYncZcJc0bx5qv2q4Gl6a0LC1AN+GSxpnBDNnK3CKEm9XNA4zqQ==" + }, + "node_modules/lodash._baseassign": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/lodash._baseassign/-/lodash._baseassign-3.2.0.tgz", + "integrity": "sha512-t3N26QR2IdSN+gqSy9Ds9pBu/J1EAFEshKlUHpJG3rvyJOYgcELIxcIeKKfZk7sjOz11cFfzJRsyFry/JyabJQ==", + "dependencies": { + "lodash._basecopy": "^3.0.0", + "lodash.keys": "^3.0.0" + } + }, + "node_modules/lodash._basecopy": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/lodash._basecopy/-/lodash._basecopy-3.0.1.tgz", + "integrity": "sha512-rFR6Vpm4HeCK1WPGvjZSJ+7yik8d8PVUdCJx5rT2pogG4Ve/2ZS7kfmO5l5T2o5V2mqlNIfSF5MZlr1+xOoYQQ==" + }, + "node_modules/lodash._baseeach": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/lodash._baseeach/-/lodash._baseeach-3.0.4.tgz", + "integrity": "sha512-IqUZ9MQo2UT1XPGuBntInqTOlc+oV+bCo0kMp+yuKGsfvRSNgUW0YjWVZUrG/gs+8z/Eyuc0jkJjOBESt9BXxg==", + "dependencies": { + "lodash.keys": "^3.0.0" + } + }, + "node_modules/lodash._bindcallback": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/lodash._bindcallback/-/lodash._bindcallback-3.0.1.tgz", + "integrity": "sha512-2wlI0JRAGX8WEf4Gm1p/mv/SZ+jLijpj0jyaE/AXeuQphzCgD8ZQW4oSpoN8JAopujOFGU3KMuq7qfHBWlGpjQ==" + }, + "node_modules/lodash._createassigner": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/lodash._createassigner/-/lodash._createassigner-3.1.1.tgz", + "integrity": "sha512-LziVL7IDnJjQeeV95Wvhw6G28Z8Q6da87LWKOPWmzBLv4u6FAT/x5v00pyGW0u38UoogNF2JnD3bGgZZDaNEBw==", + "dependencies": { + "lodash._bindcallback": "^3.0.0", + "lodash._isiterateecall": "^3.0.0", + "lodash.restparam": "^3.0.0" + } + }, + "node_modules/lodash._getnative": { + "version": "3.9.1", + "resolved": "https://registry.npmjs.org/lodash._getnative/-/lodash._getnative-3.9.1.tgz", + "integrity": "sha512-RrL9VxMEPyDMHOd9uFbvMe8X55X16/cGM5IgOKgRElQZutpX89iS6vwl64duTV1/16w5JY7tuFNXqoekmh1EmA==" + }, + "node_modules/lodash._isiterateecall": { + "version": "3.0.9", + "resolved": "https://registry.npmjs.org/lodash._isiterateecall/-/lodash._isiterateecall-3.0.9.tgz", + "integrity": "sha512-De+ZbrMu6eThFti/CSzhRvTKMgQToLxbij58LMfM8JnYDNSOjkjTCIaa8ixglOeGh2nyPlakbt5bJWJ7gvpYlQ==" + }, + "node_modules/lodash.assign": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/lodash.assign/-/lodash.assign-3.2.0.tgz", + "integrity": "sha512-/VVxzgGBmbphasTg51FrztxQJ/VgAUpol6zmJuSVSGcNg4g7FA4z7rQV8Ovr9V3vFBNWZhvKWHfpAytjTVUfFA==", + "dependencies": { + "lodash._baseassign": "^3.0.0", + "lodash._createassigner": "^3.0.0", + "lodash.keys": "^3.0.0" + } + }, + "node_modules/lodash.assignin": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/lodash.assignin/-/lodash.assignin-4.2.0.tgz", + "integrity": "sha512-yX/rx6d/UTVh7sSVWVSIMjfnz95evAgDFdb1ZozC35I9mSFCkmzptOzevxjgbQUsc78NR44LVHWjsoMQXy9FDg==" + }, + "node_modules/lodash.bind": { + "version": "4.2.1", + "resolved": "https://registry.npmjs.org/lodash.bind/-/lodash.bind-4.2.1.tgz", + "integrity": "sha512-lxdsn7xxlCymgLYo1gGvVrfHmkjDiyqVv62FAeF2i5ta72BipE1SLxw8hPEPLhD4/247Ijw07UQH7Hq/chT5LA==" + }, + "node_modules/lodash.defaults": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/lodash.defaults/-/lodash.defaults-3.1.2.tgz", + "integrity": "sha512-X7135IXFQt5JDFnYxOVAzVz+kFvwDn3N8DJYf+nrz/mMWEuSu7+OL6rWqsk3+VR1T4TejFCSu5isBJOLSID2bg==", + "dependencies": { + "lodash.assign": "^3.0.0", + "lodash.restparam": "^3.0.0" + } + }, + "node_modules/lodash.filter": { + "version": "4.6.0", + "resolved": "https://registry.npmjs.org/lodash.filter/-/lodash.filter-4.6.0.tgz", + "integrity": "sha512-pXYUy7PR8BCLwX5mgJ/aNtyOvuJTdZAo9EQFUvMIYugqmJxnrYaANvTbgndOzHSCSR0wnlBBfRXJL5SbWxo3FQ==" + }, + "node_modules/lodash.flatten": { + "version": "4.4.0", + "resolved": "https://registry.npmjs.org/lodash.flatten/-/lodash.flatten-4.4.0.tgz", + "integrity": "sha512-C5N2Z3DgnnKr0LOpv/hKCgKdb7ZZwafIrsesve6lmzvZIRZRGaZ/l6Q8+2W7NaT+ZwO3fFlSCzCzrDCFdJfZ4g==" + }, + "node_modules/lodash.foreach": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/lodash.foreach/-/lodash.foreach-3.0.3.tgz", + "integrity": "sha512-PA7Lp7pe2HMJBoB1vELegEIF3waUFnM0fWDKJVYolwZ4zHh6WTmnq0xmzfQksD66gx2quhDNyBdyaE2T8/DP3Q==", + "dependencies": { + "lodash._arrayeach": "^3.0.0", + "lodash._baseeach": "^3.0.0", + "lodash._bindcallback": "^3.0.0", + "lodash.isarray": "^3.0.0" + } + }, + "node_modules/lodash.isarguments": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/lodash.isarguments/-/lodash.isarguments-3.1.0.tgz", + "integrity": "sha512-chi4NHZlZqZD18a0imDHnZPrDeBbTtVN7GXMwuGdRH9qotxAjYs3aVLKc7zNOG9eddR5Ksd8rvFEBc9SsggPpg==" + }, + "node_modules/lodash.isarray": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/lodash.isarray/-/lodash.isarray-3.0.4.tgz", + "integrity": "sha512-JwObCrNJuT0Nnbuecmqr5DgtuBppuCvGD9lxjFpAzwnVtdGoDQ1zig+5W8k5/6Gcn0gZ3936HDAlGd28i7sOGQ==" + }, + "node_modules/lodash.keys": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/lodash.keys/-/lodash.keys-3.1.2.tgz", + "integrity": "sha512-CuBsapFjcubOGMn3VD+24HOAPxM79tH+V6ivJL3CHYjtrawauDJHUk//Yew9Hvc6e9rbCrURGk8z6PC+8WJBfQ==", + "dependencies": { + "lodash._getnative": "^3.0.0", + "lodash.isarguments": "^3.0.0", + "lodash.isarray": "^3.0.0" + } + }, + "node_modules/lodash.map": { + "version": "4.6.0", + "resolved": "https://registry.npmjs.org/lodash.map/-/lodash.map-4.6.0.tgz", + "integrity": "sha512-worNHGKLDetmcEYDvh2stPCrrQRkP20E4l0iIS7F8EvzMqBBi7ltvFN5m1HvTf1P7Jk1txKhvFcmYsCr8O2F1Q==" + }, + "node_modules/lodash.merge": { + "version": "4.6.2", + "resolved": "https://registry.npmjs.org/lodash.merge/-/lodash.merge-4.6.2.tgz", + "integrity": "sha512-0KpjqXRVvrYyCsX1swR/XTK0va6VQkQM6MNo7PqW77ByjAhoARA8EfrP1N4+KlKj8YS0ZUCtRT/YUuhyYDujIQ==" + }, + "node_modules/lodash.pick": { + "version": "4.4.0", + "resolved": "https://registry.npmjs.org/lodash.pick/-/lodash.pick-4.4.0.tgz", + "integrity": "sha512-hXt6Ul/5yWjfklSGvLQl8vM//l3FtyHZeuelpzK6mm99pNvN9yTDruNZPEJZD1oWrqo+izBmB7oUfWgcCX7s4Q==" + }, + "node_modules/lodash.reduce": { + "version": "4.6.0", + "resolved": "https://registry.npmjs.org/lodash.reduce/-/lodash.reduce-4.6.0.tgz", + "integrity": "sha512-6raRe2vxCYBhpBu+B+TtNGUzah+hQjVdu3E17wfusjyrXBka2nBS8OH/gjVZ5PvHOhWmIZTYri09Z6n/QfnNMw==" + }, + "node_modules/lodash.reject": { + "version": "4.6.0", + "resolved": "https://registry.npmjs.org/lodash.reject/-/lodash.reject-4.6.0.tgz", + "integrity": "sha512-qkTuvgEzYdyhiJBx42YPzPo71R1aEr0z79kAv7Ixg8wPFEjgRgJdUsGMG3Hf3OYSF/kHI79XhNlt+5Ar6OzwxQ==" + }, + "node_modules/lodash.restparam": { + "version": "3.6.1", + "resolved": "https://registry.npmjs.org/lodash.restparam/-/lodash.restparam-3.6.1.tgz", + "integrity": "sha512-L4/arjjuq4noiUJpt3yS6KIKDtJwNe2fIYgMqyYYKoeIfV1iEqvPwhCx23o+R9dzouGihDAPN1dTIRWa7zk8tw==" + }, + "node_modules/lodash.some": { + "version": "4.6.0", + "resolved": "https://registry.npmjs.org/lodash.some/-/lodash.some-4.6.0.tgz", + "integrity": "sha512-j7MJE+TuT51q9ggt4fSgVqro163BEFjAt3u97IqU+JA2DkWl80nFTrowzLpZ/BnpN7rrl0JA/593NAdd8p/scQ==" + }, + "node_modules/longest": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/longest/-/longest-1.0.1.tgz", + "integrity": "sha512-k+yt5n3l48JU4k8ftnKG6V7u32wyH2NfKzeMto9F/QRE0amxy/LayxwlvjjkZEIzqR+19IrtFO8p5kB9QaYUFg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/loose-envify": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/loose-envify/-/loose-envify-1.4.0.tgz", + "integrity": "sha512-lyuxPGr/Wfhrlem2CL/UcnUc1zcqKAImBDzukY7Y5F/yQiNdko6+fRLevlw1HgMySw7f611UIY408EtxRSoK3Q==", + "dependencies": { + "js-tokens": "^3.0.0 || ^4.0.0" + }, + "bin": { + "loose-envify": "cli.js" + } + }, + "node_modules/lowercase-keys": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/lowercase-keys/-/lowercase-keys-1.0.1.tgz", + "integrity": "sha512-G2Lj61tXDnVFFOi8VZds+SoQjtQC3dgokKdDG2mTm1tx4m50NUHBOZSBwQQHyy0V12A0JTG4icfZQH+xPyh8VA==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/markdown-it": { + "version": "12.3.2", + "resolved": "https://registry.npmjs.org/markdown-it/-/markdown-it-12.3.2.tgz", + "integrity": "sha512-TchMembfxfNVpHkbtriWltGWc+m3xszaRD0CZup7GFFhzIgQqxIfn3eGj1yZpfuflzPvfkt611B2Q/Bsk1YnGg==", + "dependencies": { + "argparse": "^2.0.1", + "entities": "~2.1.0", + "linkify-it": "^3.0.1", + "mdurl": "^1.0.1", + "uc.micro": "^1.0.5" + }, + "bin": { + "markdown-it": "bin/markdown-it.js" + } + }, + "node_modules/markdown-it/node_modules/entities": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/entities/-/entities-2.1.0.tgz", + "integrity": "sha512-hCx1oky9PFrJ611mf0ifBLBRW8lUUVRlFolb5gWRfIELabBlbp9xZvrqZLZAs+NxFnbfQoeGd8wDkygjg7U85w==", + "funding": { + "url": "https://github.com/fb55/entities?sponsor=1" + } + }, + "node_modules/mdn-data": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.4.tgz", + "integrity": "sha512-iV3XNKw06j5Q7mi6h+9vbx23Tv7JkjEVgKHW4pimwyDGWm0OIQntJJ+u1C6mg6mK1EaTv42XQ7w76yuzH7M2cA==" + }, + "node_modules/mdurl": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/mdurl/-/mdurl-1.0.1.tgz", + "integrity": "sha512-/sKlQJCBYVY9Ers9hqzKou4H6V5UWc/M59TH2dvkt+84itfnq7uFOMLpOiOS4ujvHP4etln18fmIxA5R5fll0g==" + }, + "node_modules/meros": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/meros/-/meros-1.2.1.tgz", + "integrity": "sha512-R2f/jxYqCAGI19KhAvaxSOxALBMkaXWH2a7rOyqQw+ZmizX5bKkEYWLzdhC+U82ZVVPVp6MCXe3EkVligh+12g==", + "engines": { + "node": ">=13" + }, + "peerDependencies": { + "@types/node": ">=13" + }, + "peerDependenciesMeta": { + "@types/node": { + "optional": true + } + } + }, + "node_modules/mime": { + "version": "1.6.0", + "resolved": "https://registry.npmjs.org/mime/-/mime-1.6.0.tgz", + "integrity": "sha512-x0Vn8spI+wuJ1O6S7gnbaQg8Pxh4NNHb7KSINmEWKiPE4RKOplvijn+NkmYmmRgP68mc70j2EbeTFRsrswaQeg==", + "bin": { + "mime": "cli.js" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/mime-db": { + "version": "1.52.0", + "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.52.0.tgz", + "integrity": "sha512-sPU4uV7dYlvtWJxwwxHD0PuihVNiE7TyAbQ5SWxDCB9mUYvOgroQOwYQQOKPJ8CIbE+1ETVlOoK1UC2nU3gYvg==", + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/mime-types": { + "version": "2.1.35", + "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.35.tgz", + "integrity": "sha512-ZDY+bPm5zTTF+YpCrAU9nK0UgICYPT0QtT1NZWFv4s++TNkcgVaT0g6+4R2uI4MjQjzysHB1zxuWL50hzaeXiw==", + "dependencies": { + "mime-db": "1.52.0" + }, + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/minimist": { + "version": "1.2.8", + "resolved": "https://registry.npmjs.org/minimist/-/minimist-1.2.8.tgz", + "integrity": "sha512-2yyAR8qBkN3YuheJanUpWC5U3bb5osDywNB8RzDVlDwDHbocAJveqqj1u8+SVD7jkWT4yvsHCpWqqWqAxb0zCA==", + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/mkdirp": { + "version": "0.5.6", + "resolved": "https://registry.npmjs.org/mkdirp/-/mkdirp-0.5.6.tgz", + "integrity": "sha512-FP+p8RB8OWpF3YZBCrP5gtADmtXApB5AMLn+vdyA+PyxCjrCs00mjyUozssO33cwDeT3wNGdLxJ5M//YqtHAJw==", + "dependencies": { + "minimist": "^1.2.6" + }, + "bin": { + "mkdirp": "bin/cmd.js" + } + }, + "node_modules/ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha512-Tpp60P6IUJDTuOq/5Z8cdskzJujfwqfOTkrwIwj7IRISpnkJnT6SyJ4PCPnGMoFjC9ddhal5KVIYtAt97ix05A==" + }, + "node_modules/nested-error-stacks": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/nested-error-stacks/-/nested-error-stacks-1.0.2.tgz", + "integrity": "sha512-o32anp9JA7oezPOFSfG2BBXSdHepOm5FpJvwxHWDtfJ3Bg3xdi68S6ijPlEOfUg6quxZWyvJM+8fHk1yMDKspA==", + "dependencies": { + "inherits": "~2.0.1" + } + }, + "node_modules/nth-check": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/nth-check/-/nth-check-1.0.2.tgz", + "integrity": "sha512-WeBOdju8SnzPN5vTUJYxYUxLeXpCaVP5i5e0LF8fg7WORF2Wd7wFX/pk0tYZk7s8T+J7VLy0Da6J1+wCT0AtHg==", + "dependencies": { + "boolbase": "~1.0.0" + } + }, + "node_modules/nullthrows": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/nullthrows/-/nullthrows-1.1.1.tgz", + "integrity": "sha512-2vPPEi+Z7WqML2jZYddDIfy5Dqb0r2fze2zTxNNknZaFpVHU3mFB3R+DWeJWGVx0ecvttSGlJTI+WG+8Z4cDWw==" + }, + "node_modules/oauth-sign": { + "version": "0.9.0", + "resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.9.0.tgz", + "integrity": "sha512-fexhUFFPTGV8ybAtSIGbV6gOkSv8UtRbDBnAyLQw4QPKkgNlsH2ByPGtMUqdWkos6YCRmAqViwgZrJc/mRDzZQ==", + "engines": { + "node": "*" + } + }, + "node_modules/object-assign": { + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-4.1.1.tgz", + "integrity": "sha512-rJgTQnkUnH1sFw8yT6VSU3zD3sWmu6sZhIseY8VX+GRu3P6F7Fu+JNDoXfklElbLJSnc3FUQHVe4cU5hj+BcUg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/object-inspect": { + "version": "1.12.3", + "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.12.3.tgz", + "integrity": "sha512-geUvdk7c+eizMNUDkRpW1wJwgfOiOeHbxBR/hLXK1aT6zmVSO0jsQcs7fj6MGw89jC/cjGfLcNOrtMYtGqm81g==", + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/object-keys": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/object-keys/-/object-keys-1.1.1.tgz", + "integrity": "sha512-NuAESUOUMrlIXOfHKzD6bpPu3tYt3xvjNdRIQ+FeT0lNb4K8WR70CaDxhuNguS2XG+GjkyMwOzsN5ZktImfhLA==", + "engines": { + "node": ">= 0.4" + } + }, + "node_modules/object.assign": { + "version": "4.1.4", + "resolved": "https://registry.npmjs.org/object.assign/-/object.assign-4.1.4.tgz", + "integrity": "sha512-1mxKf0e58bvyjSCtKYY4sRe9itRk3PJpquJOjeIkz885CczcI4IvJJDLPS72oowuSh+pBxUFROpX+TU++hxhZQ==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "has-symbols": "^1.0.3", + "object-keys": "^1.1.1" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/object.getownpropertydescriptors": { + "version": "2.1.6", + "resolved": "https://registry.npmjs.org/object.getownpropertydescriptors/-/object.getownpropertydescriptors-2.1.6.tgz", + "integrity": "sha512-lq+61g26E/BgHv0ZTFgRvi7NMEPuAxLkFU7rukXjc/AlwH4Am5xXVnIXy3un1bg/JPbXHrixRkK1itUzzPiIjQ==", + "dependencies": { + "array.prototype.reduce": "^1.0.5", + "call-bind": "^1.0.2", + "define-properties": "^1.2.0", + "es-abstract": "^1.21.2", + "safe-array-concat": "^1.0.0" + }, + "engines": { + "node": ">= 0.8" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/object.values": { + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/object.values/-/object.values-1.1.6.tgz", + "integrity": "sha512-FVVTkD1vENCsAcwNs9k6jea2uHC/X0+JcjG8YA60FN5CMaJmG95wT9jek/xX9nornqGRrBkKtzuAu2wuHpKqvw==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/once": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz", + "integrity": "sha512-lNaJgI+2Q5URQBkccEKHTQOPaXdUxnZZElQTZY0MFUAuaEqe1E+Nyvgdz/aIyNi6Z9MzO5dv1H8n58/GELp3+w==", + "dependencies": { + "wrappy": "1" + } + }, + "node_modules/os-homedir": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/os-homedir/-/os-homedir-1.0.2.tgz", + "integrity": "sha512-B5JU3cabzk8c67mRRd3ECmROafjYMXbuzlwtqdM8IbS8ktlTix8aFGb2bAGKrSRIlnfKwovGUUr72JUPyOb6kQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/os-tmpdir": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/os-tmpdir/-/os-tmpdir-1.0.2.tgz", + "integrity": "sha512-D2FR03Vir7FIu45XBY20mTb+/ZSWB00sjU9jdQXt83gDrI4Ztz5Fs7/yy74g2N5SVQY4xY1qDr4rNddwYRVX0g==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/osenv": { + "version": "0.1.5", + "resolved": "https://registry.npmjs.org/osenv/-/osenv-0.1.5.tgz", + "integrity": "sha512-0CWcCECdMVc2Rw3U5w9ZjqX6ga6ubk1xDVKxtBQPK7wis/0F2r9T6k4ydGYhecl7YUBxBVxhL5oisPsNxAPe2g==", + "dependencies": { + "os-homedir": "^1.0.0", + "os-tmpdir": "^1.0.0" + } + }, + "node_modules/package-json": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/package-json/-/package-json-1.2.0.tgz", + "integrity": "sha512-knDtirWWqKVJrLY3gEBLflVvueTMpyjbAwX/9j/EKi2DsjNemp5voS8cyKyGh57SNaMJNhNRZbIaWdneOcLU1g==", + "dependencies": { + "got": "^3.2.0", + "registry-url": "^3.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/performance-now": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/performance-now/-/performance-now-2.1.0.tgz", + "integrity": "sha512-7EAHlyLHI56VEIdK57uwHdHKIaAGbnXPiw0yWbarQZOKaKpvUIgW0jWRVLiatnM+XXlSwsanIBH/hzGMJulMow==" + }, + "node_modules/pinkie": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/pinkie/-/pinkie-2.0.4.tgz", + "integrity": "sha512-MnUuEycAemtSaeFSjXKW/aroV7akBbY+Sv+RkyqFjgAe73F+MR0TBWKBRDkmfWq/HiFmdavfZ1G7h4SPZXaCSg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/pinkie-promise": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/pinkie-promise/-/pinkie-promise-2.0.1.tgz", + "integrity": "sha512-0Gni6D4UcLTbv9c57DfxDGdr41XfgUjqWZu492f0cIGr16zDU06BWP/RAEvOuo7CQ0CNjHaLlM59YJJFm3NWlw==", + "dependencies": { + "pinkie": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/prepend-http": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/prepend-http/-/prepend-http-1.0.4.tgz", + "integrity": "sha512-PhmXi5XmoyKw1Un4E+opM2KcsJInDvKyuOumcjjw3waw86ZNjHwVUOOWLc4bCzLdcKNaWBH9e99sbWzDQsVaYg==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/process-nextick-args": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/process-nextick-args/-/process-nextick-args-2.0.1.tgz", + "integrity": "sha512-3ouUOpQhtgrbOa17J7+uxOTpITYWaGP7/AhoR3+A+/1e9skrzelGi/dXzEYyvbxubEF6Wn2ypscTKiKJFFn1ag==" + }, + "node_modules/promise": { + "version": "7.3.1", + "resolved": "https://registry.npmjs.org/promise/-/promise-7.3.1.tgz", + "integrity": "sha512-nolQXZ/4L+bP/UGlkfaIujX9BKxGwmQ9OT4mOt5yvy8iK1h3wqTEJCijzGANTCCl9nWjY41juyAn2K3Q1hLLTg==", + "dependencies": { + "asap": "~2.0.3" + } + }, + "node_modules/prop-types": { + "version": "15.8.1", + "resolved": "https://registry.npmjs.org/prop-types/-/prop-types-15.8.1.tgz", + "integrity": "sha512-oj87CgZICdulUohogVAR7AjlC0327U4el4L6eAvOqCeudMDVU0NThNaV+b9Df4dXgSP1gXMTnPdhfe/2qDH5cg==", + "dependencies": { + "loose-envify": "^1.4.0", + "object-assign": "^4.1.1", + "react-is": "^16.13.1" + } + }, + "node_modules/prop-types/node_modules/react-is": { + "version": "16.13.1", + "resolved": "https://registry.npmjs.org/react-is/-/react-is-16.13.1.tgz", + "integrity": "sha512-24e6ynE2H+OKt4kqsOvNd8kBpV65zoxbA4BVsEOB3ARVWQki/DHzaUoC5KuON/BiccDaCCTZBuOcfZs70kR8bQ==" + }, + "node_modules/psl": { + "version": "1.9.0", + "resolved": "https://registry.npmjs.org/psl/-/psl-1.9.0.tgz", + "integrity": "sha512-E/ZsdU4HLs/68gYzgGTkMicWTLPdAftJLfJFlLUAAKZGkStNU72sZjT66SnMDVOfOWY/YAoiD7Jxa9iHvngcag==" + }, + "node_modules/punycode": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-2.3.0.tgz", + "integrity": "sha512-rRV+zQD8tVFys26lAGR9WUuS4iUAngJScM+ZRSKtvl5tKeZ2t5bvdNFdNHBW9FWR4guGHlgmsZ1G7BSm2wTbuA==", + "engines": { + "node": ">=6" + } + }, + "node_modules/q": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/q/-/q-1.5.1.tgz", + "integrity": "sha512-kV/CThkXo6xyFEZUugw/+pIOywXcDbFYgSct5cT3gqlbkBE1SJdwy6UQoZvodiWF/ckQLZyDE/Bu1M6gVu5lVw==", + "engines": { + "node": ">=0.6.0", + "teleport": ">=0.2.0" + } + }, + "node_modules/qs": { + "version": "6.5.3", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.3.tgz", + "integrity": "sha512-qxXIEh4pCGfHICj1mAJQ2/2XVZkjCDTcEgfoSQxc/fYivUZxTkk7L3bDBJSoNrEzXI17oUO5Dp07ktqE5KzczA==", + "engines": { + "node": ">=0.6" + } + }, + "node_modules/rc": { + "version": "1.2.8", + "resolved": "https://registry.npmjs.org/rc/-/rc-1.2.8.tgz", + "integrity": "sha512-y3bGgqKj3QBdxLbLkomlohkvsA8gdAiUQlSBJnBhfn+BPxg4bc62d8TcBW15wavDfgexCgccckhcZvywyQYPOw==", + "dependencies": { + "deep-extend": "^0.6.0", + "ini": "~1.3.0", + "minimist": "^1.2.0", + "strip-json-comments": "~2.0.1" + }, + "bin": { + "rc": "cli.js" + } + }, + "node_modules/react": { + "version": "18.2.0", + "resolved": "https://registry.npmjs.org/react/-/react-18.2.0.tgz", + "integrity": "sha512-/3IjMdb2L9QbBdWiW5e3P2/npwMBaU9mHCSCUzNln0ZCYbcfTsGbTJrU/kGemdH2IWmB2ioZ+zkxtmq6g09fGQ==", + "dependencies": { + "loose-envify": "^1.1.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/react-clientside-effect": { + "version": "1.2.6", + "resolved": "https://registry.npmjs.org/react-clientside-effect/-/react-clientside-effect-1.2.6.tgz", + "integrity": "sha512-XGGGRQAKY+q25Lz9a/4EPqom7WRjz3z9R2k4jhVKA/puQFH/5Nt27vFZYql4m4NVNdUvX8PS3O7r/Zzm7cjUlg==", + "dependencies": { + "@babel/runtime": "^7.12.13" + }, + "peerDependencies": { + "react": "^15.3.0 || ^16.0.0 || ^17.0.0 || ^18.0.0" + } + }, + "node_modules/react-dom": { + "version": "18.2.0", + "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-18.2.0.tgz", + "integrity": "sha512-6IMTriUmvsjHUjNtEDudZfuDQUoWXVxKHhlEGSk81n4YFS+r/Kl99wXiwlVXtPBtJenozv2P+hxDsw9eA7Xo6g==", + "dependencies": { + "loose-envify": "^1.1.0", + "scheduler": "^0.23.0" + }, + "peerDependencies": { + "react": "^18.2.0" + } + }, + "node_modules/react-focus-lock": { + "version": "2.9.4", + "resolved": "https://registry.npmjs.org/react-focus-lock/-/react-focus-lock-2.9.4.tgz", + "integrity": "sha512-7pEdXyMseqm3kVjhdVH18sovparAzLg5h6WvIx7/Ck3ekjhrrDMEegHSa3swwC8wgfdd7DIdUVRGeiHT9/7Sgg==", + "dependencies": { + "@babel/runtime": "^7.0.0", + "focus-lock": "^0.11.6", + "prop-types": "^15.6.2", + "react-clientside-effect": "^1.2.6", + "use-callback-ref": "^1.3.0", + "use-sidecar": "^1.1.2" + }, + "peerDependencies": { + "@types/react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/react-is": { + "version": "17.0.2", + "resolved": "https://registry.npmjs.org/react-is/-/react-is-17.0.2.tgz", + "integrity": "sha512-w2GsyukL62IJnlaff/nRegPQR94C/XXamvMWmSHRJ4y7Ts/4ocGRmTHvOs8PSE6pB3dWOrD/nueuU5sduBsQ4w==", + "peer": true + }, + "node_modules/react-remove-scroll": { + "version": "2.5.6", + "resolved": "https://registry.npmjs.org/react-remove-scroll/-/react-remove-scroll-2.5.6.tgz", + "integrity": "sha512-bO856ad1uDYLefgArk559IzUNeQ6SWH4QnrevIUjH+GczV56giDfl3h0Idptf2oIKxQmd1p9BN25jleKodTALg==", + "dependencies": { + "react-remove-scroll-bar": "^2.3.4", + "react-style-singleton": "^2.2.1", + "tslib": "^2.1.0", + "use-callback-ref": "^1.3.0", + "use-sidecar": "^1.1.2" + }, + "engines": { + "node": ">=10" + }, + "peerDependencies": { + "@types/react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/react-remove-scroll-bar": { + "version": "2.3.4", + "resolved": "https://registry.npmjs.org/react-remove-scroll-bar/-/react-remove-scroll-bar-2.3.4.tgz", + "integrity": "sha512-63C4YQBUt0m6ALadE9XV56hV8BgJWDmmTPY758iIJjfQKt2nYwoUrPk0LXRXcB/yIj82T1/Ixfdpdk68LwIB0A==", + "dependencies": { + "react-style-singleton": "^2.2.1", + "tslib": "^2.0.0" + }, + "engines": { + "node": ">=10" + }, + "peerDependencies": { + "@types/react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/react-style-singleton": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/react-style-singleton/-/react-style-singleton-2.2.1.tgz", + "integrity": "sha512-ZWj0fHEMyWkHzKYUr2Bs/4zU6XLmq9HsgBURm7g5pAVfyn49DgUiNgY2d4lXRlYSiCif9YBGpQleewkcqddc7g==", + "dependencies": { + "get-nonce": "^1.0.0", + "invariant": "^2.2.4", + "tslib": "^2.0.0" + }, + "engines": { + "node": ">=10" + }, + "peerDependencies": { + "@types/react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/read-all-stream": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/read-all-stream/-/read-all-stream-3.1.0.tgz", + "integrity": "sha512-DI1drPHbmBcUDWrJ7ull/F2Qb8HkwBncVx8/RpKYFSIACYaVRQReISYPdZz/mt1y1+qMCOrfReTopERmaxtP6w==", + "dependencies": { + "pinkie-promise": "^2.0.0", + "readable-stream": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/read-all-stream/node_modules/isarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", + "integrity": "sha512-VLghIWNM6ELQzo7zwmcg0NmTVyWKYjvIeM83yjp0wRDTmUnrM678fQbcKBo6n2CJEF0szoG//ytg+TKla89ALQ==" + }, + "node_modules/read-all-stream/node_modules/readable-stream": { + "version": "2.3.8", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz", + "integrity": "sha512-8p0AUk4XODgIewSi0l8Epjs+EVnWiK7NoDIEGU0HhE7+ZyY8D1IMY7odu5lRrFXGg71L15KG8QrPmum45RTtdA==", + "dependencies": { + "core-util-is": "~1.0.0", + "inherits": "~2.0.3", + "isarray": "~1.0.0", + "process-nextick-args": "~2.0.0", + "safe-buffer": "~5.1.1", + "string_decoder": "~1.1.1", + "util-deprecate": "~1.0.1" + } + }, + "node_modules/read-all-stream/node_modules/safe-buffer": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz", + "integrity": "sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g==" + }, + "node_modules/read-all-stream/node_modules/string_decoder": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz", + "integrity": "sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg==", + "dependencies": { + "safe-buffer": "~5.1.0" + } + }, + "node_modules/readable-stream": { + "version": "3.6.2", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.2.tgz", + "integrity": "sha512-9u/sniCrY3D5WdsERHzHE4G2YCXqoG5FTHUiCC4SIbr6XcLZBY05ya9EKjYek9O5xOAwjGq+1JdGBAS7Q9ScoA==", + "dependencies": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + }, + "engines": { + "node": ">= 6" + } + }, + "node_modules/regenerator-runtime": { + "version": "0.13.11", + "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.13.11.tgz", + "integrity": "sha512-kY1AZVr2Ra+t+piVaJ4gxaFaReZVH40AKNo7UCX6W+dEwBo/2oZJzqfuN1qLq1oL45o56cPaTXELwrTh8Fpggg==" + }, + "node_modules/regexp.prototype.flags": { + "version": "1.5.0", + "resolved": "https://registry.npmjs.org/regexp.prototype.flags/-/regexp.prototype.flags-1.5.0.tgz", + "integrity": "sha512-0SutC3pNudRKgquxGoRGIz946MZVHqbNfPjBdxeOhBrdgDKlRoXmYLQN9xRbrR09ZXWeGAdPuif7egofn6v5LA==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.2.0", + "functions-have-names": "^1.2.3" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/registry-url": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/registry-url/-/registry-url-3.1.0.tgz", + "integrity": "sha512-ZbgR5aZEdf4UKZVBPYIgaglBmSF2Hi94s2PcIHhRGFjKYu+chjJdYfHn4rt3hB6eCKLJ8giVIIfgMa1ehDfZKA==", + "dependencies": { + "rc": "^1.0.1" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/repeat-string": { + "version": "1.6.1", + "resolved": "https://registry.npmjs.org/repeat-string/-/repeat-string-1.6.1.tgz", + "integrity": "sha512-PV0dzCYDNfRi1jCDbJzpW7jNNDRuCOG/jI5ctQcGKt/clZD+YcPS3yIlWuTJMmESC8aevCFmWJy5wjAFgNqN6w==", + "engines": { + "node": ">=0.10" + } + }, + "node_modules/repeating": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/repeating/-/repeating-1.1.3.tgz", + "integrity": "sha512-Nh30JLeMHdoI+AsQ5eblhZ7YlTsM9wiJQe/AHIunlK3KWzvXhXb36IJ7K1IOeRjIOtzMjdUHjwXUFxKJoPTSOg==", + "dependencies": { + "is-finite": "^1.0.0" + }, + "bin": { + "repeating": "cli.js" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/request": { + "version": "2.88.2", + "resolved": "https://registry.npmjs.org/request/-/request-2.88.2.tgz", + "integrity": "sha512-MsvtOrfG9ZcrOwAW+Qi+F6HbD0CWXEh9ou77uOb7FM2WPhwT7smM833PzanhJLsgXjN89Ir6V2PczXNnMpwKhw==", + "deprecated": "request has been deprecated, see https://github.com/request/request/issues/3142", + "dependencies": { + "aws-sign2": "~0.7.0", + "aws4": "^1.8.0", + "caseless": "~0.12.0", + "combined-stream": "~1.0.6", + "extend": "~3.0.2", + "forever-agent": "~0.6.1", + "form-data": "~2.3.2", + "har-validator": "~5.1.3", + "http-signature": "~1.2.0", + "is-typedarray": "~1.0.0", + "isstream": "~0.1.2", + "json-stringify-safe": "~5.0.1", + "mime-types": "~2.1.19", + "oauth-sign": "~0.9.0", + "performance-now": "^2.1.0", + "qs": "~6.5.2", + "safe-buffer": "^5.1.2", + "tough-cookie": "~2.5.0", + "tunnel-agent": "^0.6.0", + "uuid": "^3.3.2" + }, + "engines": { + "node": ">= 6" + } + }, + "node_modules/right-align": { + "version": "0.1.3", + "resolved": "https://registry.npmjs.org/right-align/-/right-align-0.1.3.tgz", + "integrity": "sha512-yqINtL/G7vs2v+dFIZmFUDbnVyFUJFKd6gK22Kgo6R4jfJGFtisKyncWDDULgjfqf4ASQuIQyjJ7XZ+3aWpsAg==", + "dependencies": { + "align-text": "^0.1.1" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/safe-array-concat": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/safe-array-concat/-/safe-array-concat-1.0.0.tgz", + "integrity": "sha512-9dVEFruWIsnie89yym+xWTAYASdpw3CJV7Li/6zBewGf9z2i1j31rP6jnY0pHEO4QZh6N0K11bFjWmdR8UGdPQ==", + "dependencies": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.2.0", + "has-symbols": "^1.0.3", + "isarray": "^2.0.5" + }, + "engines": { + "node": ">=0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/safe-buffer": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", + "integrity": "sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ] + }, + "node_modules/safe-regex-test": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/safe-regex-test/-/safe-regex-test-1.0.0.tgz", + "integrity": "sha512-JBUUzyOgEwXQY1NuPtvcj/qcBDbDmEvWufhlnXZIm75DEHp+afM1r1ujJpJsV/gSM4t59tpDyPi1sd6ZaPFfsA==", + "dependencies": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.1.3", + "is-regex": "^1.1.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/safer-buffer": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/safer-buffer/-/safer-buffer-2.1.2.tgz", + "integrity": "sha512-YZo3K82SD7Riyi0E1EQPojLz7kpepnSQI9IyPbHHg1XXXevb5dJI7tpyN2ADxGcQbHG7vcyRHk0cbwqcQriUtg==" + }, + "node_modules/sax": { + "version": "1.2.4", + "resolved": "https://registry.npmjs.org/sax/-/sax-1.2.4.tgz", + "integrity": "sha512-NqVDv9TpANUjFm0N8uM5GxL36UgKi9/atZw+x7YFnQ8ckwFGKrl4xX4yWtrey3UJm5nP1kUbnYgLopqWNSRhWw==" + }, + "node_modules/scheduler": { + "version": "0.23.0", + "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.23.0.tgz", + "integrity": "sha512-CtuThmgHNg7zIZWAXi3AsyIzA3n4xx7aNyjwC2VJldO2LMVDhFK+63xGqq6CsJH4rTAt6/M+N4GhZiDYPx9eUw==", + "dependencies": { + "loose-envify": "^1.1.0" + } + }, + "node_modules/semver": { + "version": "5.7.1", + "resolved": "https://registry.npmjs.org/semver/-/semver-5.7.1.tgz", + "integrity": "sha512-sauaDf/PZdVgrLTNYHRtpXa1iRiKcaebiKQ1BJdpQlWH2lCvexQdX55snPFyK7QzpudqbCI0qXFfOasHdyNDGQ==", + "bin": { + "semver": "bin/semver" + } + }, + "node_modules/semver-diff": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/semver-diff/-/semver-diff-2.1.0.tgz", + "integrity": "sha512-gL8F8L4ORwsS0+iQ34yCYv///jsOq0ZL7WP55d1HnJ32o7tyFYEFQZQA22mrLIacZdU6xecaBBZ+uEiffGNyXw==", + "dependencies": { + "semver": "^5.0.3" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/set-value": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/set-value/-/set-value-4.1.0.tgz", + "integrity": "sha512-zTEg4HL0RwVrqcWs3ztF+x1vkxfm0lP+MQQFPiMJTKVceBwEV0A569Ou8l9IYQG8jOZdMVI1hGsc0tmeD2o/Lw==", + "funding": [ + "https://github.com/sponsors/jonschlinkert", + "https://paypal.me/jonathanschlinkert", + "https://jonschlinkert.dev/sponsor" + ], + "dependencies": { + "is-plain-object": "^2.0.4", + "is-primitive": "^3.0.1" + }, + "engines": { + "node": ">=11.0" + } + }, + "node_modules/side-channel": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/side-channel/-/side-channel-1.0.4.tgz", + "integrity": "sha512-q5XPytqFEIKHkGdiMIrY10mvLRvnQh42/+GoBlFW3b2LXLE2xxJpZFdm94we0BaoV3RwJyGqg5wS7epxTv0Zvw==", + "dependencies": { + "call-bind": "^1.0.0", + "get-intrinsic": "^1.0.2", + "object-inspect": "^1.9.0" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/slide": { + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/slide/-/slide-1.1.6.tgz", + "integrity": "sha512-NwrtjCg+lZoqhFU8fOwl4ay2ei8PaqCBOUV3/ektPY9trO1yQ1oXEfmHAhKArUVUr/hOHvy5f6AdP17dCM0zMw==", + "engines": { + "node": "*" + } + }, + "node_modules/source-map": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.6.1.tgz", + "integrity": "sha512-UjgapumWlbMhkBgzT7Ykc5YXUT46F0iKu8SGXq0bcwP5dz/h0Plj6enJqjz1Zbq2l5WaqYnrVbwWOWMyF3F47g==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/sprintf-js": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/sprintf-js/-/sprintf-js-1.0.3.tgz", + "integrity": "sha512-D9cPgkvLlV3t3IzL0D0YLvGA9Ahk4PcvVwUbN0dSGr1aP0Nrt4AEnTUbuGvquEC0mA64Gqt1fzirlRs5ibXx8g==" + }, + "node_modules/sshpk": { + "version": "1.17.0", + "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.17.0.tgz", + "integrity": "sha512-/9HIEs1ZXGhSPE8X6Ccm7Nam1z8KcoCqPdI7ecm1N33EzAetWahvQWVqLZtaZQ+IDKX4IyA2o0gBzqIMkAagHQ==", + "dependencies": { + "asn1": "~0.2.3", + "assert-plus": "^1.0.0", + "bcrypt-pbkdf": "^1.0.0", + "dashdash": "^1.12.0", + "ecc-jsbn": "~0.1.1", + "getpass": "^0.1.1", + "jsbn": "~0.1.0", + "safer-buffer": "^2.0.2", + "tweetnacl": "~0.14.0" + }, + "bin": { + "sshpk-conv": "bin/sshpk-conv", + "sshpk-sign": "bin/sshpk-sign", + "sshpk-verify": "bin/sshpk-verify" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/stable": { + "version": "0.1.8", + "resolved": "https://registry.npmjs.org/stable/-/stable-0.1.8.tgz", + "integrity": "sha512-ji9qxRnOVfcuLDySj9qzhGSEFVobyt1kIOSkj1qZzYLzq7Tos/oUUWvotUPQLlrsidqsK6tBH89Bc9kL5zHA6w==", + "deprecated": "Modern JS already guarantees Array#sort() is a stable sort, so this library is deprecated. See the compatibility table on MDN: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array/sort#browser_compatibility" + }, + "node_modules/stream-shift": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/stream-shift/-/stream-shift-1.0.1.tgz", + "integrity": "sha512-AiisoFqQ0vbGcZgQPY1cdP2I76glaVA/RauYR4G4thNFgkTqr90yXTo4LYX60Jl+sIlPNHHdGSwo01AvbKUSVQ==" + }, + "node_modules/string_decoder": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.3.0.tgz", + "integrity": "sha512-hkRX8U1WjJFd8LsDJ2yQ/wWWxaopEsABU1XfkM8A+j0+85JAGppt16cr1Whg6KIbb4okU6Mql6BOj+uup/wKeA==", + "dependencies": { + "safe-buffer": "~5.2.0" + } + }, + "node_modules/string-length": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/string-length/-/string-length-1.0.1.tgz", + "integrity": "sha512-MNCACnufWUf3pQ57O5WTBMkKhzYIaKEcUioO0XHrTMafrbBaNk4IyDOLHBv5xbXO0jLLdsYWeFjpjG2hVHRDtw==", + "dependencies": { + "strip-ansi": "^3.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/string.prototype.trim": { + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/string.prototype.trim/-/string.prototype.trim-1.2.7.tgz", + "integrity": "sha512-p6TmeT1T3411M8Cgg9wBTMRtY2q9+PNy9EV1i2lIXUN/btt763oIfxwN3RR8VU6wHX8j/1CFy0L+YuThm6bgOg==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/string.prototype.trimend": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/string.prototype.trimend/-/string.prototype.trimend-1.0.6.tgz", + "integrity": "sha512-JySq+4mrPf9EsDBEDYMOb/lM7XQLulwg5R/m1r0PXEFqrV0qHvl58sdTilSXtKOflCsK2E8jxf+GKC0T07RWwQ==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/string.prototype.trimstart": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/string.prototype.trimstart/-/string.prototype.trimstart-1.0.6.tgz", + "integrity": "sha512-omqjMDaY92pbn5HOX7f9IccLA+U1tA9GvtU4JrodiXFfYB7jPzzHpRzpglLAjtUV6bB557zwClJezTqnAiYnQA==", + "dependencies": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/strip-ansi": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", + "integrity": "sha512-VhumSSbBqDTP8p2ZLKj40UjBCV4+v8bUSEpUb4KjRgWk9pbqGF4REFj6KEagidb2f/M6AzC0EmFyDNGaw9OCzg==", + "dependencies": { + "ansi-regex": "^2.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/strip-json-comments": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/strip-json-comments/-/strip-json-comments-2.0.1.tgz", + "integrity": "sha512-4gB8na07fecVVkOI6Rs4e7T6NOTki5EmL7TUduTs6bu3EdnSycntVJ4re8kgZA+wx9IueI2Y11bfbgwtzuE0KQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/style-mod": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/style-mod/-/style-mod-4.0.3.tgz", + "integrity": "sha512-78Jv8kYJdjbvRwwijtCevYADfsI0lGzYJe4mMFdceO8l75DFFDoqBhR1jVDicDRRaX4//g1u9wKeo+ztc2h1Rw==", + "peer": true + }, + "node_modules/supports-color": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-2.0.0.tgz", + "integrity": "sha512-KKNVtd6pCYgPIKU4cp2733HWYCpplQhddZLBUryaAHou723x+FRzQ5Df824Fj+IyyuiQTRoub4SnIFfIcrp70g==", + "engines": { + "node": ">=0.8.0" + } + }, + "node_modules/svgo": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/svgo/-/svgo-1.3.2.tgz", + "integrity": "sha512-yhy/sQYxR5BkC98CY7o31VGsg014AKLEPxdfhora76l36hD9Rdy5NZA/Ocn6yayNPgSamYdtX2rFJdcv07AYVw==", + "deprecated": "This SVGO version is no longer supported. Upgrade to v2.x.x.", + "dependencies": { + "chalk": "^2.4.1", + "coa": "^2.0.2", + "css-select": "^2.0.0", + "css-select-base-adapter": "^0.1.1", + "css-tree": "1.0.0-alpha.37", + "csso": "^4.0.2", + "js-yaml": "^3.13.1", + "mkdirp": "~0.5.1", + "object.values": "^1.1.0", + "sax": "~1.2.4", + "stable": "^0.1.8", + "unquote": "~1.1.1", + "util.promisify": "~1.0.0" + }, + "bin": { + "svgo": "bin/svgo" + }, + "engines": { + "node": ">=4.0.0" + } + }, + "node_modules/svgo/node_modules/ansi-styles": { + "version": "3.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-3.2.1.tgz", + "integrity": "sha512-VT0ZI6kZRdTh8YyJw3SMbYm/u+NqfsAxEpWO0Pf9sq8/e94WxxOpPKx9FR1FlyCtOVDNOQ+8ntlqFxiRc+r5qA==", + "dependencies": { + "color-convert": "^1.9.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/svgo/node_modules/chalk": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-2.4.2.tgz", + "integrity": "sha512-Mti+f9lpJNcwF4tWV8/OrTTtF1gZi+f8FqlyAdouralcFWFQWF2+NgCHShjkCb+IFBLq9buZwE1xckQU4peSuQ==", + "dependencies": { + "ansi-styles": "^3.2.1", + "escape-string-regexp": "^1.0.5", + "supports-color": "^5.3.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/svgo/node_modules/css-select": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-2.1.0.tgz", + "integrity": "sha512-Dqk7LQKpwLoH3VovzZnkzegqNSuAziQyNZUcrdDM401iY+R5NkGBXGmtO05/yaXQziALuPogeG0b7UAgjnTJTQ==", + "dependencies": { + "boolbase": "^1.0.0", + "css-what": "^3.2.1", + "domutils": "^1.7.0", + "nth-check": "^1.0.2" + } + }, + "node_modules/svgo/node_modules/css-what": { + "version": "3.4.2", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-3.4.2.tgz", + "integrity": "sha512-ACUm3L0/jiZTqfzRM3Hi9Q8eZqd6IK37mMWPLz9PJxkLWllYeRf+EHUSHYEtFop2Eqytaq1FizFVh7XfBnXCDQ==", + "engines": { + "node": ">= 6" + }, + "funding": { + "url": "https://github.com/sponsors/fb55" + } + }, + "node_modules/svgo/node_modules/domutils": { + "version": "1.7.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-1.7.0.tgz", + "integrity": "sha512-Lgd2XcJ/NjEw+7tFvfKxOzCYKZsdct5lczQ2ZaQY8Djz7pfAD3Gbp8ySJWtreII/vDlMVmxwa6pHmdxIYgttDg==", + "dependencies": { + "dom-serializer": "0", + "domelementtype": "1" + } + }, + "node_modules/svgo/node_modules/supports-color": { + "version": "5.5.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-5.5.0.tgz", + "integrity": "sha512-QjVjwdXIt408MIiAqCX4oUKsgU2EqAGzs2Ppkm4aQYbjm+ZEWEcW4SfFNTr4uMNZma0ey4f5lgLrkB0aX0QMow==", + "dependencies": { + "has-flag": "^3.0.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/tabbable": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/tabbable/-/tabbable-4.0.0.tgz", + "integrity": "sha512-H1XoH1URcBOa/rZZWxLxHCtOdVUEev+9vo5YdYhC9tCY4wnybX+VQrCYuy9ubkg69fCBxCONJOSLGfw0DWMffQ==" + }, + "node_modules/then-fs": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/then-fs/-/then-fs-2.0.0.tgz", + "integrity": "sha512-5ffcBcU+vFUCYDNi/o507IqjqrTkuGsLVZ1Fp50hwgZRY7ufVFa9jFfTy5uZ2QnSKacKigWKeaXkOqLa4DsjLw==", + "dependencies": { + "promise": ">=3.2 <8" + } + }, + "node_modules/timed-out": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/timed-out/-/timed-out-2.0.0.tgz", + "integrity": "sha512-pqqJOi1rF5zNs/ps4vmbE4SFCrM4iR7LW+GHAsHqO/EumqbIWceioevYLM5xZRgQSH6gFgL9J/uB7EcJhQ9niQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/tiny-warning": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/tiny-warning/-/tiny-warning-1.0.3.tgz", + "integrity": "sha512-lBN9zLN/oAf68o3zNXYrdCt1kP8WsiGW8Oo2ka41b2IM5JL/S1CTyX1rW0mb/zSuJun0ZUrDxx4sqvYS2FWzPA==" + }, + "node_modules/toggle-selection": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/toggle-selection/-/toggle-selection-1.0.6.tgz", + "integrity": "sha512-BiZS+C1OS8g/q2RRbJmy59xpyghNBqrr6k5L/uKBGRsTfxmu3ffiRnd8mlGPUVayg8pvfi5urfnu8TU7DVOkLQ==" + }, + "node_modules/tough-cookie": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.5.0.tgz", + "integrity": "sha512-nlLsUzgm1kfLXSXfRZMc1KLAugd4hqJHDTvc2hDIwS3mZAfMEuMbc03SujMF+GEcpaX/qboeycw6iO8JwVv2+g==", + "dependencies": { + "psl": "^1.1.28", + "punycode": "^2.1.1" + }, + "engines": { + "node": ">=0.8" + } + }, + "node_modules/tslib": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/tslib/-/tslib-2.5.0.tgz", + "integrity": "sha512-336iVw3rtn2BUK7ORdIAHTyxHGRIHVReokCR3XjbckJMK7ms8FysBfhLR8IXnAgy7T0PTPNBWKiH514FOW/WSg==" + }, + "node_modules/tunnel-agent": { + "version": "0.6.0", + "resolved": "https://registry.npmjs.org/tunnel-agent/-/tunnel-agent-0.6.0.tgz", + "integrity": "sha512-McnNiV1l8RYeY8tBgEpuodCC1mLUdbSN+CYBL7kJsJNInOP8UjDDEwdk6Mw60vdLLrr5NHKZhMAOSrR2NZuQ+w==", + "dependencies": { + "safe-buffer": "^5.0.1" + }, + "engines": { + "node": "*" + } + }, + "node_modules/tweetnacl": { + "version": "0.14.5", + "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", + "integrity": "sha512-KXXFFdAbFXY4geFIwoyNK+f5Z1b7swfXABfL7HXCmoIWMKU3dmS26672A4EeQtDzLKy7SXmfBu51JolvEKwtGA==" + }, + "node_modules/typed-array-length": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/typed-array-length/-/typed-array-length-1.0.4.tgz", + "integrity": "sha512-KjZypGq+I/H7HI5HlOoGHkWUUGq+Q0TPhQurLbyrVrvnKTBgzLhIJ7j6J/XTQOi0d1RjyZ0wdas8bKs2p0x3Ng==", + "dependencies": { + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "is-typed-array": "^1.1.9" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/uc.micro": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/uc.micro/-/uc.micro-1.0.6.tgz", + "integrity": "sha512-8Y75pvTYkLJW2hWQHXxoqRgV7qb9B+9vFEtidML+7koHUFapnVJAZ6cKs+Qjz5Aw3aZWHMC6u0wJE3At+nSGwA==" + }, + "node_modules/uglify-js": { + "version": "2.8.29", + "resolved": "https://registry.npmjs.org/uglify-js/-/uglify-js-2.8.29.tgz", + "integrity": "sha512-qLq/4y2pjcU3vhlhseXGGJ7VbFO4pBANu0kwl8VCa9KEI0V8VfZIx2Fy3w01iSTA/pGwKZSmu/+I4etLNDdt5w==", + "dependencies": { + "source-map": "~0.5.1", + "yargs": "~3.10.0" + }, + "bin": { + "uglifyjs": "bin/uglifyjs" + }, + "engines": { + "node": ">=0.8.0" + }, + "optionalDependencies": { + "uglify-to-browserify": "~1.0.0" + } + }, + "node_modules/uglify-js/node_modules/source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha512-LbrmJOMUSdEVxIKvdcJzQC+nQhe8FUZQTXQy6+I75skNgn3OoQ0DZA8YnFa7gp8tqtL3KPf1kmo0R5DoApeSGQ==", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/uglify-to-browserify": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/uglify-to-browserify/-/uglify-to-browserify-1.0.2.tgz", + "integrity": "sha512-vb2s1lYx2xBtUgy+ta+b2J/GLVUR+wmpINwHePmPRhOsIVCG2wDzKJ0n14GslH1BifsqVzSOwQhRaCAsZ/nI4Q==", + "optional": true + }, + "node_modules/unbox-primitive": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/unbox-primitive/-/unbox-primitive-1.0.2.tgz", + "integrity": "sha512-61pPlCD9h51VoreyJ0BReideM3MDKMKnh6+V9L08331ipq6Q8OFXZYiqP6n/tbHx4s5I9uRhcye6BrbkizkBDw==", + "dependencies": { + "call-bind": "^1.0.2", + "has-bigints": "^1.0.2", + "has-symbols": "^1.0.3", + "which-boxed-primitive": "^1.0.2" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/unquote": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/unquote/-/unquote-1.1.1.tgz", + "integrity": "sha512-vRCqFv6UhXpWxZPyGDh/F3ZpNv8/qo7w6iufLpQg9aKnQ71qM4B5KiI7Mia9COcjEhrO9LueHpMYjYzsWH3OIg==" + }, + "node_modules/update-notifier": { + "version": "0.5.0", + "resolved": "https://registry.npmjs.org/update-notifier/-/update-notifier-0.5.0.tgz", + "integrity": "sha512-zOGOlUKDAgDlLHLv7Oiszz3pSj8fKlSJ3i0u49sEakjXUEVJ6DMjo/Mh/B6mg2eOALvRTJkd0kbChcipQoYCng==", + "dependencies": { + "chalk": "^1.0.0", + "configstore": "^1.0.0", + "is-npm": "^1.0.0", + "latest-version": "^1.0.0", + "repeating": "^1.1.2", + "semver-diff": "^2.0.0", + "string-length": "^1.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/uri-js": { + "version": "4.4.1", + "resolved": "https://registry.npmjs.org/uri-js/-/uri-js-4.4.1.tgz", + "integrity": "sha512-7rKUyy33Q1yc98pQ1DAmLtwX109F7TIfWlW1Ydo8Wl1ii1SeHieeh0HHfPeL2fMXK6z0s8ecKs9frCuLJvndBg==", + "dependencies": { + "punycode": "^2.1.0" + } + }, + "node_modules/use-callback-ref": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/use-callback-ref/-/use-callback-ref-1.3.0.tgz", + "integrity": "sha512-3FT9PRuRdbB9HfXhEq35u4oZkvpJ5kuYbpqhCfmiZyReuRgpnhDlbr2ZEnnuS0RrJAPn6l23xjFg9kpDM+Ms7w==", + "dependencies": { + "tslib": "^2.0.0" + }, + "engines": { + "node": ">=10" + }, + "peerDependencies": { + "@types/react": "^16.8.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/use-sidecar": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/use-sidecar/-/use-sidecar-1.1.2.tgz", + "integrity": "sha512-epTbsLuzZ7lPClpz2TyryBfztm7m+28DlEv2ZCQ3MDr5ssiwyOwGH/e5F9CkfWjJ1t4clvI58yF822/GUkjjhw==", + "dependencies": { + "detect-node-es": "^1.1.0", + "tslib": "^2.0.0" + }, + "engines": { + "node": ">=10" + }, + "peerDependencies": { + "@types/react": "^16.9.0 || ^17.0.0 || ^18.0.0", + "react": "^16.8.0 || ^17.0.0 || ^18.0.0" + }, + "peerDependenciesMeta": { + "@types/react": { + "optional": true + } + } + }, + "node_modules/util-deprecate": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", + "integrity": "sha512-EPD5q1uXyFxJpCrLnCc1nHnq3gOa6DZBocAIiI2TaSCA7VCJ1UJDMagCzIkXNsUYfD1daK//LTEQ8xiIbrHtcw==" + }, + "node_modules/util.promisify": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/util.promisify/-/util.promisify-1.0.1.tgz", + "integrity": "sha512-g9JpC/3He3bm38zsLupWryXHoEcS22YHthuPQSJdMy6KNrzIRzWqcsHzD/WUnqe45whVou4VIsPew37DoXWNrA==", + "dependencies": { + "define-properties": "^1.1.3", + "es-abstract": "^1.17.2", + "has-symbols": "^1.0.1", + "object.getownpropertydescriptors": "^2.1.0" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/uuid": { + "version": "3.4.0", + "resolved": "https://registry.npmjs.org/uuid/-/uuid-3.4.0.tgz", + "integrity": "sha512-HjSDRw6gZE5JMggctHBcjVak08+KEVhSIiDzFnT9S9aegmp85S/bReBVTb4QTFaRNptJ9kuYaNhnbNEOkbKb/A==", + "deprecated": "Please upgrade to version 7 or higher. Older versions may use Math.random() in certain circumstances, which is known to be problematic. See https://v8.dev/blog/math-random for details.", + "bin": { + "uuid": "bin/uuid" + } + }, + "node_modules/verror": { + "version": "1.10.0", + "resolved": "https://registry.npmjs.org/verror/-/verror-1.10.0.tgz", + "integrity": "sha512-ZZKSmDAEFOijERBLkmYfJ+vmk3w+7hOLYDNkRCuRuMJGEmqYNCNLyBBFwWKVMhfwaEF3WOd0Zlw86U/WC/+nYw==", + "engines": [ + "node >=0.6.0" + ], + "dependencies": { + "assert-plus": "^1.0.0", + "core-util-is": "1.0.2", + "extsprintf": "^1.2.0" + } + }, + "node_modules/vscode-languageserver-types": { + "version": "3.17.3", + "resolved": "https://registry.npmjs.org/vscode-languageserver-types/-/vscode-languageserver-types-3.17.3.tgz", + "integrity": "sha512-SYU4z1dL0PyIMd4Vj8YOqFvHu7Hz/enbWtpfnVbJHU4Nd1YNYx8u0ennumc6h48GQNeOLxmwySmnADouT/AuZA==" + }, + "node_modules/w3c-keyname": { + "version": "2.2.6", + "resolved": "https://registry.npmjs.org/w3c-keyname/-/w3c-keyname-2.2.6.tgz", + "integrity": "sha512-f+fciywl1SJEniZHD6H+kUO8gOnwIr7f4ijKA6+ZvJFjeGi1r4PDLl53Ayud9O/rk64RqgoQine0feoeOU0kXg==", + "peer": true + }, + "node_modules/which-boxed-primitive": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/which-boxed-primitive/-/which-boxed-primitive-1.0.2.tgz", + "integrity": "sha512-bwZdv0AKLpplFY2KZRX6TvyuN7ojjr7lwkg6ml0roIy9YeuSr7JS372qlNW18UQYzgYK9ziGcerWqZOmEn9VNg==", + "dependencies": { + "is-bigint": "^1.0.1", + "is-boolean-object": "^1.1.0", + "is-number-object": "^1.0.4", + "is-string": "^1.0.5", + "is-symbol": "^1.0.3" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/which-typed-array": { + "version": "1.1.9", + "resolved": "https://registry.npmjs.org/which-typed-array/-/which-typed-array-1.1.9.tgz", + "integrity": "sha512-w9c4xkx6mPidwp7180ckYWfMmvxpjlZuIudNtDf4N/tTAUB8VJbX25qZoAsrtGuYNnGw3pa0AXgbGKRB8/EceA==", + "dependencies": { + "available-typed-arrays": "^1.0.5", + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "gopd": "^1.0.1", + "has-tostringtag": "^1.0.0", + "is-typed-array": "^1.1.10" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, + "node_modules/window-size": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/window-size/-/window-size-0.1.0.tgz", + "integrity": "sha512-1pTPQDKTdd61ozlKGNCjhNRd+KPmgLSGa3mZTHoOliaGcESD8G1PXhh7c1fgiPjVbNVfgy2Faw4BI8/m0cC8Mg==", + "engines": { + "node": ">= 0.8.0" + } + }, + "node_modules/wordwrap": { + "version": "0.0.2", + "resolved": "https://registry.npmjs.org/wordwrap/-/wordwrap-0.0.2.tgz", + "integrity": "sha512-xSBsCeh+g+dinoBv3GAOWM4LcVVO68wLXRanibtBSdUvkGWQRGeE9P7IwU9EmDDi4jA6L44lz15CGMwdw9N5+Q==", + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/wrappy": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/wrappy/-/wrappy-1.0.2.tgz", + "integrity": "sha512-l4Sp/DRseor9wL6EvV2+TuQn63dMkPjZ/sp9XkghTEbV9KlPS1xUsZ3u7/IQO4wxtcFB4bgpQPRcR3QCvezPcQ==" + }, + "node_modules/write-file-atomic": { + "version": "1.3.4", + "resolved": "https://registry.npmjs.org/write-file-atomic/-/write-file-atomic-1.3.4.tgz", + "integrity": "sha512-SdrHoC/yVBPpV0Xq/mUZQIpW2sWXAShb/V4pomcJXh92RuaO+f3UTWItiR3Px+pLnV2PvC2/bfn5cwr5X6Vfxw==", + "dependencies": { + "graceful-fs": "^4.1.11", + "imurmurhash": "^0.1.4", + "slide": "^1.1.5" + } + }, + "node_modules/xdg-basedir": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/xdg-basedir/-/xdg-basedir-2.0.0.tgz", + "integrity": "sha512-NF1pPn594TaRSUO/HARoB4jK8I+rWgcpVlpQCK6/6o5PHyLUt2CSiDrpUZbQ6rROck+W2EwF8mBJcTs+W98J9w==", + "dependencies": { + "os-homedir": "^1.0.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/yargs": { + "version": "3.10.0", + "resolved": "https://registry.npmjs.org/yargs/-/yargs-3.10.0.tgz", + "integrity": "sha512-QFzUah88GAGy9lyDKGBqZdkYApt63rCXYBGYnEP4xDJPXNqXXnBDACnbrXnViV6jRSqAePwrATi2i8mfYm4L1A==", + "dependencies": { + "camelcase": "^1.0.2", + "cliui": "^2.1.0", + "decamelize": "^1.0.0", + "window-size": "0.1.0" + } + } + }, "dependencies": { + "@babel/runtime": { + "version": "7.21.5", + "resolved": "https://registry.npmjs.org/@babel/runtime/-/runtime-7.21.5.tgz", + "integrity": "sha512-8jI69toZqqcsnqGGqwGS4Qb1VwLOEp4hz+CXPywcvjs60u3B4Pom/U/7rm4W8tMOYEB+E9wgD0mW1l3r8qlI9Q==", + "requires": { + "regenerator-runtime": "^0.13.11" + } + }, + "@codemirror/language": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/@codemirror/language/-/language-6.0.0.tgz", + "integrity": "sha512-rtjk5ifyMzOna1c7PBu7J1VCt0PvA5wy3o8eMVnxMKb7z8KA7JFecvD04dSn14vj/bBaAbqRsGed5OjtofEnLA==", + "peer": true, + "requires": { + "@codemirror/state": "^6.0.0", + "@codemirror/view": "^6.0.0", + "@lezer/common": "^1.0.0", + "@lezer/highlight": "^1.0.0", + "@lezer/lr": "^1.0.0", + "style-mod": "^4.0.0" + } + }, + "@codemirror/state": { + "version": "6.2.0", + "resolved": "https://registry.npmjs.org/@codemirror/state/-/state-6.2.0.tgz", + "integrity": "sha512-69QXtcrsc3RYtOtd+GsvczJ319udtBf1PTrr2KbLWM/e2CXUPnh0Nz9AUo8WfhSQ7GeL8dPVNUmhQVgpmuaNGA==", + "peer": true + }, + "@codemirror/view": { + "version": "6.11.0", + "resolved": "https://registry.npmjs.org/@codemirror/view/-/view-6.11.0.tgz", + "integrity": "sha512-PRpPRkqMkAKKxEuiUBxapE0YR+wqs9At92ujbJo93PwTZ0jEJDzx9wahrDcXEhQ43Pe0RK9DdZMLWrt+QN80DA==", + "peer": true, + "requires": { + "@codemirror/state": "^6.1.4", + "style-mod": "^4.0.0", + "w3c-keyname": "^2.2.4" + } + }, + "@graphiql/react": { + "version": "0.17.2", + "resolved": "https://registry.npmjs.org/@graphiql/react/-/react-0.17.2.tgz", + "integrity": "sha512-x8iTeYSq8C520UYGk3f3S+AWOm8nf7x3OuePWg+k0KkMAWJeaeFBLmxBAGQLzK5/8/dPoZfNKblXcLwByeMHew==", + "requires": { + "@graphiql/toolkit": "^0.8.4", + "@reach/combobox": "^0.17.0", + "@reach/dialog": "^0.17.0", + "@reach/listbox": "^0.17.0", + "@reach/menu-button": "^0.17.0", + "@reach/tooltip": "^0.17.0", + "@reach/visually-hidden": "^0.17.0", + "clsx": "^1.2.1", + "codemirror": "^5.65.3", + "codemirror-graphql": "^2.0.6", + "copy-to-clipboard": "^3.2.0", + "graphql-language-service": "^5.1.4", + "markdown-it": "^12.2.0", + "set-value": "^4.1.0" + }, + "dependencies": { + "@reach/combobox": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/combobox/-/combobox-0.17.0.tgz", + "integrity": "sha512-2mYvU5agOBCQBMdlM4cri+P1BbNwp05P1OuDyc33xJSNiBG7BMy4+ZSHJ0X4fyle6rHwSgCAOCLOeWV1XUYjoQ==", + "requires": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/portal": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "requires": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "requires": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "requires": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "requires": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/dialog": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/dialog/-/dialog-0.17.0.tgz", + "integrity": "sha512-AnfKXugqDTGbeG3c8xDcrQDE4h9b/vnc27Sa118oQSquz52fneUeX9MeFb5ZEiBJK8T5NJpv7QUTBIKnFCAH5A==", + "requires": { + "@reach/portal": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "react-focus-lock": "^2.5.2", + "react-remove-scroll": "^2.4.3", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "requires": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "requires": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/listbox": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/listbox/-/listbox-0.17.0.tgz", + "integrity": "sha512-AMnH1P6/3VKy2V/nPb4Es441arYR+t4YRdh9jdcFVrCOD6y7CQrlmxsYjeg9Ocdz08XpdoEBHM3PKLJqNAUr7A==", + "requires": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/machine": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2" + }, + "dependencies": { + "@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/machine": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/machine/-/machine-0.17.0.tgz", + "integrity": "sha512-9EHnuPgXzkbRENvRUzJvVvYt+C2jp7PGN0xon7ffmKoK8rTO6eA/bb7P0xgloyDDQtu88TBUXKzW0uASqhTXGA==", + "requires": { + "@reach/utils": "0.17.0", + "@xstate/fsm": "1.4.0", + "tslib": "^2.3.0" + } + }, + "@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "requires": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "requires": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "requires": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "requires": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/menu-button": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/menu-button/-/menu-button-0.17.0.tgz", + "integrity": "sha512-YyuYVyMZKamPtivoEI6D0UEILYH3qZtg4kJzEAuzPmoR/aHN66NZO75Fx0gtjG1S6fZfbiARaCOZJC0VEiDOtQ==", + "requires": { + "@reach/dropdown": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/dropdown": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/dropdown/-/dropdown-0.17.0.tgz", + "integrity": "sha512-qBTIGInhxtPHtdj4Pl2XZgZMz3e37liydh0xR3qc48syu7g71sL4nqyKjOzThykyfhA3Pb3/wFgsFJKGTSdaig==", + "requires": { + "@reach/auto-id": "0.17.0", + "@reach/descendants": "0.17.0", + "@reach/popover": "0.17.0", + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/descendants": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/descendants/-/descendants-0.17.0.tgz", + "integrity": "sha512-c7lUaBfjgcmKFZiAWqhG+VnXDMEhPkI4kAav/82XKZD6NVvFjsQOTH+v3tUkskrAPV44Yuch0mFW/u5Ntifr7Q==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/popover": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/popover/-/popover-0.17.0.tgz", + "integrity": "sha512-yYbBF4fMz4Ml4LB3agobZjcZ/oPtPsNv70ZAd7lEC2h7cvhF453pA+zOBGYTPGupKaeBvgAnrMjj7RnxDU5hoQ==", + "requires": { + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "tabbable": "^4.0.0", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "requires": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "requires": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "requires": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/tooltip": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/tooltip/-/tooltip-0.17.0.tgz", + "integrity": "sha512-HP8Blordzqb/Cxg+jnhGmWQfKgypamcYLBPlcx6jconyV5iLJ5m93qipr1giK7MqKT2wlsKWy44ZcOrJ+Wrf8w==", + "requires": { + "@reach/auto-id": "0.17.0", + "@reach/portal": "0.17.0", + "@reach/rect": "0.17.0", + "@reach/utils": "0.17.0", + "@reach/visually-hidden": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + }, + "dependencies": { + "@reach/auto-id": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/auto-id/-/auto-id-0.17.0.tgz", + "integrity": "sha512-ud8iPwF52RVzEmkHq1twuqGuPA+moreumUHdtgvU3sr3/15BNhwp3KyDLrKKSz0LP1r3V4pSdyF9MbYM8BoSjA==", + "requires": { + "@reach/utils": "0.17.0", + "tslib": "^2.3.0" + } + }, + "@reach/portal": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/portal/-/portal-0.17.0.tgz", + "integrity": "sha512-+IxsgVycOj+WOeNPL2NdgooUdHPSY285wCtj/iWID6akyr4FgGUK7sMhRM9aGFyrGpx2vzr+eggbUmAVZwOz+A==", + "requires": { + "@reach/utils": "0.17.0", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/rect": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/rect/-/rect-0.17.0.tgz", + "integrity": "sha512-3YB7KA5cLjbLc20bmPkJ06DIfXSK06Cb5BbD2dHgKXjUkT9WjZaLYIbYCO8dVjwcyO3GCNfOmPxy62VsPmZwYA==", + "requires": { + "@reach/observe-rect": "1.2.0", + "@reach/utils": "0.17.0", + "prop-types": "^15.7.2", + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + }, + "@reach/utils": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/utils/-/utils-0.17.0.tgz", + "integrity": "sha512-M5y8fCBbrWeIsxedgcSw6oDlAMQDkl5uv3VnMVJ7guwpf4E48Xlh1v66z/1BgN/WYe2y8mB/ilFD2nysEfdGeA==", + "requires": { + "tiny-warning": "^1.0.3", + "tslib": "^2.3.0" + } + } + } + }, + "@reach/visually-hidden": { + "version": "0.17.0", + "resolved": "https://registry.npmjs.org/@reach/visually-hidden/-/visually-hidden-0.17.0.tgz", + "integrity": "sha512-T6xF3Nv8vVnjVkGU6cm0+kWtvliLqPAo8PcZ+WxkKacZsaHTjaZb4v1PaCcyQHmuTNT/vtTVNOJLG0SjQOIb7g==", + "requires": { + "prop-types": "^15.7.2", + "tslib": "^2.3.0" + } + } + } + }, "@graphiql/toolkit": { - "version": "0.2.0", - "resolved": "https://registry.npmjs.org/@graphiql/toolkit/-/toolkit-0.2.0.tgz", - "integrity": "sha512-T8fdGSh1bYqpQUurIBnNbXHMOFqV/btTdlcAw3+snItA619GgZfc471lYIT95/cywxbH2Ync/gqGgeSTeZhlTg==", + "version": "0.8.4", + "resolved": "https://registry.npmjs.org/@graphiql/toolkit/-/toolkit-0.8.4.tgz", + "integrity": "sha512-cFUGqh3Dau+SD3Vq9EFlZrhzYfaHKyOJveFtaCR+U5Cn/S68p7oy+vQBIdwtO6J2J58FncnwBbVRfr+IvVfZqQ==", + "requires": { + "@n1ru4l/push-pull-async-iterable-iterator": "^3.1.0", + "meros": "^1.1.4" + } + }, + "@lezer/common": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/@lezer/common/-/common-1.0.2.tgz", + "integrity": "sha512-SVgiGtMnMnW3ActR8SXgsDhw7a0w0ChHSYAyAUxxrOiJ1OqYWEKk/xJd84tTSPo1mo6DXLObAJALNnd0Hrv7Ng==", + "peer": true + }, + "@lezer/highlight": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/@lezer/highlight/-/highlight-1.1.4.tgz", + "integrity": "sha512-IECkFmw2l7sFcYXrV8iT9GeY4W0fU4CxX0WMwhmhMIVjoDdD1Hr6q3G2NqVtLg/yVe5n7i4menG3tJ2r4eCrPQ==", + "peer": true, + "requires": { + "@lezer/common": "^1.0.0" + } + }, + "@lezer/lr": { + "version": "1.3.4", + "resolved": "https://registry.npmjs.org/@lezer/lr/-/lr-1.3.4.tgz", + "integrity": "sha512-7o+e4og/QoC/6btozDPJqnzBhUaD1fMfmvnEKQO1wRRiTse1WxaJ3OMEXZJnkgT6HCcTVOctSoXK9jGJw2oe9g==", + "peer": true, "requires": { - "@n1ru4l/push-pull-async-iterable-iterator": "^2.0.1", - "graphql-ws": "^4.3.2", - "meros": "^1.1.4", - "subscriptions-transport-ws": "^0.9.18" + "@lezer/common": "^1.0.0" } }, "@n1ru4l/push-pull-async-iterable-iterator": { - "version": "2.1.2", - "resolved": "https://registry.npmjs.org/@n1ru4l/push-pull-async-iterable-iterator/-/push-pull-async-iterable-iterator-2.1.2.tgz", - "integrity": "sha512-KwZGeX2XK7Xj9ksWwei5923QnqIGoEuLlh3O46OW9vc8hQxjzmMTKCgJMVZ5ne5xaWFQYDT2dMpbUhq6hEOhxA==" + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/@n1ru4l/push-pull-async-iterable-iterator/-/push-pull-async-iterable-iterator-3.2.0.tgz", + "integrity": "sha512-3fkKj25kEjsfObL6IlKPAlHYPq/oYwUkkQ03zsTTiDjD7vg/RxjdiLeCydqtxHZP0JgsXL3D/X5oAkMGzuUp/Q==" + }, + "@reach/observe-rect": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/@reach/observe-rect/-/observe-rect-1.2.0.tgz", + "integrity": "sha512-Ba7HmkFgfQxZqqaeIWWkNK0rEhpxVQHIoVyW1YDSkGsGIXzcaW4deC8B0pZrNSSyLTdIk7y+5olKt5+g0GmFIQ==" }, "@types/q": { - "version": "1.5.4", - "resolved": "https://registry.npmjs.org/@types/q/-/q-1.5.4.tgz", - "integrity": "sha512-1HcDas8SEj4z1Wc696tH56G8OlRaH/sqZOynNNB+HF0WOeXPaxTtbYzJY2oEfiUxjSKjhCKr+MvR7dCHcEelug==" + "version": "1.5.5", + "resolved": "https://registry.npmjs.org/@types/q/-/q-1.5.5.tgz", + "integrity": "sha512-L28j2FcJfSZOnL1WBjDYp2vUHCeIFlyYI/53EwD/rKUBQ7MtUUfbQWiyKJGpcnv4/WgrhWsFKrcPstcAt/J0tQ==" + }, + "@xstate/fsm": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/@xstate/fsm/-/fsm-1.4.0.tgz", + "integrity": "sha512-uTHDeu2xI5E1IFwf37JFQM31RrH7mY7877RqPBS4ZqSNUwoLDuct8AhBWaXGnVizBAYyimVwgCyGa9z/NiRhXA==" }, "ajv": { "version": "6.12.6", @@ -38,7 +4159,7 @@ "align-text": { "version": "0.1.4", "resolved": "https://registry.npmjs.org/align-text/-/align-text-0.1.4.tgz", - "integrity": "sha1-DNkKVhCT810KmSVsIrcGlDP60Rc=", + "integrity": "sha512-GrTZLRpmp6wIC2ztrWW9MjjTgSKccffgFagbNDOX95/dcjEcYZibYTeaOntySQLcdw1ztBoFkviiUvTMbb9MYg==", "requires": { "kind-of": "^3.0.2", "longest": "^1.0.1", @@ -48,35 +4169,53 @@ "ansi-escapes": { "version": "1.4.0", "resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-1.4.0.tgz", - "integrity": "sha1-06ioOzGapneTZisT52HHkRQiMG4=" + "integrity": "sha512-wiXutNjDUlNEDWHcYH3jtZUhd3c4/VojassD8zHdHCY13xbZy2XbW+NKQwA0tWGBVzDA9qEzYwfoSsWmviidhw==" }, "ansi-regex": { "version": "2.1.1", "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", - "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + "integrity": "sha512-TIGnTpdo+E3+pCyAluZvtED5p5wCqLdezCyhPZzKPcxvFplEt4i+W7OONCKgeZFT3+y5NZZfOOS/Bdcanm1MYA==" }, "ansi-styles": { "version": "2.2.1", "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-2.2.1.tgz", - "integrity": "sha1-tDLdM1i2NM914eRmQ2gkBTPB3b4=" + "integrity": "sha512-kmCevFghRiWM7HB5zTPULl4r9bVFSWjz62MhqizDGUrq2NWuNMQyuv4tHHoKJHs69M/MF64lEcHdYIocrdWQYA==" }, "argparse": { - "version": "1.0.10", - "resolved": "https://registry.npmjs.org/argparse/-/argparse-1.0.10.tgz", - "integrity": "sha512-o5Roy6tNG4SL/FOkCAN6RzjiakZS25RLYFrcMttJqbdd8BWrnA+fGz57iN5Pb06pvBGvl5gQ0B48dJlslXvoTg==", + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-2.0.1.tgz", + "integrity": "sha512-8+9WqebbFzpX9OR+Wa6O29asIogeRMzcGtAINdpMHHyAg10f05aSFVBbcEqGf/PXw1EjAZ+q2/bEBg3DvurK3Q==" + }, + "array-buffer-byte-length": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/array-buffer-byte-length/-/array-buffer-byte-length-1.0.0.tgz", + "integrity": "sha512-LPuwb2P+NrQw3XhxGc36+XSvuBPopovXYTR9Ew++Du9Yb/bx5AzBfrIsBoj0EZUifjQU+sHL21sseZ3jerWO/A==", "requires": { - "sprintf-js": "~1.0.2" + "call-bind": "^1.0.2", + "is-array-buffer": "^3.0.1" + } + }, + "array.prototype.reduce": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/array.prototype.reduce/-/array.prototype.reduce-1.0.5.tgz", + "integrity": "sha512-kDdugMl7id9COE8R7MHF5jWk7Dqt/fs4Pv+JXoICnYwqpjjjbUurz6w5fT5IG6brLdJhv6/VoHB0H7oyIBXd+Q==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4", + "es-array-method-boxes-properly": "^1.0.0", + "is-string": "^1.0.7" } }, "asap": { "version": "2.0.6", "resolved": "https://registry.npmjs.org/asap/-/asap-2.0.6.tgz", - "integrity": "sha1-5QNHYR1+aQlDIIu9r+vLwvuGbUY=" + "integrity": "sha512-BSHWgDSAiKs50o2Re8ppvp3seVHXSRM44cdSsT9FfNEUUZLOGWVCsiWaRPWM1Znn+mqZ1OfVZ3z3DWEzSp7hRA==" }, "asn1": { - "version": "0.2.4", - "resolved": "https://registry.npmjs.org/asn1/-/asn1-0.2.4.tgz", - "integrity": "sha512-jxwzQpLQjSmWXgwaCZE9Nz+glAG01yF1QnWgbhGwHI5A6FRIEY6IVqtHhIepHqI7/kyEyQEagBC5mBEFlIYvdg==", + "version": "0.2.6", + "resolved": "https://registry.npmjs.org/asn1/-/asn1-0.2.6.tgz", + "integrity": "sha512-ix/FxPn0MDjeyJ7i/yoHGFt/EX6LyNbxSEhPPXODPL+KB0VPk86UYfL0lMdy+KCnv+fmvIzySwaK5COwqVbWTQ==", "requires": { "safer-buffer": "~2.1.0" } @@ -84,39 +4223,32 @@ "assert-plus": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/assert-plus/-/assert-plus-1.0.0.tgz", - "integrity": "sha1-8S4PPF13sLHN2RRpQuTpbB5N1SU=" - }, - "async-limiter": { - "version": "1.0.1", - "resolved": "https://registry.npmjs.org/async-limiter/-/async-limiter-1.0.1.tgz", - "integrity": "sha512-csOlWGAcRFJaI6m+F2WKdnMKr4HhdhFVBk0H/QbJFMCr+uO2kwohwXQPxw/9OCxp05r5ghVBFSyioixx3gfkNQ==", - "optional": true + "integrity": "sha512-NfJ4UzBCcQGLDlQq7nHxH+tv3kyZ0hHQqF5BO6J7tNJeP5do1llPr8dZ8zHonfhAu0PHAdMkSo+8o0wxg9lZWw==" }, "asynckit": { "version": "0.4.0", "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", - "integrity": "sha1-x57Zf380y48robyXkLzDZkdLS3k=" + "integrity": "sha512-Oei9OH4tRh0YqU3GxhX79dM/mwVgvbZJaSNaRk+bshkj0S5cfHcgYakreBjrHwatXKbz+IoIdYLxrKim2MjW0Q==" + }, + "available-typed-arrays": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/available-typed-arrays/-/available-typed-arrays-1.0.5.tgz", + "integrity": "sha512-DMD0KiN46eipeziST1LPP/STfDU0sufISXmjSgvVsoU2tqxctQeASejWcfNtxYKqETM1UxQ8sp2OrSBWpHY6sw==" }, "aws-sign2": { "version": "0.7.0", "resolved": "https://registry.npmjs.org/aws-sign2/-/aws-sign2-0.7.0.tgz", - "integrity": "sha1-tG6JCTSpWR8tL2+G1+ap8bP+dqg=" + "integrity": "sha512-08kcGqnYf/YmjoRhfxyu+CLxBjUtHLXLXX/vUfx9l2LYzG3c1m61nrpyFUZI6zeS+Li/wWMMidD9KgrqtGq3mA==" }, "aws4": { - "version": "1.11.0", - "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.11.0.tgz", - "integrity": "sha512-xh1Rl34h6Fi1DC2WWKfxUTVqRsNnr6LsKz2+hfwDxQJWmrx8+c7ylaqBMcHfl1U1r2dsifOvKX3LQuLNZ+XSvA==" - }, - "backo2": { - "version": "1.0.2", - "resolved": "https://registry.npmjs.org/backo2/-/backo2-1.0.2.tgz", - "integrity": "sha1-MasayLEpNjRj41s+u2n038+6eUc=", - "optional": true + "version": "1.12.0", + "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.12.0.tgz", + "integrity": "sha512-NmWvPnx0F1SfrQbYwOi7OeaNGokp9XhzNioJ/CSBs8Qa4vxug81mhJEAVZwxXuBmYB5KDRfMq/F3RR0BIU7sWg==" }, "bcrypt-pbkdf": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/bcrypt-pbkdf/-/bcrypt-pbkdf-1.0.2.tgz", - "integrity": "sha1-pDAdOJtqQ/m2f/PKEaP2Y342Dp4=", + "integrity": "sha512-qeFIXtP4MSoi6NLqO12WfqARWWuCKi2Rn/9hJLEmtB5yTNr9DqFWkJRCf2qShWzPeAMRnOgCrq0sg/KLv5ES9w==", "requires": { "tweetnacl": "^0.14.3" } @@ -124,7 +4256,7 @@ "boolbase": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/boolbase/-/boolbase-1.0.0.tgz", - "integrity": "sha1-aN/1++YMUes3cl6p4+0xDcwed24=" + "integrity": "sha512-JZOSA7Mo9sNGB8+UjSgzdLtokWAky1zbztM3WRLCbZ70/3cTANmQmOdR7y2g+J0e2WXywy1yS468tY+IruqEww==" }, "call-bind": { "version": "1.0.2", @@ -138,17 +4270,17 @@ "camelcase": { "version": "1.2.1", "resolved": "https://registry.npmjs.org/camelcase/-/camelcase-1.2.1.tgz", - "integrity": "sha1-m7UwTS4LVmmLLHWLCKPqqdqlijk=" + "integrity": "sha512-wzLkDa4K/mzI1OSITC+DUyjgIl/ETNHE9QvYgy6J6Jvqyyz4C0Xfd+lQhb19sX2jMpZV4IssUn0VDVmglV+s4g==" }, "caseless": { "version": "0.12.0", "resolved": "https://registry.npmjs.org/caseless/-/caseless-0.12.0.tgz", - "integrity": "sha1-G2gcIf+EAzyCZUMJBolCDRhxUdw=" + "integrity": "sha512-4tYFyifaFfGacoiObjJegolkwSU4xQNGbVgUiNYVUxbQ2x2lUsFvY4hVgVzGiIe6WLOPqycWXA40l+PWsxthUw==" }, "center-align": { "version": "0.1.3", "resolved": "https://registry.npmjs.org/center-align/-/center-align-0.1.3.tgz", - "integrity": "sha1-qg0yYptu6XIgBBHL1EYckHvCt60=", + "integrity": "sha512-Baz3aNe2gd2LP2qk5U+sDk/m4oSuwSDcBfayTCTBoWpfIGO5XFxPmjILQII4NGiZjD6DoDI6kf7gKaxkf7s3VQ==", "requires": { "align-text": "^0.1.3", "lazy-cache": "^1.0.3" @@ -157,7 +4289,7 @@ "chalk": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/chalk/-/chalk-1.1.3.tgz", - "integrity": "sha1-qBFcVeSnAv5NFQq9OHKCKn4J/Jg=", + "integrity": "sha512-U3lRVLMSlsCfjqYPbLyVv11M9CPW4I728d6TCKMAOJueEeB9/8o+eSsMnxPJD+Q+K909sdESg7C+tIkoH6on1A==", "requires": { "ansi-styles": "^2.2.1", "escape-string-regexp": "^1.0.2", @@ -174,7 +4306,7 @@ "cheerio": { "version": "0.22.0", "resolved": "https://registry.npmjs.org/cheerio/-/cheerio-0.22.0.tgz", - "integrity": "sha1-qbqoYKP5tZWmuBsahocxIe06Jp4=", + "integrity": "sha512-8/MzidM6G/TgRelkzDG13y3Y9LxBjCb+8yOEZ9+wwq5gVF2w2pV0wmHvjfT0RvuxGyR7UEuK36r+yYMbT4uKgA==", "requires": { "css-select": "~1.2.0", "dom-serializer": "~0.1.0", @@ -194,33 +4326,33 @@ "lodash.some": "^4.4.0" }, "dependencies": { - "entities": { - "version": "1.1.2", - "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", - "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" - }, "lodash.defaults": { "version": "4.2.0", "resolved": "https://registry.npmjs.org/lodash.defaults/-/lodash.defaults-4.2.0.tgz", - "integrity": "sha1-0JF4cW/+pN3p5ft7N/bwgCJ0WAw=" + "integrity": "sha512-qjxPLHd3r5DnsdGacqOMU6pb/avJzdh9tFX2ymgoZE27BmjXrNy/y4LoaiTeAb+O3gL8AfpJGtqfX/ae2leYYQ==" }, "lodash.foreach": { "version": "4.5.0", "resolved": "https://registry.npmjs.org/lodash.foreach/-/lodash.foreach-4.5.0.tgz", - "integrity": "sha1-Gmo16s5AEoDH8G3d7DUWWrJ+PlM=" + "integrity": "sha512-aEXTF4d+m05rVOAUG3z4vZZ4xVexLKZGF0lIxuHZ1Hplpk/3B6Z1+/ICICYRLm7c41Z2xiejbkCkJoTlypoXhQ==" } } }, "cliui": { "version": "2.1.0", "resolved": "https://registry.npmjs.org/cliui/-/cliui-2.1.0.tgz", - "integrity": "sha1-S0dXYP+AJkx2LDoXGQMukcf+oNE=", + "integrity": "sha512-GIOYRizG+TGoc7Wgc1LiOTLare95R3mzKgoln+Q/lE4ceiYH19gUpl0l0Ffq4lJDEf3FxujMe6IBfOCs7pfqNA==", "requires": { "center-align": "^0.1.1", "right-align": "^0.1.1", "wordwrap": "0.0.2" } }, + "clsx": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/clsx/-/clsx-1.2.1.tgz", + "integrity": "sha512-EcR6r5a8bj6pu3ycsa/E/cKVGuTgZJZdsyUYHOksG/UHIiKfjxzRxYJpyVBwYaQeOvghal9fcc4PidlgzugAQg==" + }, "coa": { "version": "2.0.2", "resolved": "https://registry.npmjs.org/coa/-/coa-2.0.2.tgz", @@ -260,17 +4392,16 @@ } }, "codemirror": { - "version": "5.60.0", - "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.60.0.tgz", - "integrity": "sha512-AEL7LhFOlxPlCL8IdTcJDblJm8yrAGib7I+DErJPdZd4l6imx8IMgKK3RblVgBQqz3TZJR4oknQ03bz+uNjBYA==" + "version": "5.65.13", + "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.65.13.tgz", + "integrity": "sha512-SVWEzKXmbHmTQQWaz03Shrh4nybG0wXx2MEu3FO4ezbPW8IbnZEd5iGHGEffSUaitKYa3i+pHpBsSvw8sPHtzg==" }, "codemirror-graphql": { - "version": "1.0.1", - "resolved": "https://registry.npmjs.org/codemirror-graphql/-/codemirror-graphql-1.0.1.tgz", - "integrity": "sha512-5ttMpv2kMn99Rmf2aZ5P6/hMd3y11cN8LP/x5MUeF0ipcalZA/GE/OxxXkhV0YJE/uW5QIcPyZDkvtSsGZa23A==", + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/codemirror-graphql/-/codemirror-graphql-2.0.6.tgz", + "integrity": "sha512-ZuvT4+iBYabyLWaqVHdsGyiB2atvu0v1eSnGUuziX7x7tJmo5WziZGvc2j6w6EnL5aUjvYnJU0aCBhTgCdzJVg==", "requires": { - "graphql-language-service-interface": "^2.8.2", - "graphql-language-service-parser": "^1.9.0" + "graphql-language-service": "5.1.4" } }, "color-convert": { @@ -284,7 +4415,7 @@ "color-name": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.3.tgz", - "integrity": "sha1-p9BVi9icQveV3UIyj3QIMcpTvCU=" + "integrity": "sha512-72fSenhMw2HZMTVHeCA9KCmpEIbzWiQsjN+BHcBbS9vr1mtt+vJjPdksIBNUmKAW8TFUDPJK5SUU3QhE9NEXDw==" }, "combined-stream": { "version": "1.0.8", @@ -297,7 +4428,7 @@ "configstore": { "version": "1.4.0", "resolved": "https://registry.npmjs.org/configstore/-/configstore-1.4.0.tgz", - "integrity": "sha1-w1eB0FAdJowlxUuLF/YkDopPsCE=", + "integrity": "sha512-Zcx2SVdZC06IuRHd2MhkVYFNJBkZBj166LGdsJXRcqNC8Gs5Bwh8mosStNeCBBmtIm4wNii2uarD50qztjKOjw==", "requires": { "graceful-fs": "^4.1.2", "mkdirp": "^0.5.0", @@ -312,14 +4443,14 @@ "uuid": { "version": "2.0.3", "resolved": "https://registry.npmjs.org/uuid/-/uuid-2.0.3.tgz", - "integrity": "sha1-Z+LoY3lyFVMN/zGOW/nc6/1Hsho=" + "integrity": "sha512-FULf7fayPdpASncVy4DLh3xydlXEJJpvIELjYjNeQWYUZ9pclcpvCZSr2gkmN2FrrGcI7G/cJsIEwk5/8vfXpg==" } } }, "copy-to-clipboard": { - "version": "3.3.1", - "resolved": "https://registry.npmjs.org/copy-to-clipboard/-/copy-to-clipboard-3.3.1.tgz", - "integrity": "sha512-i13qo6kIHTTpCm8/Wup+0b1mVWETvu2kIMzKoK8FpkLkFxlt0znUAHcMzox+T8sPlqtZXq3CulEjQHsYiGFJUw==", + "version": "3.3.3", + "resolved": "https://registry.npmjs.org/copy-to-clipboard/-/copy-to-clipboard-3.3.3.tgz", + "integrity": "sha512-2KV8NhB5JqC3ky0r9PMCAZKbUHSwtEo4CwCs0KXgruG43gX5PMqDEBbVU4OUzw2MuAWUfsuFmWvEKG5QRfSnJA==", "requires": { "toggle-selection": "^1.0.6" } @@ -327,12 +4458,12 @@ "core-util-is": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.2.tgz", - "integrity": "sha1-tf1UIgqivFq1eqtxQMlAdUUDwac=" + "integrity": "sha512-3lqz5YjWTYnW6dlDa5TLaTCcShfar1e40rmcJVwCBJC6mWlFuj0eCHIElmG1g5kyuJ/GD+8Wn4FFCcz4gJPfaQ==" }, "css-select": { "version": "1.2.0", "resolved": "https://registry.npmjs.org/css-select/-/css-select-1.2.0.tgz", - "integrity": "sha1-KzoRBTnFNV8c2NMUYj6HCxIeyFg=", + "integrity": "sha512-dUQOBoqdR7QwV90WysXPLXG5LO7nhYBgiWVfxF80DKPF8zx1t/pUd2FYy73emg3zrjtM6dzmYgbHKfV2rxiHQA==", "requires": { "boolbase": "~1.0.0", "css-what": "2.1", @@ -386,7 +4517,7 @@ "dashdash": { "version": "1.14.1", "resolved": "https://registry.npmjs.org/dashdash/-/dashdash-1.14.1.tgz", - "integrity": "sha1-hTz6D3y+L+1d4gMmuN1YEDX24vA=", + "integrity": "sha512-jRFi8UDGo6j+odZiEpjazZaWqEal3w/basFjQHQEwVtZJGDpxbH1MeYluwCS8Xq5wmLJooDlMgvVarmWfGM44g==", "requires": { "assert-plus": "^1.0.0" } @@ -402,7 +4533,7 @@ "decamelize": { "version": "1.2.0", "resolved": "https://registry.npmjs.org/decamelize/-/decamelize-1.2.0.tgz", - "integrity": "sha1-9lNNFRSCabIDUue+4m9QH5oZEpA=" + "integrity": "sha512-z2S+W9X73hAUUki+N+9Za2lBlun89zigOyGrsax+KUQ6wKW4ZoWpEYBkGhQjwAjjDCkWxhY0VKEhk8wzY7F5cA==" }, "deep-extend": { "version": "0.6.0", @@ -410,17 +4541,23 @@ "integrity": "sha512-LOHxIOaPYdHlJRtCQfDIVZtfw/ufM8+rVj649RIHzcm/vGwQRXFt6OPqIFWsm2XEMrNIEtWR64sY1LEKD2vAOA==" }, "define-properties": { - "version": "1.1.3", - "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.1.3.tgz", - "integrity": "sha512-3MqfYKj2lLzdMSf8ZIZE/V+Zuy+BgD6f164e8K2w7dgnpKArBDerGYpM46IYYcjnkdPNMjPk9A6VFB8+3SKlXQ==", + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.2.0.tgz", + "integrity": "sha512-xvqAVKGfT1+UAvPwKTVw/njhdQ8ZhXK4lI0bCIuCMrp2up9nPnaDftrLtmpTazqd1o+UY4zgzU+avtMbDP+ldA==", "requires": { - "object-keys": "^1.0.12" + "has-property-descriptors": "^1.0.0", + "object-keys": "^1.1.1" } }, "delayed-stream": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz", - "integrity": "sha1-3zrhmayt+31ECqrgsp4icrJOxhk=" + "integrity": "sha512-ZySD7Nf91aLB0RxL4KGrKHBXl7Eds1DAmEdcoVawXnLD7SDhpNgtuII2aAkg7a7QS41jxPSZ17p4VdGnMHk3MQ==" + }, + "detect-node-es": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/detect-node-es/-/detect-node-es-1.1.0.tgz", + "integrity": "sha512-ypdmJU/TbBby2Dxibuv7ZLW3Bs1QEmM7nHjEANfohJLvE0XVujisn1qPJcZxg+qDucsr+bP6fLD1rPS3AhJ7EQ==" }, "dom-serializer": { "version": "0.1.1", @@ -429,13 +4566,6 @@ "requires": { "domelementtype": "^1.3.0", "entities": "^1.1.1" - }, - "dependencies": { - "entities": { - "version": "1.1.2", - "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", - "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" - } } }, "domelementtype": { @@ -454,17 +4584,12 @@ "domutils": { "version": "1.5.1", "resolved": "https://registry.npmjs.org/domutils/-/domutils-1.5.1.tgz", - "integrity": "sha1-3NhIiib1Y9YQeeSMn3t+Mjc2gs8=", + "integrity": "sha512-gSu5Oi/I+3wDENBsOWBiRK1eoGxcywYSqg3rR960/+EfY0CF4EX1VPkgHOZ3WiS/Jg2DtliF6BhWcHlfpYUcGw==", "requires": { "dom-serializer": "0", "domelementtype": "1" } }, - "dset": { - "version": "3.1.0", - "resolved": "https://registry.npmjs.org/dset/-/dset-3.1.0.tgz", - "integrity": "sha512-7xTQ5DzyE59Nn+7ZgXDXjKAGSGmXZHqttMVVz1r4QNfmGpyj+cm2YtI3II0c/+4zS4a9yq2mBhgdeq2QnpcYlw==" - }, "duplexify": { "version": "3.7.1", "resolved": "https://registry.npmjs.org/duplexify/-/duplexify-3.7.1.tgz", @@ -476,10 +4601,15 @@ "stream-shift": "^1.0.0" }, "dependencies": { + "isarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", + "integrity": "sha512-VLghIWNM6ELQzo7zwmcg0NmTVyWKYjvIeM83yjp0wRDTmUnrM678fQbcKBo6n2CJEF0szoG//ytg+TKla89ALQ==" + }, "readable-stream": { - "version": "2.3.7", - "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.7.tgz", - "integrity": "sha512-Ebho8K4jIbHAxnuxi7o42OrZgF/ZTNcsZj6nRKyUmkhLFq8CHItp/fy6hQZuZmP/n3yZ9VBUbp4zz/mX8hmYPw==", + "version": "2.3.8", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz", + "integrity": "sha512-8p0AUk4XODgIewSi0l8Epjs+EVnWiK7NoDIEGU0HhE7+ZyY8D1IMY7odu5lRrFXGg71L15KG8QrPmum45RTtdA==", "requires": { "core-util-is": "~1.0.0", "inherits": "~2.0.3", @@ -508,7 +4638,7 @@ "ecc-jsbn": { "version": "0.1.2", "resolved": "https://registry.npmjs.org/ecc-jsbn/-/ecc-jsbn-0.1.2.tgz", - "integrity": "sha1-OoOpBOVDUyh4dMVkt1SThoSamMk=", + "integrity": "sha512-eh9O+hwRHNbG4BLTjEl3nw044CkGm5X6LoaCf7LPp7UU8Qrt47JYNi6nPX8xjW97TKGKm1ouctg0QSpZe9qrnw==", "requires": { "jsbn": "~0.1.0", "safer-buffer": "^2.1.0" @@ -523,31 +4653,64 @@ } }, "entities": { - "version": "2.2.0", - "resolved": "https://registry.npmjs.org/entities/-/entities-2.2.0.tgz", - "integrity": "sha512-p92if5Nz619I0w+akJrLZH0MX0Pb5DX39XOwQTtXSdQQOaYH03S1uIQp4mhOZtAXrxq4ViO67YTiLBo2638o9A==" + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", + "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" }, "es-abstract": { - "version": "1.18.0", - "resolved": "https://registry.npmjs.org/es-abstract/-/es-abstract-1.18.0.tgz", - "integrity": "sha512-LJzK7MrQa8TS0ja2w3YNLzUgJCGPdPOV1yVvezjNnS89D+VR08+Szt2mz3YB2Dck/+w5tfIq/RoUAFqJJGM2yw==", + "version": "1.21.2", + "resolved": "https://registry.npmjs.org/es-abstract/-/es-abstract-1.21.2.tgz", + "integrity": "sha512-y/B5POM2iBnIxCiernH1G7rC9qQoM77lLIMQLuob0zhp8C56Po81+2Nj0WFKnd0pNReDTnkYryc+zhOzpEIROg==", "requires": { + "array-buffer-byte-length": "^1.0.0", + "available-typed-arrays": "^1.0.5", "call-bind": "^1.0.2", + "es-set-tostringtag": "^2.0.1", "es-to-primitive": "^1.2.1", - "function-bind": "^1.1.1", - "get-intrinsic": "^1.1.1", + "function.prototype.name": "^1.1.5", + "get-intrinsic": "^1.2.0", + "get-symbol-description": "^1.0.0", + "globalthis": "^1.0.3", + "gopd": "^1.0.1", "has": "^1.0.3", - "has-symbols": "^1.0.2", - "is-callable": "^1.2.3", - "is-negative-zero": "^2.0.1", - "is-regex": "^1.1.2", - "is-string": "^1.0.5", - "object-inspect": "^1.9.0", + "has-property-descriptors": "^1.0.0", + "has-proto": "^1.0.1", + "has-symbols": "^1.0.3", + "internal-slot": "^1.0.5", + "is-array-buffer": "^3.0.2", + "is-callable": "^1.2.7", + "is-negative-zero": "^2.0.2", + "is-regex": "^1.1.4", + "is-shared-array-buffer": "^1.0.2", + "is-string": "^1.0.7", + "is-typed-array": "^1.1.10", + "is-weakref": "^1.0.2", + "object-inspect": "^1.12.3", "object-keys": "^1.1.1", - "object.assign": "^4.1.2", - "string.prototype.trimend": "^1.0.4", - "string.prototype.trimstart": "^1.0.4", - "unbox-primitive": "^1.0.0" + "object.assign": "^4.1.4", + "regexp.prototype.flags": "^1.4.3", + "safe-regex-test": "^1.0.0", + "string.prototype.trim": "^1.2.7", + "string.prototype.trimend": "^1.0.6", + "string.prototype.trimstart": "^1.0.6", + "typed-array-length": "^1.0.4", + "unbox-primitive": "^1.0.2", + "which-typed-array": "^1.1.9" + } + }, + "es-array-method-boxes-properly": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/es-array-method-boxes-properly/-/es-array-method-boxes-properly-1.0.0.tgz", + "integrity": "sha512-wd6JXUmyHmt8T5a2xreUwKcGPq6f1f+WwIJkijUqiGcJz1qqnZgP6XIK+QyIWU5lT7imeNxUll48bziG+TSYcA==" + }, + "es-set-tostringtag": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/es-set-tostringtag/-/es-set-tostringtag-2.0.1.tgz", + "integrity": "sha512-g3OMbtlwY3QewlqAiMLI47KywjWZoEytKr8pf6iTC8uJq5bIAH52Z9pnQ8pVL6whrCto53JZDuUIsifGeLorTg==", + "requires": { + "get-intrinsic": "^1.1.3", + "has": "^1.0.3", + "has-tostringtag": "^1.0.0" } }, "es-to-primitive": { @@ -563,24 +4726,18 @@ "es6-promise": { "version": "2.3.0", "resolved": "https://registry.npmjs.org/es6-promise/-/es6-promise-2.3.0.tgz", - "integrity": "sha1-lu258v2wGZWCKyY92KratnSBgbw=" + "integrity": "sha512-oyOjMhyKMLEjOOtvkwg0G4pAzLQ9WdbbeX7WdqKzvYXu+UFgD0Zo/Brq5Q49zNmnGPPzV5rmYvrr0jz1zWx8Iw==" }, "escape-string-regexp": { "version": "1.0.5", "resolved": "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-1.0.5.tgz", - "integrity": "sha1-G2HAViGQqN/2rjuyzwIAyhMLhtQ=" + "integrity": "sha512-vbRorB5FUQWvla16U8R/qgaFIya2qGzwDrNmCZuYKrbdSUMG6I1ZCGQRefkRVhuOkIGVne7BQ35DSfo1qvJqFg==" }, "esprima": { "version": "4.0.1", "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==" }, - "eventemitter3": { - "version": "3.1.2", - "resolved": "https://registry.npmjs.org/eventemitter3/-/eventemitter3-3.1.2.tgz", - "integrity": "sha512-tvtQIeLVHjDkJYnzf2dgVMxfuSGJeM/7UCG17TT4EumTfNtF+0nebF/4zWOIkCreAbtNqhGEboB6BWrwqNaw4Q==", - "optional": true - }, "extend": { "version": "3.0.2", "resolved": "https://registry.npmjs.org/extend/-/extend-3.0.2.tgz", @@ -589,7 +4746,7 @@ "extsprintf": { "version": "1.3.0", "resolved": "https://registry.npmjs.org/extsprintf/-/extsprintf-1.3.0.tgz", - "integrity": "sha1-lpGEQOMEGnpBT4xS48V06zw+HgU=" + "integrity": "sha512-11Ndz7Nv+mvAC1j0ktTa7fAb0vLyGGX+rMHNBYQviQDGU0Hw7lhctJANqbPhu9nV9/izT/IntTgZ7Im/9LJs9g==" }, "fast-deep-equal": { "version": "3.1.3", @@ -601,10 +4758,26 @@ "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" }, + "focus-lock": { + "version": "0.11.6", + "resolved": "https://registry.npmjs.org/focus-lock/-/focus-lock-0.11.6.tgz", + "integrity": "sha512-KSuV3ur4gf2KqMNoZx3nXNVhqCkn42GuTYCX4tXPEwf0MjpFQmNMiN6m7dXaUXgIoivL6/65agoUMg4RLS0Vbg==", + "requires": { + "tslib": "^2.0.3" + } + }, + "for-each": { + "version": "0.3.3", + "resolved": "https://registry.npmjs.org/for-each/-/for-each-0.3.3.tgz", + "integrity": "sha512-jqYfLp7mo9vIyQf8ykW2v7A+2N4QjeCeI5+Dz9XraiO1ign81wjiH7Fb9vSOWvQfNtmSa4H2RoQTrrXivdUZmw==", + "requires": { + "is-callable": "^1.1.3" + } + }, "forever-agent": { "version": "0.6.1", "resolved": "https://registry.npmjs.org/forever-agent/-/forever-agent-0.6.1.tgz", - "integrity": "sha1-+8cfDEGt6zf5bFd60e1C2P2sypE=" + "integrity": "sha512-j0KLYPhm6zeac4lz3oJ3o65qvgQCcPubiyotZrXqEaG4hNagNYO8qdlUrX5vwqv9ohqeT/Z3j6+yW067yWWdUw==" }, "form-data": { "version": "2.3.3", @@ -621,28 +4794,74 @@ "resolved": "https://registry.npmjs.org/function-bind/-/function-bind-1.1.1.tgz", "integrity": "sha512-yIovAzMX49sF8Yl58fSCWJ5svSLuaibPxXQJFLmBObTuCr0Mf1KiPopGM9NiFjiYBCbfaa2Fh6breQ6ANVTI0A==" }, + "function.prototype.name": { + "version": "1.1.5", + "resolved": "https://registry.npmjs.org/function.prototype.name/-/function.prototype.name-1.1.5.tgz", + "integrity": "sha512-uN7m/BzVKQnCUF/iW8jYea67v++2u7m5UgENbHRtdDVclOUP+FMPlCNdmk0h/ysGyo2tavMJEDqJAkJdRa1vMA==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3", + "es-abstract": "^1.19.0", + "functions-have-names": "^1.2.2" + } + }, + "functions-have-names": { + "version": "1.2.3", + "resolved": "https://registry.npmjs.org/functions-have-names/-/functions-have-names-1.2.3.tgz", + "integrity": "sha512-xckBUXyTIqT97tq2x2AMb+g163b5JFysYk0x4qxNFwbfQkmNZoiRHb6sPzI9/QV33WeuvVYBUIiD4NzNIyqaRQ==" + }, "get-intrinsic": { - "version": "1.1.1", - "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.1.1.tgz", - "integrity": "sha512-kWZrnVM42QCiEA2Ig1bG8zjoIMOgxWwYCEeNdwY6Tv/cOSeGpcoX4pXHfKUxNKVoArnrEr2e9srnAxxGIraS9Q==", + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.2.0.tgz", + "integrity": "sha512-L049y6nFOuom5wGyRc3/gdTLO94dySVKRACj1RmJZBQXlbTMhtNIgkWkUHq+jYmZvKf14EW1EoJnnjbmoHij0Q==", "requires": { "function-bind": "^1.1.1", "has": "^1.0.3", - "has-symbols": "^1.0.1" + "has-symbols": "^1.0.3" + } + }, + "get-nonce": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/get-nonce/-/get-nonce-1.0.1.tgz", + "integrity": "sha512-FJhYRoDaiatfEkUK8HKlicmu/3SGFD51q3itKDGoSTysQJBnfOcxU5GxnhE1E6soB76MbT0MBtnKJuXyAx+96Q==" + }, + "get-symbol-description": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/get-symbol-description/-/get-symbol-description-1.0.0.tgz", + "integrity": "sha512-2EmdH1YvIQiZpltCNgkuiUnyukzxM/R6NDJX31Ke3BG1Nq5b0S2PhX59UKi9vZpPDQVdqn+1IcaAwnzTT5vCjw==", + "requires": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.1.1" } }, "getpass": { "version": "0.1.7", "resolved": "https://registry.npmjs.org/getpass/-/getpass-0.1.7.tgz", - "integrity": "sha1-Xv+OPmhNVprkyysSgmBOi6YhSfo=", + "integrity": "sha512-0fzj9JxOLfJ+XGLhR8ze3unN0KZCgZwiSSDz168VERjK8Wl8kVSdcu2kspd4s4wtAa1y/qrVRiAA0WclVsu0ng==", "requires": { "assert-plus": "^1.0.0" } }, + "globalthis": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/globalthis/-/globalthis-1.0.3.tgz", + "integrity": "sha512-sFdI5LyBiNTHjRd7cGPWapiHWMOXKyuBNX/cWJ3NfzrZQVa8GI/8cofCl74AOVqq9W5kNmguTIzJ/1s2gyI9wA==", + "requires": { + "define-properties": "^1.1.3" + } + }, + "gopd": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/gopd/-/gopd-1.0.1.tgz", + "integrity": "sha512-d65bNlIadxvpb/A2abVdlqKqV563juRnZ1Wtk6s1sIR8uNsXR70xqIzVqxVf1eTqDunwT2MkczEeaezCKTZhwA==", + "requires": { + "get-intrinsic": "^1.1.3" + } + }, "got": { "version": "3.3.1", "resolved": "https://registry.npmjs.org/got/-/got-3.3.1.tgz", - "integrity": "sha1-5dDtSvVfw+701WAHdp2YGSvLLso=", + "integrity": "sha512-7chPlc0pWHjvq7B6dEEXz4GphoDupOvBSSl6AwRsAJX7GPTZ+bturaZiIigX4Dp6KrAP67nvzuKkNc0SLA0DKg==", "requires": { "duplexify": "^3.2.0", "infinity-agent": "^2.0.0", @@ -659,86 +4878,44 @@ "object-assign": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-3.0.0.tgz", - "integrity": "sha1-m+3VygiXlJvKR+f/QIBi1Un1h/I=" + "integrity": "sha512-jHP15vXVGeVh1HuaA2wY6lxk+whK/x4KBG88VXeRma7CCun7iGD5qPc4eYykQ9sdQvg8jkwFKsSxHln2ybW3xQ==" } } }, "graceful-fs": { - "version": "4.2.6", - "resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.6.tgz", - "integrity": "sha512-nTnJ528pbqxYanhpDYsi4Rd8MAeaBA67+RZ10CM1m3bTAVFEDcd5AuA4a6W5YkGZ1iNXHzZz8T6TBKLeBuNriQ==" + "version": "4.2.11", + "resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.11.tgz", + "integrity": "sha512-RbJ5/jmFcNNCcDV5o9eTnBLJ/HszWV0P73bc+Ff4nS/rJj+YaS6IGyiOL0VoBYX+l1Wrl3k63h/KrH+nhJ0XvQ==" }, "graphiql": { - "version": "1.4.1", - "resolved": "https://registry.npmjs.org/graphiql/-/graphiql-1.4.1.tgz", - "integrity": "sha512-C7S36lTgCw2/C/Dt90eJSI9VdxQfohrUoDV1dt/WecS7dm5HcaQUIYFqvLQMZG1cSRJttRKwNwP1rYfs73v8SQ==", + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/graphiql/-/graphiql-2.4.2.tgz", + "integrity": "sha512-oQ1zJAVpOqajKH1oc5WzNIK1FNUI2m8tPgyEeA22ySmR79+/k27FlG4YxRXQOstlWeVcag0FZaqG5VyR6Nc1iw==", "requires": { - "@graphiql/toolkit": "^0.2.0", - "codemirror": "^5.54.0", - "codemirror-graphql": "^1.0.0", - "copy-to-clipboard": "^3.2.0", - "dset": "^3.1.0", - "entities": "^2.0.0", - "graphql-language-service": "^3.1.2", - "markdown-it": "^10.0.0" + "@graphiql/react": "^0.17.2", + "@graphiql/toolkit": "^0.8.4", + "graphql-language-service": "^5.1.4", + "markdown-it": "^12.2.0" } }, "graphql": { - "version": "15.5.0", - "resolved": "https://registry.npmjs.org/graphql/-/graphql-15.5.0.tgz", - "integrity": "sha512-OmaM7y0kaK31NKG31q4YbD2beNYa6jBBKtMFT6gLYJljHLJr42IqJ8KX08u3Li/0ifzTU5HjmoOOrwa5BRLeDA==" + "version": "16.6.0", + "resolved": "https://registry.npmjs.org/graphql/-/graphql-16.6.0.tgz", + "integrity": "sha512-KPIBPDlW7NxrbT/eh4qPXz5FiFdL5UbaA0XUNz2Rp3Z3hqBSkbj0GVjwFDztsWVauZUWsbKHgMg++sk8UX0bkw==" }, "graphql-language-service": { - "version": "3.1.3", - "resolved": "https://registry.npmjs.org/graphql-language-service/-/graphql-language-service-3.1.3.tgz", - "integrity": "sha512-MTJT8QOpsJbG68wbkrmitlctvaajrQkJEN24AW+KzNxHWFEHnnqil6fFbVccHkRbG3Bk7D0f57fjtffSh37aEw==", - "requires": { - "graphql-language-service-interface": "^2.8.2", - "graphql-language-service-types": "^1.8.0" - } - }, - "graphql-language-service-interface": { - "version": "2.8.3", - "resolved": "https://registry.npmjs.org/graphql-language-service-interface/-/graphql-language-service-interface-2.8.3.tgz", - "integrity": "sha512-Gh4Q3dlCT1MrZGO0eaz7v31gkp8fh+ig94YH/A+1Th2q+k3RsRqfSJm5tKZ8TJ4rSADZ/dj+hzOpWCGzLyCiHQ==", - "requires": { - "graphql-language-service-parser": "^1.9.0", - "graphql-language-service-types": "^1.8.0", - "graphql-language-service-utils": "^2.5.1", - "vscode-languageserver-types": "^3.15.1" - } - }, - "graphql-language-service-parser": { - "version": "1.9.1", - "resolved": "https://registry.npmjs.org/graphql-language-service-parser/-/graphql-language-service-parser-1.9.1.tgz", - "integrity": "sha512-GySsDrYxzxu6r1vF282xXDR2KlfVL5aOW7pgc75fF3UFiuqGm/SeoIljNM0mLpRl5KSxo1HNOxhkWoFBoy/h2w==", - "requires": { - "graphql-language-service-types": "^1.8.0" - } - }, - "graphql-language-service-types": { - "version": "1.8.1", - "resolved": "https://registry.npmjs.org/graphql-language-service-types/-/graphql-language-service-types-1.8.1.tgz", - "integrity": "sha512-IpYS0mEHEmRsFlq+loWCpSYYYizAID7Alri6GoFN1QqUdux+8rp1Tkp2NGsGDpDmm3Dbz5ojmJWzNWQGpuwveA==" - }, - "graphql-language-service-utils": { - "version": "2.5.2", - "resolved": "https://registry.npmjs.org/graphql-language-service-utils/-/graphql-language-service-utils-2.5.2.tgz", - "integrity": "sha512-hXGd4ARhyD7WTmTwuYmCYo6BcY8FtTp+1JHLaUG0Q63k0NpZTuFuRZ+N7TSP9mcRb7labeozs3DYgaqStsDe1A==", + "version": "5.1.4", + "resolved": "https://registry.npmjs.org/graphql-language-service/-/graphql-language-service-5.1.4.tgz", + "integrity": "sha512-i6cYIDL8dFd6e9LqpRFJRoVa+MZ/egMzUERsZlK65S/M7ra9SxKrZuclKgmPOq0KqHypInsEaI4D7dN5a+yEAA==", "requires": { - "graphql-language-service-types": "^1.8.0", - "nullthrows": "^1.0.0" + "nullthrows": "^1.0.0", + "vscode-languageserver-types": "^3.17.1" } }, - "graphql-ws": { - "version": "4.4.1", - "resolved": "https://registry.npmjs.org/graphql-ws/-/graphql-ws-4.4.1.tgz", - "integrity": "sha512-kHgDohfRQFDdzXzLqsV4wZM141sO1ukaXW/RSLlmIUsxT4N3r/4eQYTbkeLd4yRXaDkmv/rYf1EHL09Y5KO+Uw==" - }, "har-schema": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/har-schema/-/har-schema-2.0.0.tgz", - "integrity": "sha1-qUwiJOvKwEeCoNkDVSHyRzW37JI=" + "integrity": "sha512-Oqluz6zhGX8cyRaTQlFMPw80bSJVG2x/cFb8ZPhUILGgHka9SsokCCOQgpveePerqidZOrT14ipqfJb7ILcW5Q==" }, "har-validator": { "version": "5.1.5", @@ -760,25 +4937,46 @@ "has-ansi": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/has-ansi/-/has-ansi-2.0.0.tgz", - "integrity": "sha1-NPUEnOHs3ysGSa8+8k5F7TVBbZE=", + "integrity": "sha512-C8vBJ8DwUCx19vhm7urhTuUsr4/IyP6l4VzNQDv+ryHQObW3TTTp9yB68WpYgRe2bbaGuZ/se74IqFeVnMnLZg==", "requires": { "ansi-regex": "^2.0.0" } }, "has-bigints": { - "version": "1.0.1", - "resolved": "https://registry.npmjs.org/has-bigints/-/has-bigints-1.0.1.tgz", - "integrity": "sha512-LSBS2LjbNBTf6287JEbEzvJgftkF5qFkmCo9hDRpAzKhUOlJ+hx8dd4USs00SgsUNwc4617J9ki5YtEClM2ffA==" + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/has-bigints/-/has-bigints-1.0.2.tgz", + "integrity": "sha512-tSvCKtBr9lkF0Ex0aQiP9N+OpV4zi2r/Nee5VkRDbaqv35RLYMzbwQfFSZZH0kR+Rd6302UJZ2p/bJCEoR3VoQ==" }, "has-flag": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-3.0.0.tgz", - "integrity": "sha1-tdRU3CGZriJWmfNGfloH87lVuv0=" + "integrity": "sha512-sKJf1+ceQBr4SMkvQnBDNDtf4TXpVhVGateu0t918bl30FnbE2m4vNLX+VWe/dpjlb+HugGYzW7uQXH98HPEYw==" + }, + "has-property-descriptors": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-property-descriptors/-/has-property-descriptors-1.0.0.tgz", + "integrity": "sha512-62DVLZGoiEBDHQyqG4w9xCuZ7eJEwNmJRWw2VY84Oedb7WFcA27fiEVe8oUQx9hAUJ4ekurquucTGwsyO1XGdQ==", + "requires": { + "get-intrinsic": "^1.1.1" + } + }, + "has-proto": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/has-proto/-/has-proto-1.0.1.tgz", + "integrity": "sha512-7qE+iP+O+bgF9clE5+UoBFzE65mlBiVj3tKCrlNQ0Ogwm0BjpT/gK4SlLYDMybDh5I3TCTKnPPa0oMG7JDYrhg==" }, "has-symbols": { - "version": "1.0.2", - "resolved": "https://registry.npmjs.org/has-symbols/-/has-symbols-1.0.2.tgz", - "integrity": "sha512-chXa79rL/UC2KlX17jo3vRGz0azaWEx5tGqZg5pO3NUyEJVB17dMruQlzCCOfUvElghKcm5194+BCRvi2Rv/Gw==" + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/has-symbols/-/has-symbols-1.0.3.tgz", + "integrity": "sha512-l3LCuF6MgDNwTDKkdYGEihYjt5pRPbEg46rtlmnSPlUbgmB8LOIrKJbYYFBSbnPaJexMKtiPO8hmeRjRz2Td+A==" + }, + "has-tostringtag": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-tostringtag/-/has-tostringtag-1.0.0.tgz", + "integrity": "sha512-kFjcSNhnlGV1kyoGk7OXKSawH5JOb/LzUc5w9B02hOTO0dfFRjbHQKvg1d6cf3HbeUmtU9VbbV3qzZ2Teh97WQ==", + "requires": { + "has-symbols": "^1.0.2" + } }, "htmlparser2": { "version": "3.10.1", @@ -791,19 +4989,12 @@ "entities": "^1.1.1", "inherits": "^2.0.1", "readable-stream": "^3.1.1" - }, - "dependencies": { - "entities": { - "version": "1.1.2", - "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", - "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" - } } }, "http-signature": { "version": "1.2.0", "resolved": "https://registry.npmjs.org/http-signature/-/http-signature-1.2.0.tgz", - "integrity": "sha1-muzZJRFHcvPZW2WmCruPfBj7rOE=", + "integrity": "sha512-CAbnr6Rz4CYQkLYUtSNXxQPUH2gK8f3iWexVlsnMeD+GjlsQ0Xsy1cOX+mN3dtxYomRy21CiOzU8Uhw6OwncEQ==", "requires": { "assert-plus": "^1.0.0", "jsprim": "^1.2.2", @@ -821,12 +5012,12 @@ "imurmurhash": { "version": "0.1.4", "resolved": "https://registry.npmjs.org/imurmurhash/-/imurmurhash-0.1.4.tgz", - "integrity": "sha1-khi5srkoojixPcT7a21XbyMUU+o=" + "integrity": "sha512-JmXMZ6wuvDmLiHEml9ykzqO6lwFbof0GG4IkcGaENdCRDDmMVnny7s5HsIgHCbaq0w2MyPhDqkhTUgS2LU2PHA==" }, "infinity-agent": { "version": "2.0.3", "resolved": "https://registry.npmjs.org/infinity-agent/-/infinity-agent-2.0.3.tgz", - "integrity": "sha1-ReDi/3qesDCyfWK3SzdEt6esQhY=" + "integrity": "sha512-CnfUJe5o2S9aAQWXGMhDZI4UL39MAJV3guOTfHHIdos4tuVHkl1j/J+1XLQn+CLIvqcpgQR/p+xXYXzcrhCe5w==" }, "inherits": { "version": "2.0.4", @@ -839,8 +5030,8 @@ "integrity": "sha512-JV/yugV2uzW5iMRSiZAyDtQd+nxtUnjeLt0acNdw98kKLrvuRVyB80tsREOE7yvGVgalhZ6RNXCmEHkUKBKxew==" }, "inliner": { - "version": "github:aantron/inliner#7f2efdbe24a6a085f633d456b97c970ac2c0ca8a", - "from": "github:aantron/inliner#fork", + "version": "git+ssh://git@github.com/aantron/inliner.git#7f2efdbe24a6a085f633d456b97c970ac2c0ca8a", + "from": "inliner@aantron/inliner#fork", "requires": { "ansi-escapes": "^1.4.0", "ansi-styles": "^2.2.1", @@ -863,17 +5054,49 @@ "update-notifier": "^0.5.0" } }, + "internal-slot": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/internal-slot/-/internal-slot-1.0.5.tgz", + "integrity": "sha512-Y+R5hJrzs52QCG2laLn4udYVnxsfny9CpOhNhUvk/SSSVyF6T27FzRbF0sroPidSu3X8oEAkOn2K804mjpt6UQ==", + "requires": { + "get-intrinsic": "^1.2.0", + "has": "^1.0.3", + "side-channel": "^1.0.4" + } + }, + "invariant": { + "version": "2.2.4", + "resolved": "https://registry.npmjs.org/invariant/-/invariant-2.2.4.tgz", + "integrity": "sha512-phJfQVBuaJM5raOpJjSfkiD6BpbCE4Ns//LaXl6wGYtUBY83nWS6Rf9tXm2e8VaK60JEjYldbPif/A2B1C2gNA==", + "requires": { + "loose-envify": "^1.0.0" + } + }, + "is-array-buffer": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/is-array-buffer/-/is-array-buffer-3.0.2.tgz", + "integrity": "sha512-y+FyyR/w8vfIRq4eQcM1EYgSTnmHXPqaF+IgzgraytCFq5Xh8lllDVmAZolPJiZttZLeFSINPYMaEJ7/vWUa1w==", + "requires": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.2.0", + "is-typed-array": "^1.1.10" + } + }, "is-bigint": { - "version": "1.0.2", - "resolved": "https://registry.npmjs.org/is-bigint/-/is-bigint-1.0.2.tgz", - "integrity": "sha512-0JV5+SOCQkIdzjBK9buARcV804Ddu7A0Qet6sHi3FimE9ne6m4BGQZfRn+NZiXbBk4F4XmHfDZIipLj9pX8dSA==" + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/is-bigint/-/is-bigint-1.0.4.tgz", + "integrity": "sha512-zB9CruMamjym81i2JZ3UMn54PKGsQzsJeo6xvN3HJJ4CAsQNB6iRutp2To77OfCNuoxspsIhzaPoO1zyCEhFOg==", + "requires": { + "has-bigints": "^1.0.1" + } }, "is-boolean-object": { - "version": "1.1.1", - "resolved": "https://registry.npmjs.org/is-boolean-object/-/is-boolean-object-1.1.1.tgz", - "integrity": "sha512-bXdQWkECBUIAcCkeH1unwJLIpZYaa5VvuygSyS/c2lf719mTKZDU5UdDRlpd01UjADgmW8RfqaP+mRaVPdr/Ng==", + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/is-boolean-object/-/is-boolean-object-1.1.2.tgz", + "integrity": "sha512-gDYaKHJmnj4aWxyj6YHyXVpdQawtVLHU5cb+eztPGczf6cjuTdwve5ZIEfgXqH4e57An1D1AKf8CZ3kYrQRqYA==", "requires": { - "call-bind": "^1.0.2" + "call-bind": "^1.0.2", + "has-tostringtag": "^1.0.0" } }, "is-buffer": { @@ -882,14 +5105,17 @@ "integrity": "sha512-NcdALwpXkTm5Zvvbk7owOUSvVvBKDgKP5/ewfXEznmQFfs4ZRmanOeKBTjRVjka3QFoN6XJ+9F3USqfHqTaU5w==" }, "is-callable": { - "version": "1.2.3", - "resolved": "https://registry.npmjs.org/is-callable/-/is-callable-1.2.3.tgz", - "integrity": "sha512-J1DcMe8UYTBSrKezuIUTUwjXsho29693unXM2YhJUTR2txK/eG47bvNa/wipPFmZFgr/N6f1GA66dv0mEyTIyQ==" + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/is-callable/-/is-callable-1.2.7.tgz", + "integrity": "sha512-1BC0BVFhS/p0qtw6enp8e+8OD0UrK0oFLztSjNzhcKA3WDuJxxAPXzPuPtKkjEY9UUoEWlX/8fgKeu2S8i9JTA==" }, "is-date-object": { - "version": "1.0.4", - "resolved": "https://registry.npmjs.org/is-date-object/-/is-date-object-1.0.4.tgz", - "integrity": "sha512-/b4ZVsG7Z5XVtIxs/h9W8nvfLgSAyKYdtGWQLbqy6jA1icmgjf8WCoTKgeS4wy5tYaPePouzFMANbnj94c2Z+A==" + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/is-date-object/-/is-date-object-1.0.5.tgz", + "integrity": "sha512-9YQaSxsAiSwcvS33MBk3wTCVnWK+HhF8VZR2jRxehM16QcVOdHqPn4VPHmRK4lSr38n9JriurInLcP90xsYNfQ==", + "requires": { + "has-tostringtag": "^1.0.0" + } }, "is-finite": { "version": "1.1.0", @@ -897,43 +5123,70 @@ "integrity": "sha512-cdyMtqX/BOqqNBBiKlIVkytNHm49MtMlYyn1zxzvJKWmFMlGzm+ry5BBfYyeY9YmNKbRSo/o7OX9w9ale0wg3w==" }, "is-negative-zero": { - "version": "2.0.1", - "resolved": "https://registry.npmjs.org/is-negative-zero/-/is-negative-zero-2.0.1.tgz", - "integrity": "sha512-2z6JzQvZRa9A2Y7xC6dQQm4FSTSTNWjKIYYTt4246eMTJmIo0Q+ZyOsU66X8lxK1AbB92dFeglPLrhwpeRKO6w==" + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/is-negative-zero/-/is-negative-zero-2.0.2.tgz", + "integrity": "sha512-dqJvarLawXsFbNDeJW7zAz8ItJ9cd28YufuuFzh0G8pNHjJMnY08Dv7sYX2uF5UpQOwieAeOExEYAWWfu7ZZUA==" }, "is-npm": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/is-npm/-/is-npm-1.0.0.tgz", - "integrity": "sha1-8vtjpl5JBbQGyGBydloaTceTufQ=" + "integrity": "sha512-9r39FIr3d+KD9SbX0sfMsHzb5PP3uimOiwr3YupUaUFG4W0l1U57Rx3utpttV7qz5U3jmrO5auUa04LU9pyHsg==" }, "is-number-object": { - "version": "1.0.5", - "resolved": "https://registry.npmjs.org/is-number-object/-/is-number-object-1.0.5.tgz", - "integrity": "sha512-RU0lI/n95pMoUKu9v1BZP5MBcZuNSVJkMkAG2dJqC4z2GlkGUNeH68SuHuBKBD/XFe+LHZ+f9BKkLET60Niedw==" + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/is-number-object/-/is-number-object-1.0.7.tgz", + "integrity": "sha512-k1U0IRzLMo7ZlYIfzRu23Oh6MiIFasgpb9X76eqfFZAqwH44UI4KTBvBYIZ1dSL9ZzChTB9ShHfLkR4pdW5krQ==", + "requires": { + "has-tostringtag": "^1.0.0" + } + }, + "is-plain-object": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/is-plain-object/-/is-plain-object-2.0.4.tgz", + "integrity": "sha512-h5PpgXkWitc38BBMYawTYMWJHFZJVnBquFE57xFpjB8pJFiF6gZ+bU+WyI/yqXiFR5mdLsgYNaPe8uao6Uv9Og==", + "requires": { + "isobject": "^3.0.1" + } + }, + "is-primitive": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/is-primitive/-/is-primitive-3.0.1.tgz", + "integrity": "sha512-GljRxhWvlCNRfZyORiH77FwdFwGcMO620o37EOYC0ORWdq+WYNVqW0w2Juzew4M+L81l6/QS3t5gkkihyRqv9w==" }, "is-redirect": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/is-redirect/-/is-redirect-1.0.0.tgz", - "integrity": "sha1-HQPd7VO9jbDzDCbk+V02/HyH3CQ=" + "integrity": "sha512-cr/SlUEe5zOGmzvj9bUyC4LVvkNVAXu4GytXLNMr1pny+a65MpQ9IJzFHD5vi7FyJgb4qt27+eS3TuQnqB+RQw==" }, "is-regex": { - "version": "1.1.3", - "resolved": "https://registry.npmjs.org/is-regex/-/is-regex-1.1.3.tgz", - "integrity": "sha512-qSVXFz28HM7y+IWX6vLCsexdlvzT1PJNFSBuaQLQ5o0IEw8UDYW6/2+eCMVyIsbM8CNLX2a/QWmSpyxYEHY7CQ==", + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/is-regex/-/is-regex-1.1.4.tgz", + "integrity": "sha512-kvRdxDsxZjhzUX07ZnLydzS1TU/TJlTUHHY4YLL87e37oUA49DfkLqgy+VjFocowy29cKvcSiu+kIv728jTTVg==", "requires": { "call-bind": "^1.0.2", - "has-symbols": "^1.0.2" + "has-tostringtag": "^1.0.0" + } + }, + "is-shared-array-buffer": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-shared-array-buffer/-/is-shared-array-buffer-1.0.2.tgz", + "integrity": "sha512-sqN2UDu1/0y6uvXyStCOzyhAjCSlHceFoMKJW8W9EU9cvic/QdsZ0kEU93HEy3IUEFZIiH/3w+AH/UQbPHNdhA==", + "requires": { + "call-bind": "^1.0.2" } }, "is-stream": { "version": "1.1.0", "resolved": "https://registry.npmjs.org/is-stream/-/is-stream-1.1.0.tgz", - "integrity": "sha1-EtSj3U5o4Lec6428hBc66A2RykQ=" + "integrity": "sha512-uQPm8kcs47jx38atAcWTVxyltQYoPT68y9aWYdV6yWXSyW8mzSat0TL6CiWdZeCdF3KrAvpVtnHbTv4RN+rqdQ==" }, "is-string": { - "version": "1.0.6", - "resolved": "https://registry.npmjs.org/is-string/-/is-string-1.0.6.tgz", - "integrity": "sha512-2gdzbKUuqtQ3lYNrUTQYoClPhm7oQu4UdpSZMp1/DGgkHBT8E2Z1l0yMdb6D4zNAxwDiMv8MdulKROJGNl0Q0w==" + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/is-string/-/is-string-1.0.7.tgz", + "integrity": "sha512-tE2UXzivje6ofPW7l23cjDOMa09gb7xlAqG6jG5ej6uPV32TlWP3NKPigtaGeHNu9fohccRYvIiZMfOOnOYUtg==", + "requires": { + "has-tostringtag": "^1.0.0" + } }, "is-symbol": { "version": "1.0.4", @@ -943,26 +5196,45 @@ "has-symbols": "^1.0.2" } }, + "is-typed-array": { + "version": "1.1.10", + "resolved": "https://registry.npmjs.org/is-typed-array/-/is-typed-array-1.1.10.tgz", + "integrity": "sha512-PJqgEHiWZvMpaFZ3uTc8kHPM4+4ADTlDniuQL7cU/UDA0Ql7F70yGfHph3cLNe+c9toaigv+DFzTJKhc2CtO6A==", + "requires": { + "available-typed-arrays": "^1.0.5", + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "gopd": "^1.0.1", + "has-tostringtag": "^1.0.0" + } + }, "is-typedarray": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", - "integrity": "sha1-5HnICFjfDBsR3dppQPlgEfzaSpo=" + "integrity": "sha512-cyA56iCMHAh5CdzjJIa4aohJyeO1YbwLi3Jc35MmRU6poroFjIGZzUzupGiRPOjgHg9TLu43xbpwXk523fMxKA==" + }, + "is-weakref": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-weakref/-/is-weakref-1.0.2.tgz", + "integrity": "sha512-qctsuLZmIQ0+vSSMfoVvyFe2+GSEvnmZ2ezTup1SBse9+twCCeial6EEi3Nc2KFcf6+qz2FBPnjXsk8xhKSaPQ==", + "requires": { + "call-bind": "^1.0.2" + } }, "isarray": { - "version": "1.0.0", - "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", - "integrity": "sha1-u5NdSFgsuhaMBoNJV6VKPgcSTxE=" + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-2.0.5.tgz", + "integrity": "sha512-xHjhDr3cNBK0BzdUJSPXZntQUx/mwMS5Rw4A7lPJ90XGAO6ISP/ePDNuo0vhqOZU+UD5JoodwCAAoZQd3FeAKw==" + }, + "isobject": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/isobject/-/isobject-3.0.1.tgz", + "integrity": "sha512-WhB9zCku7EGTj/HQQRz5aUQEUeoQZH2bWcltRErOpymJ4boYE6wL9Tbr23krRPSZ+C5zqNSrSw+Cc7sZZ4b7vg==" }, "isstream": { "version": "0.1.2", "resolved": "https://registry.npmjs.org/isstream/-/isstream-0.1.2.tgz", - "integrity": "sha1-R+Y/evVa+m+S4VAOaQ64uFKcCZo=" - }, - "iterall": { - "version": "1.3.0", - "resolved": "https://registry.npmjs.org/iterall/-/iterall-1.3.0.tgz", - "integrity": "sha512-QZ9qOMdF+QLHxy1QIpUHUU1D5pS2CG2P69LF6L6CPjPYA/XMOmKV3PZpawHoAjHNyB0swdVTRxdYT4tbBbxqwg==", - "optional": true + "integrity": "sha512-Yljz7ffyPbrLpLngrMtZ7NduUgVvi6wG9RJ9IUcyCd59YQ911PBJphODUcbOVbqYfxe1wuYf/LJ8PauMRwsM/g==" }, "js-tokens": { "version": "4.0.0", @@ -976,12 +5248,22 @@ "requires": { "argparse": "^1.0.7", "esprima": "^4.0.0" + }, + "dependencies": { + "argparse": { + "version": "1.0.10", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-1.0.10.tgz", + "integrity": "sha512-o5Roy6tNG4SL/FOkCAN6RzjiakZS25RLYFrcMttJqbdd8BWrnA+fGz57iN5Pb06pvBGvl5gQ0B48dJlslXvoTg==", + "requires": { + "sprintf-js": "~1.0.2" + } + } } }, "jsbn": { "version": "0.1.1", "resolved": "https://registry.npmjs.org/jsbn/-/jsbn-0.1.1.tgz", - "integrity": "sha1-peZUwuWi3rXyAdls77yoDA7y9RM=" + "integrity": "sha512-UVU9dibq2JcFWxQPA6KCqj5O42VOmAY3zQUfEKxU0KpTGXwNoCjkX1e13eHNvw/xPynt6pU0rZ1htjWTNTSXsg==" }, "jschardet": { "version": "1.6.0", @@ -989,9 +5271,9 @@ "integrity": "sha512-xYuhvQ7I9PDJIGBWev9xm0+SMSed3ZDBAmvVjbFR1ZRLAF+vlXcQu6cRI9uAlj81rzikElRVteehwV7DuX2ZmQ==" }, "json-schema": { - "version": "0.2.3", - "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.2.3.tgz", - "integrity": "sha1-tIDIkuWaLwWVTOcnvT8qTogvnhM=" + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.4.0.tgz", + "integrity": "sha512-es94M3nTIfsEPisRafak+HDLfHXnKBhV3vU5eqPcS3flIWqcxJWgXHXiey3YrpaNsanY5ei1VoYEbOzijuq9BA==" }, "json-schema-traverse": { "version": "0.4.1", @@ -1001,23 +5283,23 @@ "json-stringify-safe": { "version": "5.0.1", "resolved": "https://registry.npmjs.org/json-stringify-safe/-/json-stringify-safe-5.0.1.tgz", - "integrity": "sha1-Epai1Y/UXxmg9s4B1lcB4sc1tus=" + "integrity": "sha512-ZClg6AaYvamvYEE82d3Iyd3vSSIjQ+odgjaTzRuO3s7toCdFKczob2i0zCh7JE8kWn17yvAWhUVxvqGwUalsRA==" }, "jsprim": { - "version": "1.4.1", - "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.1.tgz", - "integrity": "sha1-MT5mvB5cwG5Di8G3SZwuXFastqI=", + "version": "1.4.2", + "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.2.tgz", + "integrity": "sha512-P2bSOMAc/ciLz6DzgjVlGJP9+BrJWu5UDGK70C2iweC5QBIeFf0ZXRvGjEj2uYgrY2MkAAhsSWHDWlFtEroZWw==", "requires": { "assert-plus": "1.0.0", "extsprintf": "1.3.0", - "json-schema": "0.2.3", + "json-schema": "0.4.0", "verror": "1.10.0" } }, "kind-of": { "version": "3.2.2", "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", - "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "integrity": "sha512-NOW9QQXMoZGg/oqnVNoNTTIFEIid1627WCffUBJEdMxYApq7mNE7CpzucIPc+ZQg25Phej7IJSmX3hO+oblOtQ==", "requires": { "is-buffer": "^1.1.5" } @@ -1025,7 +5307,7 @@ "latest-version": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/latest-version/-/latest-version-1.0.1.tgz", - "integrity": "sha1-cs/Ebj6NG+ZR4eu1Tqn26pbzdLs=", + "integrity": "sha512-HERbxp4SBlmI380+eM0B0u4nxjfTaPeydIMzl9+9UQ4nSu3xMWKlX9WoT34e4wy7VWe67c53Nv9qPVjS8fHKgg==", "requires": { "package-json": "^1.0.0" } @@ -1033,12 +5315,12 @@ "lazy-cache": { "version": "1.0.4", "resolved": "https://registry.npmjs.org/lazy-cache/-/lazy-cache-1.0.4.tgz", - "integrity": "sha1-odePw6UEdMuAhF07O24dpJpEbo4=" + "integrity": "sha512-RE2g0b5VGZsOCFOCgP7omTRYFqydmZkBwl5oNnQ1lDYC57uyO9KqNnNVxT7COSHTxrRCWVcAVOcbjk+tvh/rgQ==" }, "linkify-it": { - "version": "2.2.0", - "resolved": "https://registry.npmjs.org/linkify-it/-/linkify-it-2.2.0.tgz", - "integrity": "sha512-GnAl/knGn+i1U/wjBz3akz2stz+HrHLsxMwHQGofCDfPvlf+gDKN58UtfmUquTY4/MXeE2x7k19KQmeoZi94Iw==", + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/linkify-it/-/linkify-it-3.0.3.tgz", + "integrity": "sha512-ynTsyrFSdE5oZ/O9GEf00kPngmOfVwazR5GKDq6EYfhlpFug3J2zybX56a2PRRpc9P+FuSoGNAwjlbDs9jJBPQ==", "requires": { "uc.micro": "^1.0.1" } @@ -1046,12 +5328,12 @@ "lodash._arrayeach": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/lodash._arrayeach/-/lodash._arrayeach-3.0.0.tgz", - "integrity": "sha1-urFWsqkNPxu9XGU0AzSeXlkz754=" + "integrity": "sha512-Mn7HidOVcl3mkQtbPsuKR0Fj0N6Q6DQB77CtYncZcJc0bx5qv2q4Gl6a0LC1AN+GSxpnBDNnK3CKEm9XNA4zqQ==" }, "lodash._baseassign": { "version": "3.2.0", "resolved": "https://registry.npmjs.org/lodash._baseassign/-/lodash._baseassign-3.2.0.tgz", - "integrity": "sha1-jDigmVAPIVrQnlnxci/QxSv+Ck4=", + "integrity": "sha512-t3N26QR2IdSN+gqSy9Ds9pBu/J1EAFEshKlUHpJG3rvyJOYgcELIxcIeKKfZk7sjOz11cFfzJRsyFry/JyabJQ==", "requires": { "lodash._basecopy": "^3.0.0", "lodash.keys": "^3.0.0" @@ -1060,12 +5342,12 @@ "lodash._basecopy": { "version": "3.0.1", "resolved": "https://registry.npmjs.org/lodash._basecopy/-/lodash._basecopy-3.0.1.tgz", - "integrity": "sha1-jaDmqHbPNEwK2KVIghEd08XHyjY=" + "integrity": "sha512-rFR6Vpm4HeCK1WPGvjZSJ+7yik8d8PVUdCJx5rT2pogG4Ve/2ZS7kfmO5l5T2o5V2mqlNIfSF5MZlr1+xOoYQQ==" }, "lodash._baseeach": { "version": "3.0.4", "resolved": "https://registry.npmjs.org/lodash._baseeach/-/lodash._baseeach-3.0.4.tgz", - "integrity": "sha1-z4cGVyyhROjZ11InyZDamC+TKvM=", + "integrity": "sha512-IqUZ9MQo2UT1XPGuBntInqTOlc+oV+bCo0kMp+yuKGsfvRSNgUW0YjWVZUrG/gs+8z/Eyuc0jkJjOBESt9BXxg==", "requires": { "lodash.keys": "^3.0.0" } @@ -1073,12 +5355,12 @@ "lodash._bindcallback": { "version": "3.0.1", "resolved": "https://registry.npmjs.org/lodash._bindcallback/-/lodash._bindcallback-3.0.1.tgz", - "integrity": "sha1-5THCdkTPi1epnhftlbNcdIeJOS4=" + "integrity": "sha512-2wlI0JRAGX8WEf4Gm1p/mv/SZ+jLijpj0jyaE/AXeuQphzCgD8ZQW4oSpoN8JAopujOFGU3KMuq7qfHBWlGpjQ==" }, "lodash._createassigner": { "version": "3.1.1", "resolved": "https://registry.npmjs.org/lodash._createassigner/-/lodash._createassigner-3.1.1.tgz", - "integrity": "sha1-g4pbri/aymOsIt7o4Z+k5taXCxE=", + "integrity": "sha512-LziVL7IDnJjQeeV95Wvhw6G28Z8Q6da87LWKOPWmzBLv4u6FAT/x5v00pyGW0u38UoogNF2JnD3bGgZZDaNEBw==", "requires": { "lodash._bindcallback": "^3.0.0", "lodash._isiterateecall": "^3.0.0", @@ -1088,17 +5370,17 @@ "lodash._getnative": { "version": "3.9.1", "resolved": "https://registry.npmjs.org/lodash._getnative/-/lodash._getnative-3.9.1.tgz", - "integrity": "sha1-VwvH3t5G1hzc3mh9ZdPuy6o6r/U=" + "integrity": "sha512-RrL9VxMEPyDMHOd9uFbvMe8X55X16/cGM5IgOKgRElQZutpX89iS6vwl64duTV1/16w5JY7tuFNXqoekmh1EmA==" }, "lodash._isiterateecall": { "version": "3.0.9", "resolved": "https://registry.npmjs.org/lodash._isiterateecall/-/lodash._isiterateecall-3.0.9.tgz", - "integrity": "sha1-UgOte6Ql+uhCRg5pbbnPPmqsBXw=" + "integrity": "sha512-De+ZbrMu6eThFti/CSzhRvTKMgQToLxbij58LMfM8JnYDNSOjkjTCIaa8ixglOeGh2nyPlakbt5bJWJ7gvpYlQ==" }, "lodash.assign": { "version": "3.2.0", "resolved": "https://registry.npmjs.org/lodash.assign/-/lodash.assign-3.2.0.tgz", - "integrity": "sha1-POnwI0tLIiPilrj6CsH+6OvKZPo=", + "integrity": "sha512-/VVxzgGBmbphasTg51FrztxQJ/VgAUpol6zmJuSVSGcNg4g7FA4z7rQV8Ovr9V3vFBNWZhvKWHfpAytjTVUfFA==", "requires": { "lodash._baseassign": "^3.0.0", "lodash._createassigner": "^3.0.0", @@ -1108,17 +5390,17 @@ "lodash.assignin": { "version": "4.2.0", "resolved": "https://registry.npmjs.org/lodash.assignin/-/lodash.assignin-4.2.0.tgz", - "integrity": "sha1-uo31+4QesKPoBEIysOJjqNxqKKI=" + "integrity": "sha512-yX/rx6d/UTVh7sSVWVSIMjfnz95evAgDFdb1ZozC35I9mSFCkmzptOzevxjgbQUsc78NR44LVHWjsoMQXy9FDg==" }, "lodash.bind": { "version": "4.2.1", "resolved": "https://registry.npmjs.org/lodash.bind/-/lodash.bind-4.2.1.tgz", - "integrity": "sha1-euMBfpOWIqwxt9fX3LGzTbFpDTU=" + "integrity": "sha512-lxdsn7xxlCymgLYo1gGvVrfHmkjDiyqVv62FAeF2i5ta72BipE1SLxw8hPEPLhD4/247Ijw07UQH7Hq/chT5LA==" }, "lodash.defaults": { "version": "3.1.2", "resolved": "https://registry.npmjs.org/lodash.defaults/-/lodash.defaults-3.1.2.tgz", - "integrity": "sha1-xzCLGNv4vJNy1wGnNJPGEZK9Liw=", + "integrity": "sha512-X7135IXFQt5JDFnYxOVAzVz+kFvwDn3N8DJYf+nrz/mMWEuSu7+OL6rWqsk3+VR1T4TejFCSu5isBJOLSID2bg==", "requires": { "lodash.assign": "^3.0.0", "lodash.restparam": "^3.0.0" @@ -1127,17 +5409,17 @@ "lodash.filter": { "version": "4.6.0", "resolved": "https://registry.npmjs.org/lodash.filter/-/lodash.filter-4.6.0.tgz", - "integrity": "sha1-ZosdSYFgOuHMWm+nYBQ+SAtMSs4=" + "integrity": "sha512-pXYUy7PR8BCLwX5mgJ/aNtyOvuJTdZAo9EQFUvMIYugqmJxnrYaANvTbgndOzHSCSR0wnlBBfRXJL5SbWxo3FQ==" }, "lodash.flatten": { "version": "4.4.0", "resolved": "https://registry.npmjs.org/lodash.flatten/-/lodash.flatten-4.4.0.tgz", - "integrity": "sha1-8xwiIlqWMtK7+OSt2+8kCqdlph8=" + "integrity": "sha512-C5N2Z3DgnnKr0LOpv/hKCgKdb7ZZwafIrsesve6lmzvZIRZRGaZ/l6Q8+2W7NaT+ZwO3fFlSCzCzrDCFdJfZ4g==" }, "lodash.foreach": { "version": "3.0.3", "resolved": "https://registry.npmjs.org/lodash.foreach/-/lodash.foreach-3.0.3.tgz", - "integrity": "sha1-b9fvt5aRrs1n/erCdhyY5wHWw5o=", + "integrity": "sha512-PA7Lp7pe2HMJBoB1vELegEIF3waUFnM0fWDKJVYolwZ4zHh6WTmnq0xmzfQksD66gx2quhDNyBdyaE2T8/DP3Q==", "requires": { "lodash._arrayeach": "^3.0.0", "lodash._baseeach": "^3.0.0", @@ -1148,17 +5430,17 @@ "lodash.isarguments": { "version": "3.1.0", "resolved": "https://registry.npmjs.org/lodash.isarguments/-/lodash.isarguments-3.1.0.tgz", - "integrity": "sha1-L1c9hcaiQon/AGY7SRwdM4/zRYo=" + "integrity": "sha512-chi4NHZlZqZD18a0imDHnZPrDeBbTtVN7GXMwuGdRH9qotxAjYs3aVLKc7zNOG9eddR5Ksd8rvFEBc9SsggPpg==" }, "lodash.isarray": { "version": "3.0.4", "resolved": "https://registry.npmjs.org/lodash.isarray/-/lodash.isarray-3.0.4.tgz", - "integrity": "sha1-eeTriMNqgSKvhvhEqpvNhRtfu1U=" + "integrity": "sha512-JwObCrNJuT0Nnbuecmqr5DgtuBppuCvGD9lxjFpAzwnVtdGoDQ1zig+5W8k5/6Gcn0gZ3936HDAlGd28i7sOGQ==" }, "lodash.keys": { "version": "3.1.2", "resolved": "https://registry.npmjs.org/lodash.keys/-/lodash.keys-3.1.2.tgz", - "integrity": "sha1-TbwEcrFWvlCgsoaFXRvQsMZWCYo=", + "integrity": "sha512-CuBsapFjcubOGMn3VD+24HOAPxM79tH+V6ivJL3CHYjtrawauDJHUk//Yew9Hvc6e9rbCrURGk8z6PC+8WJBfQ==", "requires": { "lodash._getnative": "^3.0.0", "lodash.isarguments": "^3.0.0", @@ -1168,7 +5450,7 @@ "lodash.map": { "version": "4.6.0", "resolved": "https://registry.npmjs.org/lodash.map/-/lodash.map-4.6.0.tgz", - "integrity": "sha1-dx7Hg540c9nEzeKLGTlMNWL09tM=" + "integrity": "sha512-worNHGKLDetmcEYDvh2stPCrrQRkP20E4l0iIS7F8EvzMqBBi7ltvFN5m1HvTf1P7Jk1txKhvFcmYsCr8O2F1Q==" }, "lodash.merge": { "version": "4.6.2", @@ -1178,32 +5460,32 @@ "lodash.pick": { "version": "4.4.0", "resolved": "https://registry.npmjs.org/lodash.pick/-/lodash.pick-4.4.0.tgz", - "integrity": "sha1-UvBWEP/53tQiYRRB7R/BI6AwAbM=" + "integrity": "sha512-hXt6Ul/5yWjfklSGvLQl8vM//l3FtyHZeuelpzK6mm99pNvN9yTDruNZPEJZD1oWrqo+izBmB7oUfWgcCX7s4Q==" }, "lodash.reduce": { "version": "4.6.0", "resolved": "https://registry.npmjs.org/lodash.reduce/-/lodash.reduce-4.6.0.tgz", - "integrity": "sha1-8atrg5KZrUj3hKu/R2WW8DuRTTs=" + "integrity": "sha512-6raRe2vxCYBhpBu+B+TtNGUzah+hQjVdu3E17wfusjyrXBka2nBS8OH/gjVZ5PvHOhWmIZTYri09Z6n/QfnNMw==" }, "lodash.reject": { "version": "4.6.0", "resolved": "https://registry.npmjs.org/lodash.reject/-/lodash.reject-4.6.0.tgz", - "integrity": "sha1-gNZJLcFHCGS79YNTO2UfQqn1JBU=" + "integrity": "sha512-qkTuvgEzYdyhiJBx42YPzPo71R1aEr0z79kAv7Ixg8wPFEjgRgJdUsGMG3Hf3OYSF/kHI79XhNlt+5Ar6OzwxQ==" }, "lodash.restparam": { "version": "3.6.1", "resolved": "https://registry.npmjs.org/lodash.restparam/-/lodash.restparam-3.6.1.tgz", - "integrity": "sha1-k2pOMJ7zMKdkXtQUWYbIWuWyCAU=" + "integrity": "sha512-L4/arjjuq4noiUJpt3yS6KIKDtJwNe2fIYgMqyYYKoeIfV1iEqvPwhCx23o+R9dzouGihDAPN1dTIRWa7zk8tw==" }, "lodash.some": { "version": "4.6.0", "resolved": "https://registry.npmjs.org/lodash.some/-/lodash.some-4.6.0.tgz", - "integrity": "sha1-G7nzFO9ri63tE7VJFpsqlF62jk0=" + "integrity": "sha512-j7MJE+TuT51q9ggt4fSgVqro163BEFjAt3u97IqU+JA2DkWl80nFTrowzLpZ/BnpN7rrl0JA/593NAdd8p/scQ==" }, "longest": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/longest/-/longest-1.0.1.tgz", - "integrity": "sha1-MKCy2jj3N3DoKUoNIuZiXtd9AJc=" + "integrity": "sha512-k+yt5n3l48JU4k8ftnKG6V7u32wyH2NfKzeMto9F/QRE0amxy/LayxwlvjjkZEIzqR+19IrtFO8p5kB9QaYUFg==" }, "loose-envify": { "version": "1.4.0", @@ -1219,21 +5501,21 @@ "integrity": "sha512-G2Lj61tXDnVFFOi8VZds+SoQjtQC3dgokKdDG2mTm1tx4m50NUHBOZSBwQQHyy0V12A0JTG4icfZQH+xPyh8VA==" }, "markdown-it": { - "version": "10.0.0", - "resolved": "https://registry.npmjs.org/markdown-it/-/markdown-it-10.0.0.tgz", - "integrity": "sha512-YWOP1j7UbDNz+TumYP1kpwnP0aEa711cJjrAQrzd0UXlbJfc5aAq0F/PZHjiioqDC1NKgvIMX+o+9Bk7yuM2dg==", + "version": "12.3.2", + "resolved": "https://registry.npmjs.org/markdown-it/-/markdown-it-12.3.2.tgz", + "integrity": "sha512-TchMembfxfNVpHkbtriWltGWc+m3xszaRD0CZup7GFFhzIgQqxIfn3eGj1yZpfuflzPvfkt611B2Q/Bsk1YnGg==", "requires": { - "argparse": "^1.0.7", - "entities": "~2.0.0", - "linkify-it": "^2.0.0", + "argparse": "^2.0.1", + "entities": "~2.1.0", + "linkify-it": "^3.0.1", "mdurl": "^1.0.1", "uc.micro": "^1.0.5" }, "dependencies": { "entities": { - "version": "2.0.3", - "resolved": "https://registry.npmjs.org/entities/-/entities-2.0.3.tgz", - "integrity": "sha512-MyoZ0jgnLvB2X3Lg5HqpFmn1kybDiIfEQmKzTb5apr51Rb+T3KdmMiqa70T+bhGnyv7bQ6WMj2QMHpGMmlrUYQ==" + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/entities/-/entities-2.1.0.tgz", + "integrity": "sha512-hCx1oky9PFrJ611mf0ifBLBRW8lUUVRlFolb5gWRfIELabBlbp9xZvrqZLZAs+NxFnbfQoeGd8wDkygjg7U85w==" } } }, @@ -1245,12 +5527,13 @@ "mdurl": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/mdurl/-/mdurl-1.0.1.tgz", - "integrity": "sha1-/oWy7HWlkDfyrf7BAP1sYBdhFS4=" + "integrity": "sha512-/sKlQJCBYVY9Ers9hqzKou4H6V5UWc/M59TH2dvkt+84itfnq7uFOMLpOiOS4ujvHP4etln18fmIxA5R5fll0g==" }, "meros": { - "version": "1.1.4", - "resolved": "https://registry.npmjs.org/meros/-/meros-1.1.4.tgz", - "integrity": "sha512-E9ZXfK9iQfG9s73ars9qvvvbSIkJZF5yOo9j4tcwM5tN8mUKfj/EKN5PzOr3ZH0y5wL7dLAHw3RVEfpQV9Q7VQ==" + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/meros/-/meros-1.2.1.tgz", + "integrity": "sha512-R2f/jxYqCAGI19KhAvaxSOxALBMkaXWH2a7rOyqQw+ZmizX5bKkEYWLzdhC+U82ZVVPVp6MCXe3EkVligh+12g==", + "requires": {} }, "mime": { "version": "1.6.0", @@ -1258,40 +5541,40 @@ "integrity": "sha512-x0Vn8spI+wuJ1O6S7gnbaQg8Pxh4NNHb7KSINmEWKiPE4RKOplvijn+NkmYmmRgP68mc70j2EbeTFRsrswaQeg==" }, "mime-db": { - "version": "1.47.0", - "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.47.0.tgz", - "integrity": "sha512-QBmA/G2y+IfeS4oktet3qRZ+P5kPhCKRXxXnQEudYqUaEioAU1/Lq2us3D/t1Jfo4hE9REQPrbB7K5sOczJVIw==" + "version": "1.52.0", + "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.52.0.tgz", + "integrity": "sha512-sPU4uV7dYlvtWJxwwxHD0PuihVNiE7TyAbQ5SWxDCB9mUYvOgroQOwYQQOKPJ8CIbE+1ETVlOoK1UC2nU3gYvg==" }, "mime-types": { - "version": "2.1.30", - "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.30.tgz", - "integrity": "sha512-crmjA4bLtR8m9qLpHvgxSChT+XoSlZi8J4n/aIdn3z92e/U47Z0V/yl+Wh9W046GgFVAmoNR/fmdbZYcSSIUeg==", + "version": "2.1.35", + "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.35.tgz", + "integrity": "sha512-ZDY+bPm5zTTF+YpCrAU9nK0UgICYPT0QtT1NZWFv4s++TNkcgVaT0g6+4R2uI4MjQjzysHB1zxuWL50hzaeXiw==", "requires": { - "mime-db": "1.47.0" + "mime-db": "1.52.0" } }, "minimist": { - "version": "1.2.5", - "resolved": "https://registry.npmjs.org/minimist/-/minimist-1.2.5.tgz", - "integrity": "sha512-FM9nNUYrRBAELZQT3xeZQ7fmMOBg6nWNmJKTcgsJeaLstP/UODVpGsr5OhXhhXg6f+qtJ8uiZ+PUxkDWcgIXLw==" + "version": "1.2.8", + "resolved": "https://registry.npmjs.org/minimist/-/minimist-1.2.8.tgz", + "integrity": "sha512-2yyAR8qBkN3YuheJanUpWC5U3bb5osDywNB8RzDVlDwDHbocAJveqqj1u8+SVD7jkWT4yvsHCpWqqWqAxb0zCA==" }, "mkdirp": { - "version": "0.5.5", - "resolved": "https://registry.npmjs.org/mkdirp/-/mkdirp-0.5.5.tgz", - "integrity": "sha512-NKmAlESf6jMGym1++R0Ra7wvhV+wFW63FaSOFPwRahvea0gMUcGUhVeAg/0BC0wiv9ih5NYPB1Wn1UEI1/L+xQ==", + "version": "0.5.6", + "resolved": "https://registry.npmjs.org/mkdirp/-/mkdirp-0.5.6.tgz", + "integrity": "sha512-FP+p8RB8OWpF3YZBCrP5gtADmtXApB5AMLn+vdyA+PyxCjrCs00mjyUozssO33cwDeT3wNGdLxJ5M//YqtHAJw==", "requires": { - "minimist": "^1.2.5" + "minimist": "^1.2.6" } }, "ms": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", - "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + "integrity": "sha512-Tpp60P6IUJDTuOq/5Z8cdskzJujfwqfOTkrwIwj7IRISpnkJnT6SyJ4PCPnGMoFjC9ddhal5KVIYtAt97ix05A==" }, "nested-error-stacks": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/nested-error-stacks/-/nested-error-stacks-1.0.2.tgz", - "integrity": "sha1-GfYZWRUZ8JZ2mlupqG5u7sgjw88=", + "integrity": "sha512-o32anp9JA7oezPOFSfG2BBXSdHepOm5FpJvwxHWDtfJ3Bg3xdi68S6ijPlEOfUg6quxZWyvJM+8fHk1yMDKspA==", "requires": { "inherits": "~2.0.1" } @@ -1317,12 +5600,12 @@ "object-assign": { "version": "4.1.1", "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-4.1.1.tgz", - "integrity": "sha1-IQmtx5ZYh8/AXLvUQsrIv7s2CGM=" + "integrity": "sha512-rJgTQnkUnH1sFw8yT6VSU3zD3sWmu6sZhIseY8VX+GRu3P6F7Fu+JNDoXfklElbLJSnc3FUQHVe4cU5hj+BcUg==" }, "object-inspect": { - "version": "1.10.3", - "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.10.3.tgz", - "integrity": "sha512-e5mCJlSH7poANfC8z8S9s9S2IN5/4Zb3aZ33f5s8YqoazCFzNLloLU8r5VCG+G7WoqLvAAZoVMcy3tp/3X0Plw==" + "version": "1.12.3", + "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.12.3.tgz", + "integrity": "sha512-geUvdk7c+eizMNUDkRpW1wJwgfOiOeHbxBR/hLXK1aT6zmVSO0jsQcs7fj6MGw89jC/cjGfLcNOrtMYtGqm81g==" }, "object-keys": { "version": "1.1.1", @@ -1330,41 +5613,42 @@ "integrity": "sha512-NuAESUOUMrlIXOfHKzD6bpPu3tYt3xvjNdRIQ+FeT0lNb4K8WR70CaDxhuNguS2XG+GjkyMwOzsN5ZktImfhLA==" }, "object.assign": { - "version": "4.1.2", - "resolved": "https://registry.npmjs.org/object.assign/-/object.assign-4.1.2.tgz", - "integrity": "sha512-ixT2L5THXsApyiUPYKmW+2EHpXXe5Ii3M+f4e+aJFAHao5amFRW6J0OO6c/LU8Be47utCx2GL89hxGB6XSmKuQ==", + "version": "4.1.4", + "resolved": "https://registry.npmjs.org/object.assign/-/object.assign-4.1.4.tgz", + "integrity": "sha512-1mxKf0e58bvyjSCtKYY4sRe9itRk3PJpquJOjeIkz885CczcI4IvJJDLPS72oowuSh+pBxUFROpX+TU++hxhZQ==", "requires": { - "call-bind": "^1.0.0", - "define-properties": "^1.1.3", - "has-symbols": "^1.0.1", + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "has-symbols": "^1.0.3", "object-keys": "^1.1.1" } }, "object.getownpropertydescriptors": { - "version": "2.1.2", - "resolved": "https://registry.npmjs.org/object.getownpropertydescriptors/-/object.getownpropertydescriptors-2.1.2.tgz", - "integrity": "sha512-WtxeKSzfBjlzL+F9b7M7hewDzMwy+C8NRssHd1YrNlzHzIDrXcXiNOMrezdAEM4UXixgV+vvnyBeN7Rygl2ttQ==", + "version": "2.1.6", + "resolved": "https://registry.npmjs.org/object.getownpropertydescriptors/-/object.getownpropertydescriptors-2.1.6.tgz", + "integrity": "sha512-lq+61g26E/BgHv0ZTFgRvi7NMEPuAxLkFU7rukXjc/AlwH4Am5xXVnIXy3un1bg/JPbXHrixRkK1itUzzPiIjQ==", "requires": { + "array.prototype.reduce": "^1.0.5", "call-bind": "^1.0.2", - "define-properties": "^1.1.3", - "es-abstract": "^1.18.0-next.2" + "define-properties": "^1.2.0", + "es-abstract": "^1.21.2", + "safe-array-concat": "^1.0.0" } }, "object.values": { - "version": "1.1.3", - "resolved": "https://registry.npmjs.org/object.values/-/object.values-1.1.3.tgz", - "integrity": "sha512-nkF6PfDB9alkOUxpf1HNm/QlkeW3SReqL5WXeBLpEJJnlPSvRaDQpW3gQTksTN3fgJX4hL42RzKyOin6ff3tyw==", + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/object.values/-/object.values-1.1.6.tgz", + "integrity": "sha512-FVVTkD1vENCsAcwNs9k6jea2uHC/X0+JcjG8YA60FN5CMaJmG95wT9jek/xX9nornqGRrBkKtzuAu2wuHpKqvw==", "requires": { "call-bind": "^1.0.2", - "define-properties": "^1.1.3", - "es-abstract": "^1.18.0-next.2", - "has": "^1.0.3" + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" } }, "once": { "version": "1.4.0", "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz", - "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=", + "integrity": "sha512-lNaJgI+2Q5URQBkccEKHTQOPaXdUxnZZElQTZY0MFUAuaEqe1E+Nyvgdz/aIyNi6Z9MzO5dv1H8n58/GELp3+w==", "requires": { "wrappy": "1" } @@ -1372,12 +5656,12 @@ "os-homedir": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/os-homedir/-/os-homedir-1.0.2.tgz", - "integrity": "sha1-/7xJiDNuDoM94MFox+8VISGqf7M=" + "integrity": "sha512-B5JU3cabzk8c67mRRd3ECmROafjYMXbuzlwtqdM8IbS8ktlTix8aFGb2bAGKrSRIlnfKwovGUUr72JUPyOb6kQ==" }, "os-tmpdir": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/os-tmpdir/-/os-tmpdir-1.0.2.tgz", - "integrity": "sha1-u+Z0BseaqFxc/sdm/lc0VV36EnQ=" + "integrity": "sha512-D2FR03Vir7FIu45XBY20mTb+/ZSWB00sjU9jdQXt83gDrI4Ztz5Fs7/yy74g2N5SVQY4xY1qDr4rNddwYRVX0g==" }, "osenv": { "version": "0.1.5", @@ -1391,7 +5675,7 @@ "package-json": { "version": "1.2.0", "resolved": "https://registry.npmjs.org/package-json/-/package-json-1.2.0.tgz", - "integrity": "sha1-yOysCUInzfdqMWh07QXifMk5oOA=", + "integrity": "sha512-knDtirWWqKVJrLY3gEBLflVvueTMpyjbAwX/9j/EKi2DsjNemp5voS8cyKyGh57SNaMJNhNRZbIaWdneOcLU1g==", "requires": { "got": "^3.2.0", "registry-url": "^3.0.0" @@ -1400,17 +5684,17 @@ "performance-now": { "version": "2.1.0", "resolved": "https://registry.npmjs.org/performance-now/-/performance-now-2.1.0.tgz", - "integrity": "sha1-Ywn04OX6kT7BxpMHrjZLSzd8nns=" + "integrity": "sha512-7EAHlyLHI56VEIdK57uwHdHKIaAGbnXPiw0yWbarQZOKaKpvUIgW0jWRVLiatnM+XXlSwsanIBH/hzGMJulMow==" }, "pinkie": { "version": "2.0.4", "resolved": "https://registry.npmjs.org/pinkie/-/pinkie-2.0.4.tgz", - "integrity": "sha1-clVrgM+g1IqXToDnckjoDtT3+HA=" + "integrity": "sha512-MnUuEycAemtSaeFSjXKW/aroV7akBbY+Sv+RkyqFjgAe73F+MR0TBWKBRDkmfWq/HiFmdavfZ1G7h4SPZXaCSg==" }, "pinkie-promise": { "version": "2.0.1", "resolved": "https://registry.npmjs.org/pinkie-promise/-/pinkie-promise-2.0.1.tgz", - "integrity": "sha1-ITXW36ejWMBprJsXh3YogihFD/o=", + "integrity": "sha512-0Gni6D4UcLTbv9c57DfxDGdr41XfgUjqWZu492f0cIGr16zDU06BWP/RAEvOuo7CQ0CNjHaLlM59YJJFm3NWlw==", "requires": { "pinkie": "^2.0.0" } @@ -1418,7 +5702,7 @@ "prepend-http": { "version": "1.0.4", "resolved": "https://registry.npmjs.org/prepend-http/-/prepend-http-1.0.4.tgz", - "integrity": "sha1-1PRWKwzjaW5BrFLQ4ALlemNdxtw=" + "integrity": "sha512-PhmXi5XmoyKw1Un4E+opM2KcsJInDvKyuOumcjjw3waw86ZNjHwVUOOWLc4bCzLdcKNaWBH9e99sbWzDQsVaYg==" }, "process-nextick-args": { "version": "2.0.1", @@ -1433,25 +5717,42 @@ "asap": "~2.0.3" } }, + "prop-types": { + "version": "15.8.1", + "resolved": "https://registry.npmjs.org/prop-types/-/prop-types-15.8.1.tgz", + "integrity": "sha512-oj87CgZICdulUohogVAR7AjlC0327U4el4L6eAvOqCeudMDVU0NThNaV+b9Df4dXgSP1gXMTnPdhfe/2qDH5cg==", + "requires": { + "loose-envify": "^1.4.0", + "object-assign": "^4.1.1", + "react-is": "^16.13.1" + }, + "dependencies": { + "react-is": { + "version": "16.13.1", + "resolved": "https://registry.npmjs.org/react-is/-/react-is-16.13.1.tgz", + "integrity": "sha512-24e6ynE2H+OKt4kqsOvNd8kBpV65zoxbA4BVsEOB3ARVWQki/DHzaUoC5KuON/BiccDaCCTZBuOcfZs70kR8bQ==" + } + } + }, "psl": { - "version": "1.8.0", - "resolved": "https://registry.npmjs.org/psl/-/psl-1.8.0.tgz", - "integrity": "sha512-RIdOzyoavK+hA18OGGWDqUTsCLhtA7IcZ/6NCs4fFJaHBDab+pDDmDIByWFRQJq2Cd7r1OoQxBGKOaztq+hjIQ==" + "version": "1.9.0", + "resolved": "https://registry.npmjs.org/psl/-/psl-1.9.0.tgz", + "integrity": "sha512-E/ZsdU4HLs/68gYzgGTkMicWTLPdAftJLfJFlLUAAKZGkStNU72sZjT66SnMDVOfOWY/YAoiD7Jxa9iHvngcag==" }, "punycode": { - "version": "2.1.1", - "resolved": "https://registry.npmjs.org/punycode/-/punycode-2.1.1.tgz", - "integrity": "sha512-XRsRjdf+j5ml+y/6GKHPZbrF/8p2Yga0JPtdqTIY2Xe5ohJPD9saDJJLPvp9+NSBprVvevdXZybnj2cv8OEd0A==" + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-2.3.0.tgz", + "integrity": "sha512-rRV+zQD8tVFys26lAGR9WUuS4iUAngJScM+ZRSKtvl5tKeZ2t5bvdNFdNHBW9FWR4guGHlgmsZ1G7BSm2wTbuA==" }, "q": { "version": "1.5.1", "resolved": "https://registry.npmjs.org/q/-/q-1.5.1.tgz", - "integrity": "sha1-fjL3W0E4EpHQRhHxvxQQmsAGUdc=" + "integrity": "sha512-kV/CThkXo6xyFEZUugw/+pIOywXcDbFYgSct5cT3gqlbkBE1SJdwy6UQoZvodiWF/ckQLZyDE/Bu1M6gVu5lVw==" }, "qs": { - "version": "6.5.2", - "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.2.tgz", - "integrity": "sha512-N5ZAX4/LxJmF+7wN74pUD6qAh9/wnvdQcjq9TZjevvXzSUo7bfmw91saqMjzGS2xq91/odN2dW/WOl7qQHNDGA==" + "version": "6.5.3", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.3.tgz", + "integrity": "sha512-qxXIEh4pCGfHICj1mAJQ2/2XVZkjCDTcEgfoSQxc/fYivUZxTkk7L3bDBJSoNrEzXI17oUO5Dp07ktqE5KzczA==" }, "rc": { "version": "1.2.8", @@ -1465,37 +5766,98 @@ } }, "react": { - "version": "17.0.2", - "resolved": "https://registry.npmjs.org/react/-/react-17.0.2.tgz", - "integrity": "sha512-gnhPt75i/dq/z3/6q/0asP78D0u592D5L1pd7M8P+dck6Fu/jJeL6iVVK23fptSUZj8Vjf++7wXA8UNclGQcbA==", + "version": "18.2.0", + "resolved": "https://registry.npmjs.org/react/-/react-18.2.0.tgz", + "integrity": "sha512-/3IjMdb2L9QbBdWiW5e3P2/npwMBaU9mHCSCUzNln0ZCYbcfTsGbTJrU/kGemdH2IWmB2ioZ+zkxtmq6g09fGQ==", "requires": { - "loose-envify": "^1.1.0", - "object-assign": "^4.1.1" + "loose-envify": "^1.1.0" + } + }, + "react-clientside-effect": { + "version": "1.2.6", + "resolved": "https://registry.npmjs.org/react-clientside-effect/-/react-clientside-effect-1.2.6.tgz", + "integrity": "sha512-XGGGRQAKY+q25Lz9a/4EPqom7WRjz3z9R2k4jhVKA/puQFH/5Nt27vFZYql4m4NVNdUvX8PS3O7r/Zzm7cjUlg==", + "requires": { + "@babel/runtime": "^7.12.13" } }, "react-dom": { - "version": "17.0.2", - "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-17.0.2.tgz", - "integrity": "sha512-s4h96KtLDUQlsENhMn1ar8t2bEa+q/YAtj8pPPdIjPDGBDIVNsrD9aXNWqspUe6AzKCIG0C1HZZLqLV7qpOBGA==", + "version": "18.2.0", + "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-18.2.0.tgz", + "integrity": "sha512-6IMTriUmvsjHUjNtEDudZfuDQUoWXVxKHhlEGSk81n4YFS+r/Kl99wXiwlVXtPBtJenozv2P+hxDsw9eA7Xo6g==", "requires": { "loose-envify": "^1.1.0", - "object-assign": "^4.1.1", - "scheduler": "^0.20.2" + "scheduler": "^0.23.0" + } + }, + "react-focus-lock": { + "version": "2.9.4", + "resolved": "https://registry.npmjs.org/react-focus-lock/-/react-focus-lock-2.9.4.tgz", + "integrity": "sha512-7pEdXyMseqm3kVjhdVH18sovparAzLg5h6WvIx7/Ck3ekjhrrDMEegHSa3swwC8wgfdd7DIdUVRGeiHT9/7Sgg==", + "requires": { + "@babel/runtime": "^7.0.0", + "focus-lock": "^0.11.6", + "prop-types": "^15.6.2", + "react-clientside-effect": "^1.2.6", + "use-callback-ref": "^1.3.0", + "use-sidecar": "^1.1.2" + } + }, + "react-is": { + "version": "17.0.2", + "resolved": "https://registry.npmjs.org/react-is/-/react-is-17.0.2.tgz", + "integrity": "sha512-w2GsyukL62IJnlaff/nRegPQR94C/XXamvMWmSHRJ4y7Ts/4ocGRmTHvOs8PSE6pB3dWOrD/nueuU5sduBsQ4w==", + "peer": true + }, + "react-remove-scroll": { + "version": "2.5.6", + "resolved": "https://registry.npmjs.org/react-remove-scroll/-/react-remove-scroll-2.5.6.tgz", + "integrity": "sha512-bO856ad1uDYLefgArk559IzUNeQ6SWH4QnrevIUjH+GczV56giDfl3h0Idptf2oIKxQmd1p9BN25jleKodTALg==", + "requires": { + "react-remove-scroll-bar": "^2.3.4", + "react-style-singleton": "^2.2.1", + "tslib": "^2.1.0", + "use-callback-ref": "^1.3.0", + "use-sidecar": "^1.1.2" + } + }, + "react-remove-scroll-bar": { + "version": "2.3.4", + "resolved": "https://registry.npmjs.org/react-remove-scroll-bar/-/react-remove-scroll-bar-2.3.4.tgz", + "integrity": "sha512-63C4YQBUt0m6ALadE9XV56hV8BgJWDmmTPY758iIJjfQKt2nYwoUrPk0LXRXcB/yIj82T1/Ixfdpdk68LwIB0A==", + "requires": { + "react-style-singleton": "^2.2.1", + "tslib": "^2.0.0" + } + }, + "react-style-singleton": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/react-style-singleton/-/react-style-singleton-2.2.1.tgz", + "integrity": "sha512-ZWj0fHEMyWkHzKYUr2Bs/4zU6XLmq9HsgBURm7g5pAVfyn49DgUiNgY2d4lXRlYSiCif9YBGpQleewkcqddc7g==", + "requires": { + "get-nonce": "^1.0.0", + "invariant": "^2.2.4", + "tslib": "^2.0.0" } }, "read-all-stream": { "version": "3.1.0", "resolved": "https://registry.npmjs.org/read-all-stream/-/read-all-stream-3.1.0.tgz", - "integrity": "sha1-NcPhd/IHjveJ7kv6+kNzB06u9Po=", + "integrity": "sha512-DI1drPHbmBcUDWrJ7ull/F2Qb8HkwBncVx8/RpKYFSIACYaVRQReISYPdZz/mt1y1+qMCOrfReTopERmaxtP6w==", "requires": { "pinkie-promise": "^2.0.0", "readable-stream": "^2.0.0" }, "dependencies": { + "isarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", + "integrity": "sha512-VLghIWNM6ELQzo7zwmcg0NmTVyWKYjvIeM83yjp0wRDTmUnrM678fQbcKBo6n2CJEF0szoG//ytg+TKla89ALQ==" + }, "readable-stream": { - "version": "2.3.7", - "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.7.tgz", - "integrity": "sha512-Ebho8K4jIbHAxnuxi7o42OrZgF/ZTNcsZj6nRKyUmkhLFq8CHItp/fy6hQZuZmP/n3yZ9VBUbp4zz/mX8hmYPw==", + "version": "2.3.8", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz", + "integrity": "sha512-8p0AUk4XODgIewSi0l8Epjs+EVnWiK7NoDIEGU0HhE7+ZyY8D1IMY7odu5lRrFXGg71L15KG8QrPmum45RTtdA==", "requires": { "core-util-is": "~1.0.0", "inherits": "~2.0.3", @@ -1522,19 +5884,34 @@ } }, "readable-stream": { - "version": "3.6.0", - "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", - "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "version": "3.6.2", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.2.tgz", + "integrity": "sha512-9u/sniCrY3D5WdsERHzHE4G2YCXqoG5FTHUiCC4SIbr6XcLZBY05ya9EKjYek9O5xOAwjGq+1JdGBAS7Q9ScoA==", "requires": { "inherits": "^2.0.3", "string_decoder": "^1.1.1", "util-deprecate": "^1.0.1" } }, + "regenerator-runtime": { + "version": "0.13.11", + "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.13.11.tgz", + "integrity": "sha512-kY1AZVr2Ra+t+piVaJ4gxaFaReZVH40AKNo7UCX6W+dEwBo/2oZJzqfuN1qLq1oL45o56cPaTXELwrTh8Fpggg==" + }, + "regexp.prototype.flags": { + "version": "1.5.0", + "resolved": "https://registry.npmjs.org/regexp.prototype.flags/-/regexp.prototype.flags-1.5.0.tgz", + "integrity": "sha512-0SutC3pNudRKgquxGoRGIz946MZVHqbNfPjBdxeOhBrdgDKlRoXmYLQN9xRbrR09ZXWeGAdPuif7egofn6v5LA==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.2.0", + "functions-have-names": "^1.2.3" + } + }, "registry-url": { "version": "3.1.0", "resolved": "https://registry.npmjs.org/registry-url/-/registry-url-3.1.0.tgz", - "integrity": "sha1-PU74cPc93h138M+aOBQyRE4XSUI=", + "integrity": "sha512-ZbgR5aZEdf4UKZVBPYIgaglBmSF2Hi94s2PcIHhRGFjKYu+chjJdYfHn4rt3hB6eCKLJ8giVIIfgMa1ehDfZKA==", "requires": { "rc": "^1.0.1" } @@ -1542,12 +5919,12 @@ "repeat-string": { "version": "1.6.1", "resolved": "https://registry.npmjs.org/repeat-string/-/repeat-string-1.6.1.tgz", - "integrity": "sha1-jcrkcOHIirwtYA//Sndihtp15jc=" + "integrity": "sha512-PV0dzCYDNfRi1jCDbJzpW7jNNDRuCOG/jI5ctQcGKt/clZD+YcPS3yIlWuTJMmESC8aevCFmWJy5wjAFgNqN6w==" }, "repeating": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/repeating/-/repeating-1.1.3.tgz", - "integrity": "sha1-PUEUIYh3U3SU+X93+Xhfq4EPpKw=", + "integrity": "sha512-Nh30JLeMHdoI+AsQ5eblhZ7YlTsM9wiJQe/AHIunlK3KWzvXhXb36IJ7K1IOeRjIOtzMjdUHjwXUFxKJoPTSOg==", "requires": { "is-finite": "^1.0.0" } @@ -1582,16 +5959,37 @@ "right-align": { "version": "0.1.3", "resolved": "https://registry.npmjs.org/right-align/-/right-align-0.1.3.tgz", - "integrity": "sha1-YTObci/mo1FWiSENJOFMlhSGE+8=", + "integrity": "sha512-yqINtL/G7vs2v+dFIZmFUDbnVyFUJFKd6gK22Kgo6R4jfJGFtisKyncWDDULgjfqf4ASQuIQyjJ7XZ+3aWpsAg==", "requires": { "align-text": "^0.1.1" } }, + "safe-array-concat": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/safe-array-concat/-/safe-array-concat-1.0.0.tgz", + "integrity": "sha512-9dVEFruWIsnie89yym+xWTAYASdpw3CJV7Li/6zBewGf9z2i1j31rP6jnY0pHEO4QZh6N0K11bFjWmdR8UGdPQ==", + "requires": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.2.0", + "has-symbols": "^1.0.3", + "isarray": "^2.0.5" + } + }, "safe-buffer": { "version": "5.2.1", "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", "integrity": "sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==" }, + "safe-regex-test": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/safe-regex-test/-/safe-regex-test-1.0.0.tgz", + "integrity": "sha512-JBUUzyOgEwXQY1NuPtvcj/qcBDbDmEvWufhlnXZIm75DEHp+afM1r1ujJpJsV/gSM4t59tpDyPi1sd6ZaPFfsA==", + "requires": { + "call-bind": "^1.0.2", + "get-intrinsic": "^1.1.3", + "is-regex": "^1.1.4" + } + }, "safer-buffer": { "version": "2.1.2", "resolved": "https://registry.npmjs.org/safer-buffer/-/safer-buffer-2.1.2.tgz", @@ -1603,12 +6001,11 @@ "integrity": "sha512-NqVDv9TpANUjFm0N8uM5GxL36UgKi9/atZw+x7YFnQ8ckwFGKrl4xX4yWtrey3UJm5nP1kUbnYgLopqWNSRhWw==" }, "scheduler": { - "version": "0.20.2", - "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.20.2.tgz", - "integrity": "sha512-2eWfGgAqqWFGqtdMmcL5zCMK1U8KlXv8SQFGglL3CEtd0aDVDWgeF/YoCmvln55m5zSk3J/20hTaSBeSObsQDQ==", + "version": "0.23.0", + "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.23.0.tgz", + "integrity": "sha512-CtuThmgHNg7zIZWAXi3AsyIzA3n4xx7aNyjwC2VJldO2LMVDhFK+63xGqq6CsJH4rTAt6/M+N4GhZiDYPx9eUw==", "requires": { - "loose-envify": "^1.1.0", - "object-assign": "^4.1.1" + "loose-envify": "^1.1.0" } }, "semver": { @@ -1619,15 +6016,34 @@ "semver-diff": { "version": "2.1.0", "resolved": "https://registry.npmjs.org/semver-diff/-/semver-diff-2.1.0.tgz", - "integrity": "sha1-S7uEN8jTfksM8aaP1ybsbWRdbTY=", + "integrity": "sha512-gL8F8L4ORwsS0+iQ34yCYv///jsOq0ZL7WP55d1HnJ32o7tyFYEFQZQA22mrLIacZdU6xecaBBZ+uEiffGNyXw==", "requires": { "semver": "^5.0.3" } }, + "set-value": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/set-value/-/set-value-4.1.0.tgz", + "integrity": "sha512-zTEg4HL0RwVrqcWs3ztF+x1vkxfm0lP+MQQFPiMJTKVceBwEV0A569Ou8l9IYQG8jOZdMVI1hGsc0tmeD2o/Lw==", + "requires": { + "is-plain-object": "^2.0.4", + "is-primitive": "^3.0.1" + } + }, + "side-channel": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/side-channel/-/side-channel-1.0.4.tgz", + "integrity": "sha512-q5XPytqFEIKHkGdiMIrY10mvLRvnQh42/+GoBlFW3b2LXLE2xxJpZFdm94we0BaoV3RwJyGqg5wS7epxTv0Zvw==", + "requires": { + "call-bind": "^1.0.0", + "get-intrinsic": "^1.0.2", + "object-inspect": "^1.9.0" + } + }, "slide": { "version": "1.1.6", "resolved": "https://registry.npmjs.org/slide/-/slide-1.1.6.tgz", - "integrity": "sha1-VusCfWW00tzmyy4tMsTUr8nh1wc=" + "integrity": "sha512-NwrtjCg+lZoqhFU8fOwl4ay2ei8PaqCBOUV3/ektPY9trO1yQ1oXEfmHAhKArUVUr/hOHvy5f6AdP17dCM0zMw==" }, "source-map": { "version": "0.6.1", @@ -1637,12 +6053,12 @@ "sprintf-js": { "version": "1.0.3", "resolved": "https://registry.npmjs.org/sprintf-js/-/sprintf-js-1.0.3.tgz", - "integrity": "sha1-BOaSb2YolTVPPdAVIDYzuFcpfiw=" + "integrity": "sha512-D9cPgkvLlV3t3IzL0D0YLvGA9Ahk4PcvVwUbN0dSGr1aP0Nrt4AEnTUbuGvquEC0mA64Gqt1fzirlRs5ibXx8g==" }, "sshpk": { - "version": "1.16.1", - "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.16.1.tgz", - "integrity": "sha512-HXXqVUq7+pcKeLqqZj6mHFUMvXtOJt1uoUx09pFW6011inTMxqI8BA8PM95myrIyyKwdnzjdFjLiE6KBPVtJIg==", + "version": "1.17.0", + "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.17.0.tgz", + "integrity": "sha512-/9HIEs1ZXGhSPE8X6Ccm7Nam1z8KcoCqPdI7ecm1N33EzAetWahvQWVqLZtaZQ+IDKX4IyA2o0gBzqIMkAagHQ==", "requires": { "asn1": "~0.2.3", "assert-plus": "^1.0.0", @@ -1665,44 +6081,56 @@ "resolved": "https://registry.npmjs.org/stream-shift/-/stream-shift-1.0.1.tgz", "integrity": "sha512-AiisoFqQ0vbGcZgQPY1cdP2I76glaVA/RauYR4G4thNFgkTqr90yXTo4LYX60Jl+sIlPNHHdGSwo01AvbKUSVQ==" }, + "string_decoder": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.3.0.tgz", + "integrity": "sha512-hkRX8U1WjJFd8LsDJ2yQ/wWWxaopEsABU1XfkM8A+j0+85JAGppt16cr1Whg6KIbb4okU6Mql6BOj+uup/wKeA==", + "requires": { + "safe-buffer": "~5.2.0" + } + }, "string-length": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/string-length/-/string-length-1.0.1.tgz", - "integrity": "sha1-VpcPscOFWOnnC3KL894mmsRa36w=", + "integrity": "sha512-MNCACnufWUf3pQ57O5WTBMkKhzYIaKEcUioO0XHrTMafrbBaNk4IyDOLHBv5xbXO0jLLdsYWeFjpjG2hVHRDtw==", "requires": { "strip-ansi": "^3.0.0" } }, - "string.prototype.trimend": { - "version": "1.0.4", - "resolved": "https://registry.npmjs.org/string.prototype.trimend/-/string.prototype.trimend-1.0.4.tgz", - "integrity": "sha512-y9xCjw1P23Awk8EvTpcyL2NIr1j7wJ39f+k6lvRnSMz+mz9CGz9NYPelDk42kOz6+ql8xjfK8oYzy3jAP5QU5A==", + "string.prototype.trim": { + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/string.prototype.trim/-/string.prototype.trim-1.2.7.tgz", + "integrity": "sha512-p6TmeT1T3411M8Cgg9wBTMRtY2q9+PNy9EV1i2lIXUN/btt763oIfxwN3RR8VU6wHX8j/1CFy0L+YuThm6bgOg==", "requires": { "call-bind": "^1.0.2", - "define-properties": "^1.1.3" + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" } }, - "string.prototype.trimstart": { - "version": "1.0.4", - "resolved": "https://registry.npmjs.org/string.prototype.trimstart/-/string.prototype.trimstart-1.0.4.tgz", - "integrity": "sha512-jh6e984OBfvxS50tdY2nRZnoC5/mLFKOREQfw8t5yytkoUsJRNxvI/E39qu1sD0OtWI3OC0XgKSmcWwziwYuZw==", + "string.prototype.trimend": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/string.prototype.trimend/-/string.prototype.trimend-1.0.6.tgz", + "integrity": "sha512-JySq+4mrPf9EsDBEDYMOb/lM7XQLulwg5R/m1r0PXEFqrV0qHvl58sdTilSXtKOflCsK2E8jxf+GKC0T07RWwQ==", "requires": { "call-bind": "^1.0.2", - "define-properties": "^1.1.3" + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" } }, - "string_decoder": { - "version": "1.3.0", - "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.3.0.tgz", - "integrity": "sha512-hkRX8U1WjJFd8LsDJ2yQ/wWWxaopEsABU1XfkM8A+j0+85JAGppt16cr1Whg6KIbb4okU6Mql6BOj+uup/wKeA==", + "string.prototype.trimstart": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/string.prototype.trimstart/-/string.prototype.trimstart-1.0.6.tgz", + "integrity": "sha512-omqjMDaY92pbn5HOX7f9IccLA+U1tA9GvtU4JrodiXFfYB7jPzzHpRzpglLAjtUV6bB557zwClJezTqnAiYnQA==", "requires": { - "safe-buffer": "~5.2.0" + "call-bind": "^1.0.2", + "define-properties": "^1.1.4", + "es-abstract": "^1.20.4" } }, "strip-ansi": { "version": "3.0.1", "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", - "integrity": "sha1-ajhfuIU9lS1f8F0Oiq+UJ43GPc8=", + "integrity": "sha512-VhumSSbBqDTP8p2ZLKj40UjBCV4+v8bUSEpUb4KjRgWk9pbqGF4REFj6KEagidb2f/M6AzC0EmFyDNGaw9OCzg==", "requires": { "ansi-regex": "^2.0.0" } @@ -1710,25 +6138,18 @@ "strip-json-comments": { "version": "2.0.1", "resolved": "https://registry.npmjs.org/strip-json-comments/-/strip-json-comments-2.0.1.tgz", - "integrity": "sha1-PFMZQukIwml8DsNEhYwobHygpgo=" + "integrity": "sha512-4gB8na07fecVVkOI6Rs4e7T6NOTki5EmL7TUduTs6bu3EdnSycntVJ4re8kgZA+wx9IueI2Y11bfbgwtzuE0KQ==" }, - "subscriptions-transport-ws": { - "version": "0.9.18", - "resolved": "https://registry.npmjs.org/subscriptions-transport-ws/-/subscriptions-transport-ws-0.9.18.tgz", - "integrity": "sha512-tztzcBTNoEbuErsVQpTN2xUNN/efAZXyCyL5m3x4t6SKrEiTL2N8SaKWBFWM4u56pL79ULif3zjyeq+oV+nOaA==", - "optional": true, - "requires": { - "backo2": "^1.0.2", - "eventemitter3": "^3.1.0", - "iterall": "^1.2.1", - "symbol-observable": "^1.0.4", - "ws": "^5.2.0" - } + "style-mod": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/style-mod/-/style-mod-4.0.3.tgz", + "integrity": "sha512-78Jv8kYJdjbvRwwijtCevYADfsI0lGzYJe4mMFdceO8l75DFFDoqBhR1jVDicDRRaX4//g1u9wKeo+ztc2h1Rw==", + "peer": true }, "supports-color": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-2.0.0.tgz", - "integrity": "sha1-U10EXOa2Nj+kARcIRimZXp3zJMc=" + "integrity": "sha512-KKNVtd6pCYgPIKU4cp2733HWYCpplQhddZLBUryaAHou723x+FRzQ5Df824Fj+IyyuiQTRoub4SnIFfIcrp70g==" }, "svgo": { "version": "1.3.2", @@ -1803,16 +6224,15 @@ } } }, - "symbol-observable": { - "version": "1.2.0", - "resolved": "https://registry.npmjs.org/symbol-observable/-/symbol-observable-1.2.0.tgz", - "integrity": "sha512-e900nM8RRtGhlV36KGEU9k65K3mPb1WV70OdjfxlG2EAuM1noi/E/BaW/uMhL7bPEssK8QV57vN3esixjUvcXQ==", - "optional": true + "tabbable": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/tabbable/-/tabbable-4.0.0.tgz", + "integrity": "sha512-H1XoH1URcBOa/rZZWxLxHCtOdVUEev+9vo5YdYhC9tCY4wnybX+VQrCYuy9ubkg69fCBxCONJOSLGfw0DWMffQ==" }, "then-fs": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/then-fs/-/then-fs-2.0.0.tgz", - "integrity": "sha1-cveS3Z0xcFqRrhnr/Piz+WjIHaI=", + "integrity": "sha512-5ffcBcU+vFUCYDNi/o507IqjqrTkuGsLVZ1Fp50hwgZRY7ufVFa9jFfTy5uZ2QnSKacKigWKeaXkOqLa4DsjLw==", "requires": { "promise": ">=3.2 <8" } @@ -1820,12 +6240,17 @@ "timed-out": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/timed-out/-/timed-out-2.0.0.tgz", - "integrity": "sha1-84sK6B03R9YoAB9B2vxlKs5nHAo=" + "integrity": "sha512-pqqJOi1rF5zNs/ps4vmbE4SFCrM4iR7LW+GHAsHqO/EumqbIWceioevYLM5xZRgQSH6gFgL9J/uB7EcJhQ9niQ==" + }, + "tiny-warning": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/tiny-warning/-/tiny-warning-1.0.3.tgz", + "integrity": "sha512-lBN9zLN/oAf68o3zNXYrdCt1kP8WsiGW8Oo2ka41b2IM5JL/S1CTyX1rW0mb/zSuJun0ZUrDxx4sqvYS2FWzPA==" }, "toggle-selection": { "version": "1.0.6", "resolved": "https://registry.npmjs.org/toggle-selection/-/toggle-selection-1.0.6.tgz", - "integrity": "sha1-bkWxJj8gF/oKzH2J14sVuL932jI=" + "integrity": "sha512-BiZS+C1OS8g/q2RRbJmy59xpyghNBqrr6k5L/uKBGRsTfxmu3ffiRnd8mlGPUVayg8pvfi5urfnu8TU7DVOkLQ==" }, "tough-cookie": { "version": "2.5.0", @@ -1836,10 +6261,15 @@ "punycode": "^2.1.1" } }, + "tslib": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/tslib/-/tslib-2.5.0.tgz", + "integrity": "sha512-336iVw3rtn2BUK7ORdIAHTyxHGRIHVReokCR3XjbckJMK7ms8FysBfhLR8IXnAgy7T0PTPNBWKiH514FOW/WSg==" + }, "tunnel-agent": { "version": "0.6.0", "resolved": "https://registry.npmjs.org/tunnel-agent/-/tunnel-agent-0.6.0.tgz", - "integrity": "sha1-J6XeoGs2sEoKmWZ3SykIaPD8QP0=", + "integrity": "sha512-McnNiV1l8RYeY8tBgEpuodCC1mLUdbSN+CYBL7kJsJNInOP8UjDDEwdk6Mw60vdLLrr5NHKZhMAOSrR2NZuQ+w==", "requires": { "safe-buffer": "^5.0.1" } @@ -1847,7 +6277,17 @@ "tweetnacl": { "version": "0.14.5", "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", - "integrity": "sha1-WuaBd/GS1EViadEIr6k/+HQ/T2Q=" + "integrity": "sha512-KXXFFdAbFXY4geFIwoyNK+f5Z1b7swfXABfL7HXCmoIWMKU3dmS26672A4EeQtDzLKy7SXmfBu51JolvEKwtGA==" + }, + "typed-array-length": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/typed-array-length/-/typed-array-length-1.0.4.tgz", + "integrity": "sha512-KjZypGq+I/H7HI5HlOoGHkWUUGq+Q0TPhQurLbyrVrvnKTBgzLhIJ7j6J/XTQOi0d1RjyZ0wdas8bKs2p0x3Ng==", + "requires": { + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "is-typed-array": "^1.1.9" + } }, "uc.micro": { "version": "1.0.6", @@ -1857,7 +6297,7 @@ "uglify-js": { "version": "2.8.29", "resolved": "https://registry.npmjs.org/uglify-js/-/uglify-js-2.8.29.tgz", - "integrity": "sha1-KcVzMUgFe7Th913zW3qcty5qWd0=", + "integrity": "sha512-qLq/4y2pjcU3vhlhseXGGJ7VbFO4pBANu0kwl8VCa9KEI0V8VfZIx2Fy3w01iSTA/pGwKZSmu/+I4etLNDdt5w==", "requires": { "source-map": "~0.5.1", "uglify-to-browserify": "~1.0.0", @@ -1867,36 +6307,36 @@ "source-map": { "version": "0.5.7", "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", - "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + "integrity": "sha512-LbrmJOMUSdEVxIKvdcJzQC+nQhe8FUZQTXQy6+I75skNgn3OoQ0DZA8YnFa7gp8tqtL3KPf1kmo0R5DoApeSGQ==" } } }, "uglify-to-browserify": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/uglify-to-browserify/-/uglify-to-browserify-1.0.2.tgz", - "integrity": "sha1-bgkk1r2mta/jSeOabWMoUKD4grc=", + "integrity": "sha512-vb2s1lYx2xBtUgy+ta+b2J/GLVUR+wmpINwHePmPRhOsIVCG2wDzKJ0n14GslH1BifsqVzSOwQhRaCAsZ/nI4Q==", "optional": true }, "unbox-primitive": { - "version": "1.0.1", - "resolved": "https://registry.npmjs.org/unbox-primitive/-/unbox-primitive-1.0.1.tgz", - "integrity": "sha512-tZU/3NqK3dA5gpE1KtyiJUrEB0lxnGkMFHptJ7q6ewdZ8s12QrODwNbhIJStmJkd1QDXa1NRA8aF2A1zk/Ypyw==", + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/unbox-primitive/-/unbox-primitive-1.0.2.tgz", + "integrity": "sha512-61pPlCD9h51VoreyJ0BReideM3MDKMKnh6+V9L08331ipq6Q8OFXZYiqP6n/tbHx4s5I9uRhcye6BrbkizkBDw==", "requires": { - "function-bind": "^1.1.1", - "has-bigints": "^1.0.1", - "has-symbols": "^1.0.2", + "call-bind": "^1.0.2", + "has-bigints": "^1.0.2", + "has-symbols": "^1.0.3", "which-boxed-primitive": "^1.0.2" } }, "unquote": { "version": "1.1.1", "resolved": "https://registry.npmjs.org/unquote/-/unquote-1.1.1.tgz", - "integrity": "sha1-j97XMk7G6IoP+LkF58CYzcCG1UQ=" + "integrity": "sha512-vRCqFv6UhXpWxZPyGDh/F3ZpNv8/qo7w6iufLpQg9aKnQ71qM4B5KiI7Mia9COcjEhrO9LueHpMYjYzsWH3OIg==" }, "update-notifier": { "version": "0.5.0", "resolved": "https://registry.npmjs.org/update-notifier/-/update-notifier-0.5.0.tgz", - "integrity": "sha1-B7XcIGazYnqztPUwEw9+3doHpMw=", + "integrity": "sha512-zOGOlUKDAgDlLHLv7Oiszz3pSj8fKlSJ3i0u49sEakjXUEVJ6DMjo/Mh/B6mg2eOALvRTJkd0kbChcipQoYCng==", "requires": { "chalk": "^1.0.0", "configstore": "^1.0.0", @@ -1915,10 +6355,27 @@ "punycode": "^2.1.0" } }, + "use-callback-ref": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/use-callback-ref/-/use-callback-ref-1.3.0.tgz", + "integrity": "sha512-3FT9PRuRdbB9HfXhEq35u4oZkvpJ5kuYbpqhCfmiZyReuRgpnhDlbr2ZEnnuS0RrJAPn6l23xjFg9kpDM+Ms7w==", + "requires": { + "tslib": "^2.0.0" + } + }, + "use-sidecar": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/use-sidecar/-/use-sidecar-1.1.2.tgz", + "integrity": "sha512-epTbsLuzZ7lPClpz2TyryBfztm7m+28DlEv2ZCQ3MDr5ssiwyOwGH/e5F9CkfWjJ1t4clvI58yF822/GUkjjhw==", + "requires": { + "detect-node-es": "^1.1.0", + "tslib": "^2.0.0" + } + }, "util-deprecate": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", - "integrity": "sha1-RQ1Nyfpw3nMnYvvS1KKJgUGaDM8=" + "integrity": "sha512-EPD5q1uXyFxJpCrLnCc1nHnq3gOa6DZBocAIiI2TaSCA7VCJ1UJDMagCzIkXNsUYfD1daK//LTEQ8xiIbrHtcw==" }, "util.promisify": { "version": "1.0.1", @@ -1939,7 +6396,7 @@ "verror": { "version": "1.10.0", "resolved": "https://registry.npmjs.org/verror/-/verror-1.10.0.tgz", - "integrity": "sha1-OhBcoXBTr1XW4nDB+CiGguGNpAA=", + "integrity": "sha512-ZZKSmDAEFOijERBLkmYfJ+vmk3w+7hOLYDNkRCuRuMJGEmqYNCNLyBBFwWKVMhfwaEF3WOd0Zlw86U/WC/+nYw==", "requires": { "assert-plus": "^1.0.0", "core-util-is": "1.0.2", @@ -1947,9 +6404,15 @@ } }, "vscode-languageserver-types": { - "version": "3.16.0", - "resolved": "https://registry.npmjs.org/vscode-languageserver-types/-/vscode-languageserver-types-3.16.0.tgz", - "integrity": "sha512-k8luDIWJWyenLc5ToFQQMaSrqCHiLwyKPHKPQZ5zz21vM+vIVUSvsRpcbiECH4WR88K2XZqc4ScRcZ7nk/jbeA==" + "version": "3.17.3", + "resolved": "https://registry.npmjs.org/vscode-languageserver-types/-/vscode-languageserver-types-3.17.3.tgz", + "integrity": "sha512-SYU4z1dL0PyIMd4Vj8YOqFvHu7Hz/enbWtpfnVbJHU4Nd1YNYx8u0ennumc6h48GQNeOLxmwySmnADouT/AuZA==" + }, + "w3c-keyname": { + "version": "2.2.6", + "resolved": "https://registry.npmjs.org/w3c-keyname/-/w3c-keyname-2.2.6.tgz", + "integrity": "sha512-f+fciywl1SJEniZHD6H+kUO8gOnwIr7f4ijKA6+ZvJFjeGi1r4PDLl53Ayud9O/rk64RqgoQine0feoeOU0kXg==", + "peer": true }, "which-boxed-primitive": { "version": "1.0.2", @@ -1963,44 +6426,48 @@ "is-symbol": "^1.0.3" } }, + "which-typed-array": { + "version": "1.1.9", + "resolved": "https://registry.npmjs.org/which-typed-array/-/which-typed-array-1.1.9.tgz", + "integrity": "sha512-w9c4xkx6mPidwp7180ckYWfMmvxpjlZuIudNtDf4N/tTAUB8VJbX25qZoAsrtGuYNnGw3pa0AXgbGKRB8/EceA==", + "requires": { + "available-typed-arrays": "^1.0.5", + "call-bind": "^1.0.2", + "for-each": "^0.3.3", + "gopd": "^1.0.1", + "has-tostringtag": "^1.0.0", + "is-typed-array": "^1.1.10" + } + }, "window-size": { "version": "0.1.0", "resolved": "https://registry.npmjs.org/window-size/-/window-size-0.1.0.tgz", - "integrity": "sha1-VDjNLqk7IC76Ohn+iIeu58lPnJ0=" + "integrity": "sha512-1pTPQDKTdd61ozlKGNCjhNRd+KPmgLSGa3mZTHoOliaGcESD8G1PXhh7c1fgiPjVbNVfgy2Faw4BI8/m0cC8Mg==" }, "wordwrap": { "version": "0.0.2", "resolved": "https://registry.npmjs.org/wordwrap/-/wordwrap-0.0.2.tgz", - "integrity": "sha1-t5Zpu0LstAn4PVg8rVLKF+qhZD8=" + "integrity": "sha512-xSBsCeh+g+dinoBv3GAOWM4LcVVO68wLXRanibtBSdUvkGWQRGeE9P7IwU9EmDDi4jA6L44lz15CGMwdw9N5+Q==" }, "wrappy": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/wrappy/-/wrappy-1.0.2.tgz", - "integrity": "sha1-tSQ9jz7BqjXxNkYFvA0QNuMKtp8=" + "integrity": "sha512-l4Sp/DRseor9wL6EvV2+TuQn63dMkPjZ/sp9XkghTEbV9KlPS1xUsZ3u7/IQO4wxtcFB4bgpQPRcR3QCvezPcQ==" }, "write-file-atomic": { "version": "1.3.4", "resolved": "https://registry.npmjs.org/write-file-atomic/-/write-file-atomic-1.3.4.tgz", - "integrity": "sha1-+Aek8LHZ6ROuekgRLmzDrxmRtF8=", + "integrity": "sha512-SdrHoC/yVBPpV0Xq/mUZQIpW2sWXAShb/V4pomcJXh92RuaO+f3UTWItiR3Px+pLnV2PvC2/bfn5cwr5X6Vfxw==", "requires": { "graceful-fs": "^4.1.11", "imurmurhash": "^0.1.4", "slide": "^1.1.5" } }, - "ws": { - "version": "5.2.2", - "resolved": "https://registry.npmjs.org/ws/-/ws-5.2.2.tgz", - "integrity": "sha512-jaHFD6PFv6UgoIVda6qZllptQsMlDEJkTQcybzzXDYM1XO9Y8em691FGMPmM46WGyLU4z9KMgQN+qrux/nhlHA==", - "optional": true, - "requires": { - "async-limiter": "~1.0.0" - } - }, "xdg-basedir": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/xdg-basedir/-/xdg-basedir-2.0.0.tgz", - "integrity": "sha1-7byQPMOF/ARSPZZqM1UEtVBNG9I=", + "integrity": "sha512-NF1pPn594TaRSUO/HARoB4jK8I+rWgcpVlpQCK6/6o5PHyLUt2CSiDrpUZbQ6rROck+W2EwF8mBJcTs+W98J9w==", "requires": { "os-homedir": "^1.0.0" } @@ -2008,7 +6475,7 @@ "yargs": { "version": "3.10.0", "resolved": "https://registry.npmjs.org/yargs/-/yargs-3.10.0.tgz", - "integrity": "sha1-9+572FfdfB0tOMDnTvvWgdFDH9E=", + "integrity": "sha512-QFzUah88GAGy9lyDKGBqZdkYApt63rCXYBGYnEP4xDJPXNqXXnBDACnbrXnViV6jRSqAePwrATi2i8mfYm4L1A==", "requires": { "camelcase": "^1.0.2", "cliui": "^2.1.0", diff --git a/src/graphiql/package.json b/src/graphiql/package.json index ec6fe59f..97dbeff8 100644 --- a/src/graphiql/package.json +++ b/src/graphiql/package.json @@ -2,10 +2,10 @@ "name": "dream-graphiql", "private": true, "dependencies": { - "graphiql": "^1.4.1", - "graphql": "^15.5.0", + "graphiql": "^2.4.1", + "graphql": "^16.6.0", "inliner": "aantron/inliner#fork", - "react": "^17.0.2", - "react-dom": "^17.0.2" + "react": "^18.2.0", + "react-dom": "^18.2.0" } } From 14093e16ccede8fd29f0b4b6cdd0933e1e32cc93 Mon Sep 17 00:00:00 2001 From: Jean-Michel Bea Date: Fri, 10 Jun 2022 20:21:02 +0100 Subject: [PATCH 279/312] Reason 3.8.x releases support recent OCaml Cherry-picked from #229. --- .github/workflows/test.yml | 2 -- example/r-fullstack-melange/esy.json | 2 +- example/r-graphql/esy.json | 2 +- example/r-hello/esy.json | 2 +- example/r-template-logic/esy.json | 2 +- example/r-template-stream/esy.json | 2 +- example/r-template/esy.json | 2 +- example/r-tyxml/README.md | 2 +- example/r-tyxml/esy.json | 2 +- example/z-playground/opam-switch | 2 +- 10 files changed, 9 insertions(+), 11 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 1634b245..a167c35e 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -35,8 +35,6 @@ jobs: - run: opam depext --yes conf-postgresql - run: opam depext --yes conf-libev - # Needed until https://github.com/reasonml/reason/pull/2660 is in opam. - - run: opam pin add reason --yes --no-action --dev-repo # The tests require ppx_expect. The latest versions of it introduced changes # in the formatting of the output, and also require OCaml >= 4.10, which diff --git a/example/r-fullstack-melange/esy.json b/example/r-fullstack-melange/esy.json index 9612eb3d..c2241544 100644 --- a/example/r-fullstack-melange/esy.json +++ b/example/r-fullstack-melange/esy.json @@ -4,7 +4,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "melange": "melange-re/melange", "ocaml": "^4.14.0" }, diff --git a/example/r-graphql/esy.json b/example/r-graphql/esy.json index 0bc13c60..6482d70e 100644 --- a/example/r-graphql/esy.json +++ b/example/r-graphql/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "ocaml": "^4.14.0" }, "devDependencies": { diff --git a/example/r-hello/esy.json b/example/r-hello/esy.json index 636d8f3f..f310f7ec 100644 --- a/example/r-hello/esy.json +++ b/example/r-hello/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "ocaml": "^4.14.0" }, "devDependencies": { diff --git a/example/r-template-logic/esy.json b/example/r-template-logic/esy.json index 366d43f6..e29ae7c3 100644 --- a/example/r-template-logic/esy.json +++ b/example/r-template-logic/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "ocaml": "^4.14.0" }, "devDependencies": { diff --git a/example/r-template-stream/esy.json b/example/r-template-stream/esy.json index c1d1ccaa..3ef68400 100644 --- a/example/r-template-stream/esy.json +++ b/example/r-template-stream/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "ocaml": "^4.14.0" }, "devDependencies": { diff --git a/example/r-template/esy.json b/example/r-template/esy.json index 366d43f6..e29ae7c3 100644 --- a/example/r-template/esy.json +++ b/example/r-template/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "ocaml": "^4.14.0" }, "devDependencies": { diff --git a/example/r-tyxml/README.md b/example/r-tyxml/README.md index b0fa8508..26a6d273 100644 --- a/example/r-tyxml/README.md +++ b/example/r-tyxml/README.md @@ -44,7 +44,7 @@ To get this, we depend on package `tyxml-jsx` in "dependencies": { "@opam/dream": "1.0.0~alpha4", "@opam/dune": "^2.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "@opam/tyxml": "*", "@opam/tyxml-jsx": "*", "ocaml": "4.12.x" diff --git a/example/r-tyxml/esy.json b/example/r-tyxml/esy.json index 1dbab688..3010d31e 100644 --- a/example/r-tyxml/esy.json +++ b/example/r-tyxml/esy.json @@ -3,7 +3,7 @@ "@opam/conf-libssl": "3", "@opam/dream": "1.0.0~alpha5", "@opam/dune": "^3.0", - "@opam/reason": "^3.7.0", + "@opam/reason": "^3.8.0", "@opam/tyxml": "*", "@opam/tyxml-jsx": "*", "ocaml": "^4.14.0" diff --git a/example/z-playground/opam-switch b/example/z-playground/opam-switch index cb55fb78..feee2adc 100644 --- a/example/z-playground/opam-switch +++ b/example/z-playground/opam-switch @@ -95,7 +95,7 @@ installed: [ "psq.0.2.0" "ptime.0.8.6" "re.1.10.3" - "reason.3.7.0" + "reason.3.8.0" "result.1.5" "rresult.0.7.0" "seq.base" From e14bd91a4481fe36baa38347d3e3746ac545ddbe Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 11 May 2023 06:51:12 +0300 Subject: [PATCH 280/312] Remove deprecated values Path getter and setter not removed. See #238. not_found just deprecated, so not removed, for users to have more of a chance to adapt. --- src/dream.ml | 46 ------------ src/dream.mli | 169 ------------------------------------------ src/server/tag.eml.ml | 31 -------- 3 files changed, 246 deletions(-) diff --git a/src/dream.ml b/src/dream.ml index 9f01675b..7409ac00 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -209,9 +209,6 @@ let verify_csrf_token = Csrf.verify_csrf_token ~now (* Templates *) -let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = - Tag.form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request - let csrf_tag = Tag.csrf_tag ~now @@ -274,7 +271,6 @@ let session_expires_at = Session.session_expires_at let flash = Flash.flash_messages let flash_messages = Flash.flash -let put_flash = Flash.put_flash let add_flash_message = Flash.put_flash @@ -400,48 +396,6 @@ let echo = Echo.echo (* Deprecated helpers. *) -let with_client client message = - Helpers.set_client message client; - message - -let with_method_ method_ message = - Message.set_method_ message method_; - message - let with_path path message = Router.set_path message path; message - -let with_header name value message = - Message.set_header message name value; - message - -let with_body body message = - Message.set_body message body; - message - -let with_stream message = - message - -let write_buffer ?(offset = 0) ?length message chunk = - let length = - match length with - | Some length -> length - | None -> Bigstringaf.length chunk - offset - in - let string = Bigstringaf.substring chunk ~off:offset ~len:length in - write (Message.server_stream message) string - -type 'a local = 'a Message.field -let new_local = Message.new_field -let local = Message.field - -let with_local key value message = - Message.set_field message key value; - message - -let first message = - message - -let last message = - message diff --git a/src/dream.mli b/src/dream.mli index 9d55391c..4d122e2f 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -386,25 +386,9 @@ https://github.com/aantron/dream/issues val set_client : request -> string -> unit (** Replaces the client. See {!Dream.val-client}. *) -(**/**) -val with_client : string -> request -> request -[@@ocaml.deprecated -"Use Dream.set_client. See -https://aantron.github.io/dream/#val-set_client -"] -(**/**) - val set_method_ : request -> [< method_ ] -> unit (** Replaces the method. See {!Dream.type-method_}. *) -(**/**) -val with_method_ : [< method_ ] -> request -> request -[@@ocaml.deprecated -"Use Dream.set_method_. See -https://aantron.github.io/dream/#val-set_method_ -"] -(**/**) - (**/**) val with_path : string list -> request -> request [@@ocaml.deprecated @@ -533,14 +517,6 @@ val drop_header : 'a message -> string -> unit val set_header : 'a message -> string -> string -> unit (** Equivalent to {!Dream.drop_header} followed by {!Dream.add_header}. *) -(**/**) -val with_header : string -> string -> 'a message -> 'a message -[@@ocaml.deprecated -"Use Dream.set_header. See -https://aantron.github.io/dream/#val-with_header -"] -(**/**) - (** {1 Cookies} @@ -704,14 +680,6 @@ val body : 'a message -> string promise val set_body : 'a message -> string -> unit (** Replaces the body. *) -(**/**) -val with_body : string -> response -> response -[@@ocaml.deprecated -"Use Dream.set_body. See -https://aantron.github.io/dream/#val-set_body -"] -(**/**) - (** {1 Streams} *) @@ -749,14 +717,6 @@ val read : stream -> string option promise (* TODO Document difference between receiving a request and receiving on a WebSocket. *) -(**/**) -val with_stream : response -> response -[@@ocaml.deprecated -"Use Dream.stream instead. See -https://aantron.github.io/dream/#val-set_stream -"] -(**/**) - val write : stream -> string -> unit promise (** Streams out the string. The promise is fulfilled when the response can accept more writes. *) @@ -868,15 +828,6 @@ val abort_stream : stream -> exn -> unit (** Aborts the stream, causing all readers and writers to receive the given exception. *) -(**/**) -val write_buffer : - ?offset:int -> ?length:int -> response -> buffer -> unit promise -[@@ocaml.deprecated -"Use Dream.write_stream. See -https://aantron.github.io/dream/#val-write_stream -"] -(**/**) - (* TODO Ergonomics of this stream surface API. *) @@ -1334,46 +1285,6 @@ val csrf_tag : request -> string recommended} to put the CSRF tag immediately after the starting [] tag, to prevent certain kinds of DOM manipulation-based attacks. *) -(**/**) -val form_tag : - ?method_:[< method_ ] -> - ?target:string -> - ?enctype:[< `Multipart_form_data ] -> - ?csrf_token:bool -> - action:string -> request -> string -[@ocaml.deprecated -"Use Dream.csrf_tag. See -https://aantron.github.io/dream/#val-csrf_tag -"] -(** Generates a [] tag and an [] tag with a CSRF token, suitable - for use with {!Dream.val-form} and {!Dream.val-multipart}. For example, in - a template, - - {[ - <%s! Dream.form_tag ~action:"/" request %> - - - ]} - - expands to - - {[ -
- - -
- ]} - - [~method] sets the method used to submit the form. The default is [`POST]. - - [~target] adds a [target] attribute. For example, [~target:"_blank"] causes - the browser to submit the form in a new tab or window. - - Pass [~enctype:`Multipart_form_data] for a file upload form. - - [~csrf_token:false] suppresses generation of the [dream.csrf] field. *) -(**/**) - (** {1 Middleware} @@ -1646,37 +1557,13 @@ val mime_lookup : string -> (string * string) list val session_field : request -> string -> string option (** Value from the request's session. *) -(**/**) -val session : string -> request -> string option -[@ocaml.deprecated -"Renamed to Dream.session_field. See -https://aantron.github.io/dream/#val-session_field -"] -(**/**) - val set_session_field : request -> string -> string -> unit promise (** Mutates a value in the request's session. The back end may commit the value to storage immediately, so this function returns a promise. *) -(**/**) -val put_session : string -> string -> request -> unit promise -[@ocaml.deprecated -"Renamed to Dream.set_session_field. See -https://aantron.github.io/dream/#val-set_session_field -"] -(**/**) - val all_session_fields : request -> (string * string) list (** Full session dictionary. *) -(**/**) -val all_session_values : request -> (string * string) list -[@ocaml.deprecated -"Renamed to Dream.all_session_fields. See -https://aantron.github.io/dream/#val-all_session_fields -"] -(**/**) - val invalidate_session : request -> unit promise (** Invalidates the request's session, replacing it with a fresh, empty pre-session. *) @@ -1734,14 +1621,6 @@ val flash_messages : request -> (string * string) list val add_flash_message : request -> string -> string -> unit (** Adds a flash message to the request. *) -(**/**) -val put_flash : request -> string -> string -> unit -[@@ocaml.deprecated -"Renamed to Dream.add_flash_message. See -https://aantron.github.io/dream/#val-add_flash_message -"] -(**/**) - (** {1 GraphQL} @@ -2513,49 +2392,17 @@ val decrypt : type 'a field (** Per-message variable. *) -(**/**) -type 'a local = 'a field -[@@ocaml.deprecated -"Renamed to type Dream.field. See -https://aantron.github.io/dream/#type-field -"] -(**/**) - val new_field : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field (** Declares a variable of type ['a] in all messages. The variable is initially unset in each message. The optional [~name] and [~show_value] are used by {!Dream.run} [~debug] to show the variable in debug dumps. *) -(**/**) -val new_local : ?name:string -> ?show_value:('a -> string) -> unit -> 'a field -[@@ocaml.deprecated -"Renamed to Dream.new_field. See -https://aantron.github.io/dream/#val-new_field -"] -(**/**) - val field : 'b message -> 'a field -> 'a option (** Retrieves the value of the per-message variable. *) -(**/**) -val local : 'b message -> 'a field -> 'a option -[@@ocaml.deprecated -"Renamed to Dream.field. See -https://aantron.github.io/dream/#val-field -"] -(**/**) - val set_field : 'b message -> 'a field -> 'a -> unit (** Sets the per-message variable to the value. *) -(**/**) -val with_local : 'a field -> 'a -> 'b message -> 'b message -[@@ocaml.deprecated -"Use Dream.set_field instead. See -https://aantron.github.io/dream/#val-set_field -"] -(**/**) - (** {1 Testing} *) @@ -2578,22 +2425,6 @@ val test : ?prefix:string -> handler -> (request -> response) the test is not wrapped in a promise. If you don't need these facilities, you can test [handler] by calling it directly with a request. *) -(**/**) -val first : 'a message -> 'a message -[@@ocaml.deprecated "Simply returns its own argument."] -(** [Dream.first message] evaluates to the original request or response that - [message] is immutably derived from. This is useful for getting the original - state of requests especially, when they were first created inside the HTTP - server ({!Dream.run}). *) - -val last : 'a message -> 'a message -[@@ocaml.deprecated "Simply returns its own argument."] -(** [Dream.last message] evaluates to the latest request or response that was - derived from [message]. This is most useful for obtaining the state of - requests at the time an exception was raised, without having to instrument - the latest version of the request before the exception. *) -(**/**) - val sort_headers : (string * string) list -> (string * string) list (** Sorts headers by name. Headers with the same name are not sorted by value or otherwise reordered, because order is significant for some headers. See diff --git a/src/server/tag.eml.ml b/src/server/tag.eml.ml index f22a4e2b..981d56ab 100644 --- a/src/server/tag.eml.ml +++ b/src/server/tag.eml.ml @@ -19,34 +19,3 @@ module Method = Dream_pure.Method let csrf_tag ~now request = let token = Csrf.csrf_token ~now request in - -(* TODO Include the path prefix. *) -let form_tag - ~now ?method_ ?target ?enctype ?csrf_token ~action request = - - let method_ = - match method_ with - | None -> Method.method_to_string `POST - | Some method_ -> Method.method_to_string method_ - in - let target = - match target with - | Some target -> " target=\"" ^ Dream.html_escape target ^ "\"" - | None -> "" - in - let enctype = - match enctype with - | Some `Multipart_form_data -> " enctype=\"multipart/form-data\"" - | None -> "" - in - let csrf_token = - match csrf_token with - | None -> true - | Some csrf_token -> csrf_token - in -
<%s! enctype %>> -% if csrf_token then begin - <%s! csrf_tag ~now request %> -% end; From c7da98b718b56fbc6a4b388b07ed462bb80ebd16 Mon Sep 17 00:00:00 2001 From: Yawar Amin Date: Sun, 14 May 2023 01:13:14 -0400 Subject: [PATCH 281/312] Fix typo (#281) --- src/dream.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dream.mli b/src/dream.mli index 4d122e2f..d78666ac 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -869,7 +869,7 @@ val send : ?text_or_binary:[< text_or_binary ] -> ?end_of_message:[< end_of_message ] -> websocket -> string -> unit promise -(** Sends a single WebSocket message. The WebSocket is ready another message +(** Sends a single WebSocket message. The WebSocket is ready for another message when the promise resolves. With [~text_or_binary:`Text], the default, the message is interpreted as a From d35a6338d1b2fa8a2042412151f42e735ee4653f Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 14 May 2023 08:14:33 +0300 Subject: [PATCH 282/312] Update dream-serve and add a couple tests --- Makefile | 2 +- test/expect/pure/message/message.ml | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 3010c0c9..b95a344f 100644 --- a/Makefile +++ b/Makefile @@ -30,7 +30,7 @@ test-watch : .PHONY : coverage-serve coverage-serve : - cd _coverage && dune exec -- serve -p 8082 + cd _coverage && dune exec -- dream-serve -p 8082 .PHONY : promote promote : diff --git a/test/expect/pure/message/message.ml b/test/expect/pure/message/message.ml index 90e04e85..b117639f 100644 --- a/test/expect/pure/message/message.ml +++ b/test/expect/pure/message/message.ml @@ -5,6 +5,16 @@ +let%expect_test "default status is OK" = + Dream.status (Dream.response "") |> Dream.status_to_string |> print_endline; + [%expect {| OK |}] + +let%expect_test "set_status" = + let response = Dream.response "" in + Dream.set_status response `Not_Found; + Dream.status response |> Dream.status_to_string |> print_endline; + [%expect {| Not Found |}] + let%expect_test "middleware runs sequentially onion-style" = let handler _ = print_endline "handler"; From f5558638f33c2c54a8f3d9350795df48201c8590 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 14 May 2023 16:34:55 +0300 Subject: [PATCH 283/312] Upgrades while rebuilding the playground --- example/z-playground/server/playground.ml | 2 +- example/z-playground/server/setup.sh | 6 +++--- example/z-playground/server/sync.sh | 1 + 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/example/z-playground/server/playground.ml b/example/z-playground/server/playground.ml index 52a7e665..3faa20bd 100644 --- a/example/z-playground/server/playground.ml +++ b/example/z-playground/server/playground.ml @@ -41,7 +41,7 @@ let sandbox_dune_no_eml = {|(executable (preprocess (pps lwt_ppx ppx_yojson_conv tyxml-jsx tyxml-ppx))) |} -let base_dockerfile = {|FROM ubuntu:focal-20210416 +let base_dockerfile = {|FROM ubuntu:jammy-20230425 RUN apt update && apt install -y openssl libev4 libsqlite3-0 WORKDIR /www COPY db.sqlite db.sqlite diff --git a/example/z-playground/server/setup.sh b/example/z-playground/server/setup.sh index 2657f90b..6213563a 100644 --- a/example/z-playground/server/setup.sh +++ b/example/z-playground/server/setup.sh @@ -22,7 +22,7 @@ sudo apt install -y docker-ce sudo apt install -y build-essential m4 unzip bubblewrap pkg-config # Install opam itself. -wget -O opam https://github.com/ocaml/opam/releases/download/2.0.8/opam-2.0.8-x86_64-linux +wget -O opam https://github.com/ocaml/opam/releases/download/2.1.4/opam-2.1.4-x86_64-linux sudo mv opam /usr/local/bin/ sudo chmod a+x /usr/local/bin/opam @@ -33,7 +33,7 @@ sudo apt install -y npm sudo apt install -y libev-dev libsqlite3-dev libssl-dev pkg-config # Create users. User playground is used for building and running the playground. -# The reason there isn't a separate user for buulding it is that the playground +# The reason there isn't a separate user for building it is that the playground # itself will use the build setup to build the sandboxes. User sandbox is for # the containers. sudo adduser --disabled-password playground @@ -45,7 +45,7 @@ sudo adduser --system sandbox # Initialize opam and install a compiler. sudo -H -u playground opam init --no-setup --bare -sudo -H -u playground opam switch create 4.12.0 +sudo -H -u playground opam switch create 5.0.0 # Set up UFW. sudo ufw allow ssh diff --git a/example/z-playground/server/sync.sh b/example/z-playground/server/sync.sh index 0589c339..3dce1b2b 100644 --- a/example/z-playground/server/sync.sh +++ b/example/z-playground/server/sync.sh @@ -100,6 +100,7 @@ set +x echo echo "If this is the first sync, run as playground@$HOST in ~/playground:" echo " opam install --deps-only ./dream-pure.opam ./dream-httpaf.opam ./dream.opam" +echo " cd example/z-playground/" echo " opam switch export opam-switch" echo " npm install" echo "Then, as root@$HOST:" From 6e666d4c7079b29d2f287febe312cae20c116900 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 14 May 2023 16:55:08 +0300 Subject: [PATCH 284/312] Playground: update lockfiles --- example/z-playground/opam-switch | 178 +++++++++++++------------ example/z-playground/package-lock.json | 15 ++- 2 files changed, 104 insertions(+), 89 deletions(-) diff --git a/example/z-playground/opam-switch b/example/z-playground/opam-switch index feee2adc..98425dfa 100644 --- a/example/z-playground/opam-switch +++ b/example/z-playground/opam-switch @@ -1,117 +1,119 @@ opam-version: "2.0" -compiler: [ - "base-bigarray.base" - "base-threads.base" - "base-unix.base" - "ocaml.4.12.0" - "ocaml-base-compiler.4.12.0" - "ocaml-config.2" - "ocaml-options-vanilla.1" +compiler: ["ocaml-base-compiler.5.0.0"] +roots: [ + "angstrom.0.15.0" + "base64.3.5.1" + "bigarray-compat.1.1.0" + "bigstringaf.0.9.1" + "camlp-streams.5.0.1" + "caqti.1.9.0" + "caqti-lwt.1.9.0" + "conf-libev.4-12" + "cstruct.6.2.0" + "digestif.1.1.4" + "dune.3.7.1" + "faraday.0.8.2" + "faraday-lwt-unix.0.8.2" + "fmt.0.9.0" + "graphql-lwt.0.14.0" + "graphql_parser.0.14.0" + "hmap.0.8.1" + "ke.0.6" + "logs.0.7.0" + "lwt.5.6.1" + "lwt_ppx.2.1.0" + "lwt_ssl.1.2.0" + "magic-mime.1.3.0" + "mirage-clock.4.2.0" + "mirage-crypto.0.11.1" + "mirage-crypto-rng.0.11.1" + "mirage-crypto-rng-lwt.0.11.1" + "multipart_form.0.5.0" + "multipart_form-lwt.0.5.0" + "ocaml-base-compiler.5.0.0" + "psq.0.2.1" + "ptime.1.1.0" + "result.1.5" + "ssl.0.5.13" + "uri.4.2.0" + "yojson.2.1.0" ] -roots: ["ocaml-base-compiler.4.12.0"] installed: [ "angstrom.0.15.0" - "base.v0.14.3" "base-bigarray.base" "base-bytes.base" + "base-domains.base" + "base-nnp.base" "base-threads.base" "base-unix.base" - "base64.3.5.0" + "base64.3.5.1" "bigarray-compat.1.1.0" - "bigarray-overlap.0.2.0" - "bigstringaf.0.8.0" - "biniou.1.2.1" - "bisect_ppx.2.8.0" - "caqti.1.6.0" - "caqti-driver-sqlite3.1.6.0" - "caqti-lwt.1.6.0" - "cmdliner.1.1.0" + "bigarray-overlap.0.2.1" + "bigstringaf.0.9.1" + "camlp-streams.5.0.1" + "caqti.1.9.0" + "caqti-lwt.1.9.0" "conf-libev.4-12" - "conf-libssl.3" + "conf-libssl.4" "conf-pkg-config.2" - "conf-sqlite3.1" - "cppo.1.6.8" - "csexp.1.5.1" - "cstruct.6.0.1" - "cudf.0.9-1" - "digestif.1.1.0" - "dune.2.9.3" - "dune-configurator.2.9.3" - "duration.0.2.0" - "easy-format.1.3.2" - "eqaf.0.8" - "extlib.1.7.8" - "faraday.0.8.1" - "faraday-lwt.0.8.1" - "faraday-lwt-unix.0.8.1" - "fix.20220121" + "cppo.1.6.9" + "csexp.1.5.2" + "cstruct.6.2.0" + "digestif.1.1.4" + "dune.3.7.1" + "dune-configurator.3.7.1" + "duration.0.2.1" + "eqaf.0.9" + "faraday.0.8.2" + "faraday-lwt.0.8.2" + "faraday-lwt-unix.0.8.2" "fmt.0.9.0" - "graphql.0.13.0" - "graphql-lwt.0.13.0" - "graphql_parser.0.13.0" + "graphql.0.14.0" + "graphql-lwt.0.14.0" + "graphql_parser.0.14.0" "hmap.0.8.1" - "ke.0.4" + "ke.0.6" "logs.0.7.0" - "lwt.5.5.0" - "lwt_ppx.2.0.3" - "lwt_ssl.1.1.3" - "magic-mime.1.2.0" - "markup.1.0.2" - "menhir.20220210" - "menhirLib.20220210" - "menhirSdk.20220210" - "merlin-extend.0.6" - "mirage-clock.4.1.0" - "mirage-crypto.0.10.5" - "mirage-crypto-rng.0.10.5" - "mmap.1.1.0" - "mtime.1.3.0" - "multipart-form-data.0.3.0" - "multipart_form.0.4.0" - "multipart_form-lwt.0.4.0" - "ocaml.4.12.0" - "ocaml-base-compiler.4.12.0" + "lwt.5.6.1" + "lwt_ppx.2.1.0" + "lwt_ssl.1.2.0" + "magic-mime.1.3.0" + "menhir.20230415" + "menhirLib.20230415" + "menhirSdk.20230415" + "mirage-clock.4.2.0" + "mirage-crypto.0.11.1" + "mirage-crypto-rng.0.11.1" + "mirage-crypto-rng-lwt.0.11.1" + "mtime.2.0.0" + "multipart_form.0.5.0" + "multipart_form-lwt.0.5.0" + "ocaml.5.0.0" + "ocaml-base-compiler.5.0.0" "ocaml-compiler-libs.v0.12.4" - "ocaml-config.2" - "ocaml-migrate-parsetree.2.3.0" + "ocaml-config.3" "ocaml-options-vanilla.1" "ocaml-syntax-shims.1.0.0" - "ocamlbuild.0.14.1" - "ocamlfind.1.9.3" - "ocamlgraph.2.0.0" + "ocamlbuild.0.14.2" + "ocamlfind.1.9.6" "ocplib-endian.1.2" - "octavius.1.2.2" - "opam-core.2.1.2" - "opam-file-format.2.1.3" - "opam-format.2.1.2" - "opam-installer.2.1.2" "pecu.0.6" "ppx_derivers.1.2.1" - "ppx_js_style.v0.14.1" - "ppx_yojson_conv.v0.14.0" - "ppx_yojson_conv_lib.v0.14.0" - "ppxlib.0.24.0" - "prettym.0.0.2" - "psq.0.2.0" - "ptime.0.8.6" - "re.1.10.3" - "reason.3.8.0" + "ppxlib.0.29.1" + "prettym.0.0.3" + "psq.0.2.1" + "ptime.1.1.0" + "re.1.10.4" "result.1.5" "rresult.0.7.0" "seq.base" - "sexplib0.v0.14.0" - "sqlite3.5.1.0" - "ssl.0.5.10" + "sexplib0.v0.15.1" + "ssl.0.5.13" "stdlib-shims.0.3.0" "stringext.1.6.0" - "topkg.1.0.5" - "tyxml.4.5.0" - "tyxml-jsx.4.5.0" - "tyxml-ppx.4.5.0" - "tyxml-syntax.4.5.0" - "uchar.0.0.2" + "topkg.1.0.7" "unstrctrd.0.3" "uri.4.2.0" "uutf.1.0.3" - "yojson.1.7.0" + "yojson.2.1.0" ] diff --git a/example/z-playground/package-lock.json b/example/z-playground/package-lock.json index f34206be..1e3143e1 100644 --- a/example/z-playground/package-lock.json +++ b/example/z-playground/package-lock.json @@ -1,7 +1,20 @@ { "name": "dream-playground", + "lockfileVersion": 2, "requires": true, - "lockfileVersion": 1, + "packages": { + "": { + "name": "dream-playground", + "dependencies": { + "codemirror": "*" + } + }, + "node_modules/codemirror": { + "version": "5.61.0", + "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.61.0.tgz", + "integrity": "sha512-D3wYH90tYY1BsKlUe0oNj2JAhQ9TepkD51auk3N7q+4uz7A/cgJ5JsWHreT0PqieW1QhOuqxQ2reCXV1YXzecg==" + } + }, "dependencies": { "codemirror": { "version": "5.61.0", From e529b0eb1597c5fc7e03fd490d578a1a9d5b1a42 Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Mon, 22 May 2023 15:08:23 +0200 Subject: [PATCH 285/312] Docs: add light- heme and use save in local storage (#268) Also removed the shadow on the

element. It was probably left over from an early version of the dark theme, before Dream's alpha 1 release. Resolves #235. Co-authored-by: Anton Bachin --- docs/web/site/docs.css | 110 +++++++++++++++++++++++++++------- docs/web/site/docs.js | 36 ++++++++++- docs/web/templates/index.html | 4 ++ 3 files changed, 125 insertions(+), 25 deletions(-) diff --git a/docs/web/site/docs.css b/docs/web/site/docs.css index 48bd4240..275f3a08 100644 --- a/docs/web/site/docs.css +++ b/docs/web/site/docs.css @@ -60,6 +60,47 @@ src: url('tenor-sans-v12-latin-regular.woff2') format('woff2'); } +/* Theme */ + +/* Dark theme (default) */ +:root, body:not([data-theme="light"]) { + --bg-color: #131618; + --text-color: #c9d1d9; + --code-bg-color: #2c333b; + --border-color: #282828; + --link-color: #8dc5ff; + --external-link-color: #5d7fcd; + --anchor-color: #bfcdea; + + --of-color: #bec5cd; + --target-backing-color: #390022; + + --hljs-keyword-color: #ff6c9b; + --hljs-identifier-color: #70df5c; + --hljs-tag-color: #c28eff; + --hljs-string-color: #e3db7a; +} + +/* Light theme */ +:root, body[data-theme="light"] { + --bg-color: #f5f7fa; + --text-color: #1f2937; + --code-bg-color: #eef1f6; + --header-bg-color: #f5f7fa; + --border-color: #e0e0e0; + --link-color: #1c7ed6; + --external-link-color: #1d4ed8; + --anchor-color: #888; + + --of-color: #6b7280; + --target-backing-color: #f7f6f3; + + --hljs-keyword-color: #d94879; + --hljs-identifier-color: #22863a; + --hljs-tag-color: #6f42c1; + --hljs-string-color: #b94e48; +} + body { font-family: Lato, -apple-system, BlinkMacSystemFont, Segoe UI, Roboto, Oxygen, Ubuntu, Cantarell, Open Sans, Helvetica Neue, Helvetica, Arial, sans-serif; font-size: 16px; @@ -101,15 +142,15 @@ h6 { /* Colors and presentation styles. */ body { - background-color: #131618; - color: #c9d1d9; + background-color: var(--bg-color); + color: var(--text-color); } .odoc-content pre { - background-color: #1a1f26; + background-color: var(--code-bg-color); margin-left: 1em; margin-right: 1em; - border: 1px solid #111; + border: 1px solid var(--border-color); } .odoc-content .spec > pre { background: none; @@ -119,7 +160,7 @@ body { .odoc-content code { /* color: #ddd; */ - background-color: #2c333b; + background-color: var(--code-bg-color); padding: 0 5px; margin: 0 1px; white-space: nowrap; @@ -150,17 +191,40 @@ body { } */ header { - background-color: #131618; - border-bottom: 1px solid #282828; + background-color: var(--bg-color); + border-bottom: 1px solid var(--border-color); } header .topmost { /* background-color: #0f131a; */ - border-bottom: 1px solid #282828; + border-bottom: 1px solid var(--border-color); } -h1 { - text-shadow: -2px 2px black; +.topmost .toolbar { + float: right; +} + +.topmost .toggle-theme-btn { + all: unset; + position: relative; +} + +.topmost .toggle-theme-btn::before { + content: "\F186"; /* moon */ + position: absolute; + left: calc(0% - 16px + -8px); + top: calc(0% + 4px); + width: 16px; + height: 16px; + display: flex; + justify-content: center; + align-items: center; + font-family: FontAwesome, FontAwesomeBrands; + font-size: 15px; +} + +body:not([data-theme="light"]) .topmost .toggle-theme-btn::before { + content: "\F185"; /* sun */ } header pre { @@ -191,7 +255,7 @@ footer { } :target .backing { - background-color: #390022; + background-color: var(--target-backing-color); } nav ~ * a[href="#builtin"], @@ -214,7 +278,7 @@ a[href^=http]::after { font-family: FontAwesome; font-size: 10px; line-height: 18px; - color: #5d7fcd; + color: var(--external-link-color); position: relative; top: -1px; margin-left: 2px; @@ -225,7 +289,7 @@ a[href^=http]::after { } a, a:visited, a:active { - color: #8dc5ff; + color: var(--link-color); text-decoration: none; } @@ -234,27 +298,27 @@ a:hover { } .odoc-content a > code { - color: #8dc5ff; + color: var(--link-color); } .hljs-module-access, .hljs-keyword, .keyword { - color: #ff6c9b; + color: var(--hljs-keyword-color); } .hljs-identifier, .hljs-literal, .hljs-type { - color: #70df5c; + color: var(--hljs-identifier-color); } .hljs-tag { - color: #c28eff; + color: var(--hljs-tag-color); } .hljs-string { - color: #e3db7a; + color: var(--hljs-string-color); } .of { - color: #bec5cd; + color: var(--of-color); } .topmost ul { @@ -407,7 +471,7 @@ ul ul li { height: 100%; width: 43rem; /* background-color: #262626; */ - border-right: 1px solid #282828; + border-right: 1px solid var(--border-color); } h2, h2 ~ :not(.odoc-spec):not(nav), footer { @@ -582,8 +646,8 @@ h2:first-of-type { overflow-y: scroll; scrollbar-width: none; line-height: 30px; - border-right: 1px solid #262626; - background-color: #131618; + border-right: 1px solid var(--border-color); + background-color: var(--bg-color); /* color: #ddd; */ } .odoc-toc::-webkit-scrollbar { @@ -674,7 +738,7 @@ h2 > .anchor, h3 > .anchor { font-family: FontAwesome; font-size: 10px; font-style: oblique; - color: #bfcdea; + color: var(--anchor-color); position: relative; top: -1.75px; left: -4px; diff --git a/docs/web/site/docs.js b/docs/web/site/docs.js index 8b404bf1..7dd4a374 100644 --- a/docs/web/site/docs.js +++ b/docs/web/site/docs.js @@ -4,8 +4,7 @@ // Copyright 2021 Anton Bachin *) - -console.log("foo"); +/* Scrolling */ function current_section() { var threshold = window.innerHeight / 2; @@ -49,3 +48,36 @@ function scroll() { }; window.onscroll = scroll; + + +/* Theme mode */ + +var THEME_MODE_KEY = "dream-theme" + +function apply_theme(theme) { + if (theme === "light") { + document.body.setAttribute("data-theme", "light"); + } else { + document.body.removeAttribute("data-theme"); + } +} + +function toggle_theme() { + var current_theme = localStorage.getItem(THEME_MODE_KEY); + var new_theme = current_theme === "dark" ? "light" : "dark"; + localStorage.setItem(THEME_MODE_KEY, new_theme); + apply_theme(new_theme); +} + +function init_theme() { + var default_theme = "dark"; + var stored_theme = localStorage.getItem(THEME_MODE_KEY) || default_theme; + apply_theme(stored_theme); + + var theme_toggle_button = document.querySelector(".toggle-theme-btn"); + if (theme_toggle_button) { + theme_toggle_button.addEventListener("click", toggle_theme); + } +} + +document.addEventListener("DOMContentLoaded", init_theme); diff --git a/docs/web/templates/index.html b/docs/web/templates/index.html index 5322df37..0fb0300c 100644 --- a/docs/web/templates/index.html +++ b/docs/web/templates/index.html @@ -37,6 +37,10 @@
Tidy Web framework for OCaml and ReasonML
  • GitHub
  • Edit these docs
  • + +
    + +
    let hello who =
    
    From b55d1914cfacfa4eefdb1d291c4c06ffde1878fa Mon Sep 17 00:00:00 2001
    From: Anton Bachin 
    Date: Mon, 22 May 2023 16:06:00 +0300
    Subject: [PATCH 286/312] Docs: initialize theme earlier to avoid flicker
    
    Follow-on to #268.
    ---
     docs/web/site/docs.js         | 6 ++++--
     docs/web/templates/index.html | 4 ++++
     2 files changed, 8 insertions(+), 2 deletions(-)
    
    diff --git a/docs/web/site/docs.js b/docs/web/site/docs.js
    index 7dd4a374..369f6189 100644
    --- a/docs/web/site/docs.js
    +++ b/docs/web/site/docs.js
    @@ -52,7 +52,7 @@ window.onscroll = scroll;
     
     /* Theme mode */
     
    -var THEME_MODE_KEY = "dream-theme" 
    +var THEME_MODE_KEY = "dream-theme"
     
     function apply_theme(theme) {
       if (theme === "light") {
    @@ -73,11 +73,13 @@ function init_theme() {
       var default_theme = "dark";
       var stored_theme = localStorage.getItem(THEME_MODE_KEY) || default_theme;
       apply_theme(stored_theme);
    +}
     
    +function prepare_button() {
       var theme_toggle_button = document.querySelector(".toggle-theme-btn");
       if (theme_toggle_button) {
         theme_toggle_button.addEventListener("click", toggle_theme);
       }
     }
     
    -document.addEventListener("DOMContentLoaded", init_theme);
    +document.addEventListener("DOMContentLoaded", prepare_button);
    diff --git a/docs/web/templates/index.html b/docs/web/templates/index.html
    index 0fb0300c..61784f2d 100644
    --- a/docs/web/templates/index.html
    +++ b/docs/web/templates/index.html
    @@ -24,6 +24,10 @@
     
     
     
    +
    +
     
    From 635c0589e93749d5358d3f42577e816053c27ab6 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 22 May 2023 16:14:19 +0300 Subject: [PATCH 287/312] Get the Windows CI working (#282) The syntax of the constraint is based on a suggestion in Discord. Tests are disabled due to a difference in ppx_expect output on Windows. Co-authored-by: Et7f3 --- .github/workflows/test.yml | 36 ++++++++++++++++++++++++++++++------ dream.opam | 2 +- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index a167c35e..9a53de3f 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -20,8 +20,8 @@ jobs: include: - os: macos-latest ocaml: 4.12.x - # Windows is blocked until we no longer require libev; Dream still works - # on Windows, but testing it is awkward at the moment. + - os: windows-latest + ocaml: 4.14.x runs-on: ${{matrix.os}} steps: @@ -30,16 +30,28 @@ jobs: submodules: recursive - uses: avsm/setup-ocaml@v2 + if: runner.os != 'Windows' with: ocaml-compiler: ${{matrix.ocaml}} + - uses: avsm/setup-ocaml@v2 + if: runner.os == 'Windows' + with: + ocaml-compiler: ${{matrix.ocaml}} + opam-repositories: | + opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset + default: https://github.com/ocaml/opam-repository.git + + - run: opam depext --yes conf-sqlite3 - run: opam depext --yes conf-postgresql - run: opam depext --yes conf-libev + if: runner.os != 'Windows' # The tests require ppx_expect. The latest versions of it introduced changes # in the formatting of the output, and also require OCaml >= 4.10, which # makes testing on < 4.10 awkward. So, we skip tests on < 4.10. - - run: | + - shell: bash + run: | set -e set -x @@ -49,11 +61,23 @@ jobs: 4.08.x) WITH_TEST=;; esac - opam install --yes --deps-only $WITH_TEST ./dream-pure.opam ./dream-httpaf.opam ./dream.opam + # Tests on Windows are disabled because of a difference in ppx_expect + # output. See https://github.com/aantron/dream/pull/282. + case ${{runner.os}} in + Windows) WITH_TEST=;; + esac + + OPAM=$(which opam || true) + if [ -z "$OPAM" ] + then + OPAM=D:\\cygwin\\wrapperbin\\opam.cmd + fi + + $OPAM install --yes --deps-only $WITH_TEST ./dream-pure.opam ./dream-httpaf.opam ./dream.opam if [ ! -z "$WITH_TEST" ] then - opam exec -- dune runtest + $OPAM exec -- dune runtest EXAMPLES=$(find example -maxdepth 1 -type d -not -name "w-mirage*" -not -name "r-tyxml" | grep -v "^example/0" | grep -v "^example$" | sort) shopt -s nullglob @@ -63,7 +87,7 @@ jobs: FILE=$(ls $EXAMPLE/*.ml $EXAMPLE/*.re $EXAMPLE/server/*.ml $EXAMPLE/server/*.re) EXE=$(echo $FILE | sed 's/\..*$/.exe/g') echo dune build $EXE - opam exec -- dune build $EXE + $OPAM exec -- dune build $EXE done fi diff --git a/dream.opam b/dream.opam index 07e14a0b..09f19845 100644 --- a/dream.opam +++ b/dream.opam @@ -52,7 +52,7 @@ depends: [ "camlp-streams" "caqti" {>= "1.8.0"} # Infix operators. "caqti-lwt" - "conf-libev" {os != "win32"} + ("conf-libev" {os != "win32"} | "ocaml" {os = "win32"}) "cstruct" {>= "6.0.0"} "dream-httpaf" {>= "1.0.0~alpha2"} "dream-pure" {>= "1.0.0~alpha2"} From 7b46896bf9f9ac7851234d4f3b7e82f8195da671 Mon Sep 17 00:00:00 2001 From: Thibaut Mattio Date: Sat, 13 May 2023 19:44:31 +0200 Subject: [PATCH 288/312] Add a `Dream.livereload` middleware The code is adapted from dream-livereload, itself adapted from the w-live-reload example. We update the w-live-reload to use the newly introduced middleware. Apply nits --- dream.opam | 3 +- example/w-live-reload/README.md | 84 +++---------------------- example/w-live-reload/live_reload.ml | 67 +------------------- src/dream.ml | 2 + src/dream.mli | 11 ++++ src/server/dune | 2 + src/server/livereload.ml | 94 ++++++++++++++++++++++++++++ 7 files changed, 120 insertions(+), 143 deletions(-) create mode 100644 src/server/livereload.ml diff --git a/dream.opam b/dream.opam index 09f19845..7f8d641f 100644 --- a/dream.opam +++ b/dream.opam @@ -60,11 +60,13 @@ depends: [ "fmt" {>= "0.8.7"} # `Italic. "graphql_parser" "graphql-lwt" + "lambdasoup" {>= "0.6.1"} "lwt" "lwt_ppx" {>= "1.2.2"} "lwt_ssl" "logs" {>= "0.5.0"} "magic-mime" + "markup" {>= "1.0.2"} "mirage-clock" {>= "3.0.0"} # now_d_ps : unit -> int * int64. "mirage-crypto" {>= "0.8.1"} # AES-256-GCM. "mirage-crypto-rng" @@ -85,7 +87,6 @@ depends: [ "crunch" {with-test} "js_of_ocaml" {with-test} "js_of_ocaml-ppx" {with-test} - "lambdasoup" {with-test} "ppx_expect" {with-test & >= "v0.15.0"} # Formatting changes. "ppx_yojson_conv" {with-test} "reason" {with-test} diff --git a/example/w-live-reload/README.md b/example/w-live-reload/README.md index 0e66c545..d9d9600d 100644 --- a/example/w-live-reload/README.md +++ b/example/w-live-reload/README.md @@ -2,83 +2,20 @@
    -This example shows a simple live reloading setup. It works by injecting a script -into the `` of HTML documents. The script opens a WebSocket back to the -server. If the WebSocket gets closed, the script tries to reconnect. When the -server comes back up, the client is able to reconnect, and reloads itself. +This example shows a simple live reloading setup using the `Dream.livereload` +middleware. It works by injecting a script into the `` of HTML documents. +The script opens a WebSocket back to the server. If the WebSocket gets closed, +the script tries to reconnect. When the server comes back up, the client is able +to reconnect and reloads itself. -```js -var socketUrl = "ws://" + location.host + "/_live-reload" -var socket = new WebSocket(socketUrl); - -socket.onclose = function(event) { - const intervalMs = 100; - const attempts = 100; - let attempt = 0; - - function reload() { - ++attempt; - - if(attempt > attempts) { - console.error("Could not reconnect to server"); - return; - } - - reconnectSocket = new WebSocket(socketUrl); - - reconnectSocket.onerror = function(event) { - setTimeout(reload, intervalMs); - }; - - reconnectSocket.onopen = function(event) { - location.reload(); - }; - }; - - reload(); -}; -``` - -The injection is done by a small middleware: - -```ocaml - -let inject_live_reload_script inner_handler request = - let%lwt response = inner_handler request in - - match Dream.header "Content-Type" response with - | Some "text/html; charset=utf-8" -> - let%lwt body = Dream.body response in - let soup = - Markup.string body - |> Markup.parse_html ~context:`Document - |> Markup.signals - |> Soup.from_signals - in - - begin match Soup.Infix.(soup $? "head") with - | None -> - Lwt.return response - | Some head -> - Soup.create_element "script" ~inner_text:live_reload_script - |> Soup.append_child head; - response - |> Dream.with_body (Soup.to_string soup) - |> Lwt.return - end - - | _ -> - Lwt.return response -``` - -The example server just wraps a single page at `/` with the middleware. The page +The example server just wraps a single page at `/` with the `Dream.livereload` middleware. The page displays a tag that changes each time it is loaded: ```ocaml let () = Dream.run @@ Dream.logger - @@ inject_live_reload_script + @@ Dream.livereload @@ Dream.router [ Dream.get "/" (fun _ -> @@ -87,11 +24,6 @@ let () = |> Printf.sprintf "Good morning, world! Random tag: %s" |> Dream.html); - Dream.get "/_live-reload" (fun _ -> - Dream.websocket (fun socket -> - let%lwt _ = Dream.receive socket in - Dream.close_websocket socket)); - ] ``` @@ -129,7 +61,7 @@ changes. **See also:** - [**`k-websocket`**](../k-websocket#files) introduces WebSockets. -- [**`w-fswatch`**](../w-fswatch#files) rebuilds and restarts a server each +- [**`w-watch`**](../w-watch#files) rebuilds and restarts a server each time its source code changes.
    diff --git a/example/w-live-reload/live_reload.ml b/example/w-live-reload/live_reload.ml index 999c53b3..5b5d7098 100644 --- a/example/w-live-reload/live_reload.ml +++ b/example/w-live-reload/live_reload.ml @@ -1,67 +1,7 @@ -let live_reload_script = {js| - -var socketUrl = "ws://" + location.host + "/_live-reload" -var socket = new WebSocket(socketUrl); - -socket.onclose = function(event) { - const intervalMs = 100; - const attempts = 100; - let attempt = 0; - - function reload() { - ++attempt; - - if(attempt > attempts) { - console.error("Could not reconnect to server"); - return; - } - - reconnectSocket = new WebSocket(socketUrl); - - reconnectSocket.onerror = function(event) { - setTimeout(reload, intervalMs); - }; - - reconnectSocket.onopen = function(event) { - location.reload(); - }; - }; - - reload(); -}; - -|js} - -let inject_live_reload_script inner_handler request = - let%lwt response = inner_handler request in - - match Dream.header response "Content-Type" with - | Some "text/html; charset=utf-8" -> - let%lwt body = Dream.body response in - let soup = - Markup.string body - |> Markup.parse_html ~context:`Document - |> Markup.signals - |> Soup.from_signals - in - - begin match Soup.Infix.(soup $? "head") with - | None -> - Lwt.return response - | Some head -> - Soup.create_element "script" ~inner_text:live_reload_script - |> Soup.append_child head; - Dream.set_body response (Soup.to_string soup); - Lwt.return response - end - - | _ -> - Lwt.return response - let () = Dream.run @@ Dream.logger - @@ inject_live_reload_script + @@ Dream.livereload @@ Dream.router [ Dream.get "/" (fun _ -> @@ -70,9 +10,4 @@ let () = |> Printf.sprintf "Good morning, world! Random tag: %s" |> Dream.html); - Dream.get "/_live-reload" (fun _ -> - Dream.websocket (fun socket -> - let%lwt _ = Dream.receive socket in - Dream.close_websocket socket)); - ] diff --git a/src/dream.ml b/src/dream.ml index 7409ac00..a497fcd0 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -17,6 +17,7 @@ module Formats = Dream_pure.Formats module Graphql = Dream__graphql.Graphql module Helpers = Dream__server.Helpers module Http = Dream__http.Http +module Livereload = Dream__server.Livereload module Message = Dream_pure.Message module Method = Dream_pure.Method module Origin_referrer_check = Dream__server.Origin_referrer_check @@ -216,6 +217,7 @@ let csrf_tag = Tag.csrf_tag ~now let no_middleware = Message.no_middleware let pipeline = Message.pipeline +let livereload = Livereload.livereload diff --git a/src/dream.mli b/src/dream.mli index d78666ac..2380c58f 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1304,6 +1304,17 @@ val no_middleware : middleware Dream.no_middleware ]} *) +val livereload : ?script:string -> ?path:string -> middleware +(** Adds live reloading to your Dream application. + + It works by injecting a script in the HTML pages sent to clients that will + initiate a WebSocket. + + When the server restarts, the WebSocket connection is lost, at which point, + the client will try to reconnect every 500ms for 5s. If within these 5s the + client is able to reconnect to the server, it will trigger a reload of the + page. *) + val pipeline : middleware list -> middleware (** Combines a sequence of middlewares into one, such that these two lines are equivalent: diff --git a/src/server/dune b/src/server/dune index d7dd67b7..4e5125e6 100644 --- a/src/server/dune +++ b/src/server/dune @@ -6,9 +6,11 @@ dream.cipher dream-pure fmt + lambdasoup logs lwt magic-mime + markup mirage-clock multipart_form multipart_form-lwt diff --git a/src/server/livereload.ml b/src/server/livereload.ml new file mode 100644 index 00000000..d6433f58 --- /dev/null +++ b/src/server/livereload.ml @@ -0,0 +1,94 @@ +(* This file is part of Dream, released under the MIT license. See LICENSE.md + for details, or visit https://github.com/aantron/dream. + + Copyright 2021-2023 Thibaut Mattio, Anton Bachin *) + + + +module Message = Dream_pure.Message + + + +let default_script + ?(retry_interval_ms = 500) ?(max_retry_ms = 5000) ?(route = "/_livereload") + () = + Printf.sprintf + {js| +var socketUrl = "ws://" + location.host + "%s"; +var s = new WebSocket(socketUrl); + +s.onopen = function(even) { + console.debug("Live reload: WebSocket connection open"); +}; + +s.onclose = function(even) { + console.debug("Live reload: WebSocket connection closed"); + + var innerMs = %i; + var maxMs = %i; + var maxAttempts = Math.round(maxMs / innerMs); + var attempts = 0; + + function reload() { + attempts++; + if(attempts > maxAttempts) { + console.debug("Live reload: Could not reconnect to dev server"); + return; + } + + s2 = new WebSocket(socketUrl); + + s2.onerror = function(event) { + setTimeout(reload, innerMs); + }; + + s2.onopen = function(event) { + location.reload(); + }; + }; + + reload(); +}; + +s.onerror = function(event) { + console.debug("Live reload: WebSocket error:", event); +}; +|js} + route retry_interval_ms max_retry_ms + + + +let livereload + ?(script = default_script ()) ?(path = "/_livereload") next_handler + request = + + match Message.target request with + | target when target = path -> + Helpers.websocket @@ fun socket -> + let%lwt _ = Helpers.receive socket in + Message.close_websocket socket + + | _ -> + let%lwt response = next_handler request in + match Message.header response "Content-Type" with + | Some ("text/html" | "text/html; charset=utf-8") -> + let%lwt body = Message.body response in + let soup = + Markup.string body + |> Markup.parse_html ~context:`Document + |> Markup.signals + |> Soup.from_signals + in + begin match Soup.Infix.(soup $? "head") with + | None -> + Lwt.return response + | Some head -> + Soup.create_element "script" ~inner_text:script + |> Soup.append_child head; + soup + |> Soup.to_string + |> Message.set_body response; + Lwt.return response + end + + | _ -> Lwt.return response From 8e89f7cd2ab01168f06b0abca673d10fe6176b43 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 1 Jun 2023 16:29:50 +0300 Subject: [PATCH 289/312] Live reload: remove optional arguments --- src/dream.mli | 2 +- src/server/livereload.ml | 22 ++++++++++++++-------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 2380c58f..10852e98 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1304,7 +1304,7 @@ val no_middleware : middleware Dream.no_middleware ]} *) -val livereload : ?script:string -> ?path:string -> middleware +val livereload : middleware (** Adds live reloading to your Dream application. It works by injecting a script in the HTML pages sent to clients that will diff --git a/src/server/livereload.ml b/src/server/livereload.ml index d6433f58..113b1d1f 100644 --- a/src/server/livereload.ml +++ b/src/server/livereload.ml @@ -9,10 +9,18 @@ module Message = Dream_pure.Message -let default_script - ?(retry_interval_ms = 500) ?(max_retry_ms = 5000) ?(route = "/_livereload") - () = - Printf.sprintf +let route = + "/_livereload" + +let retry_interval_ms = + 500 + +let max_retry_ms = + 5000 + + + +let script = Printf.sprintf {js| var socketUrl = "ws://" + location.host + "%s"; var s = new WebSocket(socketUrl); @@ -58,12 +66,10 @@ s.onerror = function(event) { -let livereload - ?(script = default_script ()) ?(path = "/_livereload") next_handler - request = +let livereload next_handler request = match Message.target request with - | target when target = path -> + | target when target = route -> Helpers.websocket @@ fun socket -> let%lwt _ = Helpers.receive socket in Message.close_websocket socket From 10ae36fa5fb5b08d70824edd00dccabe6c0826ab Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 1 Jun 2023 16:34:54 +0300 Subject: [PATCH 290/312] Live reload: retry indefinitely --- src/server/livereload.ml | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/src/server/livereload.ml b/src/server/livereload.ml index 113b1d1f..399cfbb6 100644 --- a/src/server/livereload.ml +++ b/src/server/livereload.ml @@ -15,9 +15,6 @@ let route = let retry_interval_ms = 500 -let max_retry_ms = - 5000 - let script = Printf.sprintf @@ -32,22 +29,13 @@ s.onopen = function(even) { s.onclose = function(even) { console.debug("Live reload: WebSocket connection closed"); - var innerMs = %i; - var maxMs = %i; - var maxAttempts = Math.round(maxMs / innerMs); - var attempts = 0; + var retryIntervalMs = %i; function reload() { - attempts++; - if(attempts > maxAttempts) { - console.debug("Live reload: Could not reconnect to dev server"); - return; - } - s2 = new WebSocket(socketUrl); s2.onerror = function(event) { - setTimeout(reload, innerMs); + setTimeout(reload, retryIntervalMs); }; s2.onopen = function(event) { @@ -62,7 +50,7 @@ s.onerror = function(event) { console.debug("Live reload: WebSocket error:", event); }; |js} - route retry_interval_ms max_retry_ms + route retry_interval_ms From 1bf8e1115c1a3f303d232b257f4906e16188384d Mon Sep 17 00:00:00 2001 From: Thomas Coopman Date: Mon, 5 Jun 2023 14:08:32 +0200 Subject: [PATCH 291/312] Add STDOUT as output from dream_eml (#228) Resolves #227. --- src/eml/eml.ml | 4 ++-- src/eml/main.ml | 10 ++++++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/eml/eml.ml b/src/eml/eml.ml index 64c714f3..864a079b 100644 --- a/src/eml/eml.ml +++ b/src/eml/eml.ml @@ -782,7 +782,7 @@ end -let process_file (input_file, location, syntax) = +let process_file (input_file, location, syntax, std_out) = let reason, extension = match syntax with | `OCaml -> (false, ".ml") | `Reason -> (true, ".re") @@ -800,7 +800,7 @@ let process_file (input_file, location, syntax) = (* We don't bother closing these - the OCaml runtime and/or kernel will close it automatically on process exit, anyway. *) let input_channel = open_in input_file in - let output_channel = open_out output_file in + let output_channel = if std_out then stdout else open_out output_file in let input_stream = Location.stream (fun () -> try Some (input_char input_channel) diff --git a/src/eml/main.ml b/src/eml/main.ml index 7f11a3ac..e169e3e9 100644 --- a/src/eml/main.ml +++ b/src/eml/main.ml @@ -7,7 +7,7 @@ module Command_line : sig - val parse : unit -> (string * string * [ `OCaml | `Reason ]) list + val parse : unit -> (string * string * [ `OCaml | `Reason ] * bool) list end = struct let usage = {|Usage: @@ -24,6 +24,9 @@ struct let emit_reason = ref false + let std_out = + ref false + let options = Arg.align [ "--workspace", Arg.Set_string workspace_path, @@ -31,6 +34,9 @@ struct "--emit-reason", Arg.Set emit_reason, " Emit Reason syntax after preprocessing the template"; + "--stdout", + Arg.Set std_out, + " Print to STDOUT"; ] let set_file file = @@ -71,7 +77,7 @@ struct | ".re" -> `Reason | _ -> `OCaml in - file, Filename.concat prefix file, syntax) + file, Filename.concat prefix file, syntax, !std_out) end let () = From 7a2c5a03ffb60e1fef7ea1f66ad304d518577ec4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 22 Jun 2023 15:50:26 +0300 Subject: [PATCH 292/312] Add Dream.drop_session_field Resolves #284. --- src/dream.ml | 1 + src/dream.mli | 3 +++ src/server/session.ml | 20 ++++++++++++++++++++ src/sql/session.ml | 7 +++++++ 4 files changed, 31 insertions(+) diff --git a/src/dream.ml b/src/dream.ml index a497fcd0..07b9248a 100644 --- a/src/dream.ml +++ b/src/dream.ml @@ -256,6 +256,7 @@ let session = Session.session let session_field request name = session name request let put_session = Session.put_session let set_session_field request name value = put_session name value request +let drop_session_field = Session.drop_session_field let all_session_values = Session.all_session_values let all_session_fields = all_session_values let invalidate_session = Session.invalidate_session diff --git a/src/dream.mli b/src/dream.mli index 10852e98..864a25c9 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1572,6 +1572,9 @@ val set_session_field : request -> string -> string -> unit promise (** Mutates a value in the request's session. The back end may commit the value to storage immediately, so this function returns a promise. *) +val drop_session_field : request -> string -> unit promise +(** Drops a field from the request's session. *) + val all_session_fields : request -> (string * string) list (** Full session dictionary. *) diff --git a/src/server/session.ml b/src/server/session.ml index 57de3d74..24942545 100644 --- a/src/server/session.ml +++ b/src/server/session.ml @@ -57,6 +57,7 @@ type session = { type operations = { put : string -> string -> unit Lwt.t; + drop : string -> unit Lwt.t; invalidate : unit -> unit Lwt.t; mutable dirty : bool; } @@ -127,6 +128,12 @@ struct |> fun dictionary -> session.payload <- dictionary; Lwt.return_unit + let drop session name = + session.payload + |> List.remove_assoc name + |> fun dictionary -> session.payload <- dictionary; + Lwt.return_unit + let invalidate hash_table ~now lifetime operations session = Hashtbl.remove hash_table !session.id; session := create hash_table (now () +. lifetime); @@ -137,6 +144,8 @@ struct let rec operations = { put = (fun name value -> put !session name value); + drop = + (fun name -> drop !session name); invalidate = (fun () -> invalidate ~now hash_table lifetime operations session); dirty; @@ -216,6 +225,13 @@ struct operations.dirty <- true; Lwt.return_unit + let drop operations session name = + session.payload + |> List.remove_assoc name + |> fun dictionary -> session.payload <- dictionary; + operations.dirty <- true; + Lwt.return_unit + let invalidate ~now lifetime operations session = session := create (now () +. lifetime); operations.dirty <- true; @@ -224,6 +240,7 @@ struct let operations ~now lifetime session dirty = let rec operations = { put = (fun name value -> put operations !session name value); + drop = (fun name -> drop operations !session name); invalidate = (fun () -> invalidate ~now lifetime operations session); dirty; } in @@ -337,6 +354,9 @@ let session name request = let put_session name value request = (fst (getter request)).put name value +let drop_session_field request name = + (fst (getter request)).drop name + let all_session_values request = !(snd (getter request)).payload diff --git a/src/sql/session.ml b/src/sql/session.ml index 28242e45..37a7b724 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -127,6 +127,12 @@ let put request (session : Session.session) name value = |> fun dictionary -> session.payload <- dictionary; Sql.sql request (fun db -> update db session) +let drop request (session : Session.session) name = + session.payload + |> List.remove_assoc name + |> fun dictionary -> session.payload <- dictionary; + Sql.sql request (fun db -> update db session) + let invalidate request lifetime operations (session : Session.session ref) = Sql.sql request begin fun db -> let%lwt () = remove db !session.id in @@ -139,6 +145,7 @@ let invalidate request lifetime operations (session : Session.session ref) = let operations request lifetime (session : Session.session ref) dirty = let rec operations = { Session.put = (fun name value -> put request !session name value); + drop = (fun name -> drop request !session name); invalidate = (fun () -> invalidate request lifetime operations session); dirty; } in From aada26ce5457b982cfada348127fa90f4667b51f Mon Sep 17 00:00:00 2001 From: Benjamin Thomas Date: Thu, 13 Jul 2023 13:33:17 +0200 Subject: [PATCH 293/312] CONTRIBUTING.md: fix bad remote URL (#288) --- docs/CONTRIBUTING.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/CONTRIBUTING.md b/docs/CONTRIBUTING.md index c69268a9..36b89ca7 100644 --- a/docs/CONTRIBUTING.md +++ b/docs/CONTRIBUTING.md @@ -46,7 +46,7 @@ Later, you'll need to fork the repository on GitHub, and add your fork as a remote: ``` -git remote add fork git@github.com/my-github-name/dream.git +git remote add fork git@github.com:my-github-name/dream.git ``` Install Dream's dependencies: From 4a5310b09b8cc18fee0253b48a25f98ffa88b832 Mon Sep 17 00:00:00 2001 From: Benjamin Thomas Date: Fri, 14 Jul 2023 14:25:57 +0200 Subject: [PATCH 294/312] Fix JSON example broken by ppx_yojson_conv 0.16.0 (#287) --- example/e-json/README.md | 2 ++ example/e-json/json.ml | 2 ++ 2 files changed, 4 insertions(+) diff --git a/example/e-json/README.md b/example/e-json/README.md index 8857fc7d..b0eddddb 100644 --- a/example/e-json/README.md +++ b/example/e-json/README.md @@ -10,6 +10,8 @@ converter between JSON and an OCaml data type. We then create a little server that listens for JSON of the right shape, and echoes back its `message` field: ```ocaml +open Ppx_yojson_conv_lib.Yojson_conv.Primitives + type message_object = { message : string; } [@@deriving yojson] diff --git a/example/e-json/json.ml b/example/e-json/json.ml index 6fde9607..3d839bf6 100644 --- a/example/e-json/json.ml +++ b/example/e-json/json.ml @@ -1,3 +1,5 @@ +open Ppx_yojson_conv_lib.Yojson_conv.Primitives + type message_object = { message : string; } [@@deriving yojson] From 8140a600e4f9401e28f77fee3e4328abdc8246ef Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 14 Jul 2023 15:41:54 +0300 Subject: [PATCH 295/312] Advance vendored Gluten commit Fixes #286 by including anmonteiro/gluten#58. --- src/vendor/gluten | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vendor/gluten b/src/vendor/gluten index 388f3a28..22ccc110 160000 --- a/src/vendor/gluten +++ b/src/vendor/gluten @@ -1 +1 @@ -Subproject commit 388f3a285dd876aa6f993b34d8fc9c05a19a7a71 +Subproject commit 22ccc110dbe469d38c1363124cf10afd7766aab7 From 6e58736e28c8dfee3deff41364594cea7a39316e Mon Sep 17 00:00:00 2001 From: "Petter A. Urkedal" Date: Tue, 31 Oct 2023 15:20:40 +0100 Subject: [PATCH 296/312] Compatibility with Caqti 2.0.0 (#302) --- dream.opam | 4 ++-- example/h-sql/sql.eml.ml | 2 +- example/w-postgres/postgres.eml.ml | 2 +- src/sql/dune | 1 + src/sql/session.ml | 8 ++++---- src/sql/sql.ml | 7 ++++--- 6 files changed, 13 insertions(+), 11 deletions(-) diff --git a/dream.opam b/dream.opam index 7f8d641f..d2edf3f1 100644 --- a/dream.opam +++ b/dream.opam @@ -50,8 +50,8 @@ depends: [ "base-unix" "bigarray-compat" "camlp-streams" - "caqti" {>= "1.8.0"} # Infix operators. - "caqti-lwt" + "caqti" {>= "2.0.0"} + "caqti-lwt" {>= "2.0.0"} ("conf-libev" {os != "win32"} | "ocaml" {os = "win32"}) "cstruct" {>= "6.0.0"} "dream-httpaf" {>= "1.0.0~alpha2"} diff --git a/example/h-sql/sql.eml.ml b/example/h-sql/sql.eml.ml index 619bae41..c542c4d8 100644 --- a/example/h-sql/sql.eml.ml +++ b/example/h-sql/sql.eml.ml @@ -4,7 +4,7 @@ module T = Caqti_type let list_comments = let query = let open Caqti_request.Infix in - (T.unit ->* T.(tup2 int string)) + (T.unit ->* T.(t2 int string)) "SELECT id, text FROM comment" in fun (module Db : DB) -> let%lwt comments_or_error = Db.collect_list query () in diff --git a/example/w-postgres/postgres.eml.ml b/example/w-postgres/postgres.eml.ml index 7c9e844e..0494c4ab 100644 --- a/example/w-postgres/postgres.eml.ml +++ b/example/w-postgres/postgres.eml.ml @@ -5,7 +5,7 @@ module T = Caqti_type let list_comments = let query = let open Caqti_request.Infix in - (T.unit ->* T.(tup2 int string)) + (T.unit ->* T.(t2 int string)) "SELECT id, text FROM comment" in fun (module Db : DB) -> let%lwt comments_or_error = Db.collect_list query () in diff --git a/src/sql/dune b/src/sql/dune index e4244f42..e8bab617 100644 --- a/src/sql/dune +++ b/src/sql/dune @@ -4,6 +4,7 @@ (libraries caqti caqti-lwt + caqti-lwt.unix dream.cipher dream-pure dream.server diff --git a/src/sql/session.ml b/src/sql/session.ml index 37a7b724..728fa48b 100644 --- a/src/sql/session.ml +++ b/src/sql/session.ml @@ -28,7 +28,7 @@ let serialize_payload payload = let insert = let query = let open Caqti_request.Infix in - (T.(tup4 string string float string) ->. T.unit) {| + (T.(t4 string string float string) ->. T.unit) {| INSERT INTO dream_session (id, label, expires_at, payload) VALUES ($1, $2, $3, $4) |} in @@ -42,7 +42,7 @@ let insert = let find_opt = let query = let open Caqti_request.Infix in - (T.string ->? T.(tup3 string float string)) + (T.string ->? T.(t3 string float string)) "SELECT label, expires_at, payload FROM dream_session WHERE id = $1" in fun (module Db : DB) id -> @@ -70,7 +70,7 @@ let find_opt = let refresh = let query = let open Caqti_request.Infix in - (T.(tup2 float string) ->. T.unit) + (T.(t2 float string) ->. T.unit) "UPDATE dream_session SET expires_at = $1 WHERE id = $2" in fun (module Db : DB) (session : Session.session) -> @@ -80,7 +80,7 @@ let refresh = let update = let query = let open Caqti_request.Infix in - (T.(tup2 string string) ->. T.unit) + (T.(t2 string string) ->. T.unit) "UPDATE dream_session SET payload = $1 WHERE id = $2" in fun (module Db : DB) (session : Session.session) -> diff --git a/src/sql/sql.ml b/src/sql/sql.ml index a5f16c0d..e778fd30 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -14,7 +14,7 @@ let log = Log.sub_log "dream.sql" (* TODO Debug metadata for the pools. *) -let pool_field : (_, Caqti_error.t) Caqti_lwt.Pool.t Message.field = +let pool_field : (_, Caqti_error.t) Caqti_lwt_unix.Pool.t Message.field = Message.new_field () (* TODO This may not be necessary since Caqti 1.8.0. May require some messing @@ -48,7 +48,8 @@ let sql_pool ?size uri = "Dream.sql_pool: \ 'sqlite' is not a valid scheme; did you mean 'sqlite3'?"); let pool = - Caqti_lwt.connect_pool ?max_size:size ~post_connect parsed_uri in + let pool_config = Caqti_pool_config.create ?max_size:size () in + Caqti_lwt_unix.connect_pool ~pool_config ~post_connect parsed_uri in match pool with | Ok pool -> pool_cell := Some pool; @@ -72,7 +73,7 @@ let sql request callback = failwith message | Some pool -> let%lwt result = - pool |> Caqti_lwt.Pool.use (fun db -> + pool |> Caqti_lwt_unix.Pool.use (fun db -> (* The special exception handling is a workaround for https://github.com/paurkedal/ocaml-caqti/issues/68. *) match%lwt callback db with From 60a0dc5df59a8b1eb65feccd3ee5801630b20ac5 Mon Sep 17 00:00:00 2001 From: Louis Pilfold Date: Tue, 31 Oct 2023 14:33:19 +0000 Subject: [PATCH 297/312] Fix typo (#292) --- src/dream.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dream.mli b/src/dream.mli index 864a25c9..c7b2cf64 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2301,7 +2301,7 @@ val from_path : string -> string list - [Dream.from_path "a%2Fb"] becomes [["a/b"]]. - [Dream.from_path "a//b"] becomes [["a"; "b"]]. - This function is not for use on full targets, because they may incldue query + This function is not for use on full targets, because they may include query strings ([?]), and {!Dream.from_path} does not treat them specially. Split query strings off with {!Dream.split_target} first. *) From f5c8ba0cff3a092ca3991383e9951be1e37055af Mon Sep 17 00:00:00 2001 From: Tim McGilchrist Date: Fri, 3 Nov 2023 00:27:16 +1100 Subject: [PATCH 298/312] Update dream-mirage (#283) Mainly to provide csrf_tag rather than form_tag helper. --- dream-mirage.opam | 2 +- src/mirage/mirage.ml | 7 ------ src/mirage/mirage.mli | 55 +++++++++++++++++-------------------------- 3 files changed, 23 insertions(+), 41 deletions(-) diff --git a/dream-mirage.opam b/dream-mirage.opam index 0c0e90f2..5ddbcc15 100644 --- a/dream-mirage.opam +++ b/dream-mirage.opam @@ -59,7 +59,7 @@ depends: [ "letsencrypt" {>= "0.3.0"} "lwt" "lwt_ppx" {>= "1.2.2"} - "mimic" + "mimic" {>= "0.0.5"} "mirage-time" "rresult" "tcpip" diff --git a/src/mirage/mirage.ml b/src/mirage/mirage.ml index 6f5f5a09..86af0c20 100644 --- a/src/mirage/mirage.ml +++ b/src/mirage/mirage.ml @@ -343,13 +343,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Tcpip let verify_csrf_token = verify_csrf_token ~now let csrf_tag = Tag.csrf_tag ~now - (* Templates *) - - let form_tag ?method_ ?target ?enctype ?csrf_token ~action request = - Tag.form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request - - - (* Errors *) type error = Catch.error = { diff --git a/src/mirage/mirage.mli b/src/mirage/mirage.mli index 177860ed..99f8f31f 100644 --- a/src/mirage/mirage.mli +++ b/src/mirage/mirage.mli @@ -908,14 +908,15 @@ module Make (** {1 Forms} - {!Dream.form_tag} and {!Dream.val-form} round-trip secure forms. - {!Dream.form_tag} is used inside a template to generate a form header with a - CSRF token: + {!Dream.csrf_tag} and {!Dream.val-form} round-trip secure forms. + {!Dream.csrf_tag} is used inside a form template to generate a hidden field + with a CSRF token: {[ - <%s! Dream.form_tag ~action:"/" request %> - - +
    + <%s! Dream.csrf_tag request %> + +
    ]} {!Dream.val-form} recieves the form and checks the CSRF token: @@ -953,13 +954,13 @@ module Make val form : ?csrf:bool -> request -> (string * string) list form_result promise (** Parses the request body as a form. Performs CSRF checks. Use - {!Dream.form_tag} in a template to transparently generate forms that will + {!Dream.csrf_tag} in a template to transparently generate forms that will pass these checks. See {!section-templates} and example {{:https://github.com/aantron/dream/tree/master/example/d-form#readme} [d-form]}. - [Content-Type:] must be [application/x-www-form-urlencoded]. - - The form must have a field named [dream.csrf]. {!Dream.form_tag} adds such + - The form must have a field named [dream.csrf]. {!Dream.csrf_tag} adds such a field. - {!Dream.form} calls {!Dream.verify_csrf_token} to check the token in [dream.csrf]. @@ -1100,8 +1101,9 @@ module Make It's usually not necessary to handle CSRF tokens directly. - - Form tag generator {!Dream.form_tag} generates and inserts a CSRF token - that {!Dream.val-form} and {!Dream.val-multipart} transparently verify. + - CSRF token field generator {!Dream.csrf_tag} generates and inserts a CSRF + token that {!Dream.val-form} and {!Dream.val-multipart} transparently + verify. - AJAX can be protected from CSRF by {!Dream.origin_referrer_check}. CSRF functions are exposed for creating custom schemes, and for @@ -1136,8 +1138,6 @@ module Make val verify_csrf_token : request -> string -> csrf_result promise (** Checks that the CSRF token is valid for the {!type-request}'s session. *) - val csrf_tag : request -> string - (** {1 Templates} Dream includes a template preprocessor that allows interleaving OCaml and @@ -1223,20 +1223,13 @@ module Make unquoted attribute values, CSS in [