fmt

.ocamlformat

@@ -0,0 +1,15 @@
+version=0.28.1
+exp-grouping=preserve
+type-decl=sparse
+break-infix=fit-or-vertical
+break-collection-expressions=wrap
+break-sequences=false
+break-infix-before-func=false
+dock-collection-brackets=true
+break-separators=after
+field-space=tight
+if-then-else=compact
+break-sequences=false
+sequence-blank-line=compact
+exp-grouping=preserve
+sequence-blank-line=preserve-one

.ocamlformat-ignore

@@ -0,0 +1 @@
+dist/dune

Makefile

@@ -0,0 +1,64 @@
+# Generated by mirage.v4.10.3
+
+-include Makefile.user
+BUILD_DIR = ./
+MIRAGE_DIR = ./mirage
+UNIKERNEL_NAME = minipaf-unix
+OPAM = opam
+
+all::
+	@$(MAKE) --no-print-directory depends
+	@$(MAKE) --no-print-directory build
+
+.PHONY: all lock install-switch pull clean depend depends build repo-add repo-rm depext-lockfile
+
+repo-add:
+	@printf "\033[2musing overlay repository mirage: [opam-overlays, mirage-overlays] \033[0m\n"
+	$(OPAM) repo add opam-overlays https://github.com/dune-universe/opam-overlays.git || $(OPAM) repo set-url opam-overlays https://github.com/dune-universe/opam-overlays.git
+	$(OPAM) repo add mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git || $(OPAM) repo set-url mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
+
+
+repo-rm:
+	@printf "\033[2mremoving overlay repository [opam-overlays, mirage-overlays]\033[0m\n"
+	$(OPAM) repo remove opam-overlays https://github.com/dune-universe/opam-overlays.git
+	$(OPAM) repo remove mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
+
+
+
+depext-lockfile: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
+	echo " ↳ install external dependencies for monorepo"
+	env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo depext -y -l $<
+
+
+$(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
+	@$(MAKE) -s repo-add
+	@echo " ↳ generate lockfile for monorepo dependencies"
+	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@ --ocaml-version $(shell ocamlc --version); (ret=$$?; $(MAKE) -s repo-rm && exit $$ret)
+
+lock::
+	@$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
+	@echo "The lock file has been generated. Run 'make pull' to retrieve the sources, or 'make install-switch' to install the host dependencies."
+
+pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
+	@echo " ↳ fetch monorepo dependencies in the duniverse folder"
+	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR))
+	@echo "The sources have been pulled to the duniverse folder. Run 'make build' to build the unikernel."
+
+install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
+	@echo " ↳ opam install switch dependencies"
+	@$(OPAM) install $< --deps-only --yes
+	@$(MAKE) -s depext-lockfile
+	@echo "The dependencies have been installed. Run 'make build' to build the unikernel."
+
+depends depend::
+	@$(MAKE) --no-print-directory lock
+	@$(MAKE) --no-print-directory install-switch
+	@$(MAKE) --no-print-directory pull
+
+build::
+	dune build --profile release --root . $(BUILD_DIR)dist
+	@echo "Your unikernel binary is now ready in $(BUILD_DIR)dist/minipaf"
+	@echo "Execute the binary using solo5-hvt, solo5-spt, xl, ..."
+
+clean::
+	mirage clean

config.ml

@@ -9,12 +9,9 @@ let minipaf =
   main "Unikernel.Make"
     ~packages:
       [
-        package "digestif";
+        package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs";
-        package ~min:"0.0.9" "mimic-happy-eyeballs";
+        package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult";
-        package "hxd" ~sublibs:[ "core"; "string" ];
+        package "h2" ~min:"0.13.0"; package "base64" ~sublibs:[ "rfc2045" ];
-        package "rresult";
-        package "h2" ~min:"0.13.0";
-        package "base64" ~sublibs:[ "rfc2045" ];
       ]
     (kv_ro @-> kv_ro @-> tcpv4v6 @-> conn @-> http_server @-> job)
 

connect.ml

@@ -20,7 +20,10 @@ struct
     type endpoint = Happy_eyeballs.t * string * int
 
     type nonrec write_error =
