test db conn after connect_pool

src/mte_device.ml

@@ -14,11 +14,15 @@ let pool : (Env.t, Pg.pool) Vifu.Device.device =
     let db_uri = Config.Exchangedb_postgres.config in
     let post_connect conn = Pg.preflight conn in
     match Caqti_mnet.connect_pool ~post_connect ~sw stack tcp dns db_uri with
-    | Error err ->
-        Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
-    | Ok pool ->
-        Logs.info (fun m -> m "Database connection done");
-        pool
+    | Error e ->
+        Fmt.failwith "Database pool connection failure: %a." Caqti_error.pp e
+    | Ok pool -> (
+        match Pg.use_pool pool Pg.test_conn with
+        | Error e ->
+            Fmt.failwith "Database connection failure: %a." Result.pp_err e
+        | Ok () ->
+            Logs.info (fun m -> m "Database connection done");
+            pool)
   in
   let finally pool = Caqti_mnet.Pool.drain pool in
   Vifu.Device.v ~name:"pool" ~finally [] f

src/pg.ml

@@ -32,6 +32,14 @@ let preflight =
   in
   fun conn -> Syntax.list_iter (fun p -> exec conn p ()) l
 
+let test_conn =
+  let req = (t2 int int ->! int) "SELECT ? - ?" in
+  fun conn ->
+    find conn req (1, 1)
+    |> Result.map (fun i ->
+        assert (i = 0);
+        ())
+
 let find_signkey =
   let req =
     (eddsa_pub ->? signkey)