From 20d2ba2fc49149afeacd9d2c39f3da409341525c Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 23 Feb 2026 12:29:49 +0100 Subject: [PATCH] +wip db-sm sync issue --- src/keys.ml | 58 +++++++++++++++++++++++++++++++++++---------- src/pg.ml | 6 ++--- src/secmod_eddsa.ml | 10 ++++---- src/secmod_rsa.ml | 13 +++++----- src/signatures.ml | 4 +--- src/time.ml | 1 - 6 files changed, 59 insertions(+), 33 deletions(-) diff --git a/src/keys.ml b/src/keys.ml index 36357e6c..c4b5f83b 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -53,14 +53,48 @@ module Make (Conn : Pg.CONN) : S = struct 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* l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in + let* () = + list_iter + (fun sk -> + match Sm_eddsa.find_key sk.Signkey.pub with + | None -> + Fmt.error + "signkeys found in database are missing from secmod, (unclean \ + database/secmod state?)" + | Some _ -> Ok ()) + l + in + Ok l - let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti + let denominations () = + let* l = Pg.get_denominations conn () |> unwrap_err_caqti in + let* () = + list_iter + (fun dn -> + match Sm_rsa.find_key dn.Denomination.pub with + | None -> + Fmt.error + "denominations found in database are missing from secmod, \ + (unclean database/secmod state?)" + | Some _ -> Ok ()) + l + in + Ok l + + (* TODO db-sm + don't fail and just warn? + have something to run tests with clean db+sm *) + (* test if database/secmod state looks ok *) + let () = + let res = + let* _sk_l = signkeys () in + let* _dn_l = denominations () in + Ok () + in + match res with Error e -> Fmt.failwith "%s" e | Ok () -> () let make_future_sk ~pub ~start ~expire = let stamp_start = Timestamp.of_absolute start in @@ -141,7 +175,7 @@ module Make (Conn : Pg.CONN) : S = struct let future_signkeys () = Sm_eddsa.keys () - |> list_filter_map (fun (pub, t1, t2) -> + |> list_filter_map (fun (pub, (t1, t2)) -> let* opt = find_signkey pub in match opt with | None -> @@ -157,7 +191,7 @@ module Make (Conn : Pg.CONN) : S = struct let future_denominations () = Sm_rsa.keys () - |> list_filter_map (fun (section_name, pub, t1) -> + |> list_filter_map (fun (pub, (section_name, t1)) -> let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in let* opt = find_denomination h_pub in match opt with @@ -241,10 +275,9 @@ module Make (Conn : Pg.CONN) : S = struct } let certify_future_signkey pub master_sig = - Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub) - |> function + match Sm_eddsa.find_key pub with | None -> Error "future signkey not found" - | Some (pub, t1, t2) -> + | Some (pub, (t1, t2)) -> let* () = let* opt = find_signkey pub in match opt with @@ -258,13 +291,14 @@ module Make (Conn : Pg.CONN) : S = struct Ok () let certify_future_denomination h_pub master_sig = + (* TODO Sm_rsa.find_key *) Sm_rsa.keys () - |> List.find_opt (fun (_section_name, pub, _t1) -> + |> List.find_opt (fun (pub, (_section_name, _t1)) -> 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) -> + | Some (pub, (section_name, t1)) -> let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in let* () = let* opt = find_denomination h_pub in diff --git a/src/pg.ml b/src/pg.ml index d64cd088..28e3d5d5 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -1,6 +1,4 @@ (* TODO - check signed/unsigned ints - check endianness can we avoid amount tuple boilerplate? clean up caqti error type @@ -44,12 +42,12 @@ let find_signkey = fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> Conn.find_opt req exchange_pub -let get_active_signkeys = +let get_signkeys = let req = Caqti_type.(time ->* signkey) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig FROM exchange_sign_keys esk WHERE \ - expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \ + esk.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 req now diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index 7a753253..7eec6927 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -200,12 +200,6 @@ module Make () = struct (* ---- *) 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 = @@ -218,6 +212,10 @@ module Make () = struct let* k = find pub in let* () = delete pub in add k.t1 k.t2; Ok () + + let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2)) + let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv + let find_key pub = Hashtbl.find_opt t.ht pub |> Option.map conv end (* TODO diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 361302b5..09bb7614 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -259,13 +259,6 @@ module Make () = struct () 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)) - let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s let sign pub s = @@ -278,4 +271,10 @@ module Make () = struct let* () = delete pub in add k.section_name k.t1 k.t2; Ok () + + let conv = + fun { section_name; priv= _; pub; t1; t2= _ } -> (pub, (section_name, t1)) + + let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv + let find_key pub = Hashtbl.find_opt t.ht pub |> Option.map conv end diff --git a/src/signatures.ml b/src/signatures.ml index 36328a2a..fe787f24 100644 --- a/src/signatures.ml +++ b/src/signatures.ml @@ -1,7 +1,5 @@ (* TODO signatures - check with taler-wallet - check signed/unsigned ints - check endianness *) + rm non-NBO bin *) open Hash module Aliases = struct diff --git a/src/time.ml b/src/time.ml index b1789951..3ac0368b 100644 --- a/src/time.ml +++ b/src/time.ml @@ -29,7 +29,6 @@ module Relative = struct let bin = Bin.neint64 let bin_nbo = Bin.beint64 - (* TODO should be in NBO here? *) let caqti = let encode v = Ok v in let decode v = Ok v in