add caqti device

dune-project

@@ -24,6 +24,9 @@
  (depends
    (ocaml (>= 5.3))
    base32
+   caqti
+   caqti-miou
+   caqti-driver-pgx
    crunch
    vif
    jsont

mte.opam

@@ -11,6 +11,9 @@ depends: [
   "dune" {>= "3.20"}
   "ocaml" {>= "5.3"}
   "base32"
+  "caqti"
+  "caqti-miou"
+  "caqti-driver-pgx"
   "crunch"
   "vif"
   "jsont"

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,26 @@ module Secmod_eddsa = struct
   let key_dir = Fpath.(v "eddsa")
 end
 
+module Exchangedb = struct
+  let idle_reserve_expiration_time = dummy_duration
+  let legal_reserve_expiration_time = dummy_duration
+  let aggregator_shift = dummy_duration
+  let default_purse_limit = 9999
+  let max_aml_program_runtime = dummy_duration
+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.
     {

src/database.ml

@@ -0,0 +1,25 @@
+(* TODO
+   GNU Taler db-events
+   https://git.gnunet.org/gana.git/tree/gnu-taler-db-events/registry.rec *)
+
+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

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

src/dune

@@ -14,6 +14,10 @@
   ;
   include
   ;
+  caqti
+  caqti-miou
+  caqti-miou.unix
+  caqti-driver-pgx
   bin
   angstrom
   zarith ;

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
+  Caqti_miou.Switch.run @@ fun caqti_switch ->
-  let devices = Vif.Devices.[ Devices.secmod_signkey; Devices.secmod_denom ] in
+  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