From 2cd4a6e88e85bb53a6c5c744628075822a3be7a7 Mon Sep 17 00:00:00 2001
From: swrup <swrup@protonmail.com>
Date: Tue, 11 Nov 2025 03:12:12 +0100
Subject: [PATCH]

---
 dune-project    |  3 +++
 mte.opam        |  3 +++
 src/config.ml   | 14 +++++++++++++-
 src/database.ml | 21 +++++++++++++++++++++
 src/devices.ml  | 20 ++++++++++++++++++--
 src/dune        |  4 ++++
 src/mte.ml      | 10 ++++++++--
 7 files changed, 70 insertions(+), 5 deletions(-)
 create mode 100644 src/database.ml

diff --git a/dune-project b/dune-project
index ee37f18e..163a239d 100644
--- a/dune-project
+++ b/dune-project
@@ -24,6 +24,9 @@
  (depends
    (ocaml (>= 5.3))
    base32
+   caqti
+   caqti-miou
+   caqti-driver-pgx
    crunch
    vif
    jsont
diff --git a/mte.opam b/mte.opam
index bf5ea8eb..1c4d5904 100644
--- a/mte.opam
+++ b/mte.opam
@@ -11,6 +11,9 @@ depends: [
   "dune" {>= "3.20"}
   "ocaml" {>= "5.3"}
   "base32"
+  "caqti"
+  "caqti-miou"
+  "caqti-driver-pgx"
   "crunch"
   "vif"
   "jsont"
diff --git a/src/config.ml b/src/config.ml
index 0ebe218b..926c73ae 100644
--- a/src/config.ml
+++ b/src/config.ml
@@ -9,7 +9,7 @@ module Exchange = struct
   let currency_round_unit = amount "EUR:0.01"
   let db = "postgres"
   let attribute_encryption_key = "uhuhg" (* high-entropy nonce. *)
-  let port = 3696
+  let port = 3434
 
   let master_public_key =
     "8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90===="
@@ -57,6 +57,18 @@ module Secmod_eddsa = struct
   let key_dir = Fpath.(v "eddsa")
 end
 
+module Exchangedb_postgres = struct
+  (* pgx://<user>:<password>@<host-or-directory>:<port>/<database> *)
+  let config =
+    let user = "mte" in
+    let password = "hunter2" in
+    let host = "localhost" in
+    let port = 5432 in
+    let database = "taler-exchange" in
+    Uri.of_string
+    @@ Fmt.str "pgx://%s:%s@%s:%d/%s" user password host port database
+end
+
 let coin_kudo_1 =
   Types.Config_types.Coin.
     {
diff --git a/src/database.ml b/src/database.ml
new file mode 100644
index 00000000..a9753418
--- /dev/null
+++ b/src/database.ml
@@ -0,0 +1,21 @@
+let test req server _ =
+  let pool = Vif.Server.device Devices.caqti server in
+  let query =
+    let open Caqti_request.Infix in
+    Caqti_type.(unit ->! int) "SELECT 53 - 11"
+  in
+  let fn (module Conn : Caqti_miou.CONNECTION) = Conn.find query () in
+  match Caqti_miou_unix.Pool.use fn pool with
+  | Ok n ->
+      let open Vif.Response.Syntax in
+      let* () =
+        Vif.Response.add ~field:"content-type" "text/plain; charset= utf-8"
+      in
+      let* () = Vif.Response.with_string req (Fmt.str "53 - 11 = %d@." n) in
+      Vif.Response.respond `OK
+  | Error err ->
+      (* TODO don't leak private data in error messages *)
+      let open Vif.Response.Syntax in
+      let str = Fmt.str "Database error: %a." Caqti_error.pp err in
+      let* () = Vif.Response.with_string req str in
+      Vif.Response.respond `Internal_server_error
diff --git a/src/devices.ml b/src/devices.ml
index bf79bf01..a61b563b 100644
--- a/src/devices.ml
+++ b/src/devices.ml
@@ -1,5 +1,10 @@
 (* TODO KV store *)
 
+type env = {
+  caqti_switch: Caqti_miou.Switch.t;
+  db_uri: Uri.t;
+}
+
 module Secmod_signkey = struct
   type t = {
     sm_key: Signkey.t;
@@ -8,7 +13,7 @@ module Secmod_signkey = struct
 
   let v =
     let finally _key = () in
-    Vif.Device.v ~name:"secmod_signkey" ~finally [] @@ fun () ->
+    Vif.Device.v ~name:"secmod_signkey" ~finally [] @@ fun (_env : env) ->
     let sm_key = Signkey.generate () in
     let keys = [ Signkey.generate () ] in
     { sm_key; keys }
@@ -22,7 +27,7 @@ module Secmod_denom = struct
 
   let v =
     let finally _key = () in
-    Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun () ->
+    Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
     let sm_key = Signkey.generate () in
     let keys = List.map Denomination.make Config.coins in
     { sm_key; keys }
@@ -30,3 +35,14 @@ end
 
 let secmod_signkey = Secmod_signkey.v
 let secmod_denom = Secmod_denom.v
+
+let caqti :
+    ( env,
+      (Caqti_miou.connection, Caqti_error.t) Caqti_miou_unix.Pool.t )
+    Vif.Device.device =
+  let finally pool = Caqti_miou_unix.Pool.drain pool in
+  Vif.Device.v ~name:"caqti" ~finally [] @@ fun { caqti_switch; db_uri } ->
+  match Caqti_miou_unix.connect_pool ~sw:caqti_switch db_uri with
+  | Error err ->
+      Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+  | Ok pool -> pool
diff --git a/src/dune b/src/dune
index 8126b6ec..18668575 100644
--- a/src/dune
+++ b/src/dune
@@ -14,6 +14,10 @@
   ;
   include
   ;
+  caqti
+  caqti-miou
+  caqti-miou.unix
+  caqti-driver-pgx
   bin
   angstrom
   zarith ;
diff --git a/src/mte.ml b/src/mte.ml
index d4b4a2e2..15220878 100644
--- a/src/mte.ml
+++ b/src/mte.ml
@@ -113,6 +113,7 @@ let routes =
     get (rel /?? nil) --> hello; get (rel / "terms" /?? nil) --> Static.terms;
     get (rel / "privacy" /?? nil) --> Static.privacy;
     get (rel / "management" / "keys" /?? nil) --> Management.keys;
+    get (rel / "db" /?? nil) --> Database.test;
   ]
 
 let () =
@@ -122,7 +123,12 @@ let () =
     Vif.config sockaddr
   in
   Miou_unix.run @@ fun () ->
-  let env = () in
-  let devices = Vif.Devices.[ Devices.secmod_signkey; Devices.secmod_denom ] in
+  Caqti_miou.Switch.run @@ fun caqti_switch ->
+  let env : Devices.env =
+    { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
+  in
+  let devices =
+    Vif.Devices.[ Devices.secmod_signkey; Devices.secmod_denom; Devices.caqti ]
+  in
   let middlewares = Vif.Middlewares.[] in
   Vif.run ~cfg ~devices ~middlewares routes env