-      [ `Write of write_error | `Connect of string | `Closed ]
+      [ `Write of write_error
+      | `Connect of string
+      | `Closed
+      ]
 
     let pp_write_error ppf = function
       | `Connect err -> Fmt.string ppf err
@@ -82,10 +85,8 @@ struct
       Mimic.fold tcp_edn
         Mimic.Fun.
           [
-            req Happy_eyeballs.happy_eyeballs;
+            req Happy_eyeballs.happy_eyeballs; req connect_scheme;
-            req connect_scheme;
+            req connect_hostname; dft connect_port 80;
-            req connect_hostname;
-            dft connect_port 80;
           ]
         ~k:k0 ctx
     in
@@ -93,11 +94,8 @@ struct
       Mimic.fold tls_edn
         Mimic.Fun.
           [
-            req Happy_eyeballs.happy_eyeballs;
+            req Happy_eyeballs.happy_eyeballs; req connect_scheme;
-            req connect_scheme;
+            req connect_hostname; dft connect_port 443; req connect_tls_config;
-            req connect_hostname;
-            dft connect_port 443;
-            req connect_tls_config;
           ]
         ~k:k1 ctx
     in
@@ -117,25 +115,25 @@ let decode_uri ~ctx uri =
        else Error (`Msg "Couldn't decode user and password"))
       >>= fun (_scheme, ctx) ->
       (match String.split_on_char '@' user_pass_host_port with
-      | [ host_port ] -> Ok (None, host_port)
+        | [ host_port ] -> Ok (None, host_port)
-      | [ _user_pass; host_port ] -> Ok (None, host_port)
+        | [ _user_pass; host_port ] -> Ok (None, host_port)
-      | _ -> Error (`Msg "Couldn't decode URI"))
+        | _ -> Error (`Msg "Couldn't decode URI"))
       >>= fun (_user_pass, host_port) ->
       (match String.split_on_char ':' host_port with
-      | [] -> Error (`Msg "Empty host & port")
+        | [] -> Error (`Msg "Empty host & port")
-      | [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx)
+        | [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx)
-      | hd :: tl -> (
+        | hd :: tl -> (
-          let port, hostname =
+            let port, hostname =
-            match List.rev (hd :: tl) with
+              match List.rev (hd :: tl) with
-            | hd :: tl -> (hd, String.concat ":" (List.rev tl))
+              | hd :: tl -> (hd, String.concat ":" (List.rev tl))
-            | _ -> assert false
+              | _ -> assert false
-          in
+            in
-          try
+            try
-            Ok
+              Ok
-              ( hostname,
+                ( hostname,
-                Mimic.add connect_hostname hostname
+                  Mimic.add connect_hostname hostname
-                  (Mimic.add connect_port (int_of_string port) ctx) )
+                    (Mimic.add connect_port (int_of_string port) ctx) )
-          with Failure _ -> Error (`Msg "Couldn't decode port")))
+            with Failure _ -> Error (`Msg "Couldn't decode port")))
       >>= fun (hostname, ctx) -> Ok (ctx, hostname)
   | _ -> Error (`Msg "Couldn't decode URI on top")
 

dune

@@ -0,0 +1,3 @@
+;; Generated by mirage.v4.10.3
+
+(include dune.build)

server.ml

@@ -66,7 +66,7 @@ let transmit_random ~write_string ~flush ~close_writer
     | 0L -> finalize ctx (Base64_rfc2045.encode encoder `End)
     | length ->
         let len = min (Int64.of_int (Cstruct.length rnd)) length in
-        let ({ Cstruct.buffer; off; len = buffer_len } as rnd) =
+        let ({ Cstruct.buffer; off; len= buffer_len } as rnd) =
           random_cstruct ~g rnd (Int64.to_int len)
         in
         Log.debug (fun m ->
@@ -115,7 +115,7 @@ let hash ~version ~create ?seed length =
         (response, Digestif.SHA256.(to_hex (get ctx)))
     | length ->
         let len = min (Int64.of_int (Cstruct.length rnd)) length in
-        let { Cstruct.buffer; off; len = buffer_len } =
+        let { Cstruct.buffer; off; len= buffer_len } =
           random_cstruct ~g rnd (Int64.to_int len)
         in
         Log.debug (fun m ->
@@ -257,7 +257,7 @@ module S_HTTP_1_1 = struct
 
   let with_etag etag response =
     let headers = response.H1.Response.headers in
-    { response with H1.Response.headers = H1.Headers.add headers "etag" etag }
+    { response with H1.Response.headers= H1.Headers.add headers "etag" etag }
 
   let with_status (status : H2.Status.t) response =
     match status with
@@ -266,9 +266,7 @@ module S_HTTP_1_1 = struct
 end
 
 let transmit src dst =
-  let rec on_eof () =
+  let rec on_eof () = H1.Body.Reader.close src; H1.Body.Writer.close dst
-    H1.Body.Reader.close src;
-    H1.Body.Writer.close dst
   and on_read buf ~off ~len =
     H1.Body.Writer.write_bigstring dst ~off ~len buf;
     H1.Body.Reader.schedule_read src ~on_eof ~on_read
@@ -300,8 +298,7 @@ let connect_http_1_1 ~ctx ~authenticator ~to_close flow reqd =
                 H1.Headers.of_list
                   [
                     ("content-length", string_of_int (String.length contents));
-                    ("connection", "close");
+                    ("connection", "close"); ("content-type", "text/plain");
-                    ("content-type", "text/plain");
                   ]
               in
               let response =
@@ -315,8 +312,7 @@ let connect_http_1_1 ~ctx ~authenticator ~to_close flow reqd =
         H1.Headers.of_list
           [
             ("content-length", string_of_int (String.length contents));
-            ("connection", "close");
+            ("connection", "close"); ("content-type", "text/plain");
-            ("content-type", "text/plain");
           ]
       in
       let response =
@@ -341,8 +337,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close =
               H1.Headers.of_list
                 [
                   ("content-length", string_of_int (String.length root));
-                  ("connection", "close");
+                  ("connection", "close"); ("content-type", "text/plain");
-                  ("content-type", "text/plain");
                 ]
             in
             let response = H1.Response.create ~reason:"root" ~headers `OK in
@@ -401,8 +396,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close =
                   H1.Headers.of_list
                     [
                       ("content-length", string_of_int (String.length contents));
-                      ("connection", "close");
+                      ("connection", "close"); ("content-type", "text/plain");
-                      ("content-type", "text/plain");
                     ]
                 in
                 let response =
@@ -414,8 +408,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close =
             let headers =
               H1.Headers.of_list
                 [
-                  ("content-type", "text/plain");
+                  ("content-type", "text/plain"); ("connection", "close");
-                  ("connection", "close");
                   ("content-length", string_of_int (String.length contents));
                 ]
             in
@@ -438,15 +431,13 @@ module S_HTTP_2_0 = struct
 
   let with_etag etag response =
     let headers = response.H2.Response.headers in
-    { response with H2.Response.headers = H2.Headers.add headers "etag" etag }
+    { response with H2.Response.headers= H2.Headers.add headers "etag" etag }
 
   let with_status status response = { response with H2.Response.status }
 end
 
 let transmit src dst =
-  let rec on_eof () =
+  let rec on_eof () = H2.Body.Reader.close src; H2.Body.Writer.close dst
-    H2.Body.Reader.close src;
-    H2.Body.Writer.close dst
   and on_read buf ~off ~len =
     H2.Body.Writer.write_bigstring dst ~off ~len buf;
     H2.Body.Reader.schedule_read src ~on_eof ~on_read

unikernel.ml

@@ -111,8 +111,8 @@ struct
       | _ -> ()
     in
     {
-      Alpn.error = Server.alpn_error_handler;
+      Alpn.error= Server.alpn_error_handler;
-      Alpn.request =
+      Alpn.request=
         (fun flow edn reqd protocol ->
           Server.alpn_request_handler ~ctx ~authenticator ~to_close (R.T flow)
             edn reqd protocol);