Merge pull request #24 from dinosaure/dns

Re-introduce dns for mimic to be sure that the injected happy-eyeballs is able to resolve domain-names
dinosaure · Jun 16, 2024 · f3e0962 · f3e0962
2 parents 2e13aa0 + 454f7c8
commit f3e0962
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 4 deletions.
diff --git a/mimic-happy-eyeballs.opam b/mimic-happy-eyeballs.opam
@@ -12,6 +12,7 @@ depends: [
   "dune" {>= "2.8"}
   "mimic" {= version}
   "happy-eyeballs-mirage" {>= "1.1.0"}
+  "dns-client-mirage" {>= "8.0.0"}
 ]
 build: [
   ["dune" "build" "-p" name "-j" jobs]

diff --git a/mirage/dune b/mirage/dune
@@ -1,4 +1,4 @@
 (library
  (name mimic_happy_eyeballs)
  (public_name mimic-happy-eyeballs)
- (libraries happy-eyeballs-mirage mimic))
+ (libraries dns-client-mirage happy-eyeballs-mirage mimic))
diff --git a/mirage/mimic_happy_eyeballs.ml b/mirage/mimic_happy_eyeballs.ml
@@ -18,7 +18,12 @@ end
 
 module Make
     (Stack : Tcpip.Stack.V4V6)
-    (Happy_eyeballs : Happy_eyeballs_mirage.S with type flow = Stack.TCP.flow) : sig
+    (Happy_eyeballs : Happy_eyeballs_mirage.S
+                        with type flow = Stack.TCP.flow
+                         and type stack = Stack.t)
+    (_ : Dns_client_mirage.S
+           with type happy_eyeballs = Happy_eyeballs.t
+            and type Transport.stack = Happy_eyeballs.t * Stack.t) : sig
   include S with type t = Happy_eyeballs.t and type flow = Stack.TCP.flow
 
   val connect : Happy_eyeballs.t -> Mimic.ctx Lwt.t
@@ -28,5 +33,5 @@ end = struct
 
   let happy_eyeballs = Mimic.make ~name:"mimic-happy-eyeballs"
   let resolve = Happy_eyeballs.connect
-  let connect t = Lwt.return (Mimic.add happy_eyeballs t Mimic.empty)
+  let connect he = Lwt.return (Mimic.add happy_eyeballs he Mimic.empty)
 end
diff --git a/mirage/mimic_happy_eyeballs.mli b/mirage/mimic_happy_eyeballs.mli
@@ -30,7 +30,12 @@ end
     user. *)
 module Make
     (Stack : Tcpip.Stack.V4V6)
-    (Happy_eyeballs : Happy_eyeballs_mirage.S with type flow = Stack.TCP.flow) : sig
+    (Happy_eyeballs : Happy_eyeballs_mirage.S
+                        with type flow = Stack.TCP.flow
+                         and type stack = Stack.t)
+    (_ : Dns_client_mirage.S
+           with type happy_eyeballs = Happy_eyeballs.t
+            and type Transport.stack = Happy_eyeballs.t * Stack.t) : sig
   include S with type t = Happy_eyeballs.t and type flow = Stack.TCP.flow
 
   val connect : t -> Mimic.ctx Lwt.t