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,30 @@
+(* 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
+
+
+
+  (* (module Keys.S) *)
+  let f (env : Env.t) =
+    let (module Conn : Pg.CONN) = db_conn in
+    let (module Fs : Fat.FS) =
+      (module struct
+        let t = env.fs
+      end)
+    in
+    (module Keys.Make (Conn) (Fs))
+  in
+  let finally _keys = () in
+  Vifu.Device.v ~name:"keys" ~finally [] f

src/mte.ml

@@ -89,32 +89,6 @@ let () =
   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 cfg = Vifu.Config.v Config.Exchange.port in
   Vifu.run ~cfg tcp routes (db_conn, keys)