diff --git a/src/keys.ml b/src/keys.ml index 36357e6c..db9b3694 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -53,14 +53,47 @@ 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 now = Timestamp.of_ptime @@ Ptime_clock.now () in*) + let* l = Pg.get_signkeys conn () |> 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 + 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 +174,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 +190,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 +274,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 +290,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..686eba37 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -44,15 +44,20 @@ let find_signkey = fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> Conn.find_opt req exchange_pub -let get_active_signkeys = +(* TODO filter active signkeys *) +(* + "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 \ + signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)" + *) +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 \ - signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)" + Caqti_type.(unit ->* signkey) + "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \ + FROM exchange_sign_keys" in - fun (module Conn : CONN) ~now -> Conn.collect_list req now + fun (module Conn : CONN) () -> Conn.collect_list req () let insert_signkey = let req = 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