diff --git a/src/database.ml b/src/database.ml index b4121bcc..06395022 100644 --- a/src/database.ml +++ b/src/database.ml @@ -26,4 +26,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 pool = Vif.Server.device Devices.caqti server in + let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in + let exchange_public_key = secmod_signkey.sm_key in + let fn = Pg.activate_signing_key exchange_public_key in + match Caqti_miou_unix.Pool.use fn pool 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 diff --git a/src/mte.ml b/src/mte.ml index b7e7e153..b7893b3b 100644 --- a/src/mte.ml +++ b/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 () = diff --git a/src/pg.ml b/src/pg.ml index c38a0fd9..e852ee2b 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -1,6 +1,8 @@ +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))" *) + module Caqti_type = struct include Caqti_type @@ -13,9 +15,11 @@ module Caqti_type = struct end open Crypto -(*open Bin_type*) -let amount_t : Amount.t Caqti_type.t = +(*open Bin_type*) +open Caqti_request.Infix + +let amount : Amount.t Caqti_type.t = let open Amount in Caqti_type.custom ~encode:(fun amount -> Ok (amount.value, amount.fraction)) @@ -23,37 +27,50 @@ let amount_t : Amount.t Caqti_type.t = Amount.make ~sign:None ~currency:Config.currency ~value ~fraction) Caqti_type.(t2 int64 int32) -let eddsa_signature_t : EddsaSignature.t Caqti_type.t = +let eddsa_public : EddsaPublicKey.t Caqti_type.t = + let open EddsaPublicKey in + Caqti_type.custom + ~encode:(fun v -> Ok (to_octets v)) + ~decode:(fun v -> Ok (of_octets v)) + Caqti_type.octets + +let eddsa_signature : EddsaSignature.t Caqti_type.t = let open EddsaSignature in Caqti_type.custom - ~encode:(fun master_sig -> Ok (to_octets master_sig)) + ~encode:(fun v -> Ok (to_octets v)) ~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 (exchange_public_key : Signkey.t) (module Conn : Caqti_miou.CONNECTION) -> + 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 +95,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