From b98a8187930951b7443cfc010663694eed159fda Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 21 Feb 2026 23:32:20 +0100 Subject: [PATCH] better secmod --- default/assets/mte.conf | 10 +- src/config.ml | 28 +- src/crypto.ml | 32 +- src/devices.ml | 8 +- src/{http_information.ml => http_info.ml} | 29 +- src/http_management.ml | 237 ++++++----- src/keys.ml | 328 +++++++++++++++ src/mte.ml | 8 +- src/pg.ml | 120 +++--- src/secmod.ml | 478 ---------------------- src/secmod.mli | 45 -- src/secmod_eddsa.ml | 245 +++++++++++ src/secmod_rsa.ml | 254 ++++++++++++ src/signatures.ml | 91 ++-- src/syntax.ml | 2 + src/time.mli | 1 + src/util.ml | 4 +- tools/offline_impl.ml | 122 +++--- 18 files changed, 1166 insertions(+), 876 deletions(-) rename src/{http_information.ml => http_info.ml} (90%) create mode 100644 src/keys.ml delete mode 100644 src/secmod.ml delete mode 100644 src/secmod.mli create mode 100644 src/secmod_eddsa.ml create mode 100644 src/secmod_rsa.ml diff --git a/default/assets/mte.conf b/default/assets/mte.conf index a6c89c52..c401d5f3 100644 --- a/default/assets/mte.conf +++ b/default/assets/mte.conf @@ -41,11 +41,17 @@ config = "pgx://mte:hunter2@localhost:5432/taler-exchange" [taler-exchange-secmod-rsa] lookahead_sign = "1 year" -overlap_duration = "1 year" +overlap_duration = "1 hour" +duration = "3 weeks" +key_dir = "secrets/secmod_rsa" +sm_priv_key = "secrets/secmod_rsa/sm_key" [taler-exchange-secmod-eddsa] lookahead_sign = "1 year" -overlap_duration = "1 year" +overlap_duration = "1 hour" +duration = "3 weeks" +key_dir = "secrets/secmod_eddsa" +sm_priv_key = "secrets/secmod_eddsa/sm_key" [coin_kudo_1] value= EUR:0.01 diff --git a/src/config.ml b/src/config.ml index 21666cf7..b4aebab2 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,8 +1,9 @@ open Parse_config let config_filename = "mte.conf" -let secrets_dir = Fpath.v "secrets" -let secmod_dir = Fpath.(secrets_dir / "secmod") + +(* TODO config + read Fpath.t *) let config_data = match Assets_crunch.read config_filename with @@ -187,7 +188,25 @@ module Exchange_secmod_rsa = struct let lookahead_sign = get "lookahead_sign" |> duration let overlap_duration = get "overlap_duration" |> duration - (* not relevant: sm_priv_key key_dir unixpath *) + let duration = get "duration" |> duration + let key_dir = get "key_dir" + let sm_priv_key = get "sm_priv_key" + + (* only support one rsa_keysize *) + let rsa_keysize = + Coin.all_coins + |> List.map (fun coin -> coin.Coin.rsa_keysize) + |> List.sort_uniq Int.compare + |> function + | [] -> fail "no coin section found" + | a :: b :: _ -> + fail + "coins with different rsa_keysize are not supported, found \ + rsa_keysize = %d and %d" + a b + | n :: [] -> n + + let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name) end module Exchange_secmod_eddsa = struct @@ -197,6 +216,9 @@ module Exchange_secmod_eddsa = struct let lookahead_sign = get "lookahead_sign" |> duration let overlap_duration = get "overlap_duration" |> duration + let duration = get "duration" |> duration + let key_dir = get "key_dir" + let sm_priv_key = get "sm_priv_key" end (* -- *) diff --git a/src/crypto.ml b/src/crypto.ml index aac1d07d..4ce582f9 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -119,6 +119,7 @@ module EddsaPrivateKey = struct type t = priv + let generate = generate let pub_of_priv = pub_of_priv let to_octets t = priv_to_octets t @@ -159,37 +160,35 @@ end = struct binary-encoded objects with just the R and S values *) type t = string - (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *) + (* mirage_crypto: + "The result is the concatenation of r and s, as specified in RFC 8032." *) let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s let verify ~key s ~msg = let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in match b with - | false -> Error "signature verification failure: invalid signature" + | false -> Error "EddsaSignature verification: invalid signature" | true -> Ok () let to_octets t = t + let check_size t = + match String.length t = 64 with + | false -> Error "EddsaSignature of_octets: data is not 64 bytes." + | true -> Ok () + let of_octets v = - match String.length v = 64 with - | false -> - Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes." - | true -> Ok v + let+ () = check_size v in + v let bin = let of_octets_exn t = of_octets t |> Result.get_ok in Bin.map (Bin.bytes 64) of_octets_exn to_octets - let check_size t = - match String.length t = 64 with - | false -> Error "EddsaSignature: invalid string length" - | true -> Ok () - let jsont = let of_b32 s = let* t = B32.decode s in - let+ () = check_size t in - t + of_octets t in let to_b32 = B32.encode in Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32 @@ -208,6 +207,7 @@ module RsaPublicKey = struct let to_octets = Binary_format_rsa.pub_to_octets let of_octets = Binary_format_rsa.pub_of_octets + let to_b32 t = B32.encode (to_octets t) let jsont = let of_b32 s = @@ -215,7 +215,6 @@ module RsaPublicKey = struct let+ v = of_octets s in v in - let to_b32 t = B32.encode (to_octets t) in Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 let caqti : t Caqti_type.t = @@ -253,9 +252,14 @@ module RsaSignature : sig type t val jsont : t Jsont.t + val sign : key:RsaPrivateKey.t -> string -> t end = struct type t = string + (* TODO crypto + this is a placeholder signature algorithm *) + let sign ~key s = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key s + let jsont = let of_b32 s = B32.decode s in let to_b32 t = B32.encode t in diff --git a/src/devices.ml b/src/devices.ml index 7da26428..15c6d389 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -18,9 +18,9 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device = Logs.info (fun m -> m "database connection initialized"); conn) -let secmod = +let keys = let finally _key = () in - Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ] + Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] @@ fun (module Conn : Pg.CONN) (_env : env) -> - let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in - sm + let keys : (module Keys.S) = (module Keys.Make (Conn)) in + keys diff --git a/src/http_information.ml b/src/http_info.ml similarity index 90% rename from src/http_information.ml rename to src/http_info.ml index 17186d5a..9f2f73d9 100644 --- a/src/http_information.ml +++ b/src/http_info.ml @@ -59,7 +59,7 @@ let denomgroup_of_denomdata RsaDenomGroup. { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } -let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = +let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = let version = Api.protocol_version in let base_url = Config.base_url in let currency = Config.currency in @@ -88,7 +88,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = (* todo asset_type Type of the asset. "fiat", "crypto", "regional" or "stock". *) let asset_type = "xxx" in - let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in + let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in let* wire_fees = (* todo where does wire_methods comes from? *) @@ -111,13 +111,12 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = let wallet_balance_limit_without_kyc = None in let hard_limits = [] in let zero_limits = [] in - let dn_l = - (*Pg.get_denominations db_conn |> unwrap_err_caqti *) - Sm.get_denominations () - |> + let* dn_l = + let+ l = Keys.denominations () in (* reverse chronological order *) - List.sort (fun a b -> - Stdlib.compare b.Denomination.stamp_start a.stamp_start) + List.sort + (fun a b -> Stdlib.compare b.Denomination.stamp_start a.stamp_start) + l in let list_issue_date = match dn_l with @@ -147,11 +146,9 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = List.map denomgroup_of_denomdata l in - let signkeys = - (* - let now = Ptime_clock.now () |> Option.some in - let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*) - Sm.get_signkeys () + let* signkeys = + let+ l = Keys.signkeys () in + l |> List.sort (fun a b -> let open Signkey in Stdlib.compare b.stamp_start a.stamp_start) @@ -176,7 +173,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = |> Hash.H64.hash in let open Signatures.ExchangeKeySet in - sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc } + signf (Keys.sign exchange_pub) R.{ list_issue_date; hc } in let recoup = (* TODO /recoup *) [] in @@ -233,7 +230,7 @@ let jsont = ExchangeKeysResponse.jsont let keys req server _env = Logs.info (fun m -> m "GET /keys"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* last_issue_date = match Vif.Queries.get req "last_issue_date" with @@ -245,7 +242,7 @@ let keys req server _env = "invalid `?last_issue_date` query param, int_of_string failure" | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n)))) in - let* v = mk_keys ~db_conn sm ~last_issue_date in + let* v = mk_keys ~db_conn keys ~last_issue_date in let s = Api.encode_exn jsont v in Ok s in diff --git a/src/http_management.ml b/src/http_management.ml index 6e739205..a8dda624 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -3,28 +3,13 @@ open Api open Hash module Keys_get = struct - let mk_future_keys_response (module Sm : Secmod.S) = - let future_signkeys = Sm.get_future_signkeys () in - let future_denoms = Sm.get_future_denominations () in - let master_pub = Config.Exchange.master_public_key in - let denom_secmod_public_key = Sm.sm_pubkey in - let signkey_secmod_public_key = Sm.sm_pubkey in - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } - let jsont = FutureKeysResponse.jsont let f req server _env = Logs.info (fun m -> m "GET /management/keys/"); - let sm = Vif.Server.device Devices.secmod server in + let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in let res = - let v = mk_future_keys_response sm in + let* v = Keys.make_future_keys_response () in let s = Api.encode_exn jsont v in Ok s in @@ -32,70 +17,89 @@ module Keys_get = struct end module Keys_post = struct - let error_key_unknown = - "404 not found, One of the keys for which a signature was provided is \ - unknown to the exchange." - - let verify_denom_signature (module Sm : Secmod.S) - DenomSignature.{ h_denom_pub; master_sig } = - let* denom = - Sm.find_future_denomination h_denom_pub - |> Option.to_result ~none:error_key_unknown - in + let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig = + let open FutureDenom in let open Signatures.DenominationKeyValidity in - let r : r = + let r = { - master= Config.master_public_key; - start= denom.stamp_start; - expire_withdraw= denom.stamp_expire_withdraw; - expire_spend= denom.stamp_expire_deposit; - expire_legal= denom.stamp_expire_legal; - value= denom.value; - fee_withdraw= denom.fee_withdraw; - fee_deposit= denom.fee_deposit; - fee_refresh= denom.fee_refresh; - fee_refund= denom.fee_refund; - denom_hash= h_denom_pub; + R.master= Config.master_public_key; + start= fdn.stamp_start; + expire_withdraw= fdn.stamp_expire_withdraw; + expire_spend= fdn.stamp_expire_deposit; + expire_legal= fdn.stamp_expire_legal; + value= fdn.value; + fee_withdraw= fdn.fee_withdraw; + fee_deposit= fdn.fee_deposit; + fee_refresh= fdn.fee_refresh; + fee_refund= fdn.fee_refund; + denom_hash; } in - verify_f ~f:Sm.verify_with_master_key master_sig r + verify master_sig r - let verify_signkey_signature (module Sm : Secmod.S) - SignKeySignature.{ key; master_sig } = - let* signkey = - Sm.find_future_signkey key |> Option.to_result ~none:error_key_unknown + let verify_denom_sigs (module Keys : Keys.S) denom_sigs = + let* fdn_l = Keys.future_denominations () in + let fdn_l = + List.map + (fun fdn -> + let h_pub = + (* TODO DenominationHash.of_denom_pub *) + DenominationHash.hash + (DenominationKey.to_octets fdn.FutureDenom.denom_pub) + in + (h_pub, fdn)) + fdn_l in + list_iter + (fun DenomSignature.{ h_denom_pub; master_sig } -> + match List.assoc_opt h_denom_pub fdn_l with + | None -> Error "future denomination not found" + | Some fdn -> verify_dn (module Keys) fdn h_denom_pub master_sig) + denom_sigs + + let verify_sk (module Keys : Keys.S) + FutureSignKey. + { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } + master_sig = let open Signatures.ExchangeSigningKeyValidity in - let r : r = + let r = { - start= signkey.stamp_start; - expire= signkey.stamp_expire; - end_= signkey.stamp_end; - signkey_pub= signkey.key; + R.start= stamp_start; + expire= stamp_expire; + end_= stamp_end; + signkey_pub= key; } in - verify_f ~f:Sm.verify_with_master_key master_sig r + verify master_sig r - let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } = - let* () = list_iter (verify_denom_signature sm) denom_sigs in - let* () = list_iter (verify_signkey_signature sm) signkey_sigs in + let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs = + let* fsk_l = Keys.future_signkeys () in + list_iter + (fun SignKeySignature.{ key; master_sig } -> + match List.find_opt (fun sk -> sk.FutureSignKey.key = key) fsk_l with + | None -> Error "future signkey not found" + | Some fsk -> verify_sk (module Keys) fsk master_sig) + signkey_sigs + + let verify keys MasterSignatures.{ denom_sigs; signkey_sigs } = + let* () = verify_signkey_sigs keys signkey_sigs in + let* () = verify_denom_sigs keys denom_sigs in Ok () - let do_ ~db_conn:_ (module Sm : Secmod.S) + let do_ ~db_conn:_ (module Keys : Keys.S) MasterSignatures.{ denom_sigs; signkey_sigs } = let* () = list_iter (fun SignKeySignature.{ key; master_sig } -> - Sm.certify_future_signkey key ~master_sig) + Keys.certify_future_signkey key master_sig) signkey_sigs in let* () = list_iter (fun DenomSignature.{ h_denom_pub; master_sig } -> - Sm.certify_future_denomination h_denom_pub ~master_sig) + Keys.certify_future_denomination h_denom_pub master_sig) denom_sigs in - let* () = Sm.save () in Ok () let jsont = MasterSignatures.jsont @@ -103,80 +107,70 @@ module Keys_post = struct let f req server _env = Logs.info (fun m -> m "POST /management/keys/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in - let* () = do_ ~db_conn sm v in + let* () = verify keys v in + let* () = do_ ~db_conn keys v in Ok "" in Respond.result res req end module Denom_revoke = struct - let verify (module Sm : Secmod.S) h_denom_pub + let verify (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = let open Signatures.MasterDenominationKeyRevocation in - verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub } + verify master_sig { h_denom_pub } - let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub + let do_ (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = - let* () = Sm.revoke_denomination h_denom_pub master_sig in - let+ () = - Pg.insert_denomination_revocation db_conn h_denom_pub master_sig - |> unwrap_err_caqti - in + let+ () = Keys.revoke_denomination h_denom_pub master_sig in () let jsont = DenomRevocationSignature.jsont let f req h_denom_pub server _env = Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); - let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm h_denom_pub v in - let* () = do_ ~db_conn sm h_denom_pub v in + let* () = verify keys h_denom_pub v in + let* () = do_ keys h_denom_pub v in Ok "" in Respond.result res req end module Signkey_revoke = struct - let verify (module Sm : Secmod.S) exchange_pub + let verify (module Keys : Keys.S) exchange_pub SignkeyRevocationSignature.{ master_sig } = let open Signatures.MasterSigningKeyRevocation in - verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub } + verify master_sig { exchange_pub } - let do_ ~db_conn (module Sm : Secmod.S) exchange_pub + let do_ (module Keys : Keys.S) exchange_pub SignkeyRevocationSignature.{ master_sig } = - let* () = Sm.revoke_signkey exchange_pub master_sig in - let+ () = - Pg.insert_signkey_revocation db_conn exchange_pub master_sig - |> unwrap_err_caqti - in + let+ () = Keys.revoke_signkey exchange_pub master_sig in () let jsont = SignkeyRevocationSignature.jsont let f req exchange_pub server _env = Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); - let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm exchange_pub v in - let* () = do_ ~db_conn sm exchange_pub v in + let* () = verify keys exchange_pub v in + let* () = do_ keys exchange_pub v in Ok "" in Respond.result res req end module Auditors = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) AuditorSetupMessage. { auditor_url; @@ -186,7 +180,7 @@ module Auditors = struct validity_start; } = let open Signatures.MasterAddAuditor in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { start_date= validity_start; auditor_pub; @@ -218,11 +212,11 @@ module Auditors = struct let f req server _env = Logs.info (fun m -> m "POST /management/auditors/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -230,11 +224,10 @@ module Auditors = struct end module Auditors_disable = struct - let verify (module Sm : Secmod.S) auditor_pub + let verify (module Keys : Keys.S) auditor_pub AuditorTeardownMessage.{ master_sig; validity_end } = let open Signatures.MasterDelAuditor in - verify_f ~f:Sm.verify_with_master_key master_sig - { end_date= validity_end; auditor_pub } + verify master_sig { end_date= validity_end; auditor_pub } let do_ ~db_conn auditor_pub AuditorTeardownMessage.{ master_sig= _; validity_end } = @@ -258,12 +251,12 @@ module Auditors_disable = struct let f req auditor_pub server _env = Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm auditor_pub v in + let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in Ok "" in @@ -271,7 +264,7 @@ module Auditors_disable = struct end module Wire_fee = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireFeeSetupMessage. { wire_method; @@ -282,7 +275,7 @@ module Wire_fee = struct wire_fee; } = let open Signatures.MasterWireFee in - verify_f ~f:Sm.verify_with_master_key master_sig_wire + verify master_sig_wire { h_wire_method= Hash.Cstring.H64.hash wire_method; start_date= fee_start; @@ -318,11 +311,11 @@ module Wire_fee = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire-fee/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -330,7 +323,7 @@ module Wire_fee = struct end module Global_fees = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) GlobalFees. { start_date; @@ -344,7 +337,7 @@ module Global_fees = struct master_sig; } = let open Signatures.GlobalFees in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { start_date; end_date; @@ -389,11 +382,11 @@ module Global_fees = struct and once set for a timeframe, it should not change. *) let f req server _env = Logs.info (fun m -> m "POST /management/global-fees/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -401,7 +394,7 @@ module Global_fees = struct end module Wire = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireSetupMessage. { payto_uri; @@ -417,7 +410,7 @@ module Wire = struct let debit_restrictions = "" in let* () = let open Signatures.MasterWireDetails in - verify_f ~f:Sm.verify_with_master_key master_sig_wire + verify master_sig_wire { h_wire_details= FullPaytoHash.hash payto_uri; h_conversion_url= Hash.Cstring.H64.hash conversion_url; @@ -427,7 +420,7 @@ module Wire = struct in let* () = let open Signatures.MasterAddWire in - verify_f ~f:Sm.verify_with_master_key master_sig_add + verify master_sig_add { start_date= validity_start; h_wire= FullPaytoHash.hash payto_uri; @@ -468,11 +461,11 @@ module Wire = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -480,10 +473,10 @@ module Wire = struct end module Wire_disable = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } = let open Signatures.MasterDelWire in - verify_f ~f:Sm.verify_with_master_key master_sig_del + verify master_sig_del { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri } let do_ ~db_conn @@ -503,11 +496,11 @@ module Wire_disable = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/disable/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -515,7 +508,7 @@ module Wire_disable = struct end module Drain = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) DrainProfitsMessage. { debit_account_section; @@ -526,7 +519,7 @@ module Drain = struct amount; } = let open Signatures.MasterDrainProfit in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { wtid; date; @@ -543,11 +536,11 @@ module Drain = struct let f req server _env = Logs.info (fun m -> m "POST /management/drain/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -555,7 +548,7 @@ module Drain = struct end module AmlOfficer = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) AmlOfficerSetup. { officer_pub; @@ -567,7 +560,7 @@ module AmlOfficer = struct } = let open Signatures.MasterAmlOfficerStatus in let is_active = match is_active with true -> 1_l | false -> 0_l in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { change_date; officer_pub; @@ -583,11 +576,11 @@ module AmlOfficer = struct let f req server _env = Logs.info (fun m -> m "POST /management/aml-officers/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -595,7 +588,7 @@ module AmlOfficer = struct end module Partners = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) ExchangePartnerSetupRequest. { partner_base_url; @@ -607,7 +600,7 @@ module Partners = struct wad_fee; } = let open Signatures.PartnerConfiguration in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { partner_pub; start_date; @@ -625,11 +618,11 @@ module Partners = struct let f req server _env = Logs.info (fun m -> m "POST /management/partners/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in diff --git a/src/keys.ml b/src/keys.ml new file mode 100644 index 00000000..69721fec --- /dev/null +++ b/src/keys.ml @@ -0,0 +1,328 @@ +open Syntax +open Crypto + +(* TODO better error type *) +type 'a result = ('a, string) Result.t + +module type S = sig + val sign : eddsa_pub -> string -> eddsa_sig + val sign_denom : rsa_pub -> string -> rsa_sig + val find_signkey : eddsa_pub -> Signkey.t option result + val find_denomination : denom_hash -> Denomination.t option result + val signkeys : unit -> Signkey.t list result + val denominations : unit -> Denomination.t list result + val future_signkeys : unit -> Api.FutureSignKey.t list result + val future_denominations : unit -> Api.FutureDenom.t list result + val make_future_keys_response : unit -> Api.FutureKeysResponse.t result + + val certify_future_signkey : + eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result + + val certify_future_denomination : + denom_hash -> Signatures.DenominationKeyValidity.t -> unit result + + val revoke_signkey : + eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result + + val revoke_denomination : + denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result +end + +module Make (Conn : Pg.CONN) : S = struct + module Sm_eddsa = Secmod_eddsa.Make () + module Sm_rsa = Secmod_rsa.Make () + + let conn = (module Conn : Pg.CONN) + + (* TODO + error "key not found", either: + - we tried to sign with a key that is not ours + - key was revoked + - bad keyring state *) + let sign pub s = + match Sm_eddsa.sign pub s with + | Error e -> Fmt.failwith "sign failure: %s." e + | Ok v -> v + + let sign_denom pub s = + match Sm_rsa.sign pub s with + | Error e -> Fmt.failwith "sign_denom failure: %s." e + | Ok v -> v + + (* - *) + let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti + let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti + + (* TODO + check if database is coherent with secmod + => have something to run independent tests with clean db+sm *) + let signkeys () : Signkey.t list result = + let now = Timestamp.of_ptime @@ Ptime_clock.now () in + Pg.get_active_signkeys conn ~now |> unwrap_err_caqti + + let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti + + (* TODO check stamps definitions *) + let make_future_sk ~pub ~start ~expire = + let stamp_start = Timestamp.of_absolute start in + let stamp_expire = Timestamp.of_absolute expire in + let stamp_end = stamp_expire in + let signkey_secmod_sig = + let open Signatures.SigningKeyAnnouncement in + let exchange_pub = pub in + let anchor_time = stamp_start in + let duration = Timestamp.diff stamp_start stamp_expire in + signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration } + in + Api.FutureSignKey. + { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } + + let make_future_dn ~coin ~pub ~start = + let Config.Coin. + { + section_name; + value; + duration_withdraw; + duration_spend; + duration_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + cipher= _; + rsa_keysize= _; + age_restricted= _; + } = + coin + in + let stamp_start = Timestamp.of_absolute start in + let stamp_expire_withdraw = + Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw + in + let stamp_expire_deposit = + Timestamp.of_absolute @@ Time.Absolute.add start duration_spend + in + let stamp_expire_legal = + Timestamp.of_absolute @@ Time.Absolute.add start duration_legal + in + let open Api in + let rsa_denomination_key = + RsaDenominationKey.{ age_mask= 0; rsa_pub= pub } + in + let denom_pub = DenominationKey.Rsa rsa_denomination_key in + let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in + let denom_secmod_sig = + let open Signatures.DenominationKeyAnnouncement in + let h_denom_pub = h_pub in + let h_section_name = Hash.Cstring.H64.hash section_name in + let anchor_time = stamp_start in + let duration_withdraw = + Timestamp.diff stamp_start stamp_expire_withdraw + in + signf Sm_rsa.sign_secmod + { h_denom_pub; h_section_name; anchor_time; duration_withdraw } + in + FutureDenom. + { + section_name; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + denom_pub; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + denom_secmod_sig; + } + + let future_signkeys () = + let l : Sm_eddsa.info list = Sm_eddsa.keys () in + let+ l = + list_map + (fun (pub, t1, t2) -> + let* opt = find_signkey pub in + match opt with + | None -> + let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in + Ok (Some future_sk) + | Some sk -> ( + match Timestamp.of_absolute t1 = sk.stamp_start with + | false -> + Fmt.error + "secmod/database stamp_start mismatch for signkey `%s`" + (EddsaPublicKey.to_b32 pub) + | true -> Ok None)) + l + in + List.filter_map Fun.id l + + let future_denominations () = + let+ l = + list_map + (fun (section_name, pub, t1, _t2) -> + let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in + (*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*) + let* opt = find_denomination h_pub in + match opt with + | None -> + let* coin = + Config.Coin.all_coins + |> List.find_opt (fun coin -> + coin.Config.Coin.section_name = section_name) + |> function + | Some v -> Ok v + | None -> + Fmt.error "coin `%s` not found in configuration" + section_name + in + let future_dn = make_future_dn ~coin ~pub ~start:t1 in + Ok (Some future_dn) + | Some sk -> ( + match Timestamp.of_absolute t1 = sk.stamp_start with + | false -> + Fmt.error + "secmod/database stamp_start mismatch for denomination `%s`" + section_name + | true -> Ok None)) + (Sm_rsa.keys ()) + in + List.filter_map Fun.id l + + let make_future_keys_response () = + let* future_signkeys = future_signkeys () in + let* future_denoms = future_denominations () in + Ok + Api.FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub= Config.Exchange.master_public_key; + denom_secmod_public_key= Sm_rsa.sm_pub; + signkey_secmod_public_key= Sm_eddsa.sm_pub; + } + + let sk_of_future_sk future_sk master_sig = + let Api.FutureSignKey. + { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } = + future_sk + in + Signkey. + { + pub= key; + stamp_start; + stamp_expire; + stamp_end; + master_sig; + revoked_sig= None; + } + + let dn_of_future_dn future_dn h_pub master_sig = + let Api.FutureDenom. + { + section_name= _; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + denom_pub; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + denom_secmod_sig= _; + } = + future_dn + in + let rsa_pub = + match denom_pub with + | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub + in + Denomination. + { + pub= rsa_pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask= 0; + h_pub; + master_sig; + revoked_sig= None; + } + + let certify_future_signkey pub master_sig = + Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub) + |> function + | None -> Error "future signkey not found" + | Some (pub, t1, t2) -> + let* () = + let* opt = find_signkey pub in + match opt with + | None -> Ok () + | Some _sk -> Error "signkey already certified" + in + (* rebuild it *) + let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in + let sk = sk_of_future_sk future_sk master_sig in + let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in + Ok () + + let certify_future_denomination h_pub master_sig = + Sm_rsa.keys () + |> List.find_opt (fun (_section_name, pub, _t1, _t2) -> + let h_pub' = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in + h_pub' = h_pub) + |> function + | None -> Error "future denomination not found" + | Some (section_name, pub, t1, _t2) -> + let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in + let* () = + let* opt = find_denomination h_pub in + match opt with + | None -> Ok () + | Some _sk -> Error "denomination already certified" + in + (* rebuild it *) + let* coin = + Config.Coin.all_coins + |> List.find_opt (fun coin -> + coin.Config.Coin.section_name = section_name) + |> function + | Some v -> Ok v + | None -> + Fmt.error "coin `%s` not found in configuration" section_name + in + let future_dn = make_future_dn ~coin ~pub ~start:t1 in + let dn = dn_of_future_dn future_dn h_pub master_sig in + let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in + Ok () + + let revoke_signkey pub revoked_sig = + let* opt = find_signkey pub in + let* _sk = Option.to_result ~none:"signkey not found" opt in + let* () = Sm_eddsa.revoke pub in + let+ () = + Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti + in + () + + let revoke_denomination h_pub revoked_sig = + let* opt = find_denomination h_pub in + let* dn = Option.to_result ~none:"denomination not found" opt in + let pub = dn.pub in + let* () = Sm_rsa.revoke pub in + let+ () = + Pg.insert_denomination_revocation conn h_pub revoked_sig + |> unwrap_err_caqti + in + () +end diff --git a/src/mte.ml b/src/mte.ml index 5dcf79a3..335a9170 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -35,9 +35,9 @@ let routes = in let status_info = [ - get (v "seed") --> Http_information.seed; - get (v "config") --> Http_information.config; - get (v "keys") --> Http_information.keys; + get (v "seed") --> Http_info.seed; + get (v "config") --> Http_info.config; + get (v "keys") --> Http_info.keys; ] in let management = @@ -76,7 +76,7 @@ let () = let env : Devices.env = { caqti_switch; db_uri= Config.Exchangedb_postgres.config } in - let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in + let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in let middlewares = Vif.Middlewares.[] in Logs.info (fun m -> m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); diff --git a/src/pg.ml b/src/pg.ml index fa9abe10..10a62e15 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -36,7 +36,7 @@ let preflight = fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l let find_signkey = - let find_signkey = + let req = Caqti_type.(eddsa_pub ->? signkey_data) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig, skr.master_sig FROM \ @@ -44,29 +44,29 @@ let find_signkey = esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1" in fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> - Conn.find_opt find_signkey exchange_pub + Conn.find_opt req exchange_pub let get_active_signkeys = - let get_active_signkeys = + let req = Caqti_type.(time ->* signkey_data) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \ WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \ signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)" in - fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now + fun (module Conn : CONN) ~now -> Conn.collect_list req now (* note: does not update revocation *) let insert_signkey = - let insert_signkey = + let req = Caqti_type.(signkey_data ->. unit) "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \ expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)" in - fun (module Conn : CONN) v -> Conn.exec insert_signkey v + fun (module Conn : CONN) v -> Conn.exec req v let find_denom = - let find_denom = + let req = Caqti_type.(denom_hash ->? denom_data) "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ @@ -75,10 +75,10 @@ let find_denom = dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ = dnr.denominations_serial WHERE dn.denom_pub_hash=$1" in - fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub + fun (module Conn : CONN) h_denom_pub -> Conn.find_opt req h_denom_pub let get_denominations = - let get_denominations = + let req = Caqti_type.(unit ->* denom_data) "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ @@ -87,11 +87,11 @@ let get_denominations = dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ = dnr.denominations_serial" in - fun (module Conn : CONN) -> Conn.collect_list get_denominations () + fun (module Conn : CONN) () -> Conn.collect_list req () (* note: does not update revocation *) let insert_denom = - let insert_denom = + let req = Caqti_type.(denom_data ->. unit) "INSERT INTO denominations (denom_pub, coin, valid_from, \ expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \ @@ -99,10 +99,10 @@ let insert_denom = master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \ ($12,$13), ($14,$15), $16, $17, $18)" in - fun (module Conn : CONN) v -> Conn.exec insert_denom v + fun (module Conn : CONN) v -> Conn.exec req v let insert_denomination_revocation = - let denomination_revocation_insert = + let req = let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in Caqti_type.(t2 denom_hash master_sig ->. unit) "INSERT INTO denomination_revocations (denominations_serial, master_sig) \ @@ -110,28 +110,27 @@ let insert_denomination_revocation = denom_pub_hash=$1" in fun (module Conn : CONN) h_denom_pub master_sig -> - Conn.exec denomination_revocation_insert (h_denom_pub, master_sig) + Conn.exec req (h_denom_pub, master_sig) let insert_signkey_revocation = - let signkey_revocation_insert = + let req = let master_sig = Signatures.MasterSigningKeyRevocation.caqti in Caqti_type.(t2 eddsa_pub master_sig ->. unit) "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \ esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1" in fun (module Conn : CONN) exchange_pub master_sig -> - Conn.exec signkey_revocation_insert (exchange_pub, master_sig) + Conn.exec req (exchange_pub, master_sig) let get_auditor_timestamp = - let get_auditor_timestamp = + let req = Caqti_type.(eddsa_pub ->? time) "SELECT last_change FROM auditors WHERE auditor_pub=$1" in - fun (module Conn : CONN) auditor_pub -> - Conn.find_opt get_auditor_timestamp auditor_pub + fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub let insert_auditor = - let insert_auditor = + let req = Caqti_type.(t4 eddsa_pub string string time ->. unit) "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \ is_active, last_change) VALUES ($1, $2, $3, true, $4)" @@ -139,12 +138,10 @@ let insert_auditor = fun (module Conn : CONN) AuditorSetupMessage. { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } - -> - Conn.exec insert_auditor - (auditor_pub, auditor_name, auditor_url, validity_start) + -> Conn.exec req (auditor_pub, auditor_name, auditor_url, validity_start) let update_auditor = - let update_auditor = + let req = Caqti_type.(t5 eddsa_pub string string bool time ->. unit) "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ last_change=$5 WHERE auditor_pub=$1" @@ -152,21 +149,19 @@ let update_auditor = fun (module Conn : CONN) AuditorSetupMessage. { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } - -> - Conn.exec update_auditor - (auditor_pub, auditor_url, auditor_name, true, validity_start) + -> Conn.exec req (auditor_pub, auditor_url, auditor_name, true, validity_start) let disable_auditor = - let update_auditor = + let req = Caqti_type.(t5 eddsa_pub string string bool time ->. unit) "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ last_change=$5 WHERE auditor_pub=$1" in fun (module Conn : CONN) ~auditor_pub ~change_date -> - Conn.exec update_auditor (auditor_pub, "", "", false, change_date) + Conn.exec req (auditor_pub, "", "", false, change_date) let insert_auditor_denom_sig = - let insert_auditor_denom_sig = + let req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in Caqti_type.(t3 eddsa_pub denom_hash auditor_sig ->. unit) "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \ @@ -176,14 +171,14 @@ let insert_auditor_denom_sig = NOTHING" in fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig -> - Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig) + Conn.exec req (auditor_pub, h_denom_pub, auditor_sig) (* todo auditors maybe check that url and name are unique/same for each auditor_pub and do the ht logic out of pg.ml? *) (* this does not return auditors that are not auditing any denom *) let get_auditor_keys = - let get_auditor_keys = + let req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in Caqti_type.(unit ->* t5 eddsa_pub string string denom_hash auditor_sig) "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \ @@ -193,7 +188,7 @@ let get_auditor_keys = in fun (module Conn : CONN) -> let open Syntax in - let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in + let* l = Conn.collect_list req () |> unwrap_err_caqti in let ht = Hashtbl.create 0xff in List.iter (fun (pub, url, name, denom_pub_h, auditor_sig) -> @@ -219,7 +214,7 @@ let get_auditor_keys = Ok l let insert_wire_fee = - let insert_wire_fee = + let req = let master_sig = Signatures.MasterWireFee.caqti in Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit) "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \ @@ -236,68 +231,65 @@ let insert_wire_fee = wire_fee; } -> - Conn.exec insert_wire_fee + Conn.exec req (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire) let get_wire_fees_by_time = - let get_wire_fee_by_time = + let req = Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee) "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \ $3" in fun (module Conn : CONN) ~wire_method ~start_date ~end_date -> - Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date) + Conn.collect_list req (wire_method, start_date, end_date) let get_wire_fees = - let get_wire_fees = + let req = Caqti_type.(string ->* aggregate_transfer_fee) "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ FROM wire_fee WHERE wire_method=$1" in - fun (module Conn : CONN) ~wire_method -> - Conn.collect_list get_wire_fees wire_method + fun (module Conn : CONN) ~wire_method -> Conn.collect_list req wire_method let get_global_fees = - let get_global_fees = + let req = Caqti_type.(time ->* global_fee) "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ master_sig FROM global_fee WHERE start_date >= $1" in - fun (module Conn : CONN) ~start_date -> - Conn.collect_list get_global_fees start_date + fun (module Conn : CONN) ~start_date -> Conn.collect_list req start_date let get_global_fees_by_time = - let get_global_fees_by_time = + let req = Caqti_type.(t2 time time ->* global_fee) "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2" in fun (module Conn : CONN) ~start_date ~end_date -> - Conn.collect_list get_global_fees_by_time (start_date, end_date) + Conn.collect_list req (start_date, end_date) let insert_global_fees = - let insert_global_fees = + let req = Caqti_type.(global_fee ->. unit) "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \ purse_fee, history_expiration, purse_account_limit, purse_timeout, \ master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \ $12)" in - fun (module Conn : CONN) v -> Conn.exec insert_global_fees v + fun (module Conn : CONN) v -> Conn.exec req v let get_wire_timestamp = - let get_wire_timestamp = + let req = Caqti_type.(payto_uri ->? time) "SELECT last_change FROM wire_accounts WHERE payto_uri=$1" in - fun (module Conn : CONN) ~payto_uri -> - Conn.find_opt get_wire_timestamp payto_uri + fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri let insert_wire = - let insert_wire = + let req = Caqti_type.(t3 exchange_wire_account bool time ->. unit) "INSERT INTO wire_accounts (payto_uri, conversion_url, \ credit_restrictions, debit_restrictions, master_sig, bank_label, \ @@ -306,10 +298,10 @@ let insert_wire = in fun (module Conn : CONN) ~last_change v -> let is_active = true in - Conn.exec insert_wire (v, is_active, last_change) + Conn.exec req (v, is_active, last_change) let update_wire = - let update_wire = + let req = Caqti_type.(t3 exchange_wire_account bool time ->. unit) "UPDATE wire_accounts SET conversion_url=$2, \ debit_restrictions=$3::TEXT::JSONB, \ @@ -317,48 +309,48 @@ let update_wire = priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1" in fun (module Conn : CONN) ~is_active ~last_change v -> - Conn.exec update_wire (v, is_active, last_change) + Conn.exec req (v, is_active, last_change) let disable_wire = - let disable_wire = + let req = Caqti_type.(t2 payto_uri time ->. unit) "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \ credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \ priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1" in fun (module Conn : CONN) ~payto_uri ~validity_end -> - Conn.exec disable_wire (payto_uri, validity_end) + Conn.exec req (payto_uri, validity_end) let get_wire_accounts = - let get_wire_accounts = + let req = Caqti_type.(unit ->* exchange_wire_account) "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ wire_accounts WHERE is_active" in - fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts () + fun (module Conn : CONN) () -> Conn.collect_list req () let insert_drain_profit = - let insert_drain_profit = + let req = Caqti_type.(drain_profit_message ->. unit) "INSERT INTO profit_drains (wtid, account_section, payto_uri, \ trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)" in - fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v + fun (module Conn : CONN) v -> Conn.exec req v let insert_aml_officer = - let exchange_do_insert_aml_officer = + let req = Caqti_type.(aml_officer_setup ->! time) "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \ $4, $5, $6)" in - fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v + fun (module Conn : CONN) v -> Conn.find req v let insert_partner = - let insert_partner = + let req = Caqti_type.(exchange_partner_setup ->. unit) "INSERT INTO partners (partner_master_pub, start_date, end_date, \ wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \ $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING" in - fun (module Conn : CONN) v -> Conn.exec insert_partner v + fun (module Conn : CONN) v -> Conn.exec req v diff --git a/src/secmod.ml b/src/secmod.ml deleted file mode 100644 index a9c980fc..00000000 --- a/src/secmod.ml +++ /dev/null @@ -1,478 +0,0 @@ -module type S = sig - open Crypto - - val sm_pubkey : eddsa_pub - val sign_with_sm_key : string -> eddsa_sig - val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig - val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result - val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result - - val verify_with_signkey : - pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result - - val get_signkeys : unit -> Signkey.t list - val get_denominations : unit -> Denomination.t list - val get_future_signkeys : unit -> Api.FutureSignKey.t list - val get_future_denominations : unit -> Api.FutureDenom.t list - val find_signkey : eddsa_pub -> Signkey.t option - val find_denomination : denom_hash -> Denomination.t option - val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option - val find_future_denomination : denom_hash -> Api.FutureDenom.t option - - val certify_future_signkey : - eddsa_pub -> - master_sig:Signatures.ExchangeSigningKeyValidity.t -> - (unit, string) result - - val certify_future_denomination : - denom_hash -> - master_sig:Signatures.DenominationKeyValidity.t -> - (unit, string) result - - val revoke_signkey : - eddsa_pub -> - Signatures.MasterSigningKeyRevocation.t -> - (unit, string) result - - val revoke_denomination : - denom_hash -> - Signatures.MasterDenominationKeyRevocation.t -> - (unit, string) result - - val save : unit -> (unit, string) result -end - -module Make (Conn : Pg.CONN) = struct - open Syntax - open Crypto - module DenominationHash = Hash.DenominationHash - - let read fname = Bos.OS.File.read fname |> unwrap_err_msg - let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg - let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv) - let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv) - - let read_eddsa fname = - let* data = read fname in - EddsaPrivateKey.of_octets data - - let read_rsa fname = - let* data = read fname in - RsaPrivateKey.of_octets data - - type sk = Signkey.t - type future_sk = Api.FutureSignKey.t - type dn = Denomination.t - type future_dn = Api.FutureDenom.t - - (* TODO ! use lock *) - (* not sure what to do with coin section_name, rm if possible *) - type t = { - sm_key: eddsa_priv; - sm_pubkey: eddsa_pub; - sk_ht: (eddsa_pub, sk) Hashtbl.t; - dn_ht: (denom_hash, dn) Hashtbl.t; - sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t; - dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t; - future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t; - future_dn_ht: (denom_hash, future_dn) Hashtbl.t; - future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t; - future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t; - dn_section_name_ht: (denom_hash, string) Hashtbl.t; - } - - let conn = (module Conn : Pg.CONN) - let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key") - let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i) - - let dn_fname section_name = - Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name) - - let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s - - let make_future_sk t = - let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in - let expire = - Time.Absolute.add start Config.Exchange.signkey_legal_duration - in - let stamp_start = Timestamp.of_absolute start in - let stamp_expire = Timestamp.of_absolute expire in - let stamp_end = stamp_expire in - let priv, pub = Mirage_crypto_ec.Ed25519.generate () in - let signkey_secmod_sig = - let open Signatures.SigningKeyAnnouncement in - let exchange_pub = pub in - let anchor_time = stamp_start in - let duration = Timestamp.diff stamp_start stamp_expire in - sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration } - in - let future_sk = - Api.FutureSignKey. - { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - in - Hashtbl.replace t.future_sk_ht pub future_sk; - Hashtbl.replace t.future_sk_key_ht pub priv; - () - - let make_future_dn t - Config.Coin. - { - section_name; - value; - duration_withdraw; - duration_spend; - duration_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - cipher; - rsa_keysize; - age_restricted= _; - } = - assert (cipher = `RSA); - let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in - let stamp_start = Timestamp.of_absolute start in - let stamp_expire_withdraw = - Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw - in - let stamp_expire_deposit = - Timestamp.of_absolute @@ Time.Absolute.add start duration_spend - in - let stamp_expire_legal = - Timestamp.of_absolute @@ Time.Absolute.add start duration_legal - in - let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in - let open Api in - let rsa_denomination_key = - RsaDenominationKey.{ age_mask= 0; rsa_pub= pub } - in - let denom_pub = DenominationKey.Rsa rsa_denomination_key in - let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in - let denom_secmod_sig = - let open Signatures.DenominationKeyAnnouncement in - let h_denom_pub = h_pub in - let h_section_name = Hash.Cstring.H64.hash section_name in - let anchor_time = stamp_start in - let duration_withdraw = - Timestamp.diff stamp_start stamp_expire_withdraw - in - sign_f ~f:(sign_with_sm_key t) - { h_denom_pub; h_section_name; anchor_time; duration_withdraw } - in - let future_dn = - FutureDenom. - { - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - denom_pub; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - denom_secmod_sig; - } - in - Hashtbl.replace t.future_dn_ht h_pub future_dn; - Hashtbl.replace t.future_dn_key_ht h_pub priv; - () - - let make_new () = - let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in - let t = - { - sm_key; - sm_pubkey; - sk_ht= Hashtbl.create 0xff; - dn_ht= Hashtbl.create 0xff; - sk_key_ht= Hashtbl.create 0xff; - dn_key_ht= Hashtbl.create 0xff; - future_sk_ht= Hashtbl.create 0xff; - future_dn_ht= Hashtbl.create 0xff; - future_sk_key_ht= Hashtbl.create 0xff; - future_dn_key_ht= Hashtbl.create 0xff; - dn_section_name_ht= Hashtbl.create 0xff; - } - in - make_future_sk t; - List.iter (make_future_dn t) Config.Coin.all_coins; - t - - let database_find_sk conn pub = - let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in - match opt with - | None -> Fmt.error "secmod: signkey data not found in database" - | Some sk_data -> Ok sk_data - - let database_find_dn conn h_pub = - let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in - match opt with - | None -> Fmt.error "secmod: denomination data not found in database" - | Some dn_data -> Ok dn_data - - let list_to_ht l = Hashtbl.of_seq (List.to_seq l) - - let load () = - let* sm_key = read_eddsa sm_key_fname in - let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in - - let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in - let* sk_l = - list_map - (fun priv -> - let pub = EddsaPrivateKey.pub_of_priv priv in - let+ sk = database_find_sk conn pub in - ((pub, sk), (pub, priv))) - sk_keys - in - let sk_ht, sk_key_ht = - match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2) - in - - let dn_section_name_ht = Hashtbl.create 0xff in - let* dn_keys = - list_map - (fun coin -> - let section_name = coin.Config.Coin.section_name in - let+ priv = read_rsa (dn_fname section_name) in - (section_name, priv)) - Config.Coin.all_coins - in - let* dn_l = - list_map - (fun (section_name, priv) -> - let h_pub = - priv - |> RsaPrivateKey.pub_of_priv - |> RsaPublicKey.to_octets - |> DenominationHash.hash - in - (* fill dn_section_name_ht *) - Hashtbl.replace dn_section_name_ht h_pub section_name; - let+ dn = database_find_dn conn h_pub in - ((h_pub, dn), (h_pub, priv))) - dn_keys - in - let dn_ht, dn_key_ht = - match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2) - in - (* future keys are not stored anywhere until they are certified with a master_sig - so we don't have any future key to load *) - let t = - { - sm_key; - sm_pubkey; - sk_ht; - dn_ht; - sk_key_ht; - dn_key_ht; - future_sk_ht= Hashtbl.create 0xff; - future_dn_ht= Hashtbl.create 0xff; - future_sk_key_ht= Hashtbl.create 0xff; - future_dn_key_ht= Hashtbl.create 0xff; - dn_section_name_ht; - } - in - Ok t - - let init () = - let dir = Config.secmod_dir in - let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in - if b then - Logs.info (fun m -> m "secmod: created directory `%a`" Fpath.pp dir); - let* l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg - in - match List.is_empty l with - | true -> - Logs.info (fun m -> m "secmod: empty storage, generating fresh keys"); - let t = make_new () in - Ok t - | false -> - Logs.info (fun m -> m "secmod: loading keys from storage"); - load () - - let t = - match init () with - | Error e -> Fmt.failwith "secmod initialization failure: `%s`." e - | Ok t -> - Logs.info (fun m -> m "secmod initialized"); - t - - let sm_pubkey = t.sm_pubkey - let sign_with_sm_key s = sign_with_sm_key t s - - let sign_with_signkey ~pub s = - match Hashtbl.find_opt t.sk_key_ht pub with - | None -> Fmt.failwith "secmod sign_with_signkey failure: not found." - | Some priv -> EddsaSignature.sign ~key:priv s - - let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg - - let verify_with_master_key = - EddsaSignature.verify ~key:Config.master_public_key - - let verify_with_signkey ~pub s ~msg = - match Hashtbl.find_opt t.sk_ht pub with - | None -> Fmt.failwith "secmod verify_with_signkey failure: not found." - | Some _sk -> EddsaSignature.verify ~key:pub s ~msg - - let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq - let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq - - let get_future_signkeys () = - t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq - - let get_future_denominations () = - t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq - - let find_signkey pub = Hashtbl.find_opt t.sk_ht pub - let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub - let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub - let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub - - let certify_future_signkey pub ~master_sig = - match - ( Hashtbl.find_opt t.future_sk_ht pub, - Hashtbl.find_opt t.future_sk_key_ht pub ) - with - | None, _ | _, None -> - Error "secmod certify_future_signkey: future signkey not found." - | Some future_sk, Some priv -> ( - match Hashtbl.find_opt t.sk_ht pub with - | Some _sk -> Error "secmod certify_future_signkey: already certified" - | None -> - let Api.FutureSignKey. - { - key; - stamp_start; - stamp_expire; - stamp_end; - signkey_secmod_sig= _; - } = - future_sk - in - let sk = - Signkey. - { - pub= key; - stamp_start; - stamp_expire; - stamp_end; - master_sig; - revoked_sig= None; - } - in - Hashtbl.replace t.sk_ht pub sk; - Hashtbl.replace t.sk_key_ht pub priv; - Hashtbl.remove t.future_sk_ht pub; - Hashtbl.remove t.future_sk_key_ht pub; - - let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in - Ok ()) - - let certify_future_denomination h_pub ~master_sig = - match - ( Hashtbl.find_opt t.future_dn_ht h_pub, - Hashtbl.find_opt t.future_dn_key_ht h_pub ) - with - | None, _ | _, None -> - Error - "secmod certify_future_denomination: future denomination not found." - | Some future_dn, Some priv -> ( - match Hashtbl.find_opt t.dn_ht h_pub with - | Some _dn -> - Error "secmod certify_future_denomination: already certified" - | None -> - let Api.FutureDenom. - { - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - denom_pub; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - denom_secmod_sig= _; - } = - future_dn - in - let rsa_pub = - match denom_pub with - | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub - in - let dn = - Denomination. - { - pub= rsa_pub; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask= 0; - h_pub; - master_sig; - revoked_sig= None; - } - in - Hashtbl.replace t.dn_ht h_pub dn; - Hashtbl.replace t.dn_key_ht h_pub priv; - Hashtbl.replace t.dn_section_name_ht h_pub section_name; - Hashtbl.remove t.future_dn_ht h_pub; - Hashtbl.remove t.future_dn_key_ht h_pub; - - let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in - Ok ()) - - let revoke_signkey pub revoked_sig = - match Hashtbl.find_opt t.sk_ht pub with - | None -> Error "secmod revoke_signkey: signkey not found." - | Some sk -> - let sk = { sk with revoked_sig= Some revoked_sig } in - Hashtbl.replace t.sk_ht pub sk; - - (* TODO revoke, apply to database *) - Ok () - - let revoke_denomination pub revoked_sig = - match Hashtbl.find_opt t.dn_ht pub with - | None -> Error "secmod revoke_denomination: denomination not found." - | Some dn -> - let dn = { dn with revoked_sig= Some revoked_sig } in - Hashtbl.replace t.dn_ht pub dn; - - (* TODO revoke, apply to database *) - Ok () - - let save () = - let* () = write_eddsa sm_key_fname t.sm_key in - let* () = - Hashtbl.to_seq_values t.sk_key_ht - |> List.of_seq - |> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv) - |> list_iter Fun.id - in - let* () = - Hashtbl.to_seq t.dn_key_ht - |> List.of_seq - |> list_iter (fun (h_pub, priv) -> - match Hashtbl.find_opt t.dn_section_name_ht h_pub with - | None -> Error "secmod save: invalid state, section_name not found" - | Some section_name -> write_rsa (dn_fname section_name) priv) - in - Logs.info (fun m -> m "saved secmod private keys data"); - Ok () -end diff --git a/src/secmod.mli b/src/secmod.mli deleted file mode 100644 index cedff889..00000000 --- a/src/secmod.mli +++ /dev/null @@ -1,45 +0,0 @@ -module type S = sig - open Crypto - - val sm_pubkey : eddsa_pub - val sign_with_sm_key : string -> eddsa_sig - val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig - val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result - val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result - - val verify_with_signkey : - pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result - - val get_signkeys : unit -> Signkey.t list - val get_denominations : unit -> Denomination.t list - val get_future_signkeys : unit -> Api.FutureSignKey.t list - val get_future_denominations : unit -> Api.FutureDenom.t list - val find_signkey : eddsa_pub -> Signkey.t option - val find_denomination : denom_hash -> Denomination.t option - val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option - val find_future_denomination : denom_hash -> Api.FutureDenom.t option - - val certify_future_signkey : - eddsa_pub -> - master_sig:Signatures.ExchangeSigningKeyValidity.t -> - (unit, string) result - - val certify_future_denomination : - denom_hash -> - master_sig:Signatures.DenominationKeyValidity.t -> - (unit, string) result - - val revoke_signkey : - eddsa_pub -> - Signatures.MasterSigningKeyRevocation.t -> - (unit, string) result - - val revoke_denomination : - denom_hash -> - Signatures.MasterDenominationKeyRevocation.t -> - (unit, string) result - - val save : unit -> (unit, string) result -end - -module Make (_ : Pg.CONN) : S diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml new file mode 100644 index 00000000..f83ca224 --- /dev/null +++ b/src/secmod_eddsa.ml @@ -0,0 +1,245 @@ +let src = Logs.Src.create "mte.secmod_eddsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) +open Syntax +open Crypto +open Time +module Cfg = Config.Exchange_secmod_eddsa + +type key = { + priv: EddsaPrivateKey.t; + pub: EddsaPublicKey.t; + t1: Absolute.t; + t2: Absolute.t; +} + +type t = { + sm_key_priv: EddsaPrivateKey.t; + sm_pub: EddsaPublicKey.t; + ht: (EddsaPublicKey.t, key) Hashtbl.t; +} + +(* -- util -- *) + +(* TODO time *) +let time_abs_of_string s = + int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) + +let t1_t2_of_fpath fpath = + let fname = Fpath.filename fpath in + match String.split_on_char '-' fname with + | [] -> Fmt.failwith "not possible" + | [ t1; t2 ] -> ( + match (time_abs_of_string t1, time_abs_of_string t2) with + | None, _ | _, None -> None + | Some t1, Some t2 -> Some (t1, t2)) + | _ -> None + +let time_abs_to_string abs = + abs + |> Timestamp.of_absolute + |> Timestamp.to_s + |> Option.get + |> Int64.to_int + |> string_of_int + +let key_fpath k = + let t1 = time_abs_to_string k.t1 in + let t2 = time_abs_to_string k.t2 in + let fname = Fmt.str "%s-%s" t1 t2 in + Fpath.(v Cfg.key_dir / fname) + +(* -- IO -- *) + +let read_key fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); + let data = EddsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_eddsa (key_fpath k) k.priv + +let delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () + +let get_key_dir_contents dir = + let* dir = Fpath.of_string dir |> unwrap_err_msg in + let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir); + let+ l = + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg + in + l + +(* -- *) + +let gen_key t1 t2 = + let priv, pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) + (EddsaPublicKey.to_b32 pub)); + { priv; pub; t1; t2 } + +let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l + +let split_in_periodes ~start ~end_ = + assert (start < end_); + (* no overlap on first periode *) + let t1 = start in + let t2 = Absolute.add start Cfg.duration in + let acc = [ (t1, t2) ] in + let start = t2 in + let rec go acc start end_ = + let t1 = Absolute.sub start Cfg.overlap_duration in + let t2 = Absolute.add start Cfg.duration in + if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_ + in + go acc start end_ + +(* TODO do not exceed lookahead (probably more important...) *) +(* try to not generate keys with validity start in the past *) +let gen_additional_keys_until_lookahead ~now l = + let start = + match List.rev (sort_keys l) with + | [] -> now + | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration + in + let end_ = Absolute.add now Cfg.lookahead_sign in + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in + new_keys + +(* TODO config *) +let sm_key_fpath = + Result.get_ok + @@ + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + Fpath.normalize fpath + +(* we load sm_key separately + we don't accept non-key files in key_dir *) +let load_key fpath = + match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with + | true -> Ok None + | false -> ( + match t1_t2_of_fpath fpath with + | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath + | Some (t1, t2) -> + let* priv = read_key fpath in + let pub = EddsaPrivateKey.pub_of_priv priv in + Ok (Some { priv; pub; t1; t2 })) + +let load () = + let* l = get_key_dir_contents Cfg.key_dir in + let* l = list_map load_key l in + let keys = List.filter_map Fun.id l in + match keys with + | [] -> Ok None + | _l -> + let* sm_key_priv = read_key sm_key_fpath in + let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in + let ht = Hashtbl.create 0xff in + let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in + Ok (Some { sm_key_priv; sm_pub; ht }) + +let init () = + let* opt = load () in + let* t = + match opt with + | Some t -> Ok t + | None -> + let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + let* () = write_eddsa sm_key_fpath sm_key_priv in + let ht = Hashtbl.create 0xff in + Ok { sm_key_priv; sm_pub; ht } + in + let now = Absolute.of_ptime (Ptime_clock.now ()) in + let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in + let new_keys = gen_additional_keys_until_lookahead ~now keys in + let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in + let+ () = list_iter write_key new_keys in + t + +type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t + +module Make () = struct + type pub = EddsaPublicKey.t + type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t + + let t = + match init () with + | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e + | Ok t -> t + + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + + let add t1 t2 = + let k = gen_key t1 t2 in + Hashtbl.replace t.ht k.pub k; + () + + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; + delete_file (key_fpath k) + + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete + + (* ---- *) + + let sm_pub = t.sm_pub + + let keys () = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) + + let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s + + let sign pub s = + let+ k = find pub in + let data = EddsaSignature.sign ~key:k.priv s in + data + + (* delete and replace *) + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.t1 k.t2; Ok () +end + +(* TODO + - more checks + - sign: check timestamps before signing + - schedule tasks + - !lock + + taler doc/config is confusing + how is computed stamp_expire stamp_end + what to do of 'Exchange.signkey_legal_duration' + => + stamp_expire = stamp_start + duration + stamp_end = stamp_start + signkey_legal_duration + (not sure about it) +*) diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml new file mode 100644 index 00000000..50aa954f --- /dev/null +++ b/src/secmod_rsa.ml @@ -0,0 +1,254 @@ +(* TODO refacto common parts with secmod_eddsa *) +let src = Logs.Src.create "mte.secmod_rsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) +open Syntax +open Crypto +open Time +module Cfg = Config.Exchange_secmod_rsa + +type key = { + section_name: string; + priv: RsaPrivateKey.t; + pub: RsaPublicKey.t; + t1: Absolute.t; + t2: Absolute.t; +} + +type t = { + sm_key_priv: EddsaPrivateKey.t; + sm_pub: EddsaPublicKey.t; + ht: (RsaPublicKey.t, key) Hashtbl.t; +} + +(* -- util -- *) + +let time_abs_of_string s = + int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) + +let t1_t2_of_fpath fpath = + let fname = Fpath.filename fpath in + match String.split_on_char '-' fname with + | [] -> Fmt.failwith "not possible" + | [ t1; t2 ] -> ( + match (time_abs_of_string t1, time_abs_of_string t2) with + | None, _ | _, None -> None + | Some t1, Some t2 -> Some (t1, t2)) + | _ -> None + +let time_abs_to_string abs = + abs + |> Timestamp.of_absolute + |> Timestamp.to_s + |> Option.get + |> Int64.to_int + |> string_of_int + +let key_fpath k = + let t1 = time_abs_to_string k.t1 in + let t2 = time_abs_to_string k.t2 in + let fname = Fmt.str "%s-%s" t1 t2 in + Fpath.(v Cfg.key_dir / k.section_name / fname) + +(* -- IO -- *) + +let read_eddsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let read_rsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + RsaPrivateKey.of_octets data + +let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); + let data = EddsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_rsa fpath priv = + let data = RsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_rsa (key_fpath k) k.priv + +let delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () + +let get_key_dir_contents dir_fpath = + let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath); + let+ l = + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg + in + l + +(* -- *) + +let gen_key section_name t1 t2 = + let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) (RsaPublicKey.to_b32 pub)); + { section_name; priv; pub; t1; t2 } + +let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l + +let split_in_periodes ~start ~end_ = + assert (start < end_); + (* no overlap on first periode *) + let t1 = start in + let t2 = Absolute.add start Cfg.duration in + let acc = [ (t1, t2) ] in + let start = t2 in + let rec go acc start end_ = + let t1 = Absolute.sub start Cfg.overlap_duration in + let t2 = Absolute.add start Cfg.duration in + if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_ + in + go acc start end_ + +let gen_additional_keys_until_lookahead ~now ~section_name l = + (* try to _not_ generate keys with validity start in the past + (probably not important) *) + let start = + match List.rev (sort_keys l) with + | [] -> now + | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration + in + let end_ = Absolute.add now Cfg.lookahead_sign in + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = + List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes + in + new_keys + +let sm_key_fpath = + Result.get_ok + @@ + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + Fpath.normalize fpath + +(* we load sm_key separately + we don't accept non-key files in key_dir *) +let load_key ~section_name fpath = + match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with + | true -> Ok None + | false -> ( + match t1_t2_of_fpath fpath with + | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath + | Some (t1, t2) -> + let* priv = read_rsa fpath in + let pub = RsaPrivateKey.pub_of_priv priv in + Ok (Some { section_name; priv; pub; t1; t2 })) + +let load_section section_name = + let section_fpath = Fpath.(v Cfg.key_dir / section_name) in + let* l = get_key_dir_contents section_fpath in + let* l = list_map (load_key ~section_name) l in + let keys = List.filter_map Fun.id l in + Ok keys + +let load () = + let* keys_l = list_map load_section Cfg.sections in + let keys = List.concat keys_l in + match keys with + | [] -> Ok None + | _l -> + let* sm_key_priv = read_eddsa sm_key_fpath in + let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in + let ht = Hashtbl.create 0xff in + let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in + Ok (Some { sm_key_priv; sm_pub; ht }) + +let init () = + let* opt = load () in + let* t = + match opt with + | Some t -> Ok t + | None -> + let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + let* () = write_eddsa sm_key_fpath sm_key_priv in + let ht = Hashtbl.create 0xff in + Ok { sm_key_priv; sm_pub; ht } + in + let now = Absolute.of_ptime (Ptime_clock.now ()) in + let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in + let new_keys_l = + List.map + (fun section_name -> + let keys = + List.filter (fun k -> k.section_name = section_name) all_keys + in + gen_additional_keys_until_lookahead ~now ~section_name keys) + Cfg.sections + in + let new_keys = List.concat new_keys_l in + let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys in + let+ () = list_iter write_key new_keys in + t + +type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t + +module Make () = struct + type pub = RsaPublicKey.t + type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t + + (* --- *) + let t = + match init () with + | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e + | Ok t -> t + + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; + delete_file (key_fpath k) + + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete + + let add section_name t1 t2 = + let k = gen_key section_name t1 t2 in + Hashtbl.replace t.ht k.pub k; + () + + let sm_pub = t.sm_pub + + let keys () = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.map (fun { section_name; priv= _; pub; t1; t2 } -> + (section_name, pub, t1, t2)) + + let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s + + let sign pub s = + let+ k = find pub in + let data = RsaSignature.sign ~key:k.priv s in + data + + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.section_name k.t1 k.t2; + Ok () +end diff --git a/src/signatures.ml b/src/signatures.ml index 80cebad6..ff7de581 100644 --- a/src/signatures.ml +++ b/src/signatures.ml @@ -1,9 +1,7 @@ (* TODO signatures - check with taler-wallet-core/src/crypto/cryptoImplementation.js + check with taler-wallet check signed/unsigned ints - check endianness - - better handling of decoding failure *) + check endianness *) open Hash module Aliases = struct @@ -147,43 +145,51 @@ end (* --- Packed Signatures --- *) -module MK (R : sig +module type R = sig type r val bin : r Bin.t -end) : sig +end + +module type SIGNATURE = sig open Crypto - type r = R.r + type r type t - val sign_f : f:(string -> eddsa_sig) -> r -> t - - val verify_f : - f:(eddsa_sig -> msg:string -> (unit, string) result) -> - t -> - r -> - (unit, string) result + val signf : (string -> EddsaSignature.t) -> r -> t + (* todo + - type for unknown/verified signatures? (nk/ok) *) + val verify : EddsaPublicKey.t -> t -> r -> (unit, string) result val jsont : t Jsont.t val caqti : t Caqti_type.t - (* TODO rm *) (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *) val to_octets : t -> string -end = struct +end + +module MK (R : R) : SIGNATURE with type r := R.r = struct open Crypto - type r = R.r type t = EddsaSignature.t - let sign_f ~f r = f (Bin.to_string R.bin r) - let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r) + let to_string = Bin.to_string R.bin + let verify key t r = EddsaSignature.verify ~key t ~msg:(to_string r) + let signf f r = f (to_string r) let jsont = EddsaSignature.jsont let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti let to_octets t = EddsaSignature.to_octets t end +module MK_master_sig (R : R) = struct + include MK (R) + + let verify = verify Config.Exchange.master_public_key +end + +(* ---- *) + module DenominationKeyAnnouncement = struct module R = struct (* CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *) @@ -211,7 +217,6 @@ module DenominationKeyAnnouncement = struct |> sealr end - include R include MK (R) end @@ -236,7 +241,6 @@ module SigningKeyAnnouncement = struct |> sealr end - include R include MK (R) end @@ -305,8 +309,7 @@ module DenominationKeyValidity = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module ExchangeSigningKeyValidity = struct @@ -333,8 +336,7 @@ module ExchangeSigningKeyValidity = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDenominationKeyRevocation = struct @@ -352,8 +354,7 @@ module MasterDenominationKeyRevocation = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterSigningKeyRevocation = struct @@ -371,8 +372,7 @@ module MasterSigningKeyRevocation = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAddAuditor = struct @@ -396,8 +396,7 @@ module MasterAddAuditor = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDelAuditor = struct @@ -418,8 +417,7 @@ module MasterDelAuditor = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module GlobalFees = struct @@ -474,8 +472,7 @@ module GlobalFees = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterWireDetails = struct @@ -513,8 +510,7 @@ module MasterWireDetails = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAddWire = struct @@ -556,8 +552,7 @@ module MasterAddWire = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDelWire = struct @@ -578,8 +573,7 @@ module MasterDelWire = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDrainProfit = struct @@ -607,8 +601,7 @@ module MasterDrainProfit = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAmlOfficerStatus = struct @@ -634,8 +627,7 @@ module MasterAmlOfficerStatus = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module PartnerConfiguration = struct @@ -674,8 +666,7 @@ module PartnerConfiguration = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module WadPartnerSignature = struct @@ -722,7 +713,6 @@ module WadPartnerSignature = struct |> sealr end - include R include MK (R) end @@ -752,8 +742,7 @@ module MasterWireFee = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module ExchangeKeyValidity = struct @@ -819,7 +808,6 @@ module ExchangeKeyValidity = struct |> sealr end - include R include MK (R) end @@ -842,7 +830,6 @@ module ExchangeKeySet = struct |> sealr end - include R include MK (R) end diff --git a/src/syntax.ml b/src/syntax.ml index c61aba15..426d9ac0 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -7,6 +7,8 @@ let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v let unwrap_err_caqti o = match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v +(* TODO list_filter_map *) + let list_iter f l = let err = ref None in try diff --git a/src/time.mli b/src/time.mli index 180df904..544e92f9 100644 --- a/src/time.mli +++ b/src/time.mli @@ -46,6 +46,7 @@ module Timestamp : sig val of_absolute : Absolute.t -> t val of_ptime : Ptime.t -> t + (* TODO add pp *) (* - *) val bin : t Bin.t val bin_nbo : t Bin.t diff --git a/src/util.ml b/src/util.ml index c690a009..bf00cd53 100644 --- a/src/util.ml +++ b/src/util.ml @@ -48,10 +48,8 @@ module Log_reporter = struct in { report } - (* TODO logs - - vif shouldn't use/set the default reporter - - Log.err all `Internal_server_error response *) let setup () = + (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*) let level = Some Logs.Info in Logs.set_level ~all:false level; Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 9a851fa5..aa0d08e3 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -1,11 +1,19 @@ open Syntax +open Crypto open Hash module Future_keys = struct - open Crypto open Api - let verify = + let verify offline_master_public_key + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub; + denom_secmod_public_key; + signkey_secmod_public_key; + } = let verify_future_denom ~sm_denom_pub FutureDenom. { @@ -31,9 +39,7 @@ module Future_keys = struct Timestamp.diff stamp_start stamp_expire_withdraw in let open Signatures.DenominationKeyAnnouncement in - verify_f - ~f:(EddsaSignature.verify ~key:sm_denom_pub) - denom_secmod_sig + verify sm_denom_pub denom_secmod_sig { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in let verify_future_signkey ~sm_signkey_pub @@ -43,42 +49,38 @@ module Future_keys = struct let anchor_time = stamp_start in let duration = Timestamp.diff stamp_start stamp_expire in let open Signatures.SigningKeyAnnouncement in - verify_f - ~f:(EddsaSignature.verify ~key:sm_signkey_pub) - signkey_secmod_sig + verify sm_signkey_pub signkey_secmod_sig { exchange_pub; anchor_time; duration } in - fun our_master_public_key + let* () = + match master_pub = offline_master_public_key with + | false -> + Fmt.error + "master public key of the future key response does not match ours" + | true -> Ok () + in + let* () = + list_iter + (verify_future_denom ~sm_denom_pub:denom_secmod_public_key) + future_denoms + in + let* () = + list_iter + (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key) + future_signkeys + in + Ok () + + let make ~master_key FutureKeysResponse. { future_denoms; future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } - -> - let* () = - match master_pub = our_master_public_key with - | false -> - Fmt.error - "master public key of the future key response does not match ours" - | true -> Ok () - in - let* () = - list_iter - (verify_future_denom ~sm_denom_pub:denom_secmod_public_key) - future_denoms - in - let* () = - list_iter - (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key) - future_signkeys - in - Ok () - - let make = - let denom_signature ~master_key + master_pub= _; + denom_secmod_public_key= _; + signkey_secmod_public_key= _; + } = + let denom_signature FutureDenom. { section_name= _; @@ -99,8 +101,8 @@ module Future_keys = struct let master_sig = let open Signatures.DenominationKeyValidity in let master = EddsaPrivateKey.(pub_of_priv master_key) in - sign_f - ~f:(EddsaSignature.sign ~key:master_key) + signf + (EddsaSignature.sign ~key:master_key) { master; start= stamp_start; @@ -117,13 +119,13 @@ module Future_keys = struct in DenomSignature.{ h_denom_pub; master_sig } in - let signkey_signature ~master_key + let signkey_signature FutureSignKey. { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } = let master_sig = let open Signatures.ExchangeSigningKeyValidity in - sign_f - ~f:(EddsaSignature.sign ~key:master_key) + signf + (EddsaSignature.sign ~key:master_key) { start= stamp_start; expire= stamp_expire; @@ -133,21 +135,9 @@ module Future_keys = struct in SignKeySignature.{ key; master_sig } in - fun ~master_key - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub= _; - denom_secmod_public_key= _; - signkey_secmod_public_key= _; - } - -> - let denom_sigs = List.map (denom_signature ~master_key) future_denoms in - let signkey_sigs = - List.map (signkey_signature ~master_key) future_signkeys - in - MasterSignatures.{ denom_sigs; signkey_sigs } + let denom_sigs = List.map denom_signature future_denoms in + let signkey_sigs = List.map signkey_signature future_signkeys in + MasterSignatures.{ denom_sigs; signkey_sigs } end (* -- *) @@ -159,7 +149,7 @@ let write_file fname content = let read_master_key_file filename = let* master_key = read_file filename in - Crypto.EddsaPrivateKey.of_octets master_key + EddsaPrivateKey.of_octets master_key let download ~output ~url = let open Bos in @@ -201,7 +191,6 @@ let setup ~output ~output_pubkey = Ok () let sign ~master_key ~input ~output = - let open Crypto in let* master_key = read_master_key_file master_key in let* input = read_file input in let master_pub = EddsaPrivateKey.pub_of_priv master_key in @@ -218,7 +207,7 @@ let revoke_denom ~output ~master_key ~h_denom = let denom_revoke = let master_sig = let open Signatures.MasterDenominationKeyRevocation in - sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub } + signf (EddsaSignature.sign ~key) { h_denom_pub } in Api.DenomRevocationSignature.{ master_sig } in @@ -231,7 +220,7 @@ let revoke_signkey ~output ~master_key ~signkey = let signkey_revoke = let master_sig = let open Signatures.MasterSigningKeyRevocation in - sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey } + signf (EddsaSignature.sign ~key) { exchange_pub= signkey } in Api.SignkeyRevocationSignature.{ master_sig } in @@ -242,7 +231,6 @@ let revoke_signkey ~output ~master_key ~signkey = let global_fees ~output ~master_key ~start_date ~end_date ~history_fee ~account_fee ~purse_fee ~history_expiration ~purse_account_limit ~purse_timeout = - let open Crypto in let* key = read_master_key_file master_key in let* purse_account_limit = match @@ -254,7 +242,7 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee in let master_sig = let open Signatures.GlobalFees in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { start_date; end_date; @@ -286,11 +274,10 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub ~validity_start = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterAddAuditor in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { start_date= validity_start; auditor_pub; @@ -306,11 +293,10 @@ let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub Ok () let disable_auditor ~output ~master_key ~auditor_pub ~validity_end = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterDelAuditor in - sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub } + signf (EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub } in let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in let* s = Api.encode Api.AuditorTeardownMessage.jsont v in @@ -319,11 +305,10 @@ let disable_auditor ~output ~master_key ~auditor_pub ~validity_end = let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee ~wire_fee = - let open Crypto in let* key = read_master_key_file master_key in let master_sig_wire = let open Signatures.MasterWireFee in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { h_wire_method= Hash.Cstring.H64.hash wire_method; start_date= fee_start; @@ -349,11 +334,10 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date ~amount = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterDrainProfit in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { wtid; date;