Repository: mirage/dream
Pull request #1: Fix dream mirage
Author: login: Willenbrink
Created: 2025-05-17T14:40:09Z | Merged: 2025-05-20T10:45:46Z

Fix the dream-mirage package so that it works with the latest version of Mirage. This is the version used by my mirage-www PR.


Diff:
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 2dc089f4..cb833373 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -114,7 +114,6 @@ jobs:
         fi
 
   mirage:
-    if: false
     runs-on: ubuntu-22.04
     steps:
     - uses: actions/checkout@v4
@@ -126,17 +125,15 @@ jobs:
       with:
         ocaml-compiler: 4.14.x
         dune-cache: true
-    # Needed until https://github.com/robur-coop/ocaml-letsencrypt/pull/34.
-    - run: opam pin add letsencrypt git+https://github.com/hannesm/ocaml-letsencrypt.git#no-cstruct --no-action
     - run: opam install --yes --deps-only ./dream-pure.opam ./dream-httpaf.opam ./dream.opam ./dream-mirage.opam
-    - run: opam install --yes mirage mirage-clock-unix mirage-crypto-rng-mirage
+    - run: opam install --yes mirage mirage-ptime mirage-crypto-rng-mirage
     - run: cd example/w-mirage && mv config.ml config.ml.backup
     - run: cd example/w-mirage && sed -e 's/package "dream-mirage"//' < config.ml.backup > config.ml
     - run: cd example/w-mirage && opam exec -- mirage configure -t unix
     - run: cd example/w-mirage && opam exec -- make depends
     - run: cd example/w-mirage && ls duniverse
     - run: cp -r ../repo-copy example/w-mirage/duniverse/dream
-    - run: cd example/w-mirage/duniverse && rm -rf ocaml-cstruct logs ke fmt lwt bytes seq mirage-flow sexplib0 ptime tls domain-name ocaml-ipaddr mirage-clock ocplib-endian digestif eqaf mirage-crypto mirage-runtime
+    - run: cd example/w-mirage/duniverse && rm -rf ocaml-cstruct logs ke fmt lwt bytes seq mirage-flow sexplib0 ptime tls domain-name ocaml-ipaddr mirage-ptime ocplib-endian digestif eqaf mirage-crypto mirage-runtime psq
     - run: cd example/w-mirage && mv config.ml.backup config.ml
     - run: cd example/w-mirage && sed -e 's/(libraries/(libraries dream-mirage/' < dune.build > dune.build.2
     - run: cd example/w-mirage && mv dune.build.2 dune.build
