working database~~

src/database.ml

@@ -1,17 +1,16 @@
 (* TODO
-   - pg.ml
-   - preflight
    - GNU Taler db-events?
-   https://git.gnunet.org/gana.git/tree/gnu-taler-db-events/registry.rec *)
+     it seems caqti/pgx does not support it *)
 
 let test req server _ =
-  let pool = Vif.Server.device Devices.caqti server in
+  let (module Conn : Caqti_miou.CONNECTION) =
+    Vif.Server.device Devices.db_connection 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
+  match Conn.find query () with
   | Ok n ->
       let open Vif.Response.Syntax in
       let* () =
@@ -26,4 +25,24 @@ let test req server _ =
       let* () = Vif.Response.with_string req str in
       Vif.Response.respond `Internal_server_error
 
-let init = test
+let test_activate req server _ =
+  (*let (module Conn : Caqti_miou.CONNECTION) =*)
+  let db_conn = Vif.Server.device Devices.db_connection server in
+  let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in
+  let exchange_public_key = secmod_signkey.sm_key in
+  match Pg.activate_signing_key db_conn exchange_public_key with
+  | Ok () ->
+      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 "activate_signing_key done~~@.")
+      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

@@ -36,13 +36,15 @@ 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
+let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
+  let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
+  Vif.Device.v ~name:"db_connection" ~finally []
+  @@ fun { caqti_switch; db_uri } ->
+  match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
   | Error err ->
       Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
-  | Ok pool -> pool
+  | Ok conn -> (
+      match Pg.preflight conn with
+      | Error err ->
+          Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
+      | Ok () -> conn)

src/mte.ml

@@ -113,7 +113,7 @@ let routes =
     get (rel / "privacy" /?? nil) --> Static.privacy;
     get (rel / "management" / "keys" /?? nil) --> Management.keys;
     get (rel / "db_test" /?? nil) --> Database.test;
-    get (rel / "db_init" /?? nil) --> Database.init;
+    get (rel / "db_activate" /?? nil) --> Database.test_activate;
   ]
 
 let () =
@@ -129,7 +129,8 @@ let () =
   in
   let devices =
     (* todo: rm unneeded env parameter from secmod devices *)
-    Vif.Devices.[ Devices.secmod_signkey; Devices.secmod_denom; Devices.caqti ]
+    Vif.Devices.
+      [ Devices.secmod_signkey; Devices.secmod_denom; Devices.db_connection ]
   in
   let middlewares = Vif.Middlewares.[] in
   Vif.run ~cfg ~devices ~middlewares routes env

src/pg.ml

@@ -1,59 +1,75 @@
+type pool = (Caqti_miou.connection, Caqti_error.t) Caqti_miou_unix.Pool.t
 (* TODO be sure to not use postgres ptime
    add a dune stanza like for prelude:
    "(flags (:standard -open Prelude))" *)
+
+open Crypto
+
 module Caqti_type = struct
   include Caqti_type
 
   (* we want to use int64 timestamps,
      not postgresql built-in timestamp type *)
-  let ptime : Ptime.t Caqti_type.t =
+  let ptime : Ptime.t t =
     let encode i = Ok (Util.ptime_to_int64 i) in
     let decode = Util.ptime_of_int64 in
-    Caqti_type.custom ~encode ~decode Caqti_type.(int64)
+    custom ~encode ~decode int64
+
+  let amount : Amount.t t =
+    let open Amount in
+    custom
+      ~encode:(fun amount -> Ok (amount.value, amount.fraction))
+      ~decode:(fun (value, fraction) ->
+        Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
+      (t2 int64 int32)
+
+  let eddsa_public : EddsaPublicKey.t t =
+    let open EddsaPublicKey in
+    custom
+      ~encode:(fun v -> Ok (to_octets v))
+      ~decode:(fun v -> Ok (of_octets v))
+      octets
+
+  let eddsa_signature : EddsaSignature.t t =
+    let open EddsaSignature in
+    custom
+      ~encode:(fun v -> Ok (to_octets v))
+      ~decode:(fun s -> Ok (of_octets s))
+      octets
+
+  include Caqti_request.Infix
 end
 
-open Crypto
-(*open Bin_type*)
-
-let amount_t : Amount.t Caqti_type.t =
-  let open Amount in
-  Caqti_type.custom
-    ~encode:(fun amount -> Ok (amount.value, amount.fraction))
-    ~decode:(fun (value, fraction) ->
-      Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
-    Caqti_type.(t2 int64 int32)
-
-let eddsa_signature_t : EddsaSignature.t Caqti_type.t =
-  let open EddsaSignature in
-  Caqti_type.custom
-    ~encode:(fun master_sig -> Ok (to_octets master_sig))
-    ~decode:(fun s -> Ok (of_octets s))
-    Caqti_type.octets
-
 (* WIP: minimum db functions for basic /management *)
 
-let pg_todo () = assert false
-
-open Caqti_request.Infix
-
-(* signkey *)
-(* todo:
-     - what type to use for TALER_ExchangePublicKeyP + TALER_EXCHANGEDB_SignkeyMetaData
-       -> I think it could be something = to FutureSignKey.t
-     - master signature: over smthing? *)
-let activate_signing_key _cls (exchange_public_key : Signkey.t) =
-  (*let open Bin_type in*)
-  let _exchange_pub = EddsaPublicKey.(to_octets exchange_public_key.pub) in
-  let _master_sig =
-    exchange_public_key.master_sig |> Option.get
-    (*|> EddsaSignature.to_octets*)
+let preflight =
+  let l =
+    List.map
+      Caqti_type.(unit ->. unit)
+      [
+        "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
+         SERIALIZABLE;"; "SET enable_sort=OFF;"; "SET enable_seqscan=OFF;";
+        "SET enable_mergejoin=OFF;"; "SET search_path TO exchange;";
+      ]
   in
-  let _insert_signkey =
-    Caqti_type.(t5 string ptime ptime ptime string ->! int)
+  fun (module Conn : Caqti_miou.CONNECTION) ->
+    Syntax.list_iter (fun p -> Conn.exec p ()) l
+
+let activate_signing_key =
+  let insert_signkey =
+    Caqti_type.(t5 eddsa_public ptime ptime ptime eddsa_signature ->. unit)
       "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
        expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5);"
   in
-  pg_todo ()
+  fun (module Conn : Caqti_miou.CONNECTION) (exchange_public_key : Signkey.t) ->
+    let exchange_pub = exchange_public_key.pub in
+    let valid_from = exchange_public_key.stamp_start in
+    let expire_sign = exchange_public_key.stamp_expire in
+    let expire_legal = exchange_public_key.stamp_end in
+    (*let master_sig = exchange_public_key.master_sig |> Option.get in*)
+    let master_sig = EddsaSignature.of_octets (String.make 64 'x') in
+    Conn.exec insert_signkey
+      (exchange_pub, valid_from, expire_sign, expire_legal, master_sig)
 
 (*
 
@@ -78,6 +94,7 @@ TEH_PG_activate_signing_key (
 
 (* ----- *)
 
+let pg_todo () = assert false
 let lookup_signing_key = pg_todo
 let iterate_active_signkeys = pg_todo
 let insert_signkey_revocation = pg_todo