diff --git a/src/mte_device.ml b/src/mte_device.ml index 1a4b1045..3398534a 100644 --- a/src/mte_device.ml +++ b/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 diff --git a/src/pg.ml b/src/pg.ml index c4331ed3..c567363b 100644 --- a/src/pg.ml +++ b/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)