diff --git a/dream-httpaf.opam b/dream-httpaf.opam
index ae04e78e..176aa06c 100644
--- a/dream-httpaf.opam
+++ b/dream-httpaf.opam
@@ -17,9 +17,10 @@ depends: [
   "dune" {>= "2.7.0"}  # --instrument-with.
   "gluten"
   "gluten-lwt-unix"
-  "h2" {< "0.13.0"}
+  "h1"
+  "h2"
   "h2-lwt-unix"
-  "httpun" {< "0.2.0"}
+  "httpun"
   "httpun-lwt-unix"
   "httpun-ws"
   "lwt"
diff --git a/dream-mirage.opam b/dream-mirage.opam
index fe0b6a41..f0bc2471 100644
--- a/dream-mirage.opam
+++ b/dream-mirage.opam
@@ -59,6 +59,7 @@ depends: [
   "ke" {>= "0.4"}  # paf.
   "letsencrypt" {>= "0.3.0"}
   "lwt"
+  "paf"
   "lwt_ppx" {>= "1.2.2"}
   "mimic" {>= "0.0.5"}
   "mirage-time"
diff --git a/dream.opam b/dream.opam
index fc9c0c12..bd70baf8 100644
--- a/dream.opam
+++ b/dream.opam
@@ -68,10 +68,9 @@ depends: [
   "logs" {>= "0.5.0"}
   "magic-mime"
   "markup" {>= "1.0.2"}
-  "mirage-clock" {>= "3.0.0"}  # now_d_ps : unit -> int * int64.
-  "mirage-crypto" {>= "1.0.0"}
-  "mirage-crypto-rng" {>= "1.0.0"}
-  "mirage-crypto-rng-lwt"
+  "mirage-crypto" {>= "1.2.0"}
+  "mirage-crypto-rng" {>= "1.2.0"}
+  "mirage-ptime" {>= "5.0.0"}
   "multipart_form" {>= "0.4.0"}
   "multipart_form-lwt"
   "ocaml" {>= "4.08.0"}
diff --git a/example/w-mirage/config.ml b/example/w-mirage/config.ml
index 20cc6d28..a42a15af 100644
--- a/example/w-mirage/config.ml
+++ b/example/w-mirage/config.ml
@@ -4,12 +4,10 @@ let main =
   main
     ~packages:[package "dream-mirage"]
     "Unikernel.Hello_world"
-    (pclock @-> time @-> stackv4v6 @-> job)
+    (stackv4v6 @-> job)
 
 let () =
   register "hello" [
     main
-      $ default_posix_clock
-      $ default_time
       $ generic_stackv4v6 default_network
   ]
diff --git a/example/w-mirage/unikernel.ml b/example/w-mirage/unikernel.ml
index ec9be8eb..2b8cf075 100644
--- a/example/w-mirage/unikernel.ml
+++ b/example/w-mirage/unikernel.ml
@@ -1,12 +1,10 @@
 module Hello_world
-  (Pclock : Mirage_clock.PCLOCK)
-  (Time : Mirage_time.S)
   (Stack : Tcpip.Stack.V4V6) =
 struct
   module Dream =
-    Dream__mirage.Mirage.Make (Pclock) (Time) (Stack)
+    Dream__mirage.Mirage.Make (Stack)
 
-  let start _pclock _time stack =
+  let start stack =
     Dream.http ~port:8080 (Stack.tcp stack)
     @@ Dream.logger
     @@ fun _ -> Dream.html "Good morning, world!"
diff --git a/src/dream.ml b/src/dream.ml
index 07b9248a..df83900e 100644
--- a/src/dream.ml
+++ b/src/dream.ml
@@ -42,7 +42,6 @@ module Upload = Dream__server.Upload
 module Log =
 struct
   include Dream__server.Log
-  include Dream__server.Log.Make (Ptime_clock)
 end
 
 let default_log =
@@ -52,16 +51,15 @@ let () =
   Log.initialize ~setup_outputs:Fmt_tty.setup_std_outputs
 
 let now () =
-  Ptime.to_float_s (Ptime.v (Ptime_clock.now_d_ps ()))
+  Ptime.to_float_s (Ptime.v (Mirage_ptime.now_d_ps ()))
 
 let () =
   Random.initialize (fun () ->
-    Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna))
+    Mirage_crypto_rng_unix.use_default ())
 
 module Session =
 struct
   include Dream__server.Session
-  include Dream__server.Session.Make (Ptime_clock)
 end
 
 
diff --git a/src/dune b/src/dune
index a82c981c..16eaacfd 100644
--- a/src/dune
+++ b/src/dune
@@ -9,13 +9,13 @@
   dream.http
   dream.server
   dream.unix
-  dream-pure
+  (re_export dream-pure)
   dream.sql
   fmt.tty
   graphql-lwt
   logs
   lwt
   lwt.unix
-  mirage-crypto-rng-lwt
-  ptime.clock.os
- ))
+  mirage-crypto-rng
+  mirage-crypto-rng.unix
+))
diff --git a/src/eml/eml.ml b/src/eml/eml.ml
index 782d69b7..864a079b 100644
--- a/src/eml/eml.ml
+++ b/src/eml/eml.ml
@@ -744,7 +744,7 @@ struct
 
         output.format ("%" ^ format);
         if needs_escape then
-          output.print "(Dream.html_escape ";
+          output.print "(Dream_pure.Formats.html_escape ";
         output.print "(\n";
 
         Printf.ksprintf output.print "#%i \"%s\"\n" (line + 1) location;
diff --git a/src/http/adapt.ml b/src/http/adapt.ml
index c6bd416e..b3f833bd 100644
--- a/src/http/adapt.ml
+++ b/src/http/adapt.ml
@@ -74,7 +74,7 @@ let forward_body
     response
     (Httpun.Body.Writer.write_string body)
     (Httpun.Body.Writer.write_bigstring body)
