(* IMPROVE: use caqti pool [connect_pool] with parameter [?post_connect] for preflight *) let db_conn = let f Env.{ sw; stack; tcp; dns; fs= _ } = Logs.info (fun m -> m "Connecting to database ..."); 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 -> Logs.info (fun m -> m "... connection done."); let () = Pg.preflight conn in Logs.info (fun m -> m "Preflight done."); 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