src/env.ml

@@ -0,0 +1,7 @@
+type t = {
+  sw: Caqti_miou.Switch.t;
+  stack: Mnet.stack;
+  tcp: Mnet.TCP.state;
+  dns: Mnet_dns.t;
+  fs: Fat.t;
+}

src/global.ml

@@ -0,0 +1,27 @@
+(* IMPROVE: use caqti pool
+   [connect_pool] with parameter [?post_connect] for preflight *)
+let db_conn =
+  let f Env.{ sw; stack; tcp; dns; fs= _ } =
+    let db_uri = Config.Exchangedb_postgres.config in
+    match Caqti_mnet.connect ~sw stack tcp dns db_uri with
+    | Error err ->
+        Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+    | Ok conn ->
+        let () = Pg.preflight conn in
+        Logs.info (fun m -> m "database connection initialized");
+        conn
+  in
+  let finally (module Conn : Pg.CONN) = Conn.disconnect () in
+  Vifu.Device.v ~name:"db_conn" ~finally [] f
+
+let keys =
+  let f (module Conn : Pg.CONN) (env : Env.t) =
+    let (module Fs : Fat.FS) =
+      (module struct
+        let t = env.fs
+      end)
+    in
+    (module Keys.Make (Conn) (Fs) : Keys.S)
+  in
+  let finally _keys = () in
+  Vifu.Device.v ~name:"keys" ~finally [ Vifu.Device.value db_conn ] f

src/mte.ml

@@ -78,8 +78,7 @@ let () =
     let ipv4 = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24" in
     Mnet.stack ~name:"service" ipv4
   in
-  Mkernel.(run [ rng; storage; service ])
-  @@ fun rng storage (stack, tcp, udp) () ->
+  Mkernel.(run [ rng; storage; service ]) @@ fun rng fs (stack, tcp, udp) () ->
   let@ () = fun () -> Mirage_crypto_rng_mkernel.kill rng in
   let@ () = fun () -> Mnet.kill stack in
   let hed, he = Mnet_happy_eyeballs.create tcp in
@@ -87,37 +86,12 @@ let () =
   let dns = Mnet_dns.create (udp, he) in
   let t = Mnet_dns.transport dns in
   let@ () = fun () -> Mnet_dns.Transport.kill t in
-  (* -- *)
   Caqti_miou.Switch.run @@ fun sw ->
-  let db_conn =
-    let db_uri = Config.Exchangedb_postgres.config in
-    (* IMPROVE: use caqti pool
-       [connect_pool] with parameter [?post_connect] for preflight *)
-    match Caqti_mnet.connect ~sw stack tcp dns db_uri with
-    | Error err ->
-        Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
-    | Ok conn -> conn
-  in
-  let@ () =
-   fun () ->
-    let (module Conn : Pg.CONN) = db_conn in
-    Conn.disconnect ()
-  in
-  let () = Pg.preflight db_conn in
-  Logs.info (fun m -> m "database connection initialized");
-  (* -- *)
-  let keys : (module Keys.S) =
-    let (module Conn : Pg.CONN) = db_conn in
-    let (module Fs : Fat.FS) =
-      (module struct
-        let t = storage
-      end)
-    in
-    (module Keys.Make (Conn) (Fs))
-  in
   (* -- *)
+  let env = Env.{ sw; stack; tcp; dns; fs } in
+  let devices = Vifu.Devices.[ Global.db_conn; Global.keys ] in
   let cfg = Vifu.Config.v Config.Exchange.port in
-  Vifu.run ~cfg tcp routes (db_conn, keys)
+  Vifu.run ~cfg ~devices tcp routes env
 
 (*
   Miou_unix.run @@ fun () ->