-    (Httpun.Body.Writer.flush body)
+    (fun fn -> Httpun.Body.Writer.flush body (fun _ -> fn ()))
     (fun _code -> Httpun.Body.Writer.close body)
 
 let forward_body_h2
@@ -85,5 +85,5 @@ let forward_body_h2
     response
     (H2.Body.Writer.write_string body)
     (H2.Body.Writer.write_bigstring body)
-    (H2.Body.Writer.flush body)
+    (fun fn -> H2.Body.Writer.flush body (fun _ -> fn ()))
     (fun _code -> H2.Body.Writer.close body)
diff --git a/src/mirage/adapt.ml b/src/mirage/adapt.ml
index 36ef4fee..5be97041 100644
--- a/src/mirage/adapt.ml
+++ b/src/mirage/adapt.ml
@@ -6,9 +6,6 @@
    XXX(dinosaure): same as [src/http/adapt.ml] without [address_to_string] - which
    depends on [Unix]. *)
 
-module Httpaf = Dream_httpaf_.Httpaf
-module H2 = Dream_h2.H2
-
 module Dream = Dream_pure
 module Stream = Dream_pure.Stream
 
@@ -63,14 +60,14 @@ let forward_body_general
 
 let forward_body
     (response : Dream.Message.response)
-    (body : Httpaf.Body.Writer.t) =
+    (body : H1.Body.Writer.t) =
 
   forward_body_general
     response
-    (Httpaf.Body.Writer.write_string body)
-    (Httpaf.Body.Writer.write_bigstring body)
-    (Httpaf.Body.Writer.flush body)
-    (fun _code -> Httpaf.Body.Writer.close body)
+    (H1.Body.Writer.write_string body)
+    (H1.Body.Writer.write_bigstring body)
+    (H1.Body.Writer.flush body)
+    (fun _code -> H1.Body.Writer.close body)
 
 let forward_body_h2
     (response : Dream.Message.response)
@@ -80,5 +77,5 @@ let forward_body_h2
     response
     (H2.Body.Writer.write_string body)
     (H2.Body.Writer.write_bigstring body)
-    (H2.Body.Writer.flush body)
+    (fun fn -> H2.Body.Writer.flush body (fun _ -> fn ()))
     (fun _code -> H2.Body.Writer.close body)
diff --git a/src/mirage/dune b/src/mirage/dune
index 242a8676..968041ed 100644
--- a/src/mirage/dune
+++ b/src/mirage/dune
@@ -9,13 +9,15 @@
   dream.server
   dream.certificate
   dream-pure
-  dream-httpaf.dream-h2
   lwt
   rresult
   tcpip
-  dream-mirage.dream-paf
-  dream-mirage.dream-paf.alpn
-  dream-mirage.dream-paf.mirage
- )
- (preprocess (pps lwt_ppx))
- (instrumentation (backend bisect_ppx)))
+  h1
+  h2
+  paf
+  paf.alpn
+  paf.mirage)
+ (preprocess
+  (pps lwt_ppx))
+ (instrumentation
+  (backend bisect_ppx)))
diff --git a/src/mirage/error_handler.ml b/src/mirage/error_handler.ml
index 958a01a8..9f25a8b0 100644
--- a/src/mirage/error_handler.ml
+++ b/src/mirage/error_handler.ml
@@ -1,5 +1,3 @@
-module Httpaf = Dream_httpaf_.Httpaf
-
 module Catch = Dream__server.Catch
 module Error_template = Dream__server.Error_template
 module Method = Dream_pure.Method
@@ -222,7 +220,7 @@ let httpaf user's_error_handler = fun client_address ?request:_ error start_resp
       let response = match response with
         | Some response -> response
         | None -> default_response caused_by in
-      let headers = Httpaf.Headers.of_list (Message.all_headers response) in
+      let headers = H1.Headers.of_list (Message.all_headers response) in
       let body = start_response headers in
       Adapt.forward_body response body;
       Lwt.return_unit
