From 4ff8d9840fb9bd38637b1a61889686586917ef49 Mon Sep 17 00:00:00 2001 From: swrup Date: Tue, 24 Feb 2026 19:04:22 +0100 Subject: [PATCH] clean up future_sk/dn --- src/http_management.ml | 53 ++++---------- src/keys.ml | 155 +++++++++++++++++------------------------ 2 files changed, 74 insertions(+), 134 deletions(-) diff --git a/src/http_management.ml b/src/http_management.ml index 3a6e10da..dd40ef66 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -9,16 +9,18 @@ module Keys_get = struct Logs.info (fun m -> m "GET /management/keys/"); let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in let res = - let* v = Keys.make_future_keys_response () in + let v = Keys.make_future_keys_response () in Api.encode jsont v in Respond.result res req end module Keys_post = struct - let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig = + let verify_fdn (module Keys : Keys.S) + DenomSignature.{ h_denom_pub; master_sig } = let open FutureDenom in let open Signatures.DenominationKeyValidity in + let* fdn = Keys.find_future_denomination h_denom_pub in verify Config.master_public_key master_sig { R.master= Config.master_public_key; @@ -31,54 +33,23 @@ module Keys_post = struct fee_deposit= fdn.fee_deposit; fee_refresh= fdn.fee_refresh; fee_refund= fdn.fee_refund; - denom_hash; + denom_hash= h_denom_pub; } - 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 verify_fsk (module Keys : Keys.S) SignKeySignature.{ key; master_sig } = let open Signatures.ExchangeSigningKeyValidity in + let* fsk = Keys.find_future_signkey key in verify Config.master_public_key master_sig { - R.start= stamp_start; - expire= stamp_expire; - end_= stamp_end; + R.start= fsk.stamp_start; + expire= fsk.stamp_expire; + end_= fsk.stamp_end; signkey_pub= key; } - 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 + let* () = list_iter (verify_fsk keys) signkey_sigs in + let* () = list_iter (verify_fdn keys) denom_sigs in Ok () let do_ ~db_conn:_ (module Keys : Keys.S) diff --git a/src/keys.ml b/src/keys.ml index 1c2af9f2..bb1b6b72 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -11,9 +11,9 @@ module type S = sig 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 find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result + val find_future_denomination : denom_hash -> Api.FutureDenom.t result + val make_future_keys_response : unit -> Api.FutureKeysResponse.t val certify_future_signkey : eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result @@ -66,8 +66,8 @@ module Make (Conn : Pg.CONN) : S = struct | _ -> Logs.warn (fun m -> m - "signkeys found in database are missing from secmod, (unclean \ - database/secmod state?)"); + "some signkeys found in database are missing from secmod, \ + (unclean database/secmod state?)"); l let denominations () = @@ -82,11 +82,11 @@ module Make (Conn : Pg.CONN) : S = struct | _ -> Logs.warn (fun m -> m - "denominations found in database are missing from secmod, \ + "some denominations found in database are missing from secmod, \ (unclean database/secmod state?)"); l - let make_future_sk ~pub ~start ~expire = + let make_future_sk (pub, (start, expire)) = let open Time in let stamp_start = Timestamp.of_absolute start in let stamp_expire = Timestamp.of_absolute expire in @@ -104,7 +104,15 @@ module Make (Conn : Pg.CONN) : S = struct Api.FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - let make_future_dn ~coin ~pub ~start = + let coin_of_section_name section_name = + Config.Coin.all_coins + |> List.find_opt (fun coin -> coin.Config.Coin.section_name = section_name) + |> function + | None -> + Fmt.failwith "coin section `%s` not found in configuration" section_name + | Some v -> v + + let make_future_dn (h_pub, (section_name, pub, start)) = let open Time in let Config.Coin. { @@ -121,7 +129,7 @@ module Make (Conn : Pg.CONN) : S = struct rsa_keysize= _; age_restricted= _; } = - coin + coin_of_section_name section_name in let stamp_start = Timestamp.of_absolute start in let stamp_expire_withdraw = @@ -138,7 +146,6 @@ module Make (Conn : Pg.CONN) : S = struct 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 signf Sm_rsa.sign_secmod @@ -165,59 +172,31 @@ module Make (Conn : Pg.CONN) : S = struct denom_secmod_sig; } - let future_signkeys () = - Sm_eddsa.keys () - |> list_filter_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 find_future_signkey pub = + match Sm_eddsa.find_key pub with + | None -> Error "future signkey not found" + | Some (pub, (t1, t2)) -> + let fsk = make_future_sk (pub, (t1, t2)) in + Ok fsk - let future_denominations () = - Sm_rsa.keys () - |> list_filter_map (fun (h_pub, (section_name, pub, t1)) -> - 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)) + let find_future_denomination h_pub = + match Sm_rsa.find_key h_pub with + | None -> Error "future denomination not found" + | Some (h_pub, (section_name, pub, t1)) -> + let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in + Ok future_dn 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 future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in + let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in + 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. @@ -268,43 +247,33 @@ module Make (Conn : Pg.CONN) : S = struct let certify_future_signkey pub master_sig = match Sm_eddsa.find_key pub with | 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 () + | Some (pub, (t1, t2)) -> ( + let* opt = find_signkey pub in + match opt with + | Some _sk -> + Logs.info (fun m -> m "signkey already certified"); + Ok () + | None -> + (* rebuild it *) + let future_sk = make_future_sk (pub, (t1, 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 = match Sm_rsa.find_key h_pub with | None -> Error "future denomination not found" - | Some (h_pub, (section_name, pub, t1)) -> - 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 () + | Some (h_pub, (section_name, pub, t1)) -> ( + let* opt = find_denomination h_pub in + match opt with + | Some _dn -> + Logs.info (fun m -> m "denomination already certified"); + Ok () + | None -> + let future_dn = make_future_dn (h_pub, (section_name, pub, 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