working database~~

src/crypto.ml

@@ -11,10 +11,7 @@ module EddsaPublicKey = struct
 
   let to_octets t = pub_to_octets t
   let of_octets t = pub_of_octets t |> Result.get_ok
-
-  let bin =
-    let open Bin in
-    map (bytes 32) of_octets to_octets
+  let bin = Bin.map (Bin.bytes 32) of_octets to_octets
 
   let of_b32 s =
     let open Syntax in
@@ -37,10 +34,7 @@ module EddsaPrivateKey = struct
 
   let to_octets t = priv_to_octets t
   let of_octets t = priv_of_octets t |> Result.get_ok
-
-  let bin =
-    let open Bin in
-    map (bytes 32) of_octets to_octets
+  let bin = Bin.map (Bin.bytes 32) of_octets to_octets
 
   let of_b32 s =
     let open Syntax in
@@ -80,9 +74,7 @@ end = struct
         Fmt.failwith "EddsaSignature.of_octets failure: data is not 64 bytes."
     | true -> v
 
-  let bin =
-    let open Bin in
-    map (bytes 64) of_octets to_octets
+  let bin = Bin.map (Bin.bytes 64) of_octets to_octets
 
   let sign ~key s =
     (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)

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 () =
@@ -128,8 +128,8 @@ let () =
     { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
   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,83 +1,77 @@
-(* 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
 
+  (* TODO add a dune stanza like for prelude:
+     "(flags (:standard -open Prelude))" *)
   (* 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)
-end
+    custom ~encode ~decode int64
 
-open Crypto
-(*open Bin_type*)
-
-let amount_t : Amount.t Caqti_type.t =
+  let amount : Amount.t t =
     let open Amount in
-  Caqti_type.custom
+    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)
+      (t2 int64 int32)
 
-let eddsa_signature_t : EddsaSignature.t Caqti_type.t =
+  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
-  Caqti_type.custom
-    ~encode:(fun master_sig -> Ok (to_octets master_sig))
+    custom
+      ~encode:(fun v -> Ok (to_octets v))
       ~decode:(fun s -> Ok (of_octets s))
-    Caqti_type.octets
+      octets
 
-(* WIP: minimum db functions for basic /management *)
+  include Caqti_request.Infix
+end
 
-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_signkey ->
+    let Signkey.
+          { pub; stamp_start; stamp_expire; stamp_end; master_sig= _; sign= _ }
+        =
+      exchange_signkey
+    in
+    (*let master_sig = master_sig |> Option.get in*)
+    let master_sig = EddsaSignature.of_octets (String.make 64 'x') in
+    Conn.exec insert_signkey
+      (pub, stamp_start, stamp_expire, stamp_end, master_sig)
 
-(*
-
-enum GNUNET_DB_QueryStatus
-TEH_PG_activate_signing_key (
-  void *cls,
-  const struct TALER_ExchangePublicKeyP *exchange_pub,
-  const struct TALER_EXCHANGEDB_SignkeyMetaData *meta,
-  const struct TALER_MasterSignatureP *master_sig)
-{
-  struct PostgresClosure *pg = cls;
-  struct GNUNET_PQ_QueryParam iparams[] = {
-    GNUNET_PQ_query_param_auto_from_type (exchange_pub),
-    GNUNET_PQ_query_param_timestamp (&meta->start),
-    GNUNET_PQ_query_param_timestamp (&meta->expire_sign),
-    GNUNET_PQ_query_param_timestamp (&meta->expire_legal),
-    GNUNET_PQ_query_param_auto_from_type (master_sig),
-    GNUNET_PQ_query_param_end
-  };
-}
-*)
+(* WIP: minimum db functions for basic /management *)
 
 (* ----- *)
 
+let pg_todo () = assert false
 let lookup_signing_key = pg_todo
 let iterate_active_signkeys = pg_todo
 let insert_signkey_revocation = pg_todo