diff --git a/src/mirage/mirage.ml b/src/mirage/mirage.ml
index 86af0c20..1e753f84 100644
--- a/src/mirage/mirage.ml
+++ b/src/mirage/mirage.ml
@@ -1,7 +1,3 @@
-module Httpaf = Dream_httpaf_.Httpaf
-module Paf_mirage = Dream_paf_mirage.Paf_mirage
-module Alpn = Dream_alpn.Alpn
-
 module Catch = Dream__server.Catch
 module Error_template = Dream__server.Error_template
 module Method = Dream_pure.Method
@@ -20,29 +16,29 @@ module Tag = Dream__server.Tag
 open Rresult
 open Lwt.Infix
 
-let to_dream_method meth = Httpaf.Method.to_string meth |> Method.string_to_method
-let to_httpaf_status status = Status.status_to_int status |> Httpaf.Status.of_code
+let to_dream_method meth = H1.Method.to_string meth |> Method.string_to_method
+let to_httpaf_status status = Status.status_to_int status |> H1.Status.of_code
 let ( >>? ) = Lwt_result.bind
 
 let wrap_handler_httpaf _user's_error_handler user's_dream_handler =
   let httpaf_request_handler = fun _ reqd ->
-    let httpaf_request = Httpaf.Reqd.request reqd in
+    let httpaf_request = H1.Reqd.request reqd in
     let method_ = to_dream_method httpaf_request.meth in
     let target  = httpaf_request.target in
     let _version = (httpaf_request.version.major, httpaf_request.version.minor) in
-    let headers = Httpaf.Headers.to_list httpaf_request.headers in
-    let body    = Httpaf.Reqd.request_body reqd in
+    let headers = H1.Headers.to_list httpaf_request.headers in
+    let body    = H1.Reqd.request_body reqd in
 
     let read ~data ~flush:_ ~ping:_ ~pong:_ ~close ~exn:_ =
-      Httpaf.Body.Reader.schedule_read
+      H1.Body.Reader.schedule_read
         body
         ~on_eof:(fun () -> close 1000)
         ~on_read:(fun buffer ~off ~len -> data buffer off len true false)
     in
     let close _close =
-      Httpaf.Body.Reader.close body in
+      H1.Body.Reader.close body in
     let abort _close =
-      Httpaf.Body.Reader.close body in
+      H1.Body.Reader.close body in
     let body =
       Stream.reader ~read ~close ~abort in
 
@@ -79,7 +75,7 @@ let wrap_handler_httpaf _user's_error_handler user's_dream_handler =
           Message.set_content_length_headers response;
 
           let headers =
-            Httpaf.Headers.of_list (Message.all_headers response) in
+            H1.Headers.of_list (Message.all_headers response) in
 
           (* let version =
             match Dream.version_override response with
@@ -92,9 +88,9 @@ let wrap_handler_httpaf _user's_error_handler user's_dream_handler =
             Dream.reason_override response in *)
 
           let httpaf_response =
-            Httpaf.Response.create ~headers status in
+            H1.Response.create ~headers status in
           let body =
-            Httpaf.Reqd.respond_with_streaming reqd httpaf_response in
+            H1.Reqd.respond_with_streaming reqd httpaf_response in
 
           Adapt.forward_body response body;
 
@@ -106,7 +102,7 @@ let wrap_handler_httpaf _user's_error_handler user's_dream_handler =
       @@ fun exn ->
         (* TODO LATER There was something in the fork changelogs about not
            requiring report_exn. Is it relevant to this? *)
-        Httpaf.Reqd.report_exn reqd exn;
+        H1.Reqd.report_exn reqd exn;
         Lwt.return_unit
     end
   in
@@ -135,7 +131,7 @@ let error_handler
     fun client protocol ?request error respond ->
     match protocol with
     | Alpn.HTTP_1_1 _ ->
-      let start_response hdrs : Httpaf.Body.Writer.t =
+      let start_response hdrs : H1.Body.Writer.t =
         respond hdrs
       in
       Error_handler.httpaf user's_error_handler client ?request:(Some request) error start_response
@@ -150,13 +146,12 @@ let handler user_err user_resp =
   }
 
 
