3.10.2 changes for master

CHANGES.md

@@ -1,3 +1,9 @@
+### v3.10.2 (2021-03-30)
+
+* Adapt to conduit 2.3 and cohttp 4.0 (@samoht @dinosaure #1209)
+* Allow mirage-crypto-rng-mirage 0.9 (@hannesm #1218)
+* Adapt to tcpip 6.1.0 release (the unix sublibrary is no longer needed)
+
 ### v3.10.1 (2020-12-04)
 
 * Fix serialising of Mirage_key.Arg.ip_address: remove superfluous '.'

lib/mirage/impl/mirage_impl_conduit.ml

@@ -1,25 +1,30 @@
 open Functoria
-open Mirage_impl_conduit_connector
+open Mirage_impl_stack
+open Mirage_impl_misc
+open Mirage_impl_random
 
 type conduit = Conduit
 
 let conduit = Type.v Conduit
 
-let conduit_with_connectors connectors =
+let pkg = package ~min:"2.3.0" ~max:"3.0.0" "conduit-mirage"
+
+let tcp =
   let packages = [ pkg ] in
-  let extra_deps = List.map dep connectors in
-  let connect _ _ connectors =
-    let pp_connector = Fmt.fmt "%s >>=@ " in
-    let pp_connectors = Fmt.list ~sep:Fmt.nop pp_connector in
-    Fmt.strf "Lwt.return Conduit_mirage.empty >>=@ %afun t -> Lwt.return t"
-      pp_connectors connectors
+  let connect _ _ = function
+    | [ stack ] -> Fmt.strf "Lwt.return %s@;" stack
+    | _ -> failwith (connect_err "tcp_conduit" 1)
   in
-  impl ~packages ~extra_deps ~connect "Conduit_mirage" conduit
+  impl ~packages ~connect "Conduit_mirage.TCP" (stackv4 @-> conduit)
 
-let conduit_direct ?(tls = false) s =
-  (* TCP must be before tls in the list. *)
-  let connectors = [ tcp_conduit_connector $ s ] in
-  let connectors =
-    if tls then connectors @ [ tls_conduit_connector ] else connectors
+let tls random =
+  let packages = [ pkg; package ~min:"0.12.0" ~max:"0.13.0" "tls-mirage" ] in
+  let extra_deps = [ dep random ] in
+  let connect _ _ = function
+    | [ stack; _random ] -> Fmt.strf "Lwt.return %s@;" stack
+    | _ -> failwith (connect_err "tls_conduit" 1)
   in
-  conduit_with_connectors connectors
+  impl ~packages ~connect ~extra_deps "Conduit_mirage.TLS" (conduit @-> conduit)
+
+let conduit_direct ?tls:(use_tls = false) ?(random = default_random) s =
+  if use_tls then tls random $ (tcp $ s) else tcp $ s

lib/mirage/impl/mirage_impl_conduit.mli

@@ -1,8 +1,13 @@
+open Functoria
+
 type conduit
 
-val conduit : conduit Functoria.typ
+val pkg : package
+
+val conduit : conduit typ
 
 val conduit_direct :
   ?tls:bool ->
-  Mirage_impl_stack.stackv4 Functoria.impl ->
-  conduit Functoria.impl
+  ?random:Mirage_impl_random.random impl ->
+  Mirage_impl_stack.stackv4 impl ->
+  conduit impl

lib/mirage/impl/mirage_impl_http.ml

@@ -1,19 +1,40 @@
 open Functoria
+open Mirage_impl_pclock
 open Mirage_impl_misc
+open Mirage_impl_conduit
+open Mirage_impl_resolver
 
 type http = HTTP
 
 let http = Type.v HTTP
 
+type http_client = HTTP_client
+
+let http_client = Type.v HTTP_client
+
 let connect err _i modname = function
-  | [ conduit ] -> Fmt.strf "%s.connect %s" modname conduit
+  | [ conduit ] -> Fmt.strf "Lwt.return (%s.listen %s)" modname conduit
   | _ -> failwith (connect_err err 1)
 
-let cohttp_server conduit =
-  let packages = [ package ~min:"2.1.0" ~max:"3.0.0" "cohttp-mirage" ] in
-  let extra_deps = [ dep conduit ] in
-  impl ~packages ~connect:(connect "http") ~extra_deps
-    "Cohttp_mirage.Server_with_conduit" http
+let cohttp_server =
+  let packages = [ package ~min:"4.0.0" ~max:"5.0.0" "cohttp-mirage" ] in
+  impl ~packages ~connect:(connect "http") "Cohttp_mirage.Server.Make"
+    (conduit @-> http)
+
+let cohttp_server conduit = cohttp_server $ conduit
+
+let cohttp_client =
+  let packages = [ package ~min:"4.0.0" ~max:"5.0.0" "cohttp-mirage" ] in
+  let connect _i modname = function
+    | [ _pclock; resolver; conduit ] ->
+        Fmt.strf "Lwt.return (%s.ctx %s %s)" modname resolver conduit
+    | _ -> failwith (connect_err "http" 2)
+  in
+  impl ~packages ~connect "Cohttp_mirage.Client.Make"
+    (pclock @-> resolver @-> conduit @-> http_client)
+
+let cohttp_client ?(pclock = default_posix_clock) resolver conduit =
+  cohttp_client $ pclock $ resolver $ conduit
 
 let httpaf_server conduit =
   let packages = [ package "httpaf-mirage" ] in

lib/mirage/impl/mirage_impl_http.mli

@@ -1,9 +1,19 @@
+open Functoria
+
 type http
 
-val http : http Functoria.typ
+val http : http typ
+
+val cohttp_server : Mirage_impl_conduit.conduit impl -> http impl
+
+val httpaf_server : Mirage_impl_conduit.conduit impl -> http impl
+
+type http_client
 
-val cohttp_server :
-  Mirage_impl_conduit.conduit Functoria.impl -> http Functoria.impl
+val http_client : http_client typ
 
-val httpaf_server :
-  Mirage_impl_conduit.conduit Functoria.impl -> http Functoria.impl
+val cohttp_client :
+  ?pclock:Mirage_impl_pclock.pclock impl ->
+  Mirage_impl_resolver.resolver impl ->
+  Mirage_impl_conduit.conduit impl ->
+  http_client impl

lib/mirage/impl/mirage_impl_ip.ml

@@ -49,12 +49,8 @@ let ( @?? ) x y = opt_map Key.v x @? y
 
 (* convenience function for linking tcpip.unix for checksums *)
 let right_tcpip_library ?libs ~sublibs pkg =
-  let min = "6.0.0" and max = "7.0.0" in
-  Key.match_ Key.(value target) @@ function
-  | #Mirage_key.mode_unix ->
-      [ package ~min ~max ?libs ~sublibs:("unix" :: sublibs) pkg ]
-  | #Mirage_key.mode_xen | #Mirage_key.mode_solo5 ->
-      [ package ~min ~max ?libs ~sublibs pkg ]
+  let min = "6.1.0" and max = "7.0.0" in
+  Key.pure [ package ~min ~max ?libs ~sublibs pkg ]
 
 let ipv4_keyed_conf ~ip ?gateway ?no_init () =
   let packages_v = right_tcpip_library ~sublibs:[ "ipv4" ] "tcpip" in

lib/mirage/impl/mirage_impl_random.ml

@@ -9,7 +9,7 @@ let random = Type.v RANDOM
 let rng ?(time = default_time) ?(mclock = default_monotonic_clock) () =
   let keys = [ Mirage_key.(v prng) ] in
   let packages =
-    [ package ~min:"0.8.0" ~max:"0.9.0" "mirage-crypto-rng-mirage" ]
+    [ package ~min:"0.8.0" ~max:"0.10.0" "mirage-crypto-rng-mirage" ]
   in
   let connect _ modname _ =
     (* here we could use the boot argument (--prng) to select the RNG! *)

lib/mirage/impl/mirage_impl_resolver.ml

@@ -14,7 +14,7 @@ let resolver_unix_system =
   let packages_v =
     Key.(if_ is_unix)
       [
-        Mirage_impl_conduit_connector.pkg;
+        Mirage_impl_conduit.pkg;
         package ~min:"2.0.2" ~max:"3.0.0" "conduit-lwt-unix";
       ]
       []
@@ -28,23 +28,23 @@ let resolver_unix_system =
   impl ~packages_v ~configure ~connect "Resolver_lwt" resolver
 
 let resolver_dns_conf ~ns ~ns_port =
-  let packages = [ Mirage_impl_conduit_connector.pkg ] in
+  let packages = [ Mirage_impl_conduit.pkg ] in
   let keys = Key.[ v ns; v ns_port ] in
   let connect _ modname = function
     | [ _r; _t; _m; stack ] ->
         Fmt.strf
           "let ns = %a in@;\
            let ns_port = %a in@;\
-           let res = %s.R.init ~ns ~ns_port ~stack:%s () in@;\
+           let res = %s.v ~ns ~ns_port %s in@;\
            Lwt.return res@;"
           pp_key ns pp_key ns_port modname stack
     | _ -> failwith (connect_err "resolver" 3)
   in
-  impl ~packages ~keys ~connect "Resolver_mirage.Make_with_stack"
+  impl ~packages ~keys ~connect "Resolver_mirage.Make"
     (random @-> time @-> mclock @-> stackv4 @-> resolver)
 
 let resolver_dns ?ns ?ns_port ?(time = default_time)
-    ?(mclock = default_monotonic_clock) ?(random = rng ~time ~mclock ()) stack =
+    ?(mclock = default_monotonic_clock) ?(random = default_random) stack =
   let ns = Key.resolver ?default:ns ()
   and ns_port = Key.resolver_port ?default:ns_port () in
   resolver_dns_conf ~ns ~ns_port $ random $ time $ mclock $ stack

lib/mirage/impl/mirage_impl_stack.ml

@@ -37,7 +37,7 @@ let stackv4_direct_conf () =
     @-> stackv4 )
 
 let direct_stackv4 ?(mclock = default_monotonic_clock) ?(time = default_time)
-    ?(random = rng ~time ~mclock ()) network eth arp ip =
+    ?(random = default_random) network eth arp ip =
   stackv4_direct_conf ()
   $ time
   $ random

lib/mirage/impl/mirage_impl_tcp.ml

@@ -33,7 +33,7 @@ let tcp_direct_func () =
     (ip @-> time @-> mclock @-> random @-> tcp)
 
 let direct_tcp ?(mclock = default_monotonic_clock) ?(time = default_time)
-    ?(random = rng ~time ~mclock ()) ip =
+    ?(random = default_random) ip =
   tcp_direct_func () $ ip $ time $ mclock $ random
 
 let tcpv4_socket_conf ipv4_key =

lib/mirage/mirage.ml

@@ -307,6 +307,13 @@ let cohttp_server = Mirage_impl_http.cohttp_server
 
 let httpaf_server = Mirage_impl_http.httpaf_server
 
+
+type http_client = Mirage_impl_http.http_client
+
+let http_client = Mirage_impl_http.http_client
+
+let cohttp_client = Mirage_impl_http.cohttp_client
+
 type argv = Functoria.argv
 
 let argv = Functoria.argv

lib/mirage/mirage.mli

@@ -732,7 +732,8 @@ type conduit
 
 val conduit : conduit typ
 
-val conduit_direct : ?tls:bool -> stackv4 impl -> conduit impl
+val conduit_direct :
+  ?tls:bool -> ?random:random impl -> stackv4 impl -> conduit impl
 
 (** {2 HTTP configuration} *)
 
@@ -751,6 +752,14 @@ val cohttp_server : conduit impl -> http impl
 val httpaf_server : conduit impl -> http impl
 (** [httpaf_server] starts a http/af server. *)
 
+type http_client
+
+val http_client: http_client typ
+
+val cohttp_client:
+  ?pclock:pclock impl -> resolver impl -> conduit impl -> http_client impl
+(** [cohttp_server] starts a Cohttp server. *)
+
 (** {2 Argv configuration} *)
 
 type argv = Functoria.argv