secmod_rsa: use denom_hash

This commit is contained in:
swrup 2026-02-24 17:23:03 +01:00 committed by Swrup
parent af885e4a7c
commit 7053607c72
3 changed files with 45 additions and 50 deletions

View file

@ -18,6 +18,7 @@ type t = {
let make_denom_group_sorted denominations = let make_denom_group_sorted denominations =
let open Syntax in let open Syntax in
(* use hashtbl to re-group denoms *)
let ht = Hashtbl.create 0xff in let ht = Hashtbl.create 0xff in
List.iter List.iter
(fun coin -> (fun coin ->
@ -63,15 +64,14 @@ let make_denom_group_sorted denominations =
lost= None; lost= None;
} }
in in
let+ l =
match Hashtbl.find_opt ht k with match Hashtbl.find_opt ht k with
| None -> | None -> Error "denomination does not match any coin in configuration"
Error "denomination does not match any coin in configuration" | Some l ->
| Some l -> Ok l Hashtbl.replace ht k (v :: l);
in Ok ())
Hashtbl.replace ht k (v :: l))
denominations denominations
in in
let l = Hashtbl.to_seq ht |> List.of_seq in
(* ! important for /keys .exchange_sig (* ! important for /keys .exchange_sig
each group must be ordered in _reverse_ chronological order each group must be ordered in _reverse_ chronological order
@ -84,6 +84,7 @@ let make_denom_group_sorted denominations =
let cmp_denom b a = Timestamp.compare a.stamp_start b.stamp_start in let cmp_denom b a = Timestamp.compare a.stamp_start b.stamp_start in
let cmp_group = let cmp_group =
let cmp_amount a b = let cmp_amount a b =
(* TODO amount *)
let open Amount in let open Amount in
match Int64.unsigned_compare a.value b.value with match Int64.unsigned_compare a.value b.value with
| 0 -> Int32.unsigned_compare a.fraction b.fraction | 0 -> Int32.unsigned_compare a.fraction b.fraction
@ -92,8 +93,7 @@ let make_denom_group_sorted denominations =
fun (Rsa a) (Rsa b) -> cmp_amount a.value b.value fun (Rsa a) (Rsa b) -> cmp_amount a.value b.value
in in
let l = let l =
Hashtbl.to_seq ht l
|> List.of_seq
|> List.map |> List.map
(fun (fun
((value, fee_withdraw, fee_deposit, fee_refresh, fee_refund), denoms) ((value, fee_withdraw, fee_deposit, fee_refresh, fee_refund), denoms)

View file

@ -6,7 +6,7 @@ type 'a result = ('a, string) Result.t
module type S = sig module type S = sig
val sign : eddsa_pub -> string -> eddsa_sig val sign : eddsa_pub -> string -> eddsa_sig
val sign_denom : rsa_pub -> string -> rsa_sig val sign_denom : denom_hash -> string -> rsa_sig
val find_signkey : eddsa_pub -> Signkey.t option result val find_signkey : eddsa_pub -> Signkey.t option result
val find_denomination : denom_hash -> Denomination.t option result val find_denomination : denom_hash -> Denomination.t option result
val signkeys : unit -> Signkey.t list result val signkeys : unit -> Signkey.t list result
@ -44,8 +44,8 @@ module Make (Conn : Pg.CONN) : S = struct
| Error e -> Fmt.failwith "sign failure: %s." e | Error e -> Fmt.failwith "sign failure: %s." e
| Ok v -> v | Ok v -> v
let sign_denom pub s = let sign_denom h_pub s =
match Sm_rsa.sign pub s with match Sm_rsa.sign h_pub s with
| Error e -> Fmt.failwith "sign_denom failure: %s." e | Error e -> Fmt.failwith "sign_denom failure: %s." e
| Ok v -> v | Ok v -> v
@ -74,7 +74,7 @@ module Make (Conn : Pg.CONN) : S = struct
let+ l = Pg.get_denominations conn () |> unwrap_err_caqti in let+ l = Pg.get_denominations conn () |> unwrap_err_caqti in
let missing_l, l = let missing_l, l =
List.partition List.partition
(fun dn -> Option.is_none @@ Sm_rsa.find_key dn.Denomination.pub) (fun dn -> Option.is_none @@ Sm_rsa.find_key dn.Denomination.h_pub)
l l
in in
match missing_l with match missing_l with
@ -181,8 +181,7 @@ module Make (Conn : Pg.CONN) : S = struct
let future_denominations () = let future_denominations () =
Sm_rsa.keys () Sm_rsa.keys ()
|> list_filter_map (fun (pub, (section_name, t1)) -> |> list_filter_map (fun (h_pub, (section_name, pub, t1)) ->
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
let* opt = find_denomination h_pub in let* opt = find_denomination h_pub in
match opt with match opt with
| None -> | None ->
@ -281,15 +280,9 @@ module Make (Conn : Pg.CONN) : S = struct
Ok () Ok ()
let certify_future_denomination h_pub master_sig = let certify_future_denomination h_pub master_sig =
(* TODO Sm_rsa.find_key *) match Sm_rsa.find_key h_pub with
Sm_rsa.keys ()
|> 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" | None -> Error "future denomination not found"
| Some (pub, (section_name, t1)) -> | Some (h_pub, (section_name, pub, t1)) ->
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
let* () = let* () =
let* opt = find_denomination h_pub in let* opt = find_denomination h_pub in
match opt with match opt with
@ -323,10 +316,9 @@ module Make (Conn : Pg.CONN) : S = struct
let revoke_denomination h_pub revoked_sig = let revoke_denomination h_pub revoked_sig =
let* opt = find_denomination h_pub in let* opt = find_denomination h_pub in
let* dn = Option.to_result ~none:"denomination not found" opt in let* dn = Option.to_result ~none:"denomination not found" opt in
let pub = dn.pub in let* () = Sm_rsa.revoke dn.h_pub in
let* () = Sm_rsa.revoke pub in
let+ () = let+ () =
Pg.insert_denomination_revocation conn h_pub revoked_sig Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
|> unwrap_err_caqti |> unwrap_err_caqti
in in
() ()

View file

@ -1,6 +1,4 @@
(* TODO (* TODO refacto common parts with secmod_eddsa *)
refacto common parts with secmod_eddsa
use DenominationHash.t instead of rsa_pub? *)
let src = Logs.Src.create "mte.secmod_rsa" let src = Logs.Src.create "mte.secmod_rsa"
module Log = (val Logs.src_log src : Logs.LOG) module Log = (val Logs.src_log src : Logs.LOG)
@ -9,6 +7,7 @@ module Log = (val Logs.src_log src : Logs.LOG)
open Syntax open Syntax
open Crypto open Crypto
open Time open Time
module DenominationHash = Hash.DenominationHash
module Cfg = struct module Cfg = struct
open Config open Config
@ -45,6 +44,7 @@ type key = {
section_name: string; section_name: string;
priv: RsaPrivateKey.t; priv: RsaPrivateKey.t;
pub: RsaPublicKey.t; pub: RsaPublicKey.t;
h_pub: DenominationHash.t;
t1: Absolute.t; t1: Absolute.t;
t2: Absolute.t; t2: Absolute.t;
} }
@ -52,7 +52,7 @@ type key = {
type t = { type t = {
sm_key_priv: EddsaPrivateKey.t; sm_key_priv: EddsaPrivateKey.t;
sm_pub: EddsaPublicKey.t; sm_pub: EddsaPublicKey.t;
ht: (RsaPublicKey.t, key) Hashtbl.t; ht: (DenominationHash.t, key) Hashtbl.t;
} }
let parse_filename = let parse_filename =
@ -119,10 +119,11 @@ let get_key_dir_contents dir_fpath =
let gen_key ~section_name t1 t2 = let gen_key ~section_name t1 t2 =
let bits = Cfg.rsa_keysize ~section_name in let bits = Cfg.rsa_keysize ~section_name in
let priv, pub = RsaPrivateKey.generate ~bits () in let priv, pub = RsaPrivateKey.generate ~bits () in
let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
Log.debug (fun m -> Log.debug (fun m ->
m "generated key (%a):@,`%s`" pp_filename (t1, t2) m "generated key (%a):@,`%s`" pp_filename (t1, t2)
(RsaPublicKey.to_b32 pub)); (DenominationHash.to_octets h_pub |> B32.encode));
{ section_name; priv; pub; t1; t2 } { section_name; priv; pub; h_pub; t1; t2 }
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
@ -172,7 +173,8 @@ let load_key ~section_name fpath =
| Some (t1, t2) -> | Some (t1, t2) ->
let+ priv = read_rsa fpath in let+ priv = read_rsa fpath in
let pub = RsaPrivateKey.pub_of_priv priv in let pub = RsaPrivateKey.pub_of_priv priv in
{ section_name; priv; pub; t1; t2 } let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
{ section_name; priv; pub; h_pub; t1; t2 }
let load_section section_name = let load_section section_name =
let section_fpath = Fpath.(v Cfg.key_dir / section_name) in let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
@ -194,7 +196,7 @@ let load () =
let* sm_key_priv = read_eddsa sm_key_fpath in let* sm_key_priv = read_eddsa sm_key_fpath in
let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
let ht = Hashtbl.create 0xff in let ht = Hashtbl.create 0xff in
let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in let () = List.iter (fun k -> Hashtbl.replace ht k.h_pub k) keys in
Ok (Some { sm_key_priv; sm_pub; ht }) Ok (Some { sm_key_priv; sm_pub; ht })
let init () = let init () =
@ -222,7 +224,7 @@ let init () =
Cfg.sections Cfg.sections
in in
let new_keys = List.concat new_keys_l in let new_keys = List.concat new_keys_l in
let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys in let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in
let+ () = list_iter write_key new_keys in let+ () = list_iter write_key new_keys in
t t
@ -238,42 +240,43 @@ module Make () = struct
| Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
| Ok t -> t | Ok t -> t
let find pub = let find h_pub =
Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" Hashtbl.find_opt t.ht h_pub |> Option.to_result ~none:"key not found"
let delete pub = let delete h_pub =
let* k = find pub in let* k = find h_pub in
Hashtbl.remove t.ht k.pub; Hashtbl.remove t.ht h_pub;
delete_file (key_fpath k) delete_file (key_fpath k)
let _delete_outdated ~now = let _delete_outdated ~now =
Hashtbl.to_seq_values t.ht Hashtbl.to_seq t.ht
|> List.of_seq |> List.of_seq
|> List.filter (fun k -> Absolute.compare now k.t2 >= 0) |> List.filter (fun (_h_pub, k) -> Absolute.compare now k.t2 >= 0)
|> List.map (fun k -> k.pub) |> List.map (fun (h_pub, _k) -> h_pub)
|> list_iter delete |> list_iter delete
let add section_name t1 t2 = let add section_name t1 t2 =
let k = gen_key ~section_name t1 t2 in let k = gen_key ~section_name t1 t2 in
Hashtbl.replace t.ht k.pub k; Hashtbl.replace t.ht k.h_pub k;
() ()
let sm_pub = t.sm_pub let sm_pub = t.sm_pub
let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
let sign pub s = let sign h_pub s =
let+ k = find pub in let+ k = find h_pub in
let data = RsaSignature.sign ~key:k.priv s in let data = RsaSignature.sign ~key:k.priv s in
data data
let revoke pub = let revoke h_pub =
let* k = find pub in let* k = find h_pub in
let* () = delete pub in let* () = delete h_pub in
add k.section_name k.t1 k.t2; add k.section_name k.t1 k.t2;
Ok () Ok ()
let conv = let conv =
fun { section_name; priv= _; pub; t1; t2= _ } -> (pub, (section_name, t1)) fun { section_name; priv= _; pub; h_pub; t1; t2= _ } ->
(h_pub, (section_name, pub, t1))
let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv 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 let find_key pub = Hashtbl.find_opt t.ht pub |> Option.map conv