-module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Tcpip.Stack.V4V6) = struct
+module Make (Stack : Tcpip.Stack.V4V6) = struct
   include Dream_pure
   include Method
   include Status
 
   include Log
-  include Log.Make (Pclock)
   include Dream__server.Echo
 
   let default_log =
@@ -169,7 +164,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Tcpip
 
   module Session = struct
     include Dream__server.Session
-    include Dream__server.Session.Make (Pclock)
   end
   module Flash = Dream__server.Flash
 
@@ -335,7 +329,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Tcpip
     Log.convenience_log
 
 
-  let now () = Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))
+  let now () = Ptime.to_float_s (Ptime.v (Mirage_ptime.now_d_ps ()))
 
   let form = form ~now
   let multipart = multipart ~now
@@ -405,13 +399,13 @@ module Make (Pclock : Mirage_clock.PCLOCK) (Time : Mirage_time.S) (Stack : Tcpip
 
   let localhost_certificate =
     let crts = Rresult.R.failwith_error_msg
-      (X509.Certificate.decode_pem_multiple (Cstruct.of_string Dream__certificate.localhost_certificate)) in
+      (X509.Certificate.decode_pem_multiple Dream__certificate.localhost_certificate) in
     let key = Rresult.R.failwith_error_msg
-      (X509.Private_key.decode_pem (Cstruct.of_string Dream__certificate.localhost_certificate_key)) in
+      (X509.Private_key.decode_pem Dream__certificate.localhost_certificate_key) in
     `Single (crts, key)
 
   let https ?stop ~port ?(prefix= "") stack
-    ?(cfg= Tls.Config.server ~certificates:localhost_certificate ())
+    ?(cfg= Tls.Config.server ~certificates:localhost_certificate () |> Result.get_ok)
     ?error_handler:(user's_error_handler : error_handler = Error_handler.default) (user's_dream_handler : Message.handler) =
     initialize ~setup_outputs:ignore ;
     let connect flow =
diff --git a/src/mirage/mirage.mli b/src/mirage/mirage.mli
index 06d73699..f743164e 100644
--- a/src/mirage/mirage.mli
+++ b/src/mirage/mirage.mli
@@ -7,8 +7,6 @@ type handler = request -> response Lwt.t
 type middleware = handler -> handler
 
 module Make
-    (Pclock : Mirage_clock.PCLOCK)
-    (Time : Mirage_time.S)
     (Stack : Tcpip.Stack.V4V6) : sig
   (* This file is part of Dream, released under the MIT license. See LICENSE.md
      for details, or visit https://github.com/aantron/dream.
diff --git a/src/server/dune b/src/server/dune
index 4e5125e6..a9a83ecf 100644
--- a/src/server/dune
+++ b/src/server/dune
@@ -11,7 +11,7 @@
   lwt
   magic-mime
   markup
-  mirage-clock
+  mirage-ptime
   multipart_form
   multipart_form-lwt
   ptime
diff --git a/src/server/log.ml b/src/server/log.ml
index 93aec6b7..82b4f98a 100644
--- a/src/server/log.ml
+++ b/src/server/log.ml
@@ -429,10 +429,8 @@ let set_log_level name level =
 let fd_field : int Message.field =
   Message.new_field ~name:"dream.fd" ~show_value:string_of_int ()
 
-module Make (Pclock : Mirage_clock.PCLOCK) =
-struct
   let now () =
-    Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))
+    Ptime.to_float_s (Ptime.v (Mirage_ptime.now_d_ps ()))
 
   let initializer_ ~setup_outputs = lazy begin
     if !enable then begin
@@ -559,7 +557,6 @@ struct
         |> iter_backtrace (fun line -> log.warning (fun log -> log "%s" line));
 
         Lwt.fail exn)
-end
 
 
 
diff --git a/src/server/session.ml b/src/server/session.ml
index 24942545..fa60088c 100644
--- a/src/server/session.ml
+++ b/src/server/session.ml
@@ -338,15 +338,13 @@ let {middleware; getter} =
 let two_weeks =
   60. *. 60. *. 24. *. 7. *. 2.
 
-module Make (Pclock : Mirage_clock.PCLOCK) = struct
-  let now () = Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))
+  let now () = Ptime.to_float_s (Ptime.v (Mirage_ptime.now_d_ps ()))
 
   let memory_sessions ?(lifetime = two_weeks) =
     middleware (Memory.back_end ~now lifetime)
 
   let cookie_sessions ?(lifetime = two_weeks) =
     middleware (Cookie.back_end ~now lifetime)
-end
 
 let session name request =
   List.assoc_opt name (!(snd (getter request)).payload)
diff --git a/test/expect/eml/dune b/test/expect/eml/dune
index 73ef13bc..737b4542 100644
--- a/test/expect/eml/dune
+++ b/test/expect/eml/dune
@@ -3,9 +3,9 @@
  (libraries
   base
   eml
-  ppx_expect.common
+  ppx_expect
   ppx_inline_test.config
-  ppx_expect.config_types
- )
+  ppx_expect.config_types)
  (inline_tests)
- (preprocess (pps ppx_expect)))
+ (preprocess
+  (pps ppx_expect)))
diff --git a/test/expect/pure/dune b/test/expect/pure/dune
index 9e218564..83444588 100644
--- a/test/expect/pure/dune
+++ b/test/expect/pure/dune
@@ -6,6 +6,6 @@
   dream-pure
   lwt
   lwt.unix
-  ppx_expect.common
+  ppx_expect
   ppx_inline_test.config
   ppx_expect.config_types))
diff --git a/test/expect/server/dune b/test/expect/server/dune
index cf730005..1b79da75 100644
--- a/test/expect/server/dune
+++ b/test/expect/server/dune
@@ -7,9 +7,9 @@
   dream.server
   lwt
   lwt.unix
-  ppx_expect.common
+  ppx_expect
   ppx_inline_test.config
-  ppx_expect.config_types
- )
+  ppx_expect.config_types)
  (inline_tests)
- (preprocess (pps lwt_ppx ppx_expect)))
+ (preprocess
+  (pps lwt_ppx ppx_expect)))


Reviews:
user: login: hannesm
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-05-17T14:45:27Z
user: login: Willenbrink
state: COMMENTED
author_association: NONE
submitted_at: 2025-05-17T14:59:40Z

Review comments:
diff_hunk: @@ -9,13 +9,13 @@
   dream.http
   dream.server
   dream.unix
-  dream-pure
+  (re_export dream-pure)
   dream.sql
   fmt.tty
   graphql-lwt
   logs
   lwt
   lwt.unix
-  mirage-crypto-rng-lwt
-  ptime.clock.os
- ))
+  mirage-crypto-rng
+  mirage-crypto-rng.unix
+  ptime.clock.os))
path: src/dune
user: login: hannesm
body: not sure if it matters. but above you're now using Mirage_ptime instead of Ptime_clock -- do we still need this dependency? shouldn't we instead depend on mirage-ptime in here?
created_at: 2025-05-17T14:45:26Z
author_association: MEMBER
diff_hunk: @@ -9,13 +9,13 @@
   dream.http
   dream.server
   dream.unix
-  dream-pure
+  (re_export dream-pure)
   dream.sql
   fmt.tty
   graphql-lwt
   logs
   lwt
   lwt.unix
-  mirage-crypto-rng-lwt
-  ptime.clock.os
- ))
+  mirage-crypto-rng
+  mirage-crypto-rng.unix
+  ptime.clock.os))
path: src/dune
user: login: Willenbrink
body: Nope, it's not necessary. I've removed it.
created_at: 2025-05-17T14:59:40Z
author_association: NONE

PR comments:
user: login: hannesm
created_at: 2025-05-17T14:48:32Z
body: LGTM
author_association: MEMBER
user: login: hannesm
created_at: 2025-05-17T14:49:01Z
body: I enabled "OCaml-CI" for this repository, so we can check what this CI thinks...
author_association: MEMBER
user: login: hannesm
created_at: 2025-05-17T15:06:02Z
body: CI is somehow useless here... maybe we should investigate in either a different CI or why "OCaml-CI" fails
author_association: MEMBER
user: login: hannesm
created_at: 2025-05-20T10:45:42Z
body: thanks for your PR.
author_association: MEMBER