unikernel/duniverse/ocaml-h1/.github/workflows/test.yml

@@ -0,0 +1,43 @@
+name: build
+
+on:
+  - push
+  - pull_request
+
+jobs:
+  builds:
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+        ocaml-compiler:
+          - 4.14.2
+          - 5.0.0
+          - 5.1.1
+          - 5.2.1
+          - 5.3.0
+
+
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v4
+
+      - name: Set-up OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+      - name: Deps
+        run: |
+          opam pin add -n h1 .
+          opam pin add -n h1-lwt-unix .
+          opam install -t --deps-only .
+
+      - name: Build
+        run: opam exec -- dune build
+
+      - name: Test
+        run: opam exec -- dune runtest

unikernel/duniverse/ocaml-h1/.gitignore

@@ -0,0 +1,9 @@
+.*.sw[po]
+_build/
+_tests/
+lib_test/tests_
+*.native
+*.byte
+*.docdir
+.merlin
+*.install

unikernel/duniverse/ocaml-h1/CHANGES.md

@@ -0,0 +1,10 @@
+## v1.1.0
+
+- Add the websocket implementation (@swrup, @dinosaure, #8)
+- Fix last references of http/af (@dinosaure, @vlog, #13, #14, #16)
+- Fix the upgrade support and allow multiple values (@dinosaure, #15)
+- Move to `bstr` (@swrup, #11)
+
+## v1.0.0
+
+- First release of h1

unikernel/duniverse/ocaml-h1/LICENSE

@@ -0,0 +1,31 @@
+Copyright (c) 2016, Inhabited Type LLC
+Copyright (c) 2025, Robur Cooperative
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.

unikernel/duniverse/ocaml-h1/Makefile

@@ -0,0 +1,21 @@
+.PHONY: all build clean test examples
+
+build:
+	dune build @install
+
+all: build
+
+test:
+	dune runtest
+
+watch:
+	dune build {h1,h1-lwt-unix}.install @runtest --watch
+
+install:
+	dune install
+
+uninstall:
+	dune uninstall
+
+clean:
+	rm -rf _build *.install

unikernel/duniverse/ocaml-h1/README.md

@@ -0,0 +1,137 @@
+# ocaml-h1
+
+`ocaml-h1` is a high-performance, memory-efficient, and scalable web server for
+OCaml. It implements the HTTP 1.1 specification with respect to parsing,
+serialization, and connection pipelining as a state machine that is agnostic to
+the underlying IO mechanism, and is therefore portable across many platform.
+It uses the [Angstrom][angstrom] and [Faraday][faraday] libraries to implement
+the parsing and serialization layers of the HTTP standard, hence the name.
+
+[angstrom]: https://github.com/inhabitedtype/angstrom
+[faraday]: https://github.com/inhabitedtype/faraday
+
+## Installation
+
+Install the library and its dependencies via [OPAM][opam]:
+
+[opam]: http://opam.ocaml.org/
+
+```bash
+opam install h1
+```
+
+## Usage
+
+Here is a Hello, World! program written using h1. It only responds to `GET`
+requests to the `/hello/*` target. As it does not itself do any IO, it can be
+used with both the Async and Lwt runtimes. See the [`examples`][examples] directory for
+usage of the individual runtimes.
+
+[examples]: https://github.com/robur-coop/ocaml-h1/tree/master/examples
+
+```ocaml
+open H1
+module String = Stdlib.String
+
+let invalid_request reqd status body =
+  (* Responses without an explicit length or transfer-encoding are
+     close-delimited. *)
+  let headers = Headers.of_list [ "Connection", "close" ] in
+  Reqd.respond_with_string reqd (Response.create ~headers status) body
+;;
+
+let request_handler reqd =
+  let { Request.meth; target; _ } = Reqd.request reqd in
+  match meth with
+  | `GET ->
+    begin match String.split_on_char '/' target with
+    | "" :: "hello" :: rest ->
+      let who =
+        match rest with
+        | [] -> "world"
+        | who :: _ -> who
+      in
+      let response_body = Printf.sprintf "Hello, %s!\n" who in
+      (* Specify the length of the response. *)
+      let headers =
+        Headers.of_list
+          [ "Content-length", string_of_int (String.length response_body) ]
+      in
+      Reqd.respond_with_string reqd (Response.create ~headers `OK) response_body
+    | _ ->
+      let response_body = Printf.sprintf "%S not found\n" target in
+      invalid_request reqd `Not_found response_body
+    end
+  | meth ->
+    let response_body =
+      Printf.sprintf "%s is not an allowed method\n" (Method.to_string meth)
+    in
+    invalid_request reqd `Method_not_allowed response_body
+;;
+```
+
+## Performance
+
+The reason for http/af's existence is [mirage/ocaml-cohttp#328][328], which
+highlights the poor scalability of cohttp. This is due to a number of factors,
+including poor scheduling, excessive allocation, and starvation of the server's
+accept loop. Here is a comparison chart of the data from that issue, along with
+data from an async-based http/af server. This server was run on a VM with 3
+virtual cores, the host being circa 2015 MacBook Pro:
+
+[328]: https://github.com/mirage/ocaml-cohttp/issues/328
+
+![h1 comparsion to cohttp](https://raw.githubusercontent.com/robur-coop/h1/master/images/h1-comparison.png)
+
+The http/af latency histogram, relative to the cohttp histograms, is pretty
+much flat along the x-axis. Here are some additional statistics from that run
+(with latencies in milliseconds):
+
+```
+#[Mean    =       27.719, StdDeviation   =       31.570]
+#[Max     =      263.424, Total count    =      1312140]
+#[Buckets =           27, SubBuckets     =         2048]
+----------------------------------------------------------
+  1709909 requests in 1.00m, 3.33GB read
+```
+
+## Development
+
+To install development dependencies, pin the package from the root of the
+repository:
+
+```bash
+opam pin add -n h1 .
+opam install --deps-only h1
+```
+
+After this, you may install a development version of the library using the
+install command as usual.
+
+Tests can be run via dune:
+
+```bash
+dune runtest
+```
+
+## `ocaml-h1` & `httpaf`
+
+`ocaml-h1` is a _hard_ fork of [httpaf][httpaf]. It was created after asking
+the author and official maintainer of httpaf if we could make such a fork.
+
+`ocaml-h1` is **not** intended to be a continuation of `httpaf`, which
+continues to evolve and exist. However, some pull requests were/are awaiting
+integration, and we wanted them to be included.
+
+After discussing it with the author, he gave us permission to make this fork,
+which includes all the PRs we wanted as well as additions such as the
+implementation of websockets.
+
+We would therefore like to thank the original author of `httpaf` for his work,
+for his trust in our cooperative, and for his permission to fork `httpaf`.
+
+## License
+
+BSD3, see LICENSE files for its text.
+
+[httpaf]: https://github.com/inhabitedtype/httpaf

unikernel/duniverse/ocaml-h1/benchmarks/dune

@@ -0,0 +1,9 @@
+(executable
+ (name wrk_lwt_benchmark)
+ (modules Wrk_lwt_benchmark)
+ (optional true)
+ (libraries h1 h1_examples h1-lwt-unix lwt.unix base))
+
+(alias
+ (name benchmarks)
+ (deps (glob_files *.exe)))

unikernel/duniverse/ocaml-h1/benchmarks/wrk_lwt_benchmark.ml

@@ -0,0 +1,28 @@
+open Base
+open H1_lwt_unix
+module Arg = Stdlib.Arg
+
+let main port =
+  let open Lwt.Infix in
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  let request_handler _ = H1_examples.Server.benchmark in
+  let error_handler _ = H1_examples.Server.error_handler in
+  Lwt.async begin fun () ->
+    Lwt_io.establish_server_with_client_socket
+      ~backlog:11_000
+      listen_address
+      (Server.create_connection_handler ~request_handler ~error_handler ~upgrade_handler:None)
+    >>= fun _server -> Lwt.return_unit
+  end;
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Responds to requests with a fixed string for benchmarking purposes.";
+  main !port
+;;

unikernel/duniverse/ocaml-h1/dune-project

@@ -0,0 +1,4 @@
+(lang dune 2.0)
+
+(name h1)
+(version v1.1.0)

unikernel/duniverse/ocaml-h1/examples/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name        h1_examples)
+ (libraries   h1 base stdio)
+ (flags (:standard -safe-string)))

unikernel/duniverse/ocaml-h1/examples/lib/h1_examples.ml

@@ -0,0 +1,99 @@
+open Base
+open H1
+module Format = Stdlib.Format
+
+let print_string = Stdio.(Out_channel.output_string stdout)
+
+let text = "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, <and what is the use of a book,> thought Alice <without pictures or conversations?> So she was considering in her own mind (as well as she could, for the hot day made her feel very sleepy and stupid), whether the pleasure of making a daisy-chain would be worth the trouble of getting up and picking the daisies, when suddenly a White Rabbit with pink eyes ran close by her. There was nothing so very remarkable in that; nor did Alice think it so very much out of the way to hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when she thought it over afterwards, it occurred to her that she ought to have wondered at this, but at the time it all seemed quite natural); but when the Rabbit actually took a watch out of its waistcoat-pocket, and looked at it, and then hurried on, Alice started to her feet, for it flashed across her mind that she had never before seen a rabbit with either a waistcoat-pocket, or a watch to take out of it, and burning with curiosity, she ran across the field after it, and fortunately was just in time to see it pop down a large rabbit-hole under the hedge. In another moment down went Alice after it, never once considering how in the world she was to get out again. The rabbit-hole went straight on like a tunnel for some way, and then dipped suddenly down, so suddenly that Alice had not a moment to think about stopping herself before she found herself falling down a very deep well. Either the well was very deep, or she fell very slowly, for she had plenty of time as she went down to look about her and to wonder what was going to happen next. First, she tried to look down and make out what she was coming to, but it was too dark to see anything; then she looked at the sides of the well, and noticed that they were filled with cupboards......"
+
+let text = Bstr.of_string text
+
+module Client = struct
+ exception Response_error
+
+  let error_handler error =
+    let error =
+      match error with
+      | `Malformed_response err -> Format.sprintf "Malformed response: %s" err
+      | `Invalid_response_body_length _ -> "Invalid body length"
+      | `Exn exn -> Format.sprintf "Exn raised: %s" (Exn.to_string exn)
+    in
+    Format.eprintf "Error handling response: %s\n%!" error;
+  ;;
+
+  let print ~on_eof response response_body =
+    match response with
+    | { Response.status = `OK; _ } as response ->
+      Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+      let rec on_read bs ~off ~len =
+        Bstr.sub_string ~off ~len bs |> print_string;
+        Body.Reader.schedule_read response_body ~on_read ~on_eof
+      in
+      Body.Reader.schedule_read response_body ~on_read ~on_eof;
+    | response ->
+      Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
+      Stdlib.exit 1
+  ;;
+end
+
+module Server = struct
+  let echo_post reqd =
+    match Reqd.request reqd  with
+    | { Request.meth = `POST; headers; _ } ->
+      let response =
+        let content_type =
+          match Headers.get headers "content-type" with
+          | None   -> "application/octet-stream"
+          | Some x -> x
+        in
+        Response.create ~headers:(Headers.of_list ["content-type", content_type; "connection", "close"]) `OK
+      in
+      let request_body  = Reqd.request_body reqd in
+      let response_body = Reqd.respond_with_streaming reqd response in
+      let rec on_read buffer ~off ~len =
+        Body.Writer.write_bigstring response_body buffer ~off ~len;
+        Body.Reader.schedule_read request_body ~on_eof ~on_read;
+      and on_eof () =
+        Body.Writer.close response_body
+      in
+      Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read
+    | _ ->
+      let headers = Headers.of_list [ "connection", "close" ] in
+      Reqd.respond_with_string reqd (Response.create ~headers `Method_not_allowed) ""
+  ;;
+
+  let benchmark =
+    let headers = Headers.of_list ["content-length", Int.to_string (Bstr.length text)] in
+    let handler reqd =
+      let { Request.target; _ } = Reqd.request reqd in
+      let request_body          = Reqd.request_body reqd in
+      Body.Reader.close request_body;
+      match target with
+      | "/" -> Reqd.respond_with_bigstring reqd (Response.create ~headers `OK) text;
+      | _   -> Reqd.respond_with_string    reqd (Response.create `Not_found) "Route not found"
+    in
+    handler
+  ;;
+
+  let error_handler ?request:_ error start_response =
+    let response_body = start_response Headers.empty in
+    begin match error with
+    | `Exn exn ->
+      Body.Writer.write_string response_body (Exn.to_string exn);
+      Body.Writer.write_string response_body "\n";
+    | #Status.standard as error ->
+      Body.Writer.write_string response_body (Status.default_reason_phrase error)
+    end;
+    Body.Writer.close response_body
+  ;;
+
+  let upgrade reqd =
+    if Request.is_upgrade (Reqd.request reqd) then (
+      let headers = Headers.of_list [ "connection", "upgrade" ] in
+      Reqd.respond_with_upgrade reqd headers;
+    ) else (
+      let headers = Headers.of_list [ "connection", "close" ] in
+      Reqd.respond_with_string reqd (Response.create ~headers `Not_found) ""
+    )
+  ;;
+end

unikernel/duniverse/ocaml-h1/examples/lwt/dune

@@ -0,0 +1,9 @@
+(executables
+ (libraries h1 h1-lwt-unix h1_examples base stdio lwt lwt.unix)
+ (optional true)
+ (names lwt_get lwt_post lwt_echo_post lwt_echo_upgrade lwt_chunked))
+
+(alias
+ (name runtest)
+ (package h1-lwt-unix)
+ (deps (glob_files *.exe)))

unikernel/duniverse/ocaml-h1/examples/lwt/lwt_chunked.ml

@@ -0,0 +1,40 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open H1_lwt_unix
+
+let request_handler (_ : Unix.sockaddr) reqd =
+  let body = H1.Reqd.respond_with_streaming reqd (H1.Response.create ~headers:(H1.Headers.of_list ["connection", "close"]) `OK) in
+  let rec respond_loop i =
+    H1.Body.Writer.write_string body (Printf.sprintf "Chunk %i\n" i);
+    H1.Body.Writer.flush_with_reason body (function
+    | `Closed  -> Stdio.print_endline "closed"
+    | `Written -> Stdio.print_endline "written"; Lwt.bind (Lwt_unix.sleep 5.) (fun () -> respond_loop (i+1)) |> ignore
+    );
+    Lwt.return_unit
+  in ignore (respond_loop 0)
+
+let error_handler (_ : Unix.sockaddr) = H1_examples.Server.error_handler
+
+let main port =
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  Lwt.async (fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address
+      (Server.create_connection_handler ~upgrade_handler:None ~request_handler ~error_handler)
+    >|= fun _server ->
+      Stdio.printf "Listening on port %i.\n" port);
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  Stdlib.Sys.set_signal Stdlib.Sys.sigpipe Stdlib.Sys.Signal_ignore;
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;

unikernel/duniverse/ocaml-h1/examples/lwt/lwt_echo_post.ml

@@ -0,0 +1,36 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open H1_lwt_unix
+
+let request_handler (_ : Unix.sockaddr) = H1_examples.Server.echo_post
+let error_handler (_ : Unix.sockaddr) = H1_examples.Server.error_handler
+
+let main port =
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  Lwt.async (fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address
+      (Server.create_connection_handler
+         ~request_handler
+         ~error_handler
+         ~upgrade_handler:None)
+    >|= fun _server ->
+      Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+      Stdio.printf "To send a POST request, try one of the following\n\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:%d\n\n%!" port);
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;

unikernel/duniverse/ocaml-h1/examples/lwt/lwt_echo_upgrade.ml

@@ -0,0 +1,47 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open H1_lwt_unix
+
+let request_handler (_ : Unix.sockaddr) = H1_examples.Server.upgrade
+let error_handler (_ : Unix.sockaddr) = H1_examples.Server.error_handler
+
+let upgrade_handler (_ : Unix.sockaddr) (fd : Lwt_unix.file_descr) =
+  let input = Lwt_io.of_fd fd ~mode:Input in
+  let output = Lwt_io.of_fd fd ~mode:Output in
+  let rec loop () =
+    Lwt_io.read input ~count:4096
+    >>= function
+    | "" -> Lwt.return_unit
+    | data -> Lwt_io.write output data >>= loop
+  in
+  loop ()
+;;
+
+let main port =
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  Lwt.async (fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address
+      (Server.create_connection_handler
+         ~request_handler
+         ~error_handler
+         ~upgrade_handler:(Some upgrade_handler))
+    >|= fun _server ->
+      Stdio.printf "Listening on port %i, upgrading, and echoing data.\n" port;
+      Stdio.printf "To send an interactive upgrade request, try\n\n";
+      Stdio.printf "  examples/script/upgrade-connect\n%!");
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;
+

unikernel/duniverse/ocaml-h1/examples/lwt/lwt_get.ml

@@ -0,0 +1,43 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open H1
+open H1_lwt_unix
+
+let main port host =
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    H1_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers = Httpun_types.Headers.of_list [ "host", host ] in
+  let request_body =
+    Client.request
+      ~error_handler:H1_examples.Client.error_handler
+      ~response_handler
+      socket
+      (Request.create ~headers `GET "/")
+  in
+  Body.Writer.close request_body;
+  finished
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 80 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/ocaml-h1/examples/lwt/lwt_post.ml

@@ -0,0 +1,53 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open H1
+open H1_lwt_unix
+
+let main port host =
+  Lwt_io.(read stdin)
+  >>= fun body ->
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    H1_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers =
+    Httpun_types.Headers.of_list
+    [ "content-length"   , (Int.to_string (String.length body))
+    ; "connection"       , "close"
+    ; "host"             , host
+    ]
+  in
+  let request_body =
+    Client.request
+      ~error_handler:H1_examples.Client.error_handler
+      ~response_handler
+      socket
+      (Request.create ~headers `POST "/")
+  in
+  Body.Writer.write_string request_body body;
+  Body.Writer.close request_body;
+  finished
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 8080 in
+
+  Arg.parse
+    ["-p", Set_int port, " Port number (8080 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/ocaml-h1/examples/script/upgrade-connect

@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+set -euo pipefail
+
+function headers {
+  printf "\
+GET / HTTP/1.1\r
+Host: localhost\r
+Connection: upgrade\r
+\r
+"
+}
+
+( headers; echo hello; cat; echo bye ) | nc localhost 8080 --close

unikernel/duniverse/ocaml-h1/h1-lwt-unix.opam

@@ -0,0 +1,24 @@
+version: "1.1.0"
+opam-version: "2.0"
+name: "h1-lwt-unix"
+maintainer: "Romain Calascibetta <romain.calascibetta@gmail.com>"
+authors: [
+  "Anton Bachin <antonbachin@yahoo.com>"
+  "Spiros Eliopoulos <spiros@inhabitedtype.com>"
+]
+license: "BSD-3-clause"
+homepage: "https://github.com/robur-coop/ocaml-h1"
+bug-reports: "https://github.com/robur-coop/ocaml-h1/issues"
+dev-repo: "git+https://github.com/robur-coop/ocaml-h1.git"
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "faraday-lwt-unix"
+  "h1" {= version}
+  "dune" {>= "2.0.0"}
+  "lwt" {>= "2.4.7"}
+]
+synopsis: "Lwt support for ocaml-h1"

unikernel/duniverse/ocaml-h1/h1.opam

@@ -0,0 +1,33 @@
+version: "1.1.0"
+opam-version: "2.0"
+maintainer: "Romain Calascibetta <romain.calascibetta@gmail.com>"
+authors: [ "Spiros Eliopoulos <spiros@inhabitedtype.com>" ]
+license: "BSD-3-clause"
+homepage: "https://github.com/robur-coop/ocaml-h1"
+bug-reports: "https://github.com/robur-coop/ocaml-h1/issues"
+dev-repo: "git+https://github.com/robur-coop/ocaml-h1.git"
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name] {with-test}
+]
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "2.0.0"}
+  "alcotest" {with-test & >= "1.2.0"}
+  "stdio" {with-test}
+  "base64"
+  "bstr"
+  "angstrom" {>= "0.14.0"}
+  "faraday"  {>= "0.6.1"}
+  "httpun-types" {>= "0.1.0"}
+  "lwt" {with-test}
+]
+synopsis:
+  "A high-performance, memory-efficient, and scalable web server for OCaml"
+description: """
+h1 implements the HTTP 1.1 specification with respect to parsing,
+serialization, and connection pipelining as a state machine that is agnostic to
+the underlying IO mechanism, and is therefore portable across many platform.
+It uses the Angstrom and Faraday libraries to implement the parsing and
+serialization layers of the HTTP standard, hence the name."""

unikernel/duniverse/ocaml-h1/lib/body.ml

@@ -0,0 +1,230 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2018 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+module Reader = struct
+  type t =
+    { faraday                        : Faraday.t
+    ; mutable read_scheduled         : bool
+    ; mutable on_eof                 : unit -> unit
+    ; mutable on_read                : Bstr.t -> off:int -> len:int -> unit
+    }
+
+  let default_on_eof         = Sys.opaque_identity (fun () -> ())
+  let default_on_read        = Sys.opaque_identity (fun _ ~off:_ ~len:_ -> ())
+
+  let create buffer =
+    { faraday                = Faraday.of_bigstring buffer
+    ; read_scheduled         = false
+    ; on_eof                 = default_on_eof
+    ; on_read                = default_on_read
+    }
+
+  let create_empty () =
+    let t = create Bstr.empty in
+    Faraday.close t.faraday;
+    t
+
+  let empty = create_empty ()
+
+  let is_closed t =
+    Faraday.is_closed t.faraday
+
+  let unsafe_faraday t =
+    t.faraday
+
+  let rec do_execute_read t on_eof on_read =
+    match Faraday.operation t.faraday with
+    | `Yield           -> ()
+    | `Close           ->
+      t.read_scheduled <- false;
+      t.on_eof         <- default_on_eof;
+      t.on_read        <- default_on_read;
+      on_eof ()
+    (* [Faraday.operation] never returns an empty list of iovecs *)
+    | `Writev []       -> assert false
+    | `Writev (iovec::_) ->
+      t.read_scheduled <- false;
+      t.on_eof         <- default_on_eof;
+      t.on_read        <- default_on_read;
+      let { Httpun_types.IOVec.buffer; off; len } = iovec in
+      Faraday.shift t.faraday len;
+      on_read buffer ~off ~len;
+      execute_read t
+  and execute_read t =
+    if t.read_scheduled then do_execute_read t t.on_eof t.on_read
+
+  let schedule_read t ~on_eof ~on_read =
+    if t.read_scheduled
+    then failwith "Body.Reader.schedule_read: reader already scheduled";
+    if not (is_closed t) then begin
+      t.read_scheduled <- true;
+      t.on_eof         <- on_eof;
+      t.on_read        <- on_read;
+    end;
+    do_execute_read t on_eof on_read
+
+  let close t =
+    Faraday.close t.faraday;
+    execute_read t
+  ;;
+
+  let has_pending_output t = Faraday.has_pending_output t.faraday
+end
+
+module Writer = struct
+  module Writer = Serialize.Writer
+
+  type encoding =
+    | Identity
+    | Chunked of { mutable written_final_chunk : bool }
+
+  type t =
+    { faraday        : Faraday.t
+    ; writer         : Writer.t
+    ; encoding       : encoding
+    ; buffered_bytes : int ref
+    }
+
+  let of_faraday faraday writer ~encoding =
+    let encoding =
+      match encoding with
+      | `Fixed _ | `Close_delimited -> Identity
+      | `Chunked -> Chunked { written_final_chunk = false }
+    in
+    { faraday
+    ; encoding
+    ; writer
+    ; buffered_bytes = ref 0
+    }
+
+  let create buffer writer ~encoding =
+    of_faraday (Faraday.of_bigstring buffer) writer ~encoding
+
+  let write_char t c =
+    if not (Faraday.is_closed t.faraday) then
+      Faraday.write_char t.faraday c
+
+  let write_string t ?off ?len s =
+    if not (Faraday.is_closed t.faraday) then
+      Faraday.write_string ?off ?len t.faraday s
+
+  let write_bigstring t ?off ?len b =
+    if not (Faraday.is_closed t.faraday) then
+      Faraday.write_bigstring ?off ?len t.faraday b
+
+  let schedule_bigstring t ?off ?len (b:Bstr.t) =
+    if not (Faraday.is_closed t.faraday) then
+      Faraday.schedule_bigstring ?off ?len t.faraday b
+
+  let ready_to_write t = Writer.wakeup t.writer
+
+  let flush t kontinue =
+    Faraday.flush t.faraday kontinue;
+    ready_to_write t
+
+  let flush_with_reason t kontinue =
+    if Writer.is_closed t.writer then
+      kontinue `Closed
+    else begin
+      Faraday.flush_with_reason t.faraday (fun reason ->
+        let result =
+          match reason with
+          | Nothing_pending | Shift -> `Written
+          | Drain -> `Closed
+        in
+        kontinue result);
+      ready_to_write t
+    end
+
+  let is_closed t =
+    Faraday.is_closed t.faraday
+
+  let close_and_drain t =
+    Faraday.close t.faraday;
+    (* Resolve all pending flushes *)
+    ignore (Faraday.drain t.faraday : int)
+
+  let close t =
+    Faraday.close t.faraday;
+    ready_to_write t;
+  ;;
+
+  let has_pending_output t =
+    (* Force another write poll to make sure that the final chunk is emitted for
+       chunk-encoded bodies. *)
+    let faraday_has_output = Faraday.has_pending_output t.faraday in
+    let additional_encoding_output =
+      match t.encoding with
+      | Identity -> false
+      | Chunked { written_final_chunk } ->
+        Faraday.is_closed t.faraday && not written_final_chunk
+    in
+    faraday_has_output || additional_encoding_output
+
+  let transfer_to_writer t =
+    let faraday = t.faraday in
+    if Writer.is_closed t.writer then
+      close_and_drain t
+    else begin
+      match Faraday.operation faraday with
+      | `Yield -> ()
+      | `Close ->
+        (match t.encoding with
+         | Identity -> ()
+         | Chunked ({ written_final_chunk } as chunked) ->
+           if not written_final_chunk then begin
+             chunked.written_final_chunk <- true;
+             Serialize.Writer.schedule_chunk t.writer [];
+           end);
+        Serialize.Writer.unyield t.writer;
+      | `Writev iovecs ->
+        let buffered = t.buffered_bytes in
+        begin match Httpun_types.IOVec.shiftv iovecs !buffered with
+        | []     -> ()
+        | iovecs ->
+          let lengthv  = Httpun_types.IOVec.lengthv iovecs in
+          buffered := !buffered + lengthv;
+          begin match t.encoding with
+          | Identity  -> Serialize.Writer.schedule_fixed t.writer iovecs
+          | Chunked _ -> Serialize.Writer.schedule_chunk t.writer iovecs
+          end;
+          Serialize.Writer.flush t.writer (fun result ->
+            match result with
+            | `Closed -> close_and_drain t
+            | `Written ->
+              Faraday.shift faraday lengthv;
+              buffered := !buffered - lengthv)
+        end
+    end
+end

unikernel/duniverse/ocaml-h1/lib/client_connection.ml

@@ -0,0 +1,219 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017-2019 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+module Reader = Parse.Reader
+module Writer = Serialize.Writer
+
+module Oneshot = struct
+  type error =
+    [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ]
+
+  type response_handler = Response.t -> Body.Reader.t  -> unit
+  type error_handler = error -> unit
+
+  type state =
+    | Awaiting_response
+    | Received_response of Response.t * Body.Reader.t
+    | Closed
+
+  type t =
+    { request          : Request.t
+    ; request_body     : Body.Writer.t
+    ; error_handler    : (error -> unit)
+    ; reader : Reader.response
+    ; writer : Writer.t
+    ; state  : state ref
+    ; mutable error_code : [ `Ok | error ]
+    }
+
+  let request ?(config=Config.default) request ~error_handler ~response_handler =
+    let state = ref Awaiting_response in
+    let request_method = request.Request.meth in
+    let handler response body =
+      state := Received_response(response, body);
+      response_handler response body
+    in
+    let writer = Writer.create () in
+    let request_body =
+      let encoding =
+        match Request.body_length request with
+        | `Fixed _ | `Chunked as encoding -> encoding
+        | `Error `Bad_request ->
+          failwith "H1.Client_connection.request: invalid body length"
+      in
+      Body.Writer.create (Bstr.create config.request_body_buffer_size) writer
+        ~encoding
+    in
+    let t =
+      { request
+      ; request_body
+      ; error_handler
+      ; error_code = `Ok
+      ; reader = Reader.response ~request_method handler
+      ; writer
+      ; state }
+    in
+    Writer.write_request t.writer request;
+    request_body, t
+  ;;
+
+  let flush_request_body t =
+    if Body.Writer.has_pending_output t.request_body
+    then Body.Writer.transfer_to_writer t.request_body
+  ;;
+
+  let set_error_and_handle_without_shutdown t error =
+    t.state := Closed;
+    t.error_code <- (error :> [`Ok | error]);
+    t.error_handler error;
+  ;;
+
+  let unexpected_eof t =
+    set_error_and_handle_without_shutdown t (`Malformed_response "unexpected eof");
+  ;;
+
+  let shutdown_reader t =
+    Reader.force_close t.reader;
+    begin match !(t.state) with
+    | Awaiting_response -> unexpected_eof t;
+    | Closed -> ()
+    | Received_response(_, response_body) ->
+      Body.Reader.close response_body;
+      Body.Reader.execute_read response_body;
+    end;
+  ;;
+
+  let shutdown_writer t =
+    flush_request_body t;
+    Writer.close t.writer;
+    Body.Writer.close t.request_body;
+  ;;
+
+  let shutdown t =
+    shutdown_reader t;
+    shutdown_writer t;
+  ;;
+
+  let set_error_and_handle t error =
+    Reader.force_close t.reader;
+    begin match !(t.state) with
+    | Closed -> ()
+    | Awaiting_response ->
+      set_error_and_handle_without_shutdown t error;
+    | Received_response(_, response_body) ->
+      Body.Reader.close response_body;
+      Body.Reader.execute_read response_body;
+      set_error_and_handle_without_shutdown t error;
+    end
+  ;;
+
+  let report_exn t exn =
+    set_error_and_handle t (`Exn exn)
+  ;;
+
+  let flush_response_body t =
+    match !(t.state) with
+    | Awaiting_response | Closed -> ()
+    | Received_response(_, response_body) ->
+      try Body.Reader.execute_read response_body
+      with exn -> report_exn t exn
+  ;;
+
+  let _next_read_operation t =
+    match !(t.state) with
+    | Awaiting_response | Closed -> Reader.next t.reader
+    | Received_response(_, response_body) ->
+      if not (Body.Reader.is_closed response_body)
+      then Reader.next t.reader
+      else begin
+        Reader.force_close t.reader;
+        Reader.next        t.reader
+      end
+  ;;
+
+  let next_read_operation t =
+    match _next_read_operation t with
+    | `Error (`Parse(marks, message)) ->
+      let message = String.concat "" [ String.concat ">" marks; ": "; message] in
+      set_error_and_handle t (`Malformed_response message);
+      `Close
+    | `Error (`Invalid_response_body_length _ as error) ->
+      set_error_and_handle t error;
+      `Close
+    | (`Read | `Close) as operation -> operation
+  ;;
+
+  let read_with_more t bs ~off ~len more =
+    let consumed = Reader.read_with_more t.reader bs ~off ~len more in
+    flush_response_body t;
+    consumed
+  ;;
+
+  let read t bs ~off ~len =
+    read_with_more t bs ~off ~len Incomplete
+
+  let read_eof t bs ~off ~len =
+    let bytes_read = read_with_more t bs ~off ~len Complete in
+    begin match !(t.state) with
+    | Received_response _ | Closed -> ()
+    | Awaiting_response -> unexpected_eof t;
+    end;
+    bytes_read
+  ;;
+
+  let next_write_operation t =
+    flush_request_body t;
+    if Body.Writer.is_closed t.request_body
+    (* Even though we've just done [flush_request_body], it might still be the case that
+       [Body.Writer.has_pending_output] returns true, because it does so when
+       we've written all output except for the final chunk. *)
+    && not (Body.Writer.has_pending_output t.request_body)
+    then Writer.close t.writer;
+    Writer.next t.writer
+  ;;
+
+  let yield_writer t k =
+    if Body.Writer.is_closed t.request_body
+    && not (Body.Writer.has_pending_output t.request_body)
+    then begin
+      Writer.close t.writer;
+      k ()
+    end else
+      Writer.on_wakeup t.writer k
+
+  let report_write_result t result =
+    Writer.report_result t.writer result
+
+  let is_closed t = Reader.is_closed t.reader && Writer.is_closed t.writer
+end

unikernel/duniverse/ocaml-h1/lib/config.ml

@@ -0,0 +1,11 @@
+type t =
+  { read_buffer_size          : int
+  ; request_body_buffer_size  : int
+  ; response_buffer_size      : int
+  ; response_body_buffer_size : int }
+
+let default =
+  { read_buffer_size          = 0x1000
+  ; request_body_buffer_size  = 0x1000
+  ; response_buffer_size      = 0x400
+  ; response_body_buffer_size = 0x1000 }

unikernel/duniverse/ocaml-h1/lib/dune

@@ -0,0 +1,6 @@
+(library
+ (name        h1)
+ (public_name h1)
+ (libraries
+   angstrom faraday base64 bstr httpun-types)
+ (flags (:standard -safe-string)))

unikernel/duniverse/ocaml-h1/lib/h1.ml

@@ -0,0 +1,20 @@
+module Headers = Httpun_types.Headers
+module IOVec = Httpun_types.IOVec
+module Method = Httpun_types.Method
+module Status = Httpun_types.Status
+module Version = Httpun_types.Version
+module Reqd = Reqd
+module Request = Request
+module Response = Response
+module Body = Body
+module Config = Config
+
+module Server_connection = Server_connection
+module Client_connection = Client_connection.Oneshot
+
+module Websocket = Websocket
+
+module H1_private = struct
+  module Parse = Parse
+  module Serialize = Serialize
+end

unikernel/duniverse/ocaml-h1/lib/h1.mli

@@ -0,0 +1,662 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+(** H1 is a high-performance, memory-efficient, and scalable web server
+    for OCaml. It implements the HTTP 1.1 specification with respect to
+    parsing, serialization, and connection pipelining. For compatibility,
+    H1 respects the imperatives of the [Server_connection] header when handling
+    HTTP 1.0 connections.
+
+    To use this library effectively, the user must be familiar with the HTTP
+    1.1 specification, and the basic principles of memory management and
+    vectorized IO. *)
+
+(** {2 Basic HTTP Types} *)
+
+module Version : module type of Httpun_types.Version
+module Method : module type of Httpun_types.Method
+module Status : module type of Httpun_types.Status
+module Headers : module type of Httpun_types.Headers
+
+(** {2 Message Body} *)
+
+module Body : sig
+  module Reader : sig
+    type t
+
+    val schedule_read
+      :  t
+      -> on_eof  : (unit -> unit)
+      -> on_read : (Bstr.t -> off:int -> len:int -> unit)
+      -> unit
+    (** [schedule_read t ~on_eof ~on_read] will setup [on_read] and [on_eof] as
+        callbacks for when bytes are available in [t] for the application to
+        consume, or when the input channel has been closed and no further bytes
+        will be received by the application.
+
+        Once either of these callbacks have been called, they become inactive.
+        The application is responsible for scheduling subsequent reads, either
+        within the [on_read] callback or by some other mechanism. *)
+
+    val close : t -> unit
+    (** [close t] closes [t], indicating that any subsequent input
+        received should be discarded. *)
+
+    val is_closed : t -> bool
+    (** [is_closed t] is [true] if {!close} has been called on [t] and [false]
+        otherwise. A closed [t] may still have bytes available for reading. *)
+  end
+
+  module Writer : sig
+    type t
+
+    val write_char : t -> char -> unit
+    (** [write_char w char] copies [char] into an internal buffer. If possible,
+        this write will be combined with previous and/or subsequent writes
+        before transmission. *)
+
+    val write_string : t -> ?off:int -> ?len:int -> string -> unit
+    (** [write_string w ?off ?len str] copies [str] into an internal buffer. If
+        possible, this write will be combined with previous and/or subsequent
+        writes before transmission. *)
+
+    val write_bigstring : t -> ?off:int -> ?len:int -> Bstr.t -> unit
+    (** [write_bigstring w ?off ?len bs] copies [bs] into an internal buffer. If
+        possible, this write will be combined with previous and/or subsequent
+        writes before transmission. *)
+
+    val schedule_bigstring : t -> ?off:int -> ?len:int -> Bstr.t -> unit
+    (** [schedule_bigstring w ?off ?len bs] schedules [bs] to be transmitted at
+        the next opportunity without performing a copy. [bs] should not be
+        modified until a subsequent call to {!flush} has successfully
+        completed. *)
+
+    val flush_with_reason : t -> ([ `Written | `Closed ] -> unit) -> unit
+    (** [flush_with_reason t f] makes all bytes in [t] available for writing to the awaiting output
+        channel. Once those bytes have reached that output channel, [f `Written] will be
+        called. If instead, the output channel is closed before all of those bytes are
+        successfully written, [f `Closed] will be called.
+
+        The type of the output channel is runtime-dependent, as are guarantees
+        about whether those packets have been queued for delivery or have
+        actually been received by the intended recipient. *)
+
+    val flush: t -> (unit -> unit) -> unit
+    (** [flush t f] is identical to [flush_with_reason t], except ignoring the result of the flush.
+        In most situations, you should use flush_with_reason and properly handle a closed output channel. *)
+
+    val close : t -> unit
+    (** [close t] closes [t], causing subsequent write calls to raise. If
+        [t] is writable, this will cause any pending output to become available
+        to the output channel. *)
+
+    val is_closed : t -> bool
+    (** [is_closed t] is [true] if {!close} has been called on [t], or if the attached
+        output channel is closed (e.g. because [report_write_result `Closed] has been
+        called). A closed [t] may still have pending output. *)
+  end
+
+end
+
+
+(** {2 Message Types} *)
+
+(** Request
+
+    A client-initiated HTTP message. *)
+module Request : sig
+  type t =
+    { meth    : Method.t
+    ; target  : string
+    ; version : Version.t
+    ; headers : Headers.t }
+
+  val create
+    :  ?version:Version.t (** default is HTTP 1.1 *)
+    -> ?headers:Headers.t (** default is {!Headers.empty} *)
+    -> Method.t
+    -> string
+    -> t
+
+  module Body_length : sig
+    type t = [
+      | `Fixed of Int64.t
+      | `Chunked
+      | `Error of [`Bad_request]
+    ]
+
+    val pp_hum : Format.formatter -> t -> unit
+  end
+
+  val body_length : t -> Body_length.t
+  (** [body_length t] is the length of the message body accompanying [t]. It is
+      an error to generate a request with a close-delimited message body.
+
+      See {{:https://tools.ietf.org/html/rfc7230#section-3.3.3} RFC7230§3.3.3}
+      for more details. *)
+
+  val persistent_connection : ?proxy:bool -> t -> bool
+  (** [persistent_connection ?proxy t] indicates whether the connection for [t]
+      can be reused for multiple requests and responses. If the calling code
+      is acting as a proxy, it should pass [~proxy:true].
+
+      See {{:https://tools.ietf.org/html/rfc7230#section-6.3} RFC7230§6.3 for
+      more details. *)
+
+  val pp_hum : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
+
+  val is_upgrade : t -> bool
+  (** [is_upgrade t] returns true if the request has the "Connection: upgrade"
+      header. *)
+end
+
+
+(** Response
+
+    A server-generated message to a {Request}. *)
+module Response : sig
+  type t =
+    { version : Version.t
+    ; status  : Status.t
+    ; reason  : string
+    ; headers : Headers.t }
+
+  val create
+    :  ?reason:string     (** default is determined by {!Status.default_reason_phrase} *)
+    -> ?version:Version.t (** default is HTTP 1.1 *)
+    -> ?headers:Headers.t (** default is {!Headers.empty} *)
+    -> Status.t
+    -> t
+  (** [create ?reason ?version ?headers status] creates an HTTP response with
+      the given parameters. For typical use cases, it's sufficient to provide
+      values for [headers] and [status]. *)
+
+  module Body_length : sig
+    type t = [
+      | `Fixed of Int64.t
+      | `Chunked
+      | `Close_delimited
+      | `Error of [ `Bad_gateway | `Internal_server_error ]
+    ]
+
+    val pp_hum : Format.formatter -> t -> unit
+  end
+
+  val body_length : ?proxy:bool -> request_method:Method.standard -> t -> Body_length.t
+  (** [body_length ?proxy ~request_method t] is the length of the message body
+      accompanying [t] assuming it is a response to a request whose method was
+      [request_method]. If the calling code is acting as a proxy, it should
+      pass [~proxy:true]. This optional parameter only affects error reporting.
+
+      See {{:https://tools.ietf.org/html/rfc7230#section-3.3.3} RFC7230§3.3.3}
+      for more details. *)
+
+  val persistent_connection : ?proxy:bool -> t -> bool
+  (** [persistent_connection ?proxy t] indicates whether the connection for [t]
+      can be reused for multiple requests and responses. If the calling code
+      is acting as a proxy, it should pass [~proxy:true].
+
+      See {{:https://tools.ietf.org/html/rfc7230#section-6.3} RFC7230§6.3 for
+      more details. *)
+
+  val pp_hum : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
+end
+
+
+(** IOVec *)
+module IOVec : module type of Httpun_types.IOVec
+
+(** {2 Request Descriptor} *)
+module Reqd : sig
+  type t
+
+  val request : t -> Request.t
+  val request_body : t -> Body.Reader.t
+
+  val response : t -> Response.t option
+  val response_exn : t -> Response.t
+
+  (** Responding
+
+      The following functions will initiate a response for the corresponding
+      request in [t]. Depending on the state of the current connection, and the
+      header values of the response, this may cause the connection to close or
+      to persist for reuse by the client.
+
+      See {{:https://tools.ietf.org/html/rfc7230#section-6.3} RFC7230§6.3} for
+      more details. *)
+
+  val respond_with_string    : t -> Response.t -> string -> unit
+  val respond_with_bigstring : t -> Response.t -> Bstr.t -> unit
+  val respond_with_streaming : ?flush_headers_immediately:bool -> t -> Response.t -> Body.Writer.t
+
+  val respond_with_upgrade : ?reason:string -> t -> Headers.t -> unit
+  (** Initiate an HTTP upgrade. [Server_connection.next_write_request] and
+      [next_read_request] will begin returning [`Upgrade] once the response
+      headers have been written, which indicates that the runtime should take
+      over direct control of the socket rather than shuttling bytes through H1.
+
+      The headers must indicate a valid upgrade message, e.g. must include
+      "Connection: upgrade". See [Request.is_upgrade]. *)
+
+  (** {3 Exception Handling} *)
+
+  val report_exn : t -> exn -> unit
+  val try_with : t -> (unit -> unit) -> (unit, exn) result
+end
+
+(** {2 Buffer Size Configuration} *)
+module Config : sig
+  type t =
+    { read_buffer_size          : int (** Default is [4096] *)
+    ; request_body_buffer_size  : int (** Default is [4096] *)
+    ; response_buffer_size      : int (** Default is [1024] *)
+    ; response_body_buffer_size : int (** Default is [4096] *)
+    }
+
+  val default : t
+  (** [default] is a configuration record with all parameters set to their
+      default values. *)
+end
+
+(** {2 Server Connection} *)
+
+module Server_connection : sig
+  type t
+
+  type error =
+    [ `Bad_request | `Bad_gateway | `Internal_server_error | `Exn of exn ]
+
+  type request_handler = Reqd.t -> unit
+
+  type error_handler =
+    ?request:Request.t -> error -> (Headers.t -> Body.Writer.t) -> unit
+
+  val create
+    :  ?config:Config.t
+    -> ?error_handler:error_handler
+    -> request_handler
+    -> t
+  (** [create ?config ?error_handler ~request_handler] creates a connection
+      handler that will service individual requests with [request_handler]. *)
+
+  val next_read_operation : t -> [ `Read | `Yield | `Close | `Upgrade ]
+  (** [next_read_operation t] returns a value describing the next operation
+      that the caller should conduct on behalf of the connection. *)
+
+  val read : t -> Bstr.t -> off:int -> len:int -> int
+  (** [read t bigstring ~off ~len] reads bytes of input from the provided range
+      of [bigstring] and returns the number of bytes consumed by the
+      connection.  {!read} should be called after {!next_read_operation}
+      returns a [`Read] value and additional input is available for the
+      connection to consume. *)
+
+  val read_eof : t -> Bstr.t -> off:int -> len:int -> int
+  (** [read_eof t bigstring ~off ~len] reads bytes of input from the provided
+      range of [bigstring] and returns the number of bytes consumed by the
+      connection.  {!read_eof} should be called after {!next_read_operation}
+      returns a [`Read] and an EOF has been received from the communication
+      channel. The connection will attempt to consume any buffered input and
+      then shutdown the HTTP parser for the connection. *)
+
+  val yield_reader : t -> (unit -> unit) -> unit
+  (** [yield_reader t continue] registers with the connection to call
+      [continue] when reading should resume. {!yield_reader} should be called
+      after {next_read_operation} returns a [`Yield] value. *)
+
+  val next_write_operation : t -> [
+    | `Write of Bstr.t IOVec.t list
+    | `Yield
+    | `Upgrade
+    | `Close of int ]
+  (** [next_write_operation t] returns a value describing the next operation
+      that the caller should conduct on behalf of the connection. *)
+
+  val report_write_result : t -> [`Ok of int | `Closed] -> unit
+  (** [report_write_result t result] reports the result of the latest write
+      attempt to the connection. {report_write_result} should be called after a
+      call to {next_write_operation} that returns a [`Write buffer] value.
+
+        {ul
+        {- [`Ok n] indicates that the caller successfully wrote [n] bytes of
+        output from the buffer that the caller was provided by
+        {next_write_operation}. }
+        {- [`Closed] indicates that the output destination will no longer
+        accept bytes from the write processor. }} *)
+
+  val yield_writer : t -> (unit -> unit) -> unit
+  (** [yield_writer t continue] registers with the connection to call
+      [continue] when writing should resume. {!yield_writer} should be called
+      after {next_write_operation} returns a [`Yield] value. *)
+
+  val report_exn : t -> exn -> unit
+  (** [report_exn t exn] reports that an error [exn] has been caught and
+      that it has been attributed to [t]. Calling this function will switch [t]
+      into an error state. Depending on the state [t] is transitioning from, it
+      may call its error handler before terminating the connection. *)
+
+  val is_closed : t -> bool
+  (** [is_closed t] is [true] if both the read and write processors have been
+      shutdown. When this is the case {!next_read_operation} will return
+      [`Close _] and {!next_write_operation} will return [`Write _] until all
+      buffered output has been flushed. *)
+
+  val error_code : t -> error option
+  (** [error_code t] returns the [error_code] that caused the connection to
+      close, if one exists. *)
+
+  (**/**)
+  val shutdown : t -> unit
+  (**/**)
+end
+
+(** {2 Client Connection} *)
+
+module Client_connection : sig
+
+  type t
+
+  type error =
+    [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ]
+
+  type response_handler = Response.t -> Body.Reader.t  -> unit
+
+  type error_handler = error -> unit
+
+  val request
+    :  ?config:Config.t
+    -> Request.t
+    -> error_handler:error_handler
+    -> response_handler:response_handler
+    -> Body.Writer.t * t
+
+  val next_read_operation : t -> [ `Read | `Close ]
+  (** [next_read_operation t] returns a value describing the next operation
+      that the caller should conduct on behalf of the connection. *)
+
+  val read : t -> Bstr.t -> off:int -> len:int -> int
+  (** [read t bigstring ~off ~len] reads bytes of input from the provided range
+      of [bigstring] and returns the number of bytes consumed by the
+      connection.  {!read} should be called after {!next_read_operation}
+      returns a [`Read] value and additional input is available for the
+      connection to consume. *)
+
+  val read_eof : t -> Bstr.t -> off:int -> len:int -> int
+  (** [read_eof t bigstring ~off ~len] reads bytes of input from the provided
+      range of [bigstring] and returns the number of bytes consumed by the
+      connection.  {!read_eof} should be called after {!next_read_operation}
+      returns a [`Read] and an EOF has been received from the communication
+      channel. The connection will attempt to consume any buffered input and
+      then shutdown the HTTP parser for the connection. *)
+
+  val next_write_operation : t -> [
+    | `Write of Bstr.t IOVec.t list
+    | `Yield
+    | `Close of int ]
+  (** [next_write_operation t] returns a value describing the next operation
+      that the caller should conduct on behalf of the connection. *)
+
+  val report_write_result : t -> [`Ok of int | `Closed] -> unit
+  (** [report_write_result t result] reports the result of the latest write
+      attempt to the connection. {report_write_result} should be called after a
+      call to {next_write_operation} that returns a [`Write buffer] value.
+
+        {ul
+        {- [`Ok n] indicates that the caller successfully wrote [n] bytes of
+        output from the buffer that the caller was provided by
+        {next_write_operation}. }
+        {- [`Closed] indicates that the output destination will no longer
+        accept bytes from the write processor. }} *)
+
+  val yield_writer : t -> (unit -> unit) -> unit
+  (** [yield_writer t continue] registers with the connection to call
+      [continue] when writing should resume. {!yield_writer} should be called
+      after {next_write_operation} returns a [`Yield] value. *)
+
+  val report_exn : t -> exn -> unit
+  (** [report_exn t exn] reports that an error [exn] has been caught and
+      that it has been attributed to [t]. Calling this function will switch [t]
+      into an error state. Depending on the state [t] is transitioning from, it
+      may call its error handler before terminating the connection. *)
+
+  val is_closed : t -> bool
+
+  (**/**)
+  val shutdown : t -> unit
+  (**/**)
+end
+
+(**/**)
+
+(** Websocket *)
+module Websocket : sig
+  module Opcode : sig
+    type standard_non_control = [ `Continuation | `Text | `Binary ]
+    type standard_control = [ `Connection_close | `Ping | `Pong ]
+    type standard = [ standard_non_control | standard_control ]
+    type t = [ standard | `Other of int ]
+
+    val code : t -> int
+    val of_code : int -> t option
+    val of_code_exn : int -> t
+    val to_int : t -> int
+    val of_int : int -> t option
+    val of_int_exn : int -> t
+    val pp_hum : Format.formatter -> t -> unit
+  end
+
+  module Close_code : sig
+    type standard =
+      [ `Normal_closure
+      | `Going_away
+      | `Protocol_error
+      | `Unsupported_data
+      | `No_status_rcvd
+      | `Abnormal_closure
+      | `Invalid_frame_payload_data
+      | `Policy_violation
+      | `Message_too_big
+      | `Mandatory_ext
+      | `Internal_server_error
+      | `TLS_handshake ]
+
+    type t = [ standard | `Other of int ]
+
+    val code : t -> int
+    val of_code : int -> t option
+    val of_code_exn : int -> t
+    val to_int : t -> int
+    val of_int : int -> t option
+    val of_int_exn : int -> t
+  end
+
+  module Frame : sig
+    type t
+
+    val is_fin : t -> bool
+    val rsv : t -> int
+    val opcode : t -> Opcode.t
+    val has_mask : t -> bool
+    val mask : t -> int32 option
+    val mask_exn : t -> int32
+    val mask_inplace : t -> unit
+    val unmask_inplace : t -> unit
+    val length : t -> int
+    val payload_length : t -> int
+    val parse : t Angstrom.t
+
+    (* does not allocate a bigstring, but instead returns a
+       new view into the frame payload *)
+    val payload_view : t -> Bstr.t
+
+    val serialize_control :
+      Faraday.t -> mask:int32 option -> opcode:Opcode.standard_control -> unit
+
+    val schedule_serialize :
+      Faraday.t ->
+      mask:int32 option ->
+      is_fin:bool ->
+      opcode:Opcode.t ->
+      payload:Bstr.t ->
+      off:int ->
+      len:int ->
+      unit
+
+    val schedule_serialize_bytes :
+      Faraday.t ->
+      mask:int32 option ->
+      is_fin:bool ->
+      opcode:Opcode.t ->
+      payload:Bytes.t ->
+      off:int ->
+      len:int ->
+      unit
+
+    val serialize_bytes :
+      Faraday.t ->
+      mask:int32 option ->
+      is_fin:bool ->
+      opcode:Opcode.t ->
+      payload:Bytes.t ->
+      off:int ->
+      len:int ->
+      unit
+  end
+
+  type frame_handler =
+    opcode:Opcode.t -> is_fin:bool -> Bstr.t -> off:int -> len:int -> unit
+
+  type input_handlers = { frame_handler : frame_handler; eof : unit -> unit }
+
+  module Wsd : sig
+    type mode = [ `Client of unit -> int32 | `Server ]
+    type t
+
+    val create : mode -> t
+
+    val schedule :
+      t ->
+      kind:Opcode.standard_non_control ->
+      is_fin:bool ->
+      Bstr.t ->
+      off:int ->
+      len:int ->
+      unit
+
+    val send_bytes :
+      t ->
+      kind:Opcode.standard_non_control ->
+      is_fin:bool ->
+      Bytes.t ->
+      off:int ->
+      len:int ->
+      unit
+
+    val send_ping : t -> unit
+    val send_pong : t -> unit
+    val flushed : t -> (unit -> unit) -> unit
+    val close : t -> unit
+    val next : t -> [ `Write of Bstr.t IOVec.t list | `Yield | `Close of int ]
+    val report_result : t -> [ `Ok of int | `Closed ] -> unit
+    val is_closed : t -> bool
+    val when_ready_to_write : t -> (unit -> unit) -> unit
+  end
+
+  module Handshake : sig
+    val get_nonce : Request.t -> string option
+
+    val server_headers : sha1:(string -> string) -> nonce:string -> Headers.t
+  end
+
+  module Client_connection : sig
+    type t
+
+    type error =
+      [ Client_connection.error
+      | `Handshake_failure of Response.t * Body.Reader.t ]
+
+    val create :
+      nonce:string ->
+      host:string ->
+      port:int ->
+      resource:string ->
+      sha1:(string -> string) ->
+      error_handler:(error -> unit) ->
+      websocket_handler:(Wsd.t -> input_handlers) ->
+      t
+
+    val next_read_operation : t -> [ `Read | `Close ]
+
+    val next_write_operation :
+      t -> [ `Write of Bstr.t IOVec.t list | `Yield | `Close of int ]
+
+    val read : t -> Bstr.t -> off:int -> len:int -> int
+    val read_eof : t -> Bstr.t -> off:int -> len:int -> int
+    val report_write_result : t -> [ `Ok of int | `Closed ] -> unit
+    val yield_writer : t -> (unit -> unit) -> unit
+    val close : t -> unit
+  end
+
+  module Server_connection : sig
+    type t
+    type error = [ `Exn of exn ]
+
+    val create : websocket_handler:(Wsd.t -> input_handlers) -> t
+    val next_read_operation : t -> [ `Read | `Close ]
+
+    val next_write_operation :
+      t -> [ `Write of Bstr.t IOVec.t list | `Yield | `Close of int ]
+
+    val read : t -> Bstr.t -> off:int -> len:int -> int
+    val read_eof : t -> Bstr.t -> off:int -> len:int -> int
+    val report_write_result : t -> [ `Ok of int | `Closed ] -> unit
+    val yield_writer : t -> (unit -> unit) -> unit
+    val is_closed : t -> bool
+    val close : t -> unit
+  end
+end
+
+(**/**)
+
+module H1_private : sig
+  module Parse : sig
+    val request : Request.t Angstrom.t
+    val response : Response.t Angstrom.t
+  end
+
+  module Serialize : sig
+    val write_request  : Faraday.t -> Request.t  -> unit
+    val write_response : Faraday.t -> Response.t -> unit
+  end
+end

unikernel/duniverse/ocaml-h1/lib/message.ml

@@ -0,0 +1,65 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+
+(* This module contains functionality that applies to both requests and
+   responses, which are collectively referred to in the HTTP 1.1 specifications
+   as 'messages'. *)
+
+open Httpun_types
+
+let persistent_connection ?(proxy=false) version headers =
+  let _ = proxy in
+  (* XXX(seliopou): use proxy argument in the case of HTTP/1.0 as per
+     https://tools.ietf.org/html/rfc7230#section-6.3 *)
+  match Headers.get headers "connection" with
+  | Some "close"      -> false
+  | Some "keep-alive" -> Version.(compare version v1_0) >= 0
+  | _                 -> Version.(compare version v1_1) >= 0
+
+let sort_uniq xs =
+  (* Though {!List.sort_uniq} performs a check on the input length and returns
+   * immediately for lists of length less than [2], it still allocates closures
+   * before it does that check! To avoid that just do our own checking here to
+   * avoid the allocations in the common case. *)
+  match xs with
+  | [] | [ _ ] -> xs
+  | _          -> List.sort_uniq String.compare xs
+
+let unique_content_length_values headers =
+  (* XXX(seliopou): perform proper content-length parsing *)
+  sort_uniq (Headers.get_multi headers "content-length")
+
+let content_length_of_string s =
+  try Int64.of_string s with _ -> -1L

unikernel/duniverse/ocaml-h1/lib/optional_thunk.ml

@@ -0,0 +1,12 @@
+type t = unit -> unit
+
+let none = Sys.opaque_identity (fun () -> ())
+let some f =
+  if f == none
+  then failwith "Optional_thunk: this function is not representable as a some value";
+  f
+
+let is_none t = t == none
+let is_some t = not (is_none t)
+let call_if_some t = t ()
+let unchecked_value t = t

unikernel/duniverse/ocaml-h1/lib/optional_thunk.mli

@@ -0,0 +1,10 @@
+type t
+
+val none : t
+val some : (unit -> unit) -> t
+
+val is_none : t -> bool
+val is_some : t -> bool
+
+val call_if_some : t -> unit
+val unchecked_value : t -> unit -> unit

unikernel/duniverse/ocaml-h1/lib/parse.ml

@@ -0,0 +1,327 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2016 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+include Angstrom
+open Httpun_types
+
+module P = struct
+  let is_space = function ' ' | '\t' -> true | _ -> false
+  let is_cr = function '\r' -> true | _ -> false
+  let is_space_or_colon = function ' ' | '\t' | ':' -> true | _ -> false
+
+  let is_hex = function
+    | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
+    | _ -> false
+
+  let is_digit = function '0' .. '9' -> true | _ -> false
+
+  let is_separator = function
+    | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' | '/' | '['
+    | ']' | '?' | '=' | '{' | '}' | ' ' | '\t' ->
+        true
+    | _ -> false
+
+  let is_token =
+    (* The commented-out ' ' and '\t' are not necessary because of the range at
+     * the top of the match. *)
+    function
+    | '\000' .. '\031'
+    | '\127' | ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' | '/'
+    | '[' | ']' | '?' | '=' | '{' | '}' (* | ' ' | '\t' *) ->
+        false
+    | _ -> true
+end
+
+let unit = return ()
+let token = take_while1 P.is_token
+let spaces = skip_while P.is_space
+
+let digit =
+  satisfy P.is_digit >>| function
+  | '0' -> 0
+  | '1' -> 1
+  | '2' -> 2
+  | '3' -> 3
+  | '4' -> 4
+  | '5' -> 5
+  | '6' -> 6
+  | '7' -> 7
+  | '8' -> 8
+  | '9' -> 9
+  | _ -> assert false
+
+let eol = string "\r\n" <?> "eol"
+let hex str = try return (Int64.of_string ("0x" ^ str)) with _ -> fail "hex"
+let skip_line = take_till P.is_cr *> eol
+
+let version =
+  string "HTTP/"
+  *> lift2
+       (fun major minor -> { Version.major; minor })
+       (digit <* char '.')
+       digit
+
+let header =
+  (* From RFC7230§3.2.4:
+
+        "No whitespace is allowed between the header field-name and colon.  In
+        the past, differences in the handling of such whitespace have led to
+        security vulnerabilities in request routing and response handling.  A
+        server MUST reject any received request message that contains whitespace
+        between a header field-name and colon with a response code of 400 (Bad
+        Request).  A proxy MUST remove any such whitespace from a response
+        message before forwarding the message downstream."
+
+     This can be detected by checking the message and marks in a parse failure,
+     which should look like this when serialized "... > header > :". *)
+  lift2
+    (fun key value -> (key, value))
+    (take_till P.is_space_or_colon <* char ':' <* spaces)
+    (take_till P.is_cr <* eol >>| String.trim)
+  <?> "header"
+
+let headers =
+  let cons x xs = x :: xs in
+  fix (fun headers ->
+      let _emp = return [] in
+      let _rec = lift2 cons header headers in
+      peek_char_fail >>= function '\r' -> _emp | _ -> _rec)
+  >>| Headers.of_list
+
+let request =
+  let meth = take_till P.is_space >>| Method.of_string in
+  lift4
+    (fun meth target version headers ->
+      Request.create ~version ~headers meth target)
+    (meth <* char ' ')
+    (take_till P.is_space <* char ' ')
+    (version <* eol <* commit)
+    (headers <* eol)
+
+let response =
+  let status =
+    take_while P.is_digit >>= fun str ->
+    if String.length str = 0 then fail "status-code empty"
+    else if String.length str > 3 then
+      fail (Printf.sprintf "status-code too long: %S" str)
+    else return (Status.of_string str)
+  in
+  lift4
+    (fun version status reason headers ->
+      Response.create ~reason ~version ~headers status)
+    (version <* char ' ')
+    (status <* char ' ')
+    (take_till P.is_cr <* eol <* commit)
+    (headers <* eol)
+
+let finish body =
+  Body.Reader.close body;
+  commit
+
+let schedule_size body n =
+  let faraday = Body.Reader.unsafe_faraday body in
+  (* XXX(seliopou): performance regression due to switching to a single output
+   * format in Farady. Once a specialized operation is exposed to avoid the
+   * intemediate copy, this should be back to the original performance. *)
+  (if Faraday.is_closed faraday then advance n
+   else take n >>| fun s -> Faraday.write_string faraday s)
+  *> commit
+
+let body ~encoding body =
+  let rec fixed n ~unexpected =
+    if n = 0L then unit
+    else
+      at_end_of_input >>= function
+      | true -> finish body *> fail unexpected
+      | false ->
+          available >>= fun m ->
+          let m' = Int64.(min (of_int m) n) in
+          let n' = Int64.sub n m' in
+          schedule_size body (Int64.to_int m') >>= fun () ->
+          fixed n' ~unexpected
+  in
+  match encoding with
+  | `Fixed n ->
+      fixed n ~unexpected:"expected more from fixed body" >>= fun () ->
+      finish body
+  | `Chunked ->
+      (* XXX(seliopou): The [eol] in this parser should really parse a collection
+       * of "chunk extensions", as defined in RFC7230§4.1. These do not show up
+       * in the wild very frequently, and the h1 API has no way of exposing
+       * them to the suer, so for now the parser does not attempt to recognize
+       * them. This means that any chunked messages that contain chunk extensions
+       * will fail to parse. *)
+      fix (fun p ->
+          let _hex =
+            take_while1 P.is_hex
+            >>= (fun size -> hex size)
+            (* swallows chunk-ext, if present, and CRLF *)
+            <* eol *> commit
+          in
+          _hex >>= fun size ->
+          if size = 0L then eol >>= fun _eol -> finish body
+          else
+            fixed size ~unexpected:"expected more from body chunk" *> eol *> p)
+  | `Close_delimited ->
+      fix (fun p ->
+          let _rec = (available >>= fun n -> schedule_size body n) *> p in
+          at_end_of_input >>= function true -> finish body | false -> _rec)
+
+module Reader = struct
+  module AU = Angstrom.Unbuffered
+
+  type request_error =
+    [ `Bad_request of Request.t | `Parse of string list * string ]
+
+  type response_error =
+    [ `Invalid_response_body_length of Response.t
+    | `Parse of string list * string ]
+
+  type 'error parse_state =
+    | Done
+    | Fail    of 'error
+    | Partial of (Bstr.t -> off:int -> len:int -> AU.more -> (unit, 'error) result AU.state)
+
+  type 'error t =
+    { parser              : (unit, 'error) result Angstrom.t
+    ; mutable parse_state : 'error parse_state
+      (* The state of the parse for the current request *)
+    ; mutable closed      : bool
+      (* Whether the input source has left the building, indicating that no
+       * further input will be received. *)
+    }
+
+  type request = request_error t
+  type response = response_error t
+
+  let create parser =
+    { parser
+    ; parse_state = Done
+    ; closed      = false
+    }
+
+  let ok = return (Ok ())
+
+  let request handler =
+    let parser =
+      request <* commit >>= fun request ->
+      match Request.body_length request with
+      | `Error `Bad_request -> return (Error (`Bad_request request))
+      | `Fixed 0L  ->
+        handler request Body.Reader.empty;
+        ok
+      | `Fixed _ | `Chunked when Request.is_upgrade request ->
+        return (Error (`Bad_request request))
+      | `Fixed _ | `Chunked as encoding ->
+        let request_body = Body.Reader.create Bstr.empty in
+        handler request request_body;
+        body ~encoding request_body *> ok
+    in
+    create parser
+
+  let response ~request_method handler =
+    let parser =
+      response <* commit >>= fun response ->
+      let proxy = false in
+      match Response.body_length ~request_method response with
+      | `Error `Bad_gateway ->
+          assert (not proxy);
+          assert false
+      | `Error `Internal_server_error ->
+          return (Error (`Invalid_response_body_length response))
+      | `Fixed 0L ->
+        handler response Body.Reader.empty;
+        ok
+      | `Fixed _ | `Chunked | `Close_delimited as encoding ->
+        (* We do not trust the length provided in the [`Fixed] case, as the
+           client could DOS easily. *)
+        let response_body = Body.Reader.create Bstr.empty in
+        handler response response_body;
+        body ~encoding response_body *> ok
+    in
+    create parser
+
+  let is_closed t = t.closed
+
+  let transition t state =
+    match state with
+    | AU.Done(consumed, Ok ()) ->
+      t.parse_state <- Done;
+      consumed
+    | AU.Done(consumed, Error error) ->
+      t.parse_state <- Fail error;
+      consumed
+    | AU.Fail(consumed, marks, msg) ->
+      t.parse_state <- Fail (`Parse(marks, msg));
+      consumed
+    | AU.Partial { committed; continue } ->
+        t.parse_state <- Partial continue;
+        committed
+
+  and start t state =
+    match state with
+    | AU.Done _ -> failwith "H1.Parse.unable to start parser"
+    | AU.Fail (0, marks, msg) -> t.parse_state <- Fail (`Parse (marks, msg))
+    | AU.Partial { committed = 0; continue } ->
+        t.parse_state <- Partial continue
+    | _ -> assert false
+
+  let rec read_with_more t bs ~off ~len more =
+    let consumed =
+      match t.parse_state with
+      | Fail _ -> 0
+      | Done   ->
+        start t (AU.parse t.parser);
+        read_with_more  t bs ~off ~len more;
+      | Partial continue ->
+        transition t (continue bs more ~off ~len)
+    in
+    (match more with
+    | Complete when consumed = len -> t.closed <- true
+    | Complete | Incomplete -> ());
+    consumed
+
+  let force_close t = t.closed <- true
+
+  let next t =
+    if t.closed
+    then `Close
+    else (
+      match t.parse_state with
+      | Fail err  -> `Error err
+      | Done      -> `Read
+      | Partial _ -> `Read
+    )
+  ;;
+end

unikernel/duniverse/ocaml-h1/lib/reqd.ml

@@ -0,0 +1,294 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Httpun_types
+
+type error =
+  [ `Bad_request | `Bad_gateway | `Internal_server_error | `Exn of exn ]
+
+module Response_state = struct
+  type t =
+    | Waiting
+    | Upgrade   of Response.t
+    | Fixed     of Response.t
+    | Streaming of Response.t * Body.Writer.t
+end
+
+module Input_state = struct
+  type t =
+    | Waiting
+    | Ready
+    | Complete
+    | Upgraded
+end
+
+module Output_state = struct
+  type t =
+    | Waiting
+    | Ready
+    | Complete
+    | Upgraded
+end
+
+type error_handler =
+  ?request:Request.t -> error -> (Headers.t -> Body.Writer.t) -> unit
+
+module Writer = Serialize.Writer
+
+(* XXX(seliopou): The current design assumes that a new [Reqd.t] will be
+ * allocated for each new request/response on a connection. This is wasteful,
+ * as it creates garbage on persistent connections. A better approach would be
+ * to allocate a single [Reqd.t] per connection and reuse it across
+ * request/responses. This would allow a single [Faraday.t] to be allocated for
+ * the body and reused. The [response_state] type could then be inlined into
+ * the [Reqd.t] record, with dummy values occuping the fields for [response].
+ * Something like this:
+ *
+ * {[
+ *   type 'handle t =
+ *     { mutable request        : Request.t
+ *     ; mutable request_body   : Response.Body.Reader.t
+ *     ; mutable response       : Response.t (* Starts off as a dummy value,
+ *                                            * using [(==)] to identify it when
+ *                                            * necessary *)
+ *     ; mutable response_body  : Response.Body.Writer.t
+ *     ; mutable persistent     : bool
+ *     ; mutable response_state : [ `Waiting | `Started | `Streaming ]
+ *     }
+ *  ]}
+ *
+ * *)
+type t = {
+  request : Request.t;
+  request_body : Body.Reader.t;
+  writer : Writer.t;
+  response_body_buffer : Bstr.t;
+  error_handler : error_handler;
+  mutable persistent : bool;
+  mutable response_state : Response_state.t;
+  mutable error_code : [ `Ok | error ];
+}
+
+let create error_handler request request_body writer response_body_buffer =
+  {
+    request;
+    request_body;
+    writer;
+    response_body_buffer;
+    error_handler;
+    persistent = Request.persistent_connection request;
+    response_state = Waiting;
+    error_code = `Ok;
+  }
+
+let request { request; _ } = request
+let request_body { request_body; _ } = request_body
+
+let response { response_state; _ } =
+  match response_state with
+  | Waiting -> None
+  | Streaming (response, _)
+  | Upgrade response
+  | Fixed response -> Some response
+
+let response_exn { response_state; _ } =
+  match response_state with
+  | Waiting -> failwith "H1.Reqd.response_exn: response has not started"
+  | Streaming (response, _)
+  | Upgrade response
+  | Fixed response -> response
+
+let respond_with_string t response str =
+  if t.error_code <> `Ok then
+    failwith
+      "H1.Reqd.respond_with_string: invalid state, currently handling error";
+  match t.response_state with
+  | Waiting ->
+      (* XXX(seliopou): check response body length *)
+      Writer.write_response t.writer response;
+      Writer.write_string t.writer str;
+      if t.persistent then
+        t.persistent <- Response.persistent_connection response;
+      t.response_state <- Fixed response;
+      Writer.wakeup t.writer
+  | Streaming _ ->
+    failwith "H1.Reqd.respond_with_string: response already started"
+  | Upgrade _
+  | Fixed _ ->
+    failwith "H1.Reqd.respond_with_string: response already complete"
+
+let respond_with_bigstring t response (bstr : Bstr.t) =
+  if t.error_code <> `Ok then
+    failwith
+      "H1.Reqd.respond_with_bigstring: invalid state, currently handling error";
+  match t.response_state with
+  | Waiting ->
+      (* XXX(seliopou): check response body length *)
+      Writer.write_response t.writer response;
+      Writer.schedule_bigstring t.writer bstr;
+      if t.persistent then
+        t.persistent <- Response.persistent_connection response;
+      t.response_state <- Fixed response;
+      Writer.wakeup t.writer
+  | Streaming _ ->
+    failwith "H1.Reqd.respond_with_bigstring: response already started"
+  | Upgrade _
+  | Fixed _ ->
+      failwith "H1.Reqd.respond_with_bigstring: response already complete"
+
+let unsafe_respond_with_streaming ~flush_headers_immediately t response =
+  match t.response_state with
+  | Waiting ->
+      let encoding =
+        match Response.body_length ~request_method:t.request.meth response with
+        | (`Fixed _ | `Close_delimited | `Chunked) as encoding -> encoding
+        | `Error (`Bad_gateway | `Internal_server_error) ->
+            failwith
+              "H1.Reqd.respond_with_streaming: invalid response body length"
+      in
+      let response_body =
+        Body.Writer.create t.response_body_buffer t.writer ~encoding
+      in
+      Writer.write_response t.writer response;
+      if t.persistent then
+        t.persistent <- Response.persistent_connection response;
+      t.response_state <- Streaming (response, response_body);
+      if flush_headers_immediately then Writer.wakeup t.writer;
+      response_body
+  | Streaming _ ->
+    failwith "H1.Reqd.respond_with_streaming: response already started"
+  | Upgrade _
+  | Fixed _ ->
+      failwith "H1.Reqd.respond_with_streaming: response already complete"
+
+let respond_with_streaming ?(flush_headers_immediately = false) t response =
+  if t.error_code <> `Ok then
+    failwith
+      "H1.Reqd.respond_with_streaming: invalid state, currently handling error";
+  unsafe_respond_with_streaming ~flush_headers_immediately t response
+
+let respond_with_upgrade ?reason t headers =
+  match t.response_state with
+  | Waiting ->
+    if not (Request.is_upgrade t.request) then
+      failwith "H1.Reqd.respond_with_upgrade: request was not an upgrade request"
+    else (
+      let response = Response.create ?reason ~headers `Switching_protocols in
+      t.response_state <- Upgrade response;
+      (* The parser ensures it only passes empty bodies in the case of an
+         upgrade request *)
+      assert (Body.Reader.is_closed t.request_body);
+      Writer.write_response t.writer response;
+      Writer.wakeup t.writer);
+  | Streaming _ ->
+    failwith "H1.Reqd.respond_with_upgrade: response already started"
+  | Upgrade _
+  | Fixed _ ->
+    failwith "H1.Reqd.respond_with_upgrade: response already complete"
+
+let report_error t error =
+  t.persistent <- false;
+  Body.Reader.close t.request_body;
+  match (t.response_state, t.error_code) with
+  | Waiting, `Ok ->
+      t.error_code <- (error :> [ `Ok | error ]);
+      let status =
+        match (error :> [ error | Status.standard ]) with
+        | `Exn _ -> `Internal_server_error
+        | #Status.standard as status -> status
+      in
+      t.error_handler ~request:t.request error (fun headers ->
+          unsafe_respond_with_streaming ~flush_headers_immediately:true t
+            (Response.create ~headers status))
+  | Waiting, `Exn _ ->
+      (* XXX(seliopou): Decide what to do in this unlikely case. There is an
+       * outstanding call to the [error_handler], but an intervening exception
+       * has been reported as well. *)
+      failwith "H1.Reqd.report_exn: NYI"
+  | Streaming (_response, response_body), `Ok -> Body.Writer.close response_body
+  | Streaming (_response, response_body), `Exn _ ->
+    Body.Writer.close response_body;
+    Writer.close_and_drain t.writer
+  | (Fixed _ | Streaming _ | Waiting | Upgrade _) , _ ->
+    (* XXX(seliopou): Once additional logging support is added, log the error
+     * in case it is not spurious. *)
+    ()
+
+let report_exn t exn = report_error t (`Exn exn)
+
+let try_with t f : (unit, exn) result =
+  try
+    f ();
+    Ok ()
+  with exn ->
+    report_exn t exn;
+    Error exn
+
+(* Private API, not exposed to the user through h1.mli *)
+
+let close_request_body { request_body; _ } = Body.Reader.close request_body
+
+let error_code t =
+  match t.error_code with #error as error -> Some error | `Ok -> None
+
+let persistent_connection t = t.persistent
+
+let input_state t : Input_state.t =
+  match t.response_state with
+  | Upgrade _ -> Upgraded
+  | Waiting when Request.is_upgrade t.request -> Waiting
+  | Waiting | Fixed _ | Streaming _ ->
+    if Body.Reader.is_closed t.request_body
+    then Complete
+    else Ready
+;;
+
+let output_state t : Output_state.t =
+  match t.response_state with
+  | Upgrade _ -> Upgraded
+  | Fixed _ -> Complete
+  | Streaming (_, response_body) ->
+      if Body.Writer.has_pending_output response_body then Ready
+      else if Body.Writer.is_closed response_body then Complete
+      else Waiting
+  | Waiting -> Waiting
+
+let flush_request_body t =
+  if Body.Reader.has_pending_output t.request_body then
+    try Body.Reader.execute_read t.request_body with exn -> report_exn t exn
+
+let flush_response_body t =
+  match t.response_state with
+  | Streaming (_, response_body) -> Body.Writer.transfer_to_writer response_body
+  | _ -> ()

unikernel/duniverse/ocaml-h1/lib/request.ml

@@ -0,0 +1,94 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Httpun_types
+
+type t =
+  { meth    : Method.t
+  ; target  : string
+  ; version : Version.t
+  ; headers : Headers.t }
+
+let create ?(version=Version.v1_1) ?(headers=Headers.empty) meth target =
+  { meth; target; version; headers }
+
+let bad_request = `Error `Bad_request
+
+module Body_length = struct
+  type t = [
+    | `Fixed of Int64.t
+    | `Chunked
+    | `Error of [`Bad_request]
+  ]
+
+  let pp_hum fmt (len : t) =
+    match len with
+    | `Fixed n -> Format.fprintf fmt "Fixed %Li" n
+    | `Chunked -> Format.pp_print_string fmt "Chunked"
+    | `Error `Bad_request -> Format.pp_print_string fmt "Error: Bad request"
+  ;;
+end
+
+let body_length { headers; _ } : Body_length.t =
+  (* The last entry in transfer-encoding is the correct entry. We only accept
+     chunked transfer-encodings. *)
+  match List.rev (Headers.get_multi headers "transfer-encoding") with
+  | value::_ when Headers.ci_equal value "chunked" -> `Chunked
+  | _    ::_ -> bad_request
+  | [] ->
+    begin match Message.unique_content_length_values headers with
+    | []      -> `Fixed 0L
+    | [ len ] ->
+      let len = Message.content_length_of_string len in
+      if len >= 0L
+      then `Fixed len
+      else bad_request
+    | _       -> bad_request
+    end
+
+let persistent_connection ?proxy { version; headers; _ } =
+  Message.persistent_connection ?proxy version headers
+
+let pp_hum fmt { meth; target; version; headers } =
+  Format.fprintf fmt "((method \"%a\") (target %S) (version \"%a\") (headers %a))"
+    Method.pp_hum meth target Version.pp_hum version Headers.pp_hum headers
+
+let is_upgrade t =
+  match Headers.get t.headers "Connection" with
+  | None -> false
+  | Some v ->
+      let vs = String.split_on_char ',' v in
+      let vs = List.map String.trim vs in
+      let vs = List.map String.lowercase_ascii vs in
+      List.mem "upgrade" vs

unikernel/duniverse/ocaml-h1/lib/response.ml

@@ -0,0 +1,107 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Httpun_types
+
+type t =
+  { version : Version.t
+  ; status  : Status.t
+  ; reason  : string
+  ; headers : Headers.t }
+
+let create ?reason ?(version=Version.v1_1) ?(headers=Headers.empty) status =
+  let reason =
+    match reason with
+    | Some reason -> reason
+    | None ->
+      begin match status with
+      | #Status.standard as status -> Status.default_reason_phrase status
+      | `Code _                    -> "Non-standard status code"
+      end
+  in
+  { version; status; reason; headers }
+
+let persistent_connection ?proxy { version; headers; _ } =
+  Message.persistent_connection ?proxy version headers
+
+let proxy_error  = `Error `Bad_gateway
+let server_error = `Error `Internal_server_error
+
+module Body_length = struct
+  type t = [
+    | `Fixed of Int64.t
+    | `Chunked
+    | `Close_delimited
+    | `Error of [ `Bad_gateway | `Internal_server_error ]
+  ]
+
+  let pp_hum fmt (len : t) =
+    match len with
+    | `Fixed n -> Format.fprintf fmt "Fixed %Li" n
+    | `Chunked -> Format.pp_print_string fmt "Chunked"
+    | `Close_delimited -> Format.pp_print_string fmt "Close delimited"
+    | `Error `Bad_gateway -> Format.pp_print_string fmt "Error: Bad gateway"
+    | `Error `Internal_server_error ->
+        Format.pp_print_string fmt "Error: Internal server error"
+  ;;
+end
+
+let body_length ?(proxy=false) ~request_method { status; headers; _ } : Body_length.t =
+  match status, request_method with
+  | _, `HEAD                                   -> `Fixed 0L
+  | (`No_content | `Not_modified), _           -> `Fixed 0L
+  | s, _        when Status.is_informational s -> `Fixed 0L
+  | s, `CONNECT when Status.is_successful s    -> `Close_delimited
+  | _, _                                       ->
+    (* The last entry in transfer-encoding is the correct entry. We only handle
+       chunked transfer-encodings. *)
+    begin match List.rev (Headers.get_multi headers "transfer-encoding") with
+    | value::_ when Headers.ci_equal value "chunked" -> `Chunked
+    | _    ::_ -> `Close_delimited
+    | [] ->
+      begin match Message.unique_content_length_values headers with
+      | []      -> `Close_delimited
+      | [ len ] ->
+        let len = Message.content_length_of_string len in
+        if len >= 0L
+        then `Fixed len
+        else if proxy then proxy_error else server_error
+      | _       ->
+        if proxy then proxy_error else server_error
+      end
+    end
+
+let pp_hum fmt { version; status; reason; headers } =
+  Format.fprintf fmt "((version \"%a\") (status %a) (reason %S) (headers %a))"
+    Version.pp_hum version Status.pp_hum status reason Headers.pp_hum headers

unikernel/duniverse/ocaml-h1/lib/serialize.ml

@@ -0,0 +1,208 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Faraday
+open Httpun_types
+
+let write_space t   = write_char t ' '
+let write_crlf  t   = write_string t "\r\n"
+
+let write_version t version =
+  write_string t (Version.to_string version)
+
+let write_method t meth =
+  write_string t (Method.to_string meth)
+
+let write_status t status =
+  write_string t (Status.to_string status)
+
+let write_headers t headers =
+  (* XXX(seliopou): escape these thigns *)
+  List.iter (fun (name, value) ->
+    write_string t name;
+    write_string t ": ";
+    write_string t value;
+    write_crlf   t)
+  (Headers.to_list headers);
+  write_crlf t
+
+let write_request t { Request.meth; target; version; headers } =
+  write_method  t meth   ; write_space t;
+  write_string  t target ; write_space t;
+  write_version t version; write_crlf  t;
+  write_headers t headers
+
+let write_response t { Response.version; status; reason; headers } =
+  write_version t version; write_space t;
+  write_status  t status ; write_space t;
+  write_string  t reason ; write_crlf  t;
+  write_headers t headers
+
+let write_chunk_length t len =
+  write_string t (Printf.sprintf "%x" len);
+  write_crlf   t
+
+let write_string_chunk t chunk =
+  write_chunk_length t (String.length chunk);
+  write_string       t chunk;
+  write_crlf         t
+
+let write_bigstring_chunk t chunk =
+  write_chunk_length t (Bstr.length chunk);
+  write_bigstring    t chunk;
+  write_crlf         t
+
+let schedule_bigstring_chunk t chunk =
+  write_chunk_length t (Bstr.length chunk);
+  schedule_bigstring t chunk;
+  write_crlf         t
+
+module Writer = struct
+  type t =
+    { buffer                : Bstr.t
+    (* The buffer that the encoder uses for buffered writes. Managed by the
+     * control module for the encoder. *)
+    ; encoder               : Faraday.t
+    (* The encoder that handles encoding for writes. Uses the [buffer]
+     * referenced above internally. *)
+    ; mutable drained_bytes : int
+    (* The number of bytes that were not written due to the output stream
+     * being closed before all buffered output could be written. Useful for
+     * detecting error cases. *)
+    ; mutable wakeup        : Optional_thunk.t
+    (* The callback from the runtime to be invoked when output is ready to be
+     * flushed. *)
+    }
+
+  let create ?(buffer_size=0x800) () =
+    let buffer = Bstr.create buffer_size in
+    let encoder = Faraday.of_bigstring buffer in
+    { buffer
+    ; encoder
+    ; drained_bytes = 0
+    ; wakeup = Optional_thunk.none
+    }
+
+  let faraday t = t.encoder
+
+  let write_request t request =
+    write_request t.encoder request
+
+  let write_response t response =
+    write_response t.encoder response
+
+  let write_string t ?off ?len string =
+    write_string t.encoder ?off ?len string
+
+  let write_bytes t ?off ?len bytes =
+    write_bytes t.encoder ?off ?len bytes
+
+  let write_bigstring t ?off ?len bigstring =
+    write_bigstring t.encoder ?off ?len bigstring
+
+  let schedule_bigstring t ?off ?len bigstring =
+    schedule_bigstring t.encoder ?off ?len bigstring
+
+  let schedule_fixed t iovecs =
+    List.iter (fun { IOVec.buffer; off; len } ->
+      schedule_bigstring t ~off ~len buffer)
+    iovecs
+
+  let schedule_chunk t iovecs =
+    let length = IOVec.lengthv iovecs in
+    write_chunk_length t.encoder length;
+    schedule_fixed t iovecs;
+    write_crlf     t.encoder
+
+  let on_wakeup t k =
+    if Faraday.is_closed t.encoder
+    then failwith "on_wakeup on closed writer"
+    else if Optional_thunk.is_some t.wakeup
+    then failwith "on_wakeup: only one callback can be registered at a time"
+    else t.wakeup <- Optional_thunk.some k
+  ;;
+
+  let wakeup t =
+    let f = t.wakeup in
+    t.wakeup <- Optional_thunk.none;
+    Optional_thunk.call_if_some f
+  ;;
+
+  let flush t f =
+    flush_with_reason t.encoder (fun reason ->
+      let result =
+        match reason with
+        | Nothing_pending | Shift -> `Written
+        | Drain -> `Closed
+      in
+      f result)
+
+  let unyield t =
+    (* This would be better implemented by a function that just takes the
+       encoder out of a yielded state if it's in that state. Requires a change
+       to the faraday library. *)
+    flush t (fun _result -> ())
+
+  let yield t =
+    Faraday.yield t.encoder
+
+  let close t =
+    Faraday.close t.encoder
+
+  let close_and_drain t =
+    Faraday.close t.encoder;
+    let drained = Faraday.drain t.encoder in
+    t.drained_bytes <- t.drained_bytes + drained;
+    wakeup t
+
+  let is_closed t =
+    Faraday.is_closed t.encoder
+
+  let drained_bytes t =
+    t.drained_bytes
+
+  let report_result t result =
+    match result with
+    | `Closed -> close_and_drain t
+    | `Ok len -> shift t.encoder len
+
+  let next t =
+    assert (Optional_thunk.is_none t.wakeup);
+    match Faraday.operation t.encoder with
+    | `Close         -> `Close (drained_bytes t)
+    | `Yield         -> `Yield
+    | `Writev iovecs -> `Write iovecs
+
+  let has_pending_output t = Faraday.has_pending_output t.encoder
+end

unikernel/duniverse/ocaml-h1/lib/server_connection.ml

@@ -0,0 +1,307 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2017 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Httpun_types
+
+module Queue = struct
+  include Queue
+
+  let peek_exn = peek
+  let peek t = if is_empty t then None else Some (peek_exn t)
+end
+
+module Reader = Parse.Reader
+module Writer = Serialize.Writer
+
+type request_handler = Reqd.t -> unit
+
+type error =
+  [ `Bad_gateway | `Bad_request | `Internal_server_error | `Exn of exn ]
+
+type error_handler =
+  ?request:Request.t -> error -> (Headers.t -> Body.Writer.t) -> unit
+
+type t = {
+  reader : Reader.request;
+  writer : Writer.t;
+  response_body_buffer : Bstr.t;
+  request_handler : request_handler;
+  error_handler : error_handler;
+  request_queue : Reqd.t Queue.t;
+      (* invariant: If [request_queue] is not empty, then the head of the queue
+         has already had [request_handler] called on it. *)
+  mutable is_errored : bool;
+      (* if there is a parse or connection error, we invoke the [error_handler]
+         and set [is_errored] to indicate we should not close the writer yet. *)
+  mutable wakeup_reader : Optional_thunk.t;
+}
+
+let is_closed t = Reader.is_closed t.reader && Writer.is_closed t.writer
+let is_active t = not (Queue.is_empty t.request_queue)
+let current_reqd_exn t = Queue.peek_exn t.request_queue
+
+let yield_reader t k =
+  if is_closed t then failwith "yield_reader on closed conn"
+  else if Optional_thunk.is_some t.wakeup_reader then
+    failwith "yield_reader: only one callback can be registered at a time"
+  else t.wakeup_reader <- Optional_thunk.some k
+
+let wakeup_reader t =
+  let f = t.wakeup_reader in
+  t.wakeup_reader <- Optional_thunk.none;
+  Optional_thunk.call_if_some f
+
+let yield_writer t k =
+  if Writer.is_closed t.writer then k () else Writer.on_wakeup t.writer k
+
+let wakeup_writer t = Writer.wakeup t.writer
+
+let default_error_handler ?request:_ error handle =
+  let message =
+    match error with
+    | `Exn exn -> Printexc.to_string exn
+    | (#Status.client_error | #Status.server_error) as error ->
+        Status.to_string error
+  in
+  let body = handle Headers.empty in
+  Body.Writer.write_string body message;
+  Body.Writer.close body
+
+let create ?(config = Config.default) ?(error_handler = default_error_handler)
+    request_handler =
+  let { Config.response_buffer_size; response_body_buffer_size; _ } = config in
+  let writer = Writer.create ~buffer_size:response_buffer_size () in
+  let request_queue = Queue.create () in
+  let response_body_buffer = Bstr.create response_body_buffer_size in
+  let handler request request_body =
+    let reqd =
+      Reqd.create error_handler request request_body writer response_body_buffer
+    in
+    Queue.push reqd request_queue
+  in
+  {
+    reader = Reader.request handler;
+    writer;
+    response_body_buffer;
+    request_handler;
+    error_handler;
+    request_queue;
+    is_errored = false;
+    wakeup_reader = Optional_thunk.none;
+  }
+
+let shutdown_reader t =
+  if is_active t then Reqd.close_request_body (current_reqd_exn t);
+  Reader.force_close t.reader;
+  wakeup_reader t
+
+let shutdown_writer t =
+  if is_active t then (
+    let reqd = current_reqd_exn t in
+    (* XXX(dpatti): I'm not sure I understand why we close the *request* body
+       here. Maybe we can write a test such that removing this line causes it to
+       fail? *)
+    Reqd.close_request_body reqd;
+    Reqd.flush_response_body reqd);
+  Writer.close t.writer;
+  wakeup_writer t
+
+let error_code t =
+  if is_active t then Reqd.error_code (current_reqd_exn t) else None
+
+let shutdown t =
+  shutdown_reader t;
+  shutdown_writer t
+
+let set_error_and_handle ?request t error =
+  if is_active t then (
+    assert (request = None);
+    let reqd = current_reqd_exn t in
+    Reqd.report_error reqd error)
+  else (
+    t.is_errored <- true;
+    let status =
+      match (error :> [ error | Status.standard ]) with
+      | `Exn _ -> `Internal_server_error
+      | #Status.standard as status -> status
+    in
+    shutdown_reader t;
+    let writer = t.writer in
+    t.error_handler ?request error (fun headers ->
+        let response = Response.create ~headers status in
+        Writer.write_response writer response;
+        let encoding =
+          (* If we haven't parsed the request method, just use GET as a standard
+             placeholder. The method is only used for edge cases, like HEAD or
+             CONNECT. *)
+          let request_method =
+            match request with None -> `GET | Some request -> request.meth
+          in
+          match Response.body_length ~request_method response with
+          | (`Fixed _ | `Close_delimited) as encoding -> encoding
+          | `Chunked ->
+              (* XXX(dpatti): Because we pass the writer's faraday directly to the
+                 new body, we don't write the chunked encoding. A client won't be
+                 able to interpret this. *)
+              `Close_delimited
+          | `Error (`Bad_gateway | `Internal_server_error) ->
+              failwith
+                "H1.Server_connection.error_handler: invalid response body \
+                 length"
+        in
+        Body.Writer.of_faraday (Writer.faraday writer) writer ~encoding
+    )
+  )
+
+let report_exn t exn = set_error_and_handle t (`Exn exn)
+
+let advance_request_queue t =
+  ignore (Queue.take t.request_queue);
+  if not (Queue.is_empty t.request_queue) then
+    t.request_handler (Queue.peek_exn t.request_queue)
+
+let rec _next_read_operation t =
+  if not (is_active t)
+  then (
+    (* If the request queue is empty, there is no connection error, and the
+       reader is closed, then we can assume that no more user code will be able
+       to write. *)
+    if Reader.is_closed t.reader && not t.is_errored then shutdown_writer t;
+    Reader.next t.reader)
+  else
+    let reqd = current_reqd_exn t in
+    match Reqd.input_state reqd with
+    | Waiting  -> _yield_reader t
+    | Ready    -> Reader.next t.reader
+    | Complete -> _final_read_operation_for t reqd
+    | Upgraded -> `Upgrade
+
+and _final_read_operation_for t reqd =
+  if not (Reqd.persistent_connection reqd) then (
+    shutdown_reader t;
+    Reader.next t.reader;
+  ) else (
+    match Reqd.output_state reqd with
+    | Waiting | Ready -> _yield_reader t
+    | Upgraded ->
+      (* If the input state is not [Upgraded], the output state cannot be
+         either. *)
+      assert false
+    | Complete ->
+      advance_request_queue t;
+      _next_read_operation t;
+  )
+
+and _yield_reader t =
+  (* XXX(dpatti): This is a way in which the reader and writer are not
+     parallel -- we tell the writer when it needs to yield but the reader is
+     always asking for more data. This is the only branch in either
+     operation function that does not return `(Reader|Writer).next`, which
+     means there are surprising states you can get into. For example, we ask
+     the runtime to yield but then raise when it tries to because the reader
+     is closed. I think this can be avoided if we allow this module to tell the
+     reader when it should yield/resume, then we'd just do an inlined
+     `Reader.next` call instead. I put this function here to describe why this
+     is subtle. *)
+  if Reader.is_closed t.reader
+  then Reader.next t.reader
+  else `Yield
+;;
+
+let next_read_operation t =
+  match _next_read_operation t with
+  | `Error (`Parse _)             -> set_error_and_handle          t `Bad_request; `Close
+  | `Error (`Bad_request request) -> set_error_and_handle ~request t `Bad_request; `Close
+  | (`Read | `Yield | `Close | `Upgrade) as operation -> operation
+
+let rec read_with_more t bs ~off ~len more =
+  let call_handler = Queue.is_empty t.request_queue in
+  let consumed = Reader.read_with_more t.reader bs ~off ~len more in
+  if is_active t then (
+    let reqd = current_reqd_exn t in
+    if call_handler then t.request_handler reqd;
+    Reqd.flush_request_body reqd);
+  (* Keep consuming input as long as progress is made and data is
+     available, in case multiple requests were received at once. *)
+  if consumed > 0 && consumed < len then
+    let off = off + consumed and len = len - consumed in
+    consumed + read_with_more t bs ~off ~len more
+  else consumed
+
+let read t bs ~off ~len = read_with_more t bs ~off ~len Incomplete
+let read_eof t bs ~off ~len = read_with_more t bs ~off ~len Complete
+
+let rec _next_write_operation t =
+  if not (is_active t)
+  then Writer.next t.writer
+  else (
+    let reqd = current_reqd_exn t in
+    match Reqd.output_state reqd with
+    | Waiting ->
+      (* XXX(dpatti): I don't think we should need to call this, but it is
+         necessary in the case of a streaming, non-chunked body so that you can
+         set the appropriate flag. *)
+      Reqd.flush_response_body reqd;
+      Writer.next t.writer
+    | Ready ->
+      Reqd.flush_response_body reqd;
+      Writer.next t.writer
+    | Complete -> _final_write_operation_for t reqd
+    | Upgraded ->
+      wakeup_reader t;
+      (* Even in the Upgrade case, we're still responsible for writing the
+         response header, so we might have work to do. *)
+      if Writer.has_pending_output t.writer
+      then Writer.next t.writer
+      else `Upgrade)
+
+and _final_write_operation_for t reqd =
+  let next =
+    if not (Reqd.persistent_connection reqd) then (
+      shutdown_writer t;
+      Writer.next t.writer)
+    else
+      match Reqd.input_state reqd with
+      | Waiting -> `Yield
+      | Ready -> Writer.next t.writer;
+      | Upgraded -> `Upgrade
+      | Complete ->
+          advance_request_queue t;
+          _next_write_operation t
+  in
+  wakeup_reader t;
+  next
+
+let next_write_operation t = _next_write_operation t
+let report_write_result t result = Writer.report_result t.writer result

unikernel/duniverse/ocaml-h1/lib/websocket.ml

@@ -0,0 +1,656 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2018 Inhabited Type LLC.
+    Copyright (c) 2025 Robur Cooperative
+    Copyright (c) 2025 Swrup <swrup@protonmail.com>
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------
+
+  Modified by Swrup <swrup@protonmail.com> *)
+
+open Httpun_types
+module H1_client_connection = Client_connection.Oneshot
+
+module Opcode = struct
+  type standard_non_control = [ `Continuation | `Text | `Binary ]
+  type standard_control = [ `Connection_close | `Ping | `Pong ]
+  type standard = [ standard_non_control | standard_control ]
+  type t = [ standard | `Other of int ]
+
+  let code = function
+    | `Continuation -> 0x0
+    | `Text -> 0x1
+    | `Binary -> 0x2
+    | `Connection_close -> 0x8
+    | `Ping -> 0x9
+    | `Pong -> 0xa
+    | `Other code -> code
+
+  let code_table : t array =
+    [|
+      `Continuation;
+      `Text;
+      `Binary;
+      `Other 0x3;
+      `Other 0x4;
+      `Other 0x5;
+      `Other 0x6;
+      `Other 0x7;
+      `Connection_close;
+      `Ping;
+      `Other 0xb;
+      `Other 0xc;
+      `Other 0xd;
+      `Other 0xe;
+      `Other 0xf;
+    |]
+
+  let unsafe_of_code code = Array.unsafe_get code_table code
+
+  let of_code code =
+    if code > 0xf then None else Some (Array.unsafe_get code_table code)
+
+  let of_code_exn code =
+    if code > 0xf then
+      failwith "Opcode.of_code_exn: value can't fit in four bits";
+    Array.unsafe_get code_table code
+
+  let to_int = code
+  let of_int = of_code
+  let of_int_exn = of_code_exn
+
+  let pp_hum fmt = function
+    | `Continuation -> Format.fprintf fmt "`Continuation"
+    | `Text -> Format.fprintf fmt "`Text"
+    | `Binary -> Format.fprintf fmt "`Binary"
+    | `Connection_close -> Format.fprintf fmt "`Connection_close"
+    | `Ping -> Format.fprintf fmt "`Ping"
+    | `Pong -> Format.fprintf fmt "`Pong"
+    | `Other code -> Format.fprintf fmt "`Other %#x" code
+end
+
+module Close_code = struct
+  type standard =
+    [ `Normal_closure
+    | `Going_away
+    | `Protocol_error
+    | `Unsupported_data
+    | `No_status_rcvd
+    | `Abnormal_closure
+    | `Invalid_frame_payload_data
+    | `Policy_violation
+    | `Message_too_big
+    | `Mandatory_ext
+    | `Internal_server_error
+    | `TLS_handshake ]
+
+  type t = [ standard | `Other of int ]
+
+  let code = function
+    | `Normal_closure -> 1000
+    | `Going_away -> 1001
+    | `Protocol_error -> 1002
+    | `Unsupported_data -> 1003
+    | `No_status_rcvd -> 1005
+    | `Abnormal_closure -> 1006
+    | `Invalid_frame_payload_data -> 1007
+    | `Policy_violation -> 1008
+    | `Message_too_big -> 1009
+    | `Mandatory_ext -> 1010
+    | `Internal_server_error -> 1011
+    | `TLS_handshake -> 1015
+    | `Other code -> code
+
+  let code_table : t array =
+    [|
+      `Normal_closure;
+      `Going_away;
+      `Protocol_error;
+      `Unsupported_data;
+      `Other 1004;
+      `No_status_rcvd;
+      `Abnormal_closure;
+      `Invalid_frame_payload_data;
+      `Policy_violation;
+      `Message_too_big;
+      `Mandatory_ext;
+      `Internal_server_error;
+      `Other 1012;
+      `Other 1013;
+      `Other 1014;
+      `TLS_handshake;
+    |]
+
+  let unsafe_of_code code = Array.unsafe_get code_table code
+
+  let of_code code =
+    if code > 0xffff || code < 1000 then None
+    else if code < 1016 then Some (unsafe_of_code (code land 0b1111))
+    else Some (`Other code)
+
+  let of_code_exn code =
+    if code > 0xffff then
+      failwith "Close_code.of_code_exn: value can't fit in two bytes";
+    if code < 1000 then
+      failwith "Close_code.of_code_exn: value in invalid range 0-999";
+    if code < 1016 then unsafe_of_code (code land 0b1111) else `Other code
+
+  let to_int = code
+  let of_int = of_code
+  let of_int_exn = of_code_exn
+end
+
+module Frame = struct
+  type t = Bstr.t
+
+  let is_fin t =
+    let bits = Bstr.unsafe_get t 0 |> Char.code in
+    bits land (1 lsl 7) = 1 lsl 7
+
+  let rsv t =
+    let bits = Bstr.unsafe_get t 0 |> Char.code in
+    (bits lsr 4) land 0b0111
+
+  let opcode t =
+    let bits = Bstr.unsafe_get t 0 |> Char.code in
+    bits land 0b1111 |> Opcode.unsafe_of_code
+
+  let payload_length_of_offset t off =
+    let bits = Bstr.unsafe_get t (off + 1) |> Char.code in
+    let length = bits land 0b01111111 in
+    if length = 126 then Bstr.get_int16_be t (off + 2)
+    else if
+      (* This is technically unsafe, but if somebody's asking us to read 2^63
+       * bytes, then we're already screwd. *)
+      length = 127
+    then Bstr.get_int64_be t (off + 2) |> Int64.to_int
+    else length
+
+  let payload_length t = payload_length_of_offset t 0
+
+  let has_mask t =
+    let bits = Bstr.unsafe_get t 1 |> Char.code in
+    bits land (1 lsl 7) = 1 lsl 7
+
+  let mask t =
+    if not (has_mask t) then None
+    else
+      Some
+        (let bits = Bstr.unsafe_get t 1 |> Char.code in
+         if bits = 254 then Bstr.get_int32_be t 4
+         else if bits = 255 then Bstr.get_int32_be t 10
+         else Bstr.get_int32_be t 2)
+
+  let mask_exn t =
+    let bits = Bstr.unsafe_get t 1 |> Char.code in
+    if bits = 254 then Bstr.get_int32_be t 4
+    else if bits = 255 then Bstr.get_int32_be t 10
+    else if bits >= 127 then Bstr.get_int32_be t 2
+    else failwith "Frame.mask_exn: no mask present"
+
+  let payload_offset_of_bits bits =
+    let initial_offset = 2 in
+    let mask_offset = (bits land (1 lsl 7)) lsr (7 - 2) in
+    let length_offset =
+      let length = bits land 0b01111111 in
+      if length < 126 then 0 else 2 lsl (length land 0b1) lsl 2
+    in
+    initial_offset + mask_offset + length_offset
+
+  let payload_offset t =
+    let bits = Bstr.unsafe_get t 1 |> Char.code in
+    payload_offset_of_bits bits
+
+  let payload_view t =
+    let len = payload_length t in
+    let off = payload_offset t in
+    Bstr.sub t ~off ~len
+
+  let length_of_offset t off =
+    let bits = Bstr.unsafe_get t (off + 1) |> Char.code in
+    let payload_offset = payload_offset_of_bits bits in
+    let payload_length = payload_length_of_offset t off in
+    payload_offset + payload_length
+
+  let length t = length_of_offset t 0
+
+  let apply_mask mask bs ~off ~len =
+    for i = off to off + len - 1 do
+      let j = (i - off) mod 4 in
+      let c = Bstr.unsafe_get bs i |> Char.code in
+      let c =
+        c lxor Int32.(logand (shift_right mask (8 * (3 - j))) 0xffl |> to_int)
+      in
+      Bstr.unsafe_set bs i (Char.unsafe_chr c)
+    done
+
+  let apply_mask_bytes mask bs ~off ~len =
+    for i = off to off + len - 1 do
+      let j = (i - off) mod 4 in
+      let c = Bytes.unsafe_get bs i |> Char.code in
+      let c =
+        c lxor Int32.(logand (shift_right mask (8 * (3 - j))) 0xffl |> to_int)
+      in
+      Bytes.unsafe_set bs i (Char.unsafe_chr c)
+    done
+
+  let unmask_inplace t =
+    if has_mask t then
+      let mask = mask_exn t in
+      let len = payload_length t in
+      let off = payload_offset t in
+      apply_mask mask t ~off ~len
+
+  let mask_inplace = unmask_inplace
+
+  let parse =
+    let open Angstrom in
+    Unsafe.peek 2 (fun bs ~off ~len:_ -> length_of_offset bs off) >>= fun len ->
+    Unsafe.take len Bstr.sub
+
+  let serialize_headers faraday ~mask ~is_fin ~opcode ~payload_length =
+    let opcode = Opcode.to_int opcode in
+    let is_fin = if is_fin then 1 lsl 7 else 0 in
+    let is_mask = match mask with None -> 0 | Some _ -> 1 lsl 7 in
+    Faraday.write_uint8 faraday (is_fin lor opcode);
+    if payload_length <= 125 then
+      Faraday.write_uint8 faraday (is_mask lor payload_length)
+    else if payload_length <= 0xffff then (
+      Faraday.write_uint8 faraday (is_mask lor 126);
+      Faraday.BE.write_uint16 faraday payload_length)
+    else (
+      Faraday.write_uint8 faraday (is_mask lor 127);
+      Faraday.BE.write_uint64 faraday (Int64.of_int payload_length));
+    match mask with
+    | None -> ()
+    | Some mask -> Faraday.BE.write_uint32 faraday mask
+
+  let serialize_control faraday ~mask ~opcode =
+    let opcode = (opcode :> Opcode.t) in
+    serialize_headers faraday ~mask ~is_fin:true ~opcode ~payload_length:0
+
+  let schedule_serialize faraday ~mask ~is_fin ~opcode ~payload ~off ~len =
+    serialize_headers faraday ~mask ~is_fin ~opcode ~payload_length:len;
+    (match mask with
+    | None -> ()
+    | Some mask -> apply_mask mask payload ~off ~len);
+    Faraday.schedule_bigstring faraday payload ~off ~len
+
+  let serialize_bytes faraday ~mask ~is_fin ~opcode ~payload ~off ~len =
+    serialize_headers faraday ~mask ~is_fin ~opcode ~payload_length:len;
+    (match mask with
+    | None -> ()
+    | Some mask -> apply_mask_bytes mask payload ~off ~len);
+    Faraday.write_bytes faraday payload ~off ~len
+
+  let schedule_serialize_bytes faraday ~mask ~is_fin ~opcode ~payload ~off ~len
+      =
+    serialize_headers faraday ~mask ~is_fin ~opcode ~payload_length:len;
+    (match mask with
+    | None -> ()
+    | Some mask -> apply_mask_bytes mask payload ~off ~len);
+    Faraday.write_bytes faraday payload ~off ~len
+end
+
+type frame_handler =
+  opcode:Opcode.t -> is_fin:bool -> Bstr.t -> off:int -> len:int -> unit
+
+type input_handlers = { frame_handler : frame_handler; eof : unit -> unit }
+
+module Wsd = struct
+  type mode = [ `Client of unit -> int32 | `Server ]
+
+  type t = {
+    faraday : Faraday.t;
+    mode : mode;
+    mutable when_ready_to_write : unit -> unit;
+  }
+
+  let default_ready_to_write = Sys.opaque_identity (fun () -> ())
+
+  let create mode =
+    {
+      faraday = Faraday.create 0x1000;
+      mode;
+      when_ready_to_write = default_ready_to_write;
+    }
+
+  let mask t = match t.mode with `Client m -> Some (m ()) | `Server -> None
+
+  let ready_to_write t =
+    let callback = t.when_ready_to_write in
+    t.when_ready_to_write <- default_ready_to_write;
+    callback ()
+
+  let schedule t ~kind ~is_fin payload ~off ~len =
+    let opcode :> Opcode.t = kind in
+    let mask = mask t in
+    Frame.schedule_serialize t.faraday ~mask ~is_fin ~opcode ~payload
+      ~off ~len;
+    ready_to_write t
+
+  let send_bytes t ~kind ~is_fin payload ~off ~len =
+    let opcode :> Opcode.t = kind in
+    let mask = mask t in
+    Frame.schedule_serialize_bytes t.faraday ~mask ~is_fin ~opcode
+      ~payload ~off ~len;
+    ready_to_write t
+
+  let send_ping t =
+    Frame.serialize_control t.faraday ~mask:None ~opcode:`Ping;
+    ready_to_write t
+
+  let send_pong t =
+    Frame.serialize_control t.faraday ~mask:None ~opcode:`Pong;
+    ready_to_write t
+
+  let flushed t f = Faraday.flush t.faraday f
+
+  let close t =
+    Frame.serialize_control t.faraday ~mask:None
+      ~opcode:`Connection_close;
+    Faraday.close t.faraday;
+    ready_to_write t
+
+  let next t =
+    match Faraday.operation t.faraday with
+    | `Close -> `Close 0 (* XXX(andreas): should track unwritten bytes *)
+    | `Yield -> `Yield
+    | `Writev iovecs -> `Write iovecs
+
+  let report_result t result =
+    match result with
+    | `Closed -> close t
+    | `Ok len -> Faraday.shift t.faraday len
+
+  let is_closed t = Faraday.is_closed t.faraday
+
+  let when_ready_to_write t callback =
+    if not (t.when_ready_to_write == default_ready_to_write) then
+      failwith
+        "Wsd.when_ready_to_write: only one callback can be registered at a time"
+    else if is_closed t then callback ()
+    else t.when_ready_to_write <- callback
+end
+
+module Reader = struct
+  module AU = Angstrom.Unbuffered
+
+  type 'error parse_state =
+    | Done
+    | Fail of 'error
+    | Partial of (Bstr.t -> off:int -> len:int -> AU.more -> unit AU.state)
+
+  type 'error t = {
+    parser : unit Angstrom.t;
+    mutable parse_state : 'error parse_state;
+    mutable closed : bool;
+  }
+
+  let create frame_handler =
+    let parser =
+      let open Angstrom in
+      Frame.parse >>| fun frame ->
+      let is_fin = Frame.is_fin frame in
+      let opcode = Frame.opcode frame in
+      Frame.unmask_inplace frame;
+      let off = Frame.payload_offset frame in
+      let len = Frame.payload_length frame in
+      frame_handler ~opcode ~is_fin frame ~off ~len
+    in
+    { parser; parse_state = Done; closed = false }
+
+  let transition t state =
+    match state with
+    | AU.Done (consumed, ()) | AU.Fail ((0 as consumed), _, _) ->
+        t.parse_state <- Done;
+        consumed
+    | AU.Fail (consumed, marks, msg) ->
+        t.parse_state <- Fail (`Parse (marks, msg));
+        consumed
+    | AU.Partial { committed; continue } ->
+        t.parse_state <- Partial continue;
+        committed
+
+  and start t state =
+    match state with
+    | AU.Done _ -> failwith "Websocket.Reader.unable to start parser"
+    | AU.Fail (0, marks, msg) -> t.parse_state <- Fail (`Parse (marks, msg))
+    | AU.Partial { committed = 0; continue } -> t.parse_state <- Partial continue
+    | _ -> assert false
+
+  let next t =
+    match t.parse_state with
+    | Done -> if t.closed then `Close else `Read
+    | Fail _ -> `Close
+    | Partial _ -> `Read
+
+  let rec read_with_more t bs ~off ~len more =
+    let consumed =
+      match t.parse_state with
+      | Fail _ -> 0
+      | Done ->
+          start t (AU.parse t.parser);
+          read_with_more t bs ~off ~len more
+      | Partial continue -> transition t (continue bs more ~off ~len)
+    in
+    (match more with Complete -> t.closed <- true | Incomplete -> ());
+    consumed
+end
+
+module Connection = struct
+  type t = {
+    wsd : Wsd.t;
+    reader : [ `Parse of string list * string ] Reader.t;
+    eof : unit -> unit;
+  }
+
+  let create ~mode ~websocket_handler =
+    let wsd = Wsd.create mode in
+    let { frame_handler; eof } = websocket_handler wsd in
+    { wsd; reader = Reader.create frame_handler; eof }
+
+  let next_read_operation t = Reader.next t.reader
+  let next_write_operation t = Wsd.next t.wsd
+  let read t bs ~off ~len = Reader.read_with_more t.reader bs ~off ~len Incomplete
+
+  let read_eof t bs ~off ~len =
+    let len = Reader.read_with_more t.reader bs ~off ~len Complete in
+    t.eof ();
+    len
+
+  let is_closed t = Wsd.is_closed t.wsd
+  let close t = Wsd.close t.wsd
+
+  let yield_writer t k =
+    if is_closed t then (
+      close t;
+      k ())
+    else Wsd.when_ready_to_write t.wsd k
+
+  let report_write_result t result = Wsd.report_result t.wsd result
+end
+
+module Handshake = struct
+  let compute_accept ~sha1 nonce = sha1 (nonce ^ "258EAFA5-E914-47DA-95CA-C5AB0DC85B11")
+
+  let get_nonce request = Headers.get request.Request.headers "sec-websocket-key"
+
+  let server_headers ~sha1 ~nonce =
+    Headers.of_list
+      [ ("connection", "upgrade"); ("upgrade", "websocket")
+      ; ("sec-websocket-accept", compute_accept ~sha1 nonce ) ]
+
+  let is_valid_accept_headers ~sha1 ~nonce headers =
+    let sec_websocket_accept = Headers.get headers "sec-websocket-accept" in
+    let upgrade = Headers.get headers "upgrade" |> Option.map String.lowercase_ascii in
+    let connection = Headers.get headers "connection" |> Option.map String.lowercase_ascii in
+    (sec_websocket_accept = Some (compute_accept ~sha1 nonce))
+    && (upgrade = Some "websocket")
+    && (connection = Some "upgrade")
+end
+
+module Client_handshake = struct
+  type t = { connection : H1_client_connection.t; body : Body.Writer.t }
+
+  (* assumes [nonce] is base64 encoded *)
+  let create ~nonce ~host ~port ~resource ~error_handler ~response_handler =
+    let headers = Headers.of_list
+      [ ("upgrade", "websocket");
+        ("connection", "upgrade");
+        ("host", String.concat ":" [ host; string_of_int port ]);
+        ("sec-websocket-version", "13");
+        ("sec-websocket-key", nonce); ]
+    in
+    let body, connection =
+       H1_client_connection.request
+        (Request.create ~headers `GET resource)
+        ~error_handler ~response_handler
+    in
+    { connection; body }
+
+  let next_read_operation t =
+     H1_client_connection.next_read_operation t.connection
+
+  let next_write_operation t =
+     H1_client_connection.next_write_operation t.connection
+
+  let read t = H1_client_connection.read t.connection
+
+  let report_write_result t =
+     H1_client_connection.report_write_result t.connection
+
+  let yield_writer t = H1_client_connection.yield_writer t.connection
+  let close t = Body.Writer.close t.body
+
+end
+
+module Client_connection = struct
+  type state =
+    | Uninitialized
+    | Handshake of Client_handshake.t
+    | Websocket of Connection.t
+
+  type t = state ref
+
+  type error =
+    [ H1_client_connection.error
+    | `Handshake_failure of Response.t * Body.Reader.t ]
+
+  let handshake_exn t =
+    match !t with
+    | Handshake handshake -> handshake
+    | Uninitialized | Websocket _ -> assert false
+
+  let create ~nonce ~host ~port ~resource ~sha1 ~error_handler ~websocket_handler
+      =
+    let t = ref Uninitialized in
+    let nonce = Base64.encode_exn nonce in
+    let response_handler response response_body =
+      match response.Response.status with
+      | `Switching_protocols when Handshake.is_valid_accept_headers ~sha1 ~nonce response.headers ->
+          Body.Reader.close response_body;
+          let handshake = handshake_exn t in
+          t :=
+            Websocket
+              (Connection.create
+                 ~mode:(`Client (fun () -> Random.int32 Int32.max_int))
+                 ~websocket_handler);
+          Client_handshake.close handshake
+      | _ -> error_handler (`Handshake_failure (response, response_body))
+    in
+    let handshake =
+      let error_handler = (error_handler :> H1_client_connection.error_handler) in
+      Client_handshake.create ~nonce ~host ~port ~resource ~error_handler
+        ~response_handler
+    in
+    t := Handshake handshake;
+    t
+
+  let next_read_operation t =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.next_read_operation handshake
+    | Websocket websocket -> Connection.next_read_operation websocket
+
+  let read t bs ~off ~len =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.read handshake bs ~off ~len
+    | Websocket websocket -> Connection.read websocket bs ~off ~len
+
+  let read_eof t bs ~off ~len =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.read handshake bs ~off ~len
+    | Websocket websocket -> Connection.read_eof websocket bs ~off ~len
+
+  let next_write_operation t =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.next_write_operation handshake
+    | Websocket websocket -> Connection.next_write_operation websocket
+
+  let report_write_result t result =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.report_write_result handshake result
+    | Websocket websocket -> Connection.report_write_result websocket result
+
+  let yield_writer t f =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.yield_writer handshake f
+    | Websocket websocket -> Connection.yield_writer websocket f
+
+  let close t =
+    match !t with
+    | Uninitialized -> assert false
+    | Handshake handshake -> Client_handshake.close handshake
+    | Websocket websocket -> Connection.close websocket
+end
+
+module Server_connection = struct
+  type t = Connection.t
+  type error = [ `Exn of exn ]
+
+  let create ~websocket_handler =
+    let t = Connection.create ~mode:`Server ~websocket_handler in
+    t
+
+  let next_read_operation = Connection.next_read_operation
+  let next_write_operation = Connection.next_write_operation
+  let read t bs ~off ~len = Connection.read t bs ~off ~len
+  let read_eof t bs ~off ~len = Connection.read_eof t bs ~off ~len
+  let report_write_result t result = Connection.report_write_result t result
+  let yield_writer t f = Connection.yield_writer t f
+  let is_closed t = Connection.is_closed t
+  let close t = Connection.close t
+end

unikernel/duniverse/ocaml-h1/lib_test/dune

@@ -0,0 +1,15 @@
+(tests
+ (libraries h1 alcotest)
+ (modules
+   helpers
+   test_client_connection
+   test_headers
+   test_h1
+   test_iovec
+   test_method
+   test_request
+   test_response
+   test_server_connection
+   test_version
+   test_websocket)
+ (names test_h1))

unikernel/duniverse/ocaml-h1/lib_test/helpers.ml

@@ -0,0 +1,76 @@
+open H1
+
+let maybe_serialize_body f body =
+  match body with
+  | None -> ()
+  | Some body -> Faraday.write_string f body
+
+let request_to_string ?body r =
+  let f = Faraday.create 0x1000 in
+  H1_private.Serialize.write_request f r;
+  maybe_serialize_body f body;
+  Faraday.serialize_to_string f
+
+let response_to_string ?body r =
+  let f = Faraday.create 0x1000 in
+  H1_private.Serialize.write_response f r;
+  maybe_serialize_body f body;
+  Faraday.serialize_to_string f
+
+module Read_operation = struct
+  type t = [ `Read | `Yield | `Close | `Upgrade ]
+
+  let pp_hum fmt (t : t) =
+    let str =
+      match t with
+      | `Read -> "Read"
+      | `Yield -> "Yield"
+      | `Close -> "Close"
+      | `Upgrade -> "Upgrade"
+    in
+    Format.pp_print_string fmt str
+  ;;
+end
+
+module Write_operation = struct
+  type t = [ `Write of Bstr.t IOVec.t list | `Yield | `Close of int | `Upgrade ]
+
+  let iovecs_to_string iovecs =
+    let len = IOVec.lengthv iovecs in
+    let bytes = Bytes.create len in
+    let dst_off = ref 0 in
+    List.iter (fun { IOVec.buffer; off = src_off; len } ->
+      Bstr.blit_to_bytes buffer ~src_off bytes ~dst_off:!dst_off ~len;
+      dst_off := !dst_off + len)
+    iovecs;
+    Bytes.to_string bytes
+  ;;
+
+  let pp_hum fmt (t : t) =
+    match t with
+    | `Write iovecs -> Format.fprintf fmt "Write %S" (iovecs_to_string iovecs)
+    | `Yield -> Format.pp_print_string fmt "Yield"
+    | `Close len -> Format.fprintf fmt "Close %i" len
+    | `Upgrade -> Format.pp_print_string fmt "Upgrade"
+  ;;
+
+  let to_write_as_string t =
+    match t with
+    | `Write iovecs -> Some (iovecs_to_string iovecs)
+    | `Close _ | `Yield | `Upgrade -> None
+  ;;
+end
+
+let write_operation = Alcotest.of_pp Write_operation.pp_hum
+let read_operation = Alcotest.of_pp Read_operation.pp_hum
+
+module Headers = struct
+  include Headers
+
+  let (@) a b = Headers.add_list a (Headers.to_list b)
+
+  let connection_close = Headers.of_list ["connection", "close"]
+  let encoding_chunked = Headers.of_list ["transfer-encoding", "chunked"]
+  let encoding_fixed n = Headers.of_list ["content-length", string_of_int n]
+  let upgrade protocol = Headers.of_list ["connection", "upgrade" ; "upgrade", protocol]
+end

unikernel/duniverse/ocaml-h1/lib_test/test_client_connection.ml

@@ -0,0 +1,339 @@
+open H1
+open Helpers
+open Client_connection
+
+let response_error_pp_hum fmt = function
+  | `Malformed_response str ->
+    Format.fprintf fmt "Malformed_response: %s" str
+  | `Invalid_response_body_length resp ->
+    Format.fprintf fmt "Invalid_response_body_length: %s" (response_to_string resp)
+  | `Exn exn ->
+    Format.fprintf fmt "Exn (%s)" (Printexc.to_string exn)
+;;
+
+module Response = struct
+  include Response
+
+  let pp = pp_hum
+  let equal x y = x = y
+end
+
+module Alcotest = struct
+  include Alcotest
+
+  let response_error = of_pp response_error_pp_hum
+end
+
+let feed_string t str =
+  let len = String.length str in
+  let input = Bstr.of_string str in
+  read t input ~off:0 ~len
+
+let read_string t str =
+  let c = feed_string t str in
+  Alcotest.(check int) "read consumes all input" (String.length str) c;
+;;
+
+let read_response t r =
+  let response_string = response_to_string r in
+  read_string t response_string
+;;
+
+let reader_ready t =
+  Alcotest.check read_operation "Reader is ready"
+    `Read (next_read_operation t :> Read_operation.t);
+;;
+
+let reader_closed t =
+  Alcotest.check read_operation "Reader is closed"
+    `Close (next_read_operation t :> Read_operation.t);
+;;
+
+let write_string ?(msg="output written") t str =
+  let len = String.length str in
+  Alcotest.(check (option string)) msg
+    (Some str)
+    (next_write_operation t |> Write_operation.to_write_as_string);
+  report_write_result t (`Ok len);
+;;
+
+let write_request ?(msg="request written") t r =
+  let request_string = request_to_string r in
+  write_string ~msg t request_string
+;;
+
+let writer_yielded t =
+  Alcotest.check write_operation "Writer is in a yield state"
+    `Yield (next_write_operation t :> Write_operation.t);
+;;
+
+let writer_closed t =
+  Alcotest.check write_operation "Writer is closed"
+    (`Close 0) (next_write_operation t :> Write_operation.t);
+;;
+
+let connection_is_shutdown t =
+  Alcotest.check read_operation "Reader is closed"
+    `Close (next_read_operation t :> Read_operation.t);
+  writer_closed t;
+;;
+
+let default_response_handler expected_response response body =
+  Alcotest.check (module Response) "expected response" expected_response response;
+  let on_read _ ~off:_ ~len:_ = () in
+  let on_eof () = () in
+  Body.Reader.schedule_read body ~on_read ~on_eof;
+;;
+
+let no_error_handler _ = assert false
+
+let test_get () =
+  let request' = Request.create `GET "/" in
+  let response = Response.create `OK in
+
+  (* Single GET *)
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:no_error_handler
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  writer_closed  t;
+  read_response  t response;
+
+  (* Single GET, response closes connection *)
+  let response = Response.create `OK ~headers:Headers.connection_close in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:no_error_handler
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  read_response  t response;
+  let c = read_eof t Bstr.empty ~off:0 ~len:0 in
+  Alcotest.(check int) "read_eof with no input returns 0" 0 c;
+  connection_is_shutdown t;
+
+  (* Single GET, streaming body *)
+  let response = Response.create `OK ~headers:Headers.encoding_chunked in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:no_error_handler
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  read_response  t response;
+  read_string    t "d\r\nHello, world!\r\n0\r\n\r\n"
+;;
+
+let test_send_streaming_body () =
+  let request' = Request.create `GET "/" ~headers:Headers.encoding_chunked in
+  let response = Response.create `OK ~headers:Headers.encoding_chunked in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:no_error_handler
+  in
+  write_request  t request';
+  read_response  t response;
+  Body.Writer.write_string body "hello";
+  write_string t "5\r\nhello\r\n";
+  Body.Writer.write_string body "world";
+  Body.Writer.close body;
+  write_string t "5\r\nworld\r\n";
+  write_string t "0\r\n\r\n";
+  writer_closed t
+;;
+
+let test_response_eof () =
+  let request' = Request.create `GET "/" in
+  let response = Response.create `OK in (* not actually writen to the channel *)
+
+  let error_message = ref None in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:(function
+        | `Malformed_response msg -> error_message := Some msg
+        | _ -> assert false)
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  writer_closed  t;
+  reader_ready t;
+  let c = read_eof t Bstr.empty ~off:0 ~len:0 in
+  Alcotest.(check int) "read_eof with no input returns 0" 0 c;
+  connection_is_shutdown t;
+  Alcotest.(check (option string)) "unexpected eof"
+    (Some "unexpected eof")
+    !error_message
+;;
+
+let test_response_header_order () =
+  let request' = Request.create `GET "/" in
+  let headers =
+    [ "a", "1"
+    ; "b", "2"
+    ; "c", "3"
+    ]
+  in
+  let response = Response.create `OK ~headers:(Headers.of_list headers) in
+  let received = ref None in
+  let body, t =
+    request
+      request'
+      ~response_handler:(fun response _ -> received := Some response)
+      ~error_handler:no_error_handler
+  in
+  Body.Writer.close body;
+  write_request t request';
+  writer_closed t;
+  read_response t response;
+  match !received with
+  | None -> assert false
+  | Some received ->
+    Alcotest.(check (list (pair string string))) "headers are equal"
+      headers (Headers.to_list received.headers);
+;;
+
+let test_report_exn () =
+  let request' = Request.create `GET "/" in
+  let response = Response.create `OK in (* not actually writen to the channel *)
+
+  let error_message = ref None in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:(function
+        | `Exn (Failure msg) -> error_message := Some msg
+        | _ -> assert false)
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  writer_closed  t;
+  reader_ready t;
+  report_exn t (Failure "something went wrong");
+  connection_is_shutdown t;
+  Alcotest.(check (option string)) "something went wrong"
+    (Some "something went wrong")
+    !error_message
+;;
+
+let test_input_shrunk () =
+  let request' = Request.create `GET "/" in
+  let response = Response.create `OK in (* not actually writen to the channel *)
+
+  let error_message = ref None in
+  let body, t =
+    request
+      request'
+      ~response_handler:(default_response_handler response)
+      ~error_handler:(function
+        | `Exn (Failure msg) -> error_message := Some msg
+        | _ -> assert false)
+  in
+  Body.Writer.close body;
+  write_request  t request';
+  writer_closed  t;
+  reader_ready t;
+  let c = feed_string  t "HTTP/1.1 200 OK\r\nDate" in
+  Alcotest.(check int) "read the status line" c 17;
+  report_exn t (Failure "something went wrong");
+  connection_is_shutdown t;
+  Alcotest.(check (option string)) "something went wrong"
+    (Some "something went wrong")
+    !error_message
+;;
+
+let test_failed_response_parse () =
+  let request' = Request.create `GET "/" in
+
+  let test response bytes_read expected_error =
+    let error = ref None in
+    let body, t =
+      request
+        request'
+        ~response_handler:(fun _ _ -> assert false)
+        ~error_handler:(fun e -> error := Some e)
+    in
+    Body.Writer.close body;
+    write_request t request';
+    writer_closed t;
+    reader_ready t;
+    let len = feed_string t response in
+    Alcotest.(check int) "bytes read" len bytes_read;
+    connection_is_shutdown t;
+    Alcotest.(check (option response_error)) "Response error"
+      (Some expected_error) !error;
+  in
+
+  test "HTTP/1.1 200\r\n\r\n" 12 (`Malformed_response ": char ' '");
+
+  let response = Response.create `OK ~headers:(Headers.encoding_fixed (-1)) in
+  test (response_to_string response) 39 (`Invalid_response_body_length response);
+;;
+
+let test_schedule_read_with_data_available () =
+  let request' = Request.create `GET "/" in
+  let response = Response.create `OK ~headers:(Headers.encoding_fixed 6) in
+
+  let body = ref None in
+  let response_handler response' body' =
+    body := Some body';
+    Alcotest.check (module Response) "expected response" response response';
+  in
+  let req_body, t =
+    request request' ~response_handler ~error_handler:no_error_handler
+  in
+  Body.Writer.close req_body;
+  write_request t request';
+  writer_closed t;
+  read_response t response;
+
+  let body = Option.get !body in
+  let schedule_read expected =
+    let did_read = ref false in
+    Body.Reader.schedule_read body
+      ~on_read:(fun buf ~off ~len ->
+        let actual = Bstr.sub_string buf ~off ~len in
+        did_read := true;
+        Alcotest.(check string) "Body" expected actual)
+      ~on_eof:(fun () -> assert false);
+    Alcotest.(check bool) "on_read called" true !did_read;
+  in
+
+  (* We get some data on the connection, but not the full response yet. *)
+  read_string t "Hello";
+
+  (* Schedule a read when there is already data available. on_read should be called
+     straight away, as who knows how long it'll be before more data arrives. *)
+  schedule_read "Hello";
+  read_string t "!";
+  schedule_read "!";
+  let did_eof = ref false in
+  Body.Reader.schedule_read body
+    ~on_read:(fun _ ~off:_ ~len:_ -> Alcotest.fail "Expected eof")
+    ~on_eof:(fun () -> did_eof := true);
+  Alcotest.(check bool) "on_eof called" true !did_eof;
+  reader_closed t;
+;;
+
+let tests =
+  [ "GET"         , `Quick, test_get
+  ; "send streaming body", `Quick, test_send_streaming_body
+  ; "Response EOF", `Quick, test_response_eof
+  ; "Response header order preserved", `Quick, test_response_header_order
+  ; "report_exn"  , `Quick, test_report_exn
+  ; "input_shrunk", `Quick, test_input_shrunk
+  ; "failed response parse", `Quick, test_failed_response_parse
+  ; "schedule read with data available", `Quick, test_schedule_read_with_data_available
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_h1.ml

@@ -0,0 +1,12 @@
+let () =
+  Alcotest.run "h1 unit tests"
+    [ "websocket"        , Test_websocket.tests
+    ; "version"          , Test_version.tests
+    ; "method"           , Test_method.tests
+    ; "iovec"            , Test_iovec.tests
+    ; "headers"          , Test_headers.tests
+    ; "request"          , Test_request.tests
+    ; "response"         , Test_response.tests
+    ; "client connection", Test_client_connection.tests
+    ; "server connection", Test_server_connection.tests
+    ]

unikernel/duniverse/ocaml-h1/lib_test/test_headers.ml

@@ -0,0 +1,78 @@
+open H1
+module Array = ArrayLabels
+module List = ListLabels
+
+let check msg ~expect actual =
+  Alcotest.(check (list (pair string string))) msg expect (Headers.to_list actual)
+;;
+
+let test_replace () =
+  check "replace trailing element"
+    ~expect:["c", "d"; "a", "d"]
+    (Headers.replace
+      (Headers.of_list ["c", "d"; "a", "b"])
+      "a"
+      "d");
+
+  check "replace middle element"
+    ~expect:["e", "f"; "c", "z"; "a", "b"]
+    (Headers.replace
+       (Headers.of_list ["e", "f"; "c", "d"; "a", "b"])
+       "c"
+       "z");
+
+  check "remove multiple trailing elements"
+    ~expect:["c", "d"; "a", "d"]
+    (Headers.replace
+      (Headers.of_list [ "c", "d"; "a", "b"; "a", "c"])
+      "a"
+      "d");
+;;
+
+let test_remove () =
+  check "remove leading element"
+    ~expect:["c", "d"]
+    (Headers.remove
+      (Headers.of_list ["a", "b"; "c", "d"])
+      "a");
+  check "remove trailing element"
+    ~expect:["c", "d"]
+    (Headers.remove
+      (Headers.of_list ["c", "d"; "a", "b"])
+      "a");
+;;
+
+let test_ci_equal () =
+  let string_of_char x = String.init 1 (fun _ -> x) in
+  let ascii =
+    Array.init (0xff + 1) ~f:Char.chr
+    |> Array.to_list
+  in
+  let ascii_pairs =
+    List.map ascii ~f:(fun x ->
+      List.map ascii ~f:(fun y -> x, y))
+    |> List.concat
+  in
+  (* Ensure that the branch free case-insensitive equality check is consistent
+   * with a naive implementation. *)
+  List.iter ascii_pairs ~f:(fun (x, y) ->
+    let char_ci_equal =
+      Char.compare (Char.lowercase_ascii x) (Char.lowercase_ascii y) = 0
+    in
+    let headers_equal =
+      let headers = Headers.of_list [ string_of_char y, "value" ] in
+      Headers.mem headers (string_of_char x)
+    in
+    Alcotest.(check bool)
+      (Printf.sprintf "CI: %C = %C" x y)
+      char_ci_equal
+      headers_equal)
+;;
+
+
+
+let tests =
+  [ "remove"  , `Quick, test_remove
+  ; "replace" , `Quick, test_replace
+  ; "CI equal", `Quick, test_ci_equal
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_iovec.ml

@@ -0,0 +1,43 @@
+open H1
+open IOVec
+
+(* The length of the buffer is ignored by iovec operations *)
+let buffer = Bstr.empty
+
+let test_lengthv () =
+  Alcotest.(check int) "lengthv [] = 0"                 (lengthv []) 0;
+  Alcotest.(check int) "lengthv [iovec] = length iovec"
+    (lengthv [{ buffer; off = 0; len = 0 }]) (length {buffer; off = 0; len = 0 });
+  Alcotest.(check int) "lengthv [iovec] = length iovec"
+    (lengthv [{ buffer; off = 0; len = 10 }]) (length {buffer; off = 0; len = 10 });
+;;
+
+let test_shiftv_raises () =
+  Alcotest.check_raises
+    "IOVec.shiftv: -1 is a negative number"
+    (Failure "IOVec.shiftv: -1 is a negative number")
+    (fun () -> ignore (shiftv [] (-1)));
+  let test f =
+    Alcotest.check_raises
+      "shiftv iovecs n raises when n > lengthv iovecs"
+      (Failure "shiftv: n > lengthv iovecs")
+    (fun () -> ignore (f ()))
+  in
+  test (fun () -> shiftv [] 1);
+  test (fun () -> shiftv [{ buffer; off = 0; len = 1 }] 2);
+  test (fun () -> shiftv [{ buffer; off = 0; len = 1 }; { buffer; off = 0; len = 1 }] 3);
+;;
+
+let test_shiftv () =
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [] 0 = []" (shiftv [] 0) [];
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [{... len ... }] len = []"
+    (shiftv [{ buffer; off = 0; len = 1 }] 1) [];
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [iovec] n when length iovec < n"
+    (shiftv [{ buffer; off = 0; len = 4 }] 2) [{ buffer; off = 2; len = 2 }];
+;;
+
+let tests =
+  [ "lengthv"       , `Quick, test_lengthv
+  ; "shiftv"        , `Quick, test_shiftv
+  ; "shiftv raises ", `Quick, test_shiftv_raises
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_method.ml

@@ -0,0 +1,41 @@
+open H1
+open Method
+
+let test_is_safe () =
+  Alcotest.(check bool) "GET is safe"     (is_safe `GET )    true;
+  Alcotest.(check bool) "HEAD is safe"    (is_safe `HEAD)    true;
+  Alcotest.(check bool) "POST is safe"    (is_safe `POST)    false;
+  Alcotest.(check bool) "PUT is safe"     (is_safe `PUT )    false;
+  Alcotest.(check bool) "DELETE is safe"  (is_safe `DELETE ) false;
+  Alcotest.(check bool) "CONNECT is safe" (is_safe `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is safe" (is_safe `OPTIONS) true;
+  Alcotest.(check bool) "TRACE is safe"   (is_safe `TRACE  ) true;
+;;
+
+let test_is_cacheable () =
+  Alcotest.(check bool) "GET is cacheable"     (is_cacheable `GET )    true;
+  Alcotest.(check bool) "HEAD is cacheable"    (is_cacheable `HEAD)    true;
+  Alcotest.(check bool) "POST is cacheable"    (is_cacheable `POST)    true;
+  Alcotest.(check bool) "PUT is cacheable"     (is_cacheable `PUT )    false;
+  Alcotest.(check bool) "DELETE is cacheable"  (is_cacheable `DELETE ) false;
+  Alcotest.(check bool) "CONNECT is cacheable" (is_cacheable `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is cacheable" (is_cacheable `OPTIONS) false;
+  Alcotest.(check bool) "TRACE is cacheable"   (is_cacheable `TRACE  ) false;
+;;
+
+let test_is_idempotent () =
+  Alcotest.(check bool) "GET is idempotent"     (is_idempotent `GET )    true;
+  Alcotest.(check bool) "HEAD is idempotent"    (is_idempotent `HEAD)    true;
+  Alcotest.(check bool) "POST is idempotent"    (is_idempotent `POST)    false;
+  Alcotest.(check bool) "PUT is idempotent"     (is_idempotent `PUT )    true;
+  Alcotest.(check bool) "DELETE is idempotent"  (is_idempotent `DELETE ) true;
+  Alcotest.(check bool) "CONNECT is idempotent" (is_idempotent `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is idempotent" (is_idempotent `OPTIONS) true;
+  Alcotest.(check bool) "TRACE is idempotent"   (is_idempotent `TRACE  ) true;
+;;
+
+let tests =
+  [ "is_safe"      , `Quick, test_is_safe
+  ; "is_cacheable" , `Quick, test_is_cacheable
+  ; "is_idempotent", `Quick, test_is_idempotent
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_request.ml

@@ -0,0 +1,104 @@
+open H1
+open Request
+open Helpers
+
+let body_length = Alcotest.of_pp Request.Body_length.pp_hum
+
+let check =
+  let alco =
+    Alcotest.result
+      (Alcotest.of_pp pp_hum)
+      Alcotest.string
+  in
+  fun message ~expect input ->
+    let actual =
+      Angstrom.parse_string ~consume:All H1_private.Parse.request input
+    in
+    Alcotest.check alco message expect actual
+;;
+
+let test_parse_valid () =
+  check
+    "valid GET without headers"
+    ~expect:(Ok (Request.create `GET "/"))
+    "GET / HTTP/1.1\r\n\r\n";
+  check
+    "valid non-standard method without headers"
+    ~expect:(Ok (Request.create (`Other "some-other-verb") "/"))
+    "some-other-verb / HTTP/1.1\r\n\r\n";
+  check
+    "valid GET with headers"
+    ~expect:(Ok (Request.create ~headers:(Headers.of_list [ "Link", "/path/to/some/website"]) `GET "/"))
+    "GET / HTTP/1.1\r\nLink: /path/to/some/website\r\n\r\n";
+;;
+
+let test_parse_invalid_errors () =
+  check
+    "doesn't end"
+    ~expect:(Error ": not enough input")
+    "GET / HTTP/1.1\r\n";
+  check
+    "invalid version"
+    ~expect:(Error "eol: string")
+    "GET / HTTP/1.22\r\n\r\n";
+  check
+    "malformed header"
+    ~expect:(Error "header: char ':'")
+    "GET / HTTP/1.1\r\nLink : /path/to/some/website\r\n\r\n";
+;;
+
+let test_body_length () =
+  let check message request ~expect =
+    let actual = Request.body_length request in
+    Alcotest.check body_length message expect actual
+  in
+  let req method_ headers = Request.create method_ ~headers "/" in
+  check
+    "no headers"
+    ~expect:(`Fixed 0L)
+    (req `GET Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    (req `GET Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    (req `GET Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:(`Error `Bad_request)
+    (req `GET encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    (req `GET Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
+
+let tests =
+  [ "parse valid"         , `Quick, test_parse_valid
+  ; "parse invalid errors", `Quick, test_parse_invalid_errors
+  ; "body length",          `Quick, test_body_length
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_response.ml

@@ -0,0 +1,115 @@
+open H1
+open Response
+open Helpers
+
+let body_length = Alcotest.of_pp Response.Body_length.pp_hum
+
+let check =
+  let alco =
+    Alcotest.result
+      (Alcotest.of_pp pp_hum)
+      Alcotest.string
+  in
+  fun message ~expect input ->
+    let actual =
+      Angstrom.parse_string ~consume:All H1_private.Parse.response input
+    in
+    Alcotest.check alco message expect actual
+;;
+
+let test_parse_valid () =
+  check
+    "OK response without headers"
+    ~expect:(Ok (Response.create `OK))
+    "HTTP/1.1 200 OK\r\n\r\n";
+;;
+
+let test_parse_invalid_error () =
+  check
+    "OK response without a status message"
+    ~expect:(Error ": char ' '")
+    "HTTP/1.1 200\r\n\r\n";
+  check
+    "OK response without a status message"
+    ~expect:(Error ": status-code empty")
+    "HTTP/1.1 OK\r\n\r\n";
+  check
+    "OK response without a status message"
+    ~expect:(Error ": status-code too long: \"999999937377999999999200\"")
+    "HTTP/1.1 999999937377999999999200\r\n\r\n";
+;;
+
+let test_body_length () =
+  let check message request_method response ~expect =
+    let actual = Response.body_length response ~request_method in
+    Alcotest.check body_length message expect actual
+  in
+  let res status headers = Response.create status ~headers in
+  check
+    "requested HEAD"
+    ~expect:(`Fixed 0L)
+    `HEAD (res `OK Headers.empty);
+  check
+    "requested CONNECT"
+    ~expect:(`Close_delimited)
+    `CONNECT (res `OK Headers.empty);
+  check
+    "status: informational"
+    ~expect:(`Fixed 0L)
+    `GET (res `Continue Headers.empty);
+  check
+    "status: no content"
+    ~expect:(`Fixed 0L)
+    `GET (res `No_content Headers.empty);
+  check
+    "status: not modified"
+    ~expect:(`Fixed 0L)
+    `GET (res `Not_modified Headers.empty);
+  check
+    "no header"
+    ~expect:(`Close_delimited)
+    `GET (res `OK Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    `GET (res `OK Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:`Close_delimited
+    `GET (res `OK encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:`Close_delimited
+    `GET (res `OK Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
+let tests =
+  [ "parse valid"        , `Quick, test_parse_valid
+  ; "parse invalid error", `Quick, test_parse_invalid_error
+  ; "body length"        , `Quick, test_body_length
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_version.ml

@@ -0,0 +1,22 @@
+open H1
+open Version
+
+let v1_0 = { major = 1; minor = 0 }
+let v1_1 = { major = 1; minor = 1 }
+
+let test_compare () =
+  Alcotest.(check int) "compare v1_1 v1_0" (compare v1_1 v1_0) 1;
+  Alcotest.(check int) "compare v1_1 v1_1" (compare v1_1 v1_1) 0;
+  Alcotest.(check int) "compare v1_0 v1_0" (compare v1_0 v1_0) 0;
+  Alcotest.(check int) "compare v1_0 v1_1" (compare v1_0 v1_1) (-1);
+;;
+
+let test_to_string () =
+  Alcotest.(check string) "to_string v1_1" (to_string v1_1) "HTTP/1.1";
+  Alcotest.(check string) "to_string v1_0" (to_string v1_0) "HTTP/1.0";
+;;
+
+let tests =
+  [ "compare"  , `Quick, test_compare
+  ; "to_string", `Quick, test_to_string
+  ]

unikernel/duniverse/ocaml-h1/lib_test/test_websocket.ml

@@ -0,0 +1,46 @@
+open H1.Websocket
+
+module Testable = struct
+  let opcode = Alcotest.testable Opcode.pp_hum ( = )
+end
+
+let parse_frame serialized_frame =
+  match Angstrom.parse_string ~consume:All Frame.parse serialized_frame with
+  | Ok frame -> frame
+  | Error err -> Alcotest.fail err
+
+let test_parsing_ping_frame () =
+  let frame = parse_frame "\137\128\000\000\046\216" in
+  Alcotest.check Testable.opcode "opcode" `Ping (Frame.opcode frame);
+  Alcotest.(check bool) "has mask" true (Frame.has_mask frame);
+  Alcotest.(check int32) "mask" 11992l (Frame.mask_exn frame);
+  Alcotest.(check int) "payload_length" (Frame.payload_length frame) 0;
+  Alcotest.(check int) "length" (Frame.length frame) 6
+
+let test_parsing_close_frame () =
+  let frame = parse_frame "\136\000" in
+  Alcotest.check Testable.opcode "opcode" `Connection_close
+    (Frame.opcode frame);
+  Alcotest.(check int) "payload_length" (Frame.payload_length frame) 0;
+  Alcotest.(check int) "length" (Frame.length frame) 2
+
+let test_parsing_text_frame () =
+  let frame =
+    parse_frame
+      "\129\139\086\057\046\216\103\011\029\236\099\015\025\224\111\009\036"
+  in
+  Alcotest.check Testable.opcode "opcode" `Text (Frame.opcode frame);
+  Alcotest.(check bool) "has mask" true (Frame.has_mask frame);
+  Alcotest.(check int32) "mask" 1446588120l (Frame.mask_exn frame);
+  Alcotest.(check int) "payload_length" (Frame.payload_length frame) 11;
+  Alcotest.(check int) "length" (Frame.length frame) 17;
+  Frame.unmask_inplace frame;
+  let payload = Bstr.to_string (Frame.payload_view frame) in
+  Alcotest.(check string) "payload" "1234567890\n" payload
+
+let tests =
+  [
+    ("parsing ping frame", `Quick, test_parsing_ping_frame);
+    ("parsing close frame", `Quick, test_parsing_close_frame);
+    ("parsing text frame", `Quick, test_parsing_text_frame);
+  ]

unikernel/duniverse/ocaml-h1/lwt-unix/dune

@@ -0,0 +1,5 @@
+(library
+ (name h1_lwt_unix)
+ (public_name h1-lwt-unix)
+ (libraries faraday-lwt-unix h1 lwt.unix)
+ (flags (:standard -safe-string)))

unikernel/duniverse/ocaml-h1/lwt-unix/h1_lwt_unix.ml

@@ -0,0 +1,322 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2018 Inhabited Type LLC.
+    Copyright (c) 2018 Anton Bachin
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open Lwt.Infix
+
+module Buffer : sig
+  type t
+
+  val create : int -> t
+
+  val get : t -> f:(Lwt_bytes.t -> off:int -> len:int -> int) -> int
+  val put : t -> f:(Lwt_bytes.t -> off:int -> len:int -> int Lwt.t) -> int Lwt.t
+end = struct
+  type t =
+    { buffer      : Lwt_bytes.t
+    ; mutable off : int
+    ; mutable len : int }
+
+  let create size =
+    let buffer = Lwt_bytes.create size in
+    { buffer; off = 0; len = 0 }
+
+  let compress t =
+    if t.len = 0
+    then begin
+      t.off <- 0;
+      t.len <- 0;
+    end else if t.off > 0
+    then begin
+      Lwt_bytes.blit t.buffer t.off t.buffer 0 t.len;
+      t.off <- 0;
+    end
+
+  let get t ~f =
+    let n = f t.buffer ~off:t.off ~len:t.len in
+    t.off <- t.off + n;
+    t.len <- t.len - n;
+    if t.len = 0
+    then t.off <- 0;
+    n
+
+  let put t ~f =
+    compress t;
+    f t.buffer ~off:(t.off + t.len) ~len:(Lwt_bytes.length t.buffer - t.len)
+    >>= fun n ->
+    t.len <- t.len + n;
+    Lwt.return n
+end
+
+let read fd buffer =
+  Lwt.catch
+    (fun () ->
+      Buffer.put buffer ~f:(fun bigstring ~off ~len ->
+        Lwt_bytes.read fd bigstring off len))
+    (function
+    | Unix.Unix_error (Unix.EBADF, _, _) as exn ->
+      Lwt.fail exn
+    | exn ->
+      Lwt.async (fun () ->
+        Lwt_unix.close fd);
+      Lwt.fail exn)
+
+  >>= fun bytes_read ->
+  if bytes_read = 0 then
+    Lwt.return `Eof
+  else
+    Lwt.return (`Ok bytes_read)
+
+
+
+let shutdown socket command =
+  try Lwt_unix.shutdown socket command
+  with Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
+
+module Config = H1.Config
+
+module Server = struct
+  let create_connection_handler
+        ?(config=Config.default) ~request_handler ~upgrade_handler ~error_handler =
+    fun client_addr socket ->
+      let module Server_connection = H1.Server_connection in
+      let connection =
+        Server_connection.create
+          ~config
+          ~error_handler:(error_handler client_addr)
+          (request_handler client_addr)
+      in
+
+      let read_buffer = Buffer.create config.read_buffer_size in
+      let read_loop_exited, notify_read_loop_exited = Lwt.wait () in
+      let write_loop_exited, notify_write_loop_exited = Lwt.wait () in
+
+      let upgrade_read, notify_upgrade_read = Lwt.wait () in
+      let upgrade_write, notify_upgrade_write = Lwt.wait () in
+      Lwt.async (fun () ->
+        upgrade_read
+        >>= fun () ->
+        upgrade_write
+        >>= fun () ->
+        match upgrade_handler with
+        | None -> Lwt.fail_with "HTTP upgrades not supported"
+        | Some upgrade_handler ->
+          upgrade_handler client_addr socket
+          >>= fun () ->
+          if (Lwt_unix.state socket = Lwt_unix.Closed)
+          then Lwt.return_unit
+          else Lwt_unix.close socket
+          >>= fun () ->
+          Lwt.wakeup_later notify_read_loop_exited ();
+          Lwt.wakeup_later notify_write_loop_exited ();
+          Lwt.return_unit);
+
+      let rec read_loop () =
+        let rec read_loop_step () =
+          match Server_connection.next_read_operation connection with
+          | `Read ->
+            read socket read_buffer >>= begin function
+            | `Eof ->
+              Buffer.get read_buffer ~f:(fun bigstring ~off ~len ->
+                Server_connection.read_eof connection bigstring ~off ~len)
+              |> ignore;
+              read_loop_step ()
+            | `Ok _ ->
+              Buffer.get read_buffer ~f:(fun bigstring ~off ~len ->
+                Server_connection.read connection bigstring ~off ~len)
+              |> ignore;
+              read_loop_step ()
+            end
+
+          | `Yield ->
+            Server_connection.yield_reader connection read_loop;
+            Lwt.return_unit
+
+          | `Upgrade ->
+            Lwt.wakeup_later notify_upgrade_read ();
+            Lwt.return_unit
+
+          | `Close ->
+            Lwt.wakeup_later notify_read_loop_exited ();
+            if not (Lwt_unix.state socket = Lwt_unix.Closed) then begin
+              shutdown socket Unix.SHUTDOWN_RECEIVE
+            end;
+            Lwt.return_unit
+        in
+
+        Lwt.async (fun () ->
+          Lwt.catch
+            read_loop_step
+            (fun exn ->
+              Server_connection.report_exn connection exn;
+              Lwt.return_unit))
+      in
+
+
+      let writev = Faraday_lwt_unix.writev_of_fd socket in
+
+      let rec write_loop () =
+        let rec write_loop_step () =
+          match Server_connection.next_write_operation connection with
+          | `Write io_vectors ->
+            writev io_vectors >>= fun result ->
+            Server_connection.report_write_result connection result;
+            write_loop_step ()
+
+          | `Yield ->
+            Server_connection.yield_writer connection write_loop;
+            Lwt.return_unit
+
+          | `Upgrade ->
+            Lwt.wakeup_later notify_upgrade_write ();
+            Lwt.return_unit
+
+          | `Close _ ->
+            Lwt.wakeup_later notify_write_loop_exited ();
+            if not (Lwt_unix.state socket = Lwt_unix.Closed) then begin
+              shutdown socket Unix.SHUTDOWN_SEND
+            end;
+            Lwt.return_unit
+        in
+
+        Lwt.async (fun () ->
+          Lwt.catch
+            write_loop_step
+            (fun exn ->
+              Server_connection.report_exn connection exn;
+              Lwt.return_unit))
+      in
+
+
+      read_loop ();
+      write_loop ();
+      Lwt.join [read_loop_exited; write_loop_exited] >>= fun () ->
+
+      if Lwt_unix.state socket <> Lwt_unix.Closed then
+        Lwt.catch
+          (fun () -> Lwt_unix.close socket)
+          (fun _exn -> Lwt.return_unit)
+      else
+        Lwt.return_unit
+end
+
+
+
+module Client = struct
+  let request ?(config=Config.default) socket request ~error_handler ~response_handler =
+    let module Client_connection = H1.Client_connection in
+    let request_body, connection =
+      Client_connection.request ~config request ~error_handler ~response_handler in
+
+
+    let read_buffer = Buffer.create config.read_buffer_size in
+    let read_loop_exited, notify_read_loop_exited = Lwt.wait () in
+
+    let read_loop () =
+      let rec read_loop_step () =
+        match Client_connection.next_read_operation connection with
+        | `Read ->
+          read socket read_buffer >>= begin function
+          | `Eof ->
+            Buffer.get read_buffer ~f:(fun bigstring ~off ~len ->
+              Client_connection.read_eof connection bigstring ~off ~len)
+            |> ignore;
+            read_loop_step ()
+          | `Ok _ ->
+            Buffer.get read_buffer ~f:(fun bigstring ~off ~len ->
+              Client_connection.read connection bigstring ~off ~len)
+            |> ignore;
+            read_loop_step ()
+          end
+
+        | `Close ->
+          Lwt.wakeup_later notify_read_loop_exited ();
+          if not (Lwt_unix.state socket = Lwt_unix.Closed) then begin
+            shutdown socket Unix.SHUTDOWN_RECEIVE
+          end;
+          Lwt.return_unit
+      in
+
+      Lwt.async (fun () ->
+        Lwt.catch
+          read_loop_step
+          (fun exn ->
+            Client_connection.report_exn connection exn;
+            Lwt.return_unit))
+    in
+
+
+    let writev = Faraday_lwt_unix.writev_of_fd socket in
+    let write_loop_exited, notify_write_loop_exited = Lwt.wait () in
+
+    let rec write_loop () =
+      let rec write_loop_step () =
+        match Client_connection.next_write_operation connection with
+        | `Write io_vectors ->
+          writev io_vectors >>= fun result ->
+          Client_connection.report_write_result connection result;
+          write_loop_step ()
+
+        | `Yield ->
+          Client_connection.yield_writer connection write_loop;
+          Lwt.return_unit
+
+        | `Close _ ->
+          Lwt.wakeup_later notify_write_loop_exited ();
+          Lwt.return_unit
+      in
+
+      Lwt.async (fun () ->
+        Lwt.catch
+          write_loop_step
+          (fun exn ->
+            Client_connection.report_exn connection exn;
+            Lwt.return_unit))
+    in
+
+
+    read_loop ();
+    write_loop ();
+
+    Lwt.async (fun () ->
+      Lwt.join [read_loop_exited; write_loop_exited] >>= fun () ->
+
+      if Lwt_unix.state socket <> Lwt_unix.Closed then
+        Lwt.catch
+          (fun () -> Lwt_unix.close socket)
+          (fun _exn -> Lwt.return_unit)
+      else
+        Lwt.return_unit);
+
+    request_body
+end

unikernel/duniverse/ocaml-h1/lwt-unix/h1_lwt_unix.mli

@@ -0,0 +1,61 @@
+(*----------------------------------------------------------------------------
+    Copyright (c) 2018 Inhabited Type LLC.
+    Copyright (c) 2018 Anton Bachin
+
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    3. Neither the name of the author nor the names of his contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+    OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+    DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+    STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+  ----------------------------------------------------------------------------*)
+
+open H1
+
+
+(* The function that results from [create_connection_handler] should be passed
+   to [Lwt_io.establish_server_with_client_socket]. For an example, see
+   [examples/lwt_echo_server.ml]. *)
+module Server : sig
+  val create_connection_handler
+    :  ?config         : Config.t
+    -> request_handler : (Unix.sockaddr -> Server_connection.request_handler)
+    -> upgrade_handler : (Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t) option
+    -> error_handler   : (Unix.sockaddr -> Server_connection.error_handler)
+    -> Unix.sockaddr
+    -> Lwt_unix.file_descr
+    -> unit Lwt.t
+end
+
+(* For an example, see [examples/lwt_get.ml]. *)
+module Client : sig
+  val request
+    :  ?config          : H1.Config.t
+    -> Lwt_unix.file_descr
+    -> Request.t
+    -> error_handler    : Client_connection.error_handler
+    -> response_handler : Client_connection.response_handler
+    -> H1.Body.Writer.t
+end