From ae8ff0e6f7289d30866a6c1a70e547a7a14817c9 Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 20 Feb 2026 20:44:52 +0100 Subject: [PATCH] --- src/http_info.ml | 25 +- src/http_management.ml | 44 +-- src/keys.ml | 623 ++++++++++++----------------------------- src/keys_intf.ml | 48 ++-- src/pg.ml | 4 +- src/secmod_eddsa.ml | 12 + src/secmod_rsa.ml | 13 + 7 files changed, 249 insertions(+), 520 deletions(-) diff --git a/src/http_info.ml b/src/http_info.ml index 6c4068d9..5c8fa438 100644 --- a/src/http_info.ml +++ b/src/http_info.ml @@ -88,7 +88,7 @@ let mk_keys ~db_conn (module Keys : Keys.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 Keys : Keys.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 *) - Keys.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 Keys : Keys.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*) - Keys.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,9 +173,7 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = |> Hash.H64.hash in let open Signatures.ExchangeKeySet in - sign_f - ~f:(Keys.sign_with_signkey ~pub:exchange_pub) - R.{ list_issue_date; hc } + sign_f ~f:(Keys.sign ~pub:exchange_pub) R.{ list_issue_date; hc } in let recoup = (* TODO /recoup *) [] in diff --git a/src/http_management.ml b/src/http_management.ml index be19ac91..148029a8 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -4,19 +4,20 @@ open Hash module Keys_get = struct let mk_future_keys_response (module Keys : Keys.S) = - let future_signkeys = Keys.get_future_signkeys () in - let future_denoms = Keys.get_future_denominations () in - let master_pub = Config.Exchange.master_public_key in - let denom_secmod_public_key = Keys.sm_pubkey in - let signkey_secmod_public_key = Keys.sm_pubkey in - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } + let* future_signkeys = Keys.future_signkeys () in + let* future_denoms = Keys.future_denominations () in + let master_pub = Keys.master_pub in + let denom_secmod_public_key = Keys.secmod_rsa_pub in + let signkey_secmod_public_key = Keys.secmod_eddsa_pub in + Ok + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub; + denom_secmod_public_key; + signkey_secmod_public_key; + } let jsont = FutureKeysResponse.jsont @@ -24,7 +25,7 @@ module Keys_get = struct Logs.info (fun m -> m "GET /management/keys/"); let keys = Vif.Server.device Devices.keys server in let res = - let v = mk_future_keys_response keys in + let* v = mk_future_keys_response keys in let s = Api.encode_exn jsont v in Ok s in @@ -38,10 +39,8 @@ module Keys_post = struct let verify_denom_signature (module Keys : Keys.S) DenomSignature.{ h_denom_pub; master_sig } = - let* denom = - Keys.find_future_denomination h_denom_pub - |> Option.to_result ~none:error_key_unknown - in + let* opt = Keys.find_future_denomination h_denom_pub in + let* denom = Option.to_result ~none:error_key_unknown opt in let open Signatures.DenominationKeyValidity in let r : r = { @@ -86,16 +85,15 @@ module Keys_post = struct let* () = list_iter (fun SignKeySignature.{ key; master_sig } -> - Keys.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 } -> - Keys.certify_future_denomination h_denom_pub ~master_sig) + Keys.certify_future_denomination h_denom_pub master_sig) denom_sigs in - let* () = Keys.save () in Ok () let jsont = MasterSignatures.jsont @@ -117,7 +115,9 @@ module Denom_revoke = struct let verify (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = let open Signatures.MasterDenominationKeyRevocation in - verify_f ~f:Keys.verify_with_master_key master_sig { h_denom_pub } + verify_f + ~f:(Crypto.EddsaSignature.verify ~key:Keys.master_pub) + master_sig { h_denom_pub } let do_ (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = diff --git a/src/keys.ml b/src/keys.ml index d6a93db2..0dba0e60 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -1,182 +1,35 @@ +type 'a result = ('a, string) Result.t + module type S = Keys_intf.S 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 master_pub = Config.Exchange.master_public_key + let secmod_rsa_pub = Secmod_rsa.sm_key_pub + let secmod_eddsa_pub = Secmod_eddsa.sm_key_pub - let read_eddsa fname = - let* data = read fname in - EddsaPrivateKey.of_octets data + let sign ~pub s = + Secmod_eddsa.sign ~pub s |> function + | Error e -> Fmt.failwith "sign failure: %s." e + | Ok v -> v - 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 sign_denom ~pub s = + Secmod_rsa.sign ~pub s |> function + | Error e -> Fmt.failwith "sign_denom failure: %s." e + | Ok v -> v + (* - *) let conn = (module Conn : Pg.CONN) - let sm_key_fname = Fpath.(v Config.Exchange_secmod_eddsa.sm_priv_key) - - let sk_fname i = - Fpath.(v Config.Exchange_secmod_eddsa.key_dir / Fmt.str "sk_%d" i) - - let dn_fname section_name = - Fpath.( - v Config.Exchange_secmod_eddsa.key_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 "Keys: 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 "Keys: denomination data not found in database" - | Some dn_data -> Ok dn_data - let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti - let find_denom h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti + let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti + + 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 = @@ -194,22 +47,6 @@ module Make (Conn : Pg.CONN) = struct Api.FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - let _get_future_signkeys () = - Secmod_eddsa.keys () - |> 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)) - let make_future_dn ~coin ~pub ~start = let Config.Coin. { @@ -271,295 +108,181 @@ module Make (Conn : Pg.CONN) = struct denom_secmod_sig; } - let _get_future_denominations () = - Secmod_rsa.keys () - |> List.map (fun (section_name, pub, t1, _t2) -> - let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in - (*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*) - let* opt = find_denom 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)) - - 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 = + let future_signkeys () = + let+ 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) + (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)) + (Secmod_eddsa.keys ()) in + List.filter_map Fun.id l - let dn_section_name_ht = Hashtbl.create 0xff in - let* dn_keys = + let future_denominations () = + let+ l = 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 + (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)) + (Secmod_rsa.keys ()) 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 + List.filter_map Fun.id l + + 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 - 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 = + Signkey. { - 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; + 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 - Ok t - - let init () = - let dir = Fpath.v Config.Exchange_secmod_eddsa.key_dir in - let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in - if b then Logs.info (fun m -> m "Keys: created directory `%a`" Fpath.pp dir); - let* l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg + let rsa_pub = + match denom_pub with + | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub in - match List.is_empty l with - | true -> - Logs.info (fun m -> m "Keys: empty storage, generating fresh keys"); - let t = make_new () in - Ok t - | false -> - Logs.info (fun m -> m "Keys: loading keys from storage"); - load () + 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 t = - match init () with - | Error e -> Fmt.failwith "Keys: initialization failure: `%s`." e - | Ok t -> - Logs.info (fun m -> m "Keys: initialized"); - t + let certify_future_signkey pub master_sig = + Secmod_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 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 "Keys 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 "Keys 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 "Keys certify_future_signkey: future signkey not found." - | Some future_sk, Some priv -> ( - match Hashtbl.find_opt t.sk_ht pub with - | Some _sk -> Error "Keys 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 "Keys 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 "Keys 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 certify_future_denomination h_pub master_sig = + Secmod_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 = - match Hashtbl.find_opt t.sk_ht pub with - | None -> Error "Keys revoke_signkey: signkey not found." - | Some sk -> - let sk = { sk with revoked_sig= Some revoked_sig } in - Hashtbl.replace t.sk_ht pub sk; - + let* opt = find_signkey pub in + match opt with + | None -> Error "signkey not found" + | Some _sk -> + let* () = Secmod_eddsa.revoke_key pub in let+ () = Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti in () let revoke_denomination h_pub revoked_sig = - match Hashtbl.find_opt t.dn_ht h_pub with - | None -> Error "Keys revoke_denomination: denomination not found." - | Some dn -> - let dn = { dn with revoked_sig= Some revoked_sig } in - Hashtbl.replace t.dn_ht h_pub dn; - + let* opt = find_denomination h_pub in + match opt with + | None -> Error "denomination not found" + | Some sk -> + let pub = sk.pub in + let* () = Secmod_rsa.revoke_key pub in let+ () = Pg.insert_denomination_revocation conn h_pub revoked_sig |> unwrap_err_caqti in () - - 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 "Keys save: invalid state, section_name not found" - | Some section_name -> write_rsa (dn_fname section_name) priv) - in - Logs.info (fun m -> m "saved private keys data"); - Ok () end diff --git a/src/keys_intf.ml b/src/keys_intf.ml index 48e39dad..162503fd 100644 --- a/src/keys_intf.ml +++ b/src/keys_intf.ml @@ -1,43 +1,29 @@ +type 'a result = ('a, string) Result.t + 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 master_pub : eddsa_pub + val secmod_rsa_pub : eddsa_pub + val secmod_eddsa_pub : eddsa_pub + val sign : pub:eddsa_pub -> string -> eddsa_sig + val sign_denom : pub:rsa_pub -> string -> string + 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 certify_future_signkey : - eddsa_pub -> - master_sig:Signatures.ExchangeSigningKeyValidity.t -> - (unit, string) result + eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result val certify_future_denomination : - denom_hash -> - master_sig:Signatures.DenominationKeyValidity.t -> - (unit, string) result + denom_hash -> Signatures.DenominationKeyValidity.t -> unit result val revoke_signkey : - eddsa_pub -> - Signatures.MasterSigningKeyRevocation.t -> - (unit, string) result + eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result val revoke_denomination : - denom_hash -> - Signatures.MasterDenominationKeyRevocation.t -> - (unit, string) result - - val save : unit -> (unit, string) result + denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result end diff --git a/src/pg.ml b/src/pg.ml index 12150a49..10a62e15 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -87,7 +87,7 @@ 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 req () + fun (module Conn : CONN) () -> Conn.collect_list req () (* note: does not update revocation *) let insert_denom = @@ -328,7 +328,7 @@ let get_wire_accounts = credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ wire_accounts WHERE is_active" in - fun (module Conn : CONN) -> Conn.collect_list req () + fun (module Conn : CONN) () -> Conn.collect_list req () let insert_drain_profit = let req = diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index 9537e783..d0fff792 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -195,6 +195,18 @@ let delete_outdated ~now = |> List.map (fun k -> k.pub) |> list_iter delete_key +let add_key t1 t2 = + let priv, pub = EddsaPrivateKey.generate () in + let k = { priv; pub; t1; t2 } in + Hashtbl.replace t.ht k.pub k; + () + +(* delete and replace *) +let revoke_key pub = + let* k = find_key pub in + let* () = delete_key pub in + add_key k.t1 k.t2; Ok () + (* TODO - more checks - sign: check time diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 95d072de..8da46ee9 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -221,3 +221,16 @@ let delete_outdated ~now = |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) |> List.map (fun k -> k.pub) |> list_iter delete_key + +let add_key section_name t1 t2 = + let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in + let k = { section_name; priv; pub; t1; t2 } in + Hashtbl.replace t.ht k.pub k; + () + +(* delete and replace *) +let revoke_key pub = + let* k = find_key pub in + let* () = delete_key pub in + add_key k.section_name k.t1 k.t2; + Ok ()