From d23409628cdbf56f696bc52f4f94d6643556d987 Mon Sep 17 00:00:00 2001 From: swrup Date: Wed, 25 Feb 2026 18:34:25 +0100 Subject: [PATCH] --- src/http_management.ml | 2 +- src/keys.ml | 43 +++++++++++++++++++++++++++++++----------- src/secmod_eddsa.ml | 10 +++------- src/secmod_rsa.ml | 10 +++------- 4 files changed, 39 insertions(+), 26 deletions(-) diff --git a/src/http_management.ml b/src/http_management.ml index dd40ef66..a431f362 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -9,7 +9,7 @@ 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 diff --git a/src/keys.ml b/src/keys.ml index 17ceda97..18ec76ad 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -13,7 +13,7 @@ module type S = sig val denominations : unit -> Denomination.t list 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 make_future_keys_response : unit -> Api.FutureKeysResponse.t result val certify_future_signkey : eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result @@ -194,16 +194,37 @@ module Make (Conn : Pg.CONN) : S = struct Ok future_dn let make_future_keys_response () = - 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 now = Timestamp.of_ptime @@ Ptime_clock.now () in + (* get keys from database to filter out keys already certified *) + let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in + let sk_ht = Hashtbl.create 0xff in + List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l; + let future_signkeys = + Sm_eddsa.keys () + |> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub) + |> List.map make_future_sk + in + let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in + let dn_ht = Hashtbl.create 0xff in + List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l; + let future_denoms = + Sm_rsa.keys () + |> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub) + |> List.map make_future_dn + in + Logs.info (fun m -> + m "%d future signkey(s) and %d future denomination(s) to certify" + (List.length future_signkeys) + (List.length future_denoms)); + 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. diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index f6f21c28..6cf9ac1e 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -76,7 +76,7 @@ let get_key_dir_contents dir = let+ l = Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg in - l + List.map Fpath.normalize l (* -- *) @@ -137,11 +137,7 @@ let load_key fpath = let load () = let* l = get_key_dir_contents Cfg.key_dir in - let l = - l - |> List.map Fpath.normalize - |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) - in + let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in let* keys = list_map load_key l in match keys with | [] -> Ok None @@ -168,7 +164,7 @@ let init () = let now = TimeAbsolute.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 + List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys; let+ () = list_iter write_key new_keys in t diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 4c07667f..226afccb 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -118,7 +118,7 @@ let get_key_dir_contents dir_fpath = let+ l = Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg in - l + List.map Fpath.normalize l (* -- *) @@ -185,11 +185,7 @@ let load_key ~section_name fpath = 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 = - l - |> List.map Fpath.normalize - |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) - in + let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in let* keys = list_map (load_key ~section_name) l in Ok keys @@ -230,7 +226,7 @@ let init () = Cfg.sections in let new_keys = List.concat new_keys_l in - let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in + List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys; let+ () = list_iter write_key new_keys in t