This commit is contained in:
swrup 2026-02-17 10:48:31 +01:00
parent f6cf06591b
commit 3af6a62540

View file

@ -44,37 +44,29 @@ module type S = sig
end end
module Make (Conn : Pg.CONN) = struct module Make (Conn : Pg.CONN) = struct
(* TODO
- key rotation
- how many signkey to use?
we just use 1 for now
- does the secmod's own key as metadata/expiration date?
- something to refer to valid sk/dn
- eddsa.ml with phantom type for key-kind + signed-data-kind *)
open Syntax open Syntax
open Crypto open Crypto
type signkey = { type sk = Signkey.t
priv: eddsa_priv; type future_sk = Api.FutureSignKey.t
sk_data: Signkey.t; type dn = Denomination.t
} type future_dn = Api.FutureDenom.t
type denom = {
priv: rsa_priv;
dn_data: Denomination.t;
}
(* TODO use lock *)
type t = { type t = {
lock: Miou.Mutex.t; sm_key: eddsa_priv;
sm_key_priv: eddsa_priv; sm_pubkey: eddsa_pub;
sm_key_pub: eddsa_pub; sk_ht: (eddsa_pub, sk) Hashtbl.t;
sk_ht: (eddsa_pub, signkey) Hashtbl.t; dn_ht: (rsa_pub, dn) Hashtbl.t;
dn_ht: (denomination_hash, denom) Hashtbl.t; sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
dn_section_name_ht: (denomination_hash, string) Hashtbl.t; dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t;
future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
future_dn_ht: (rsa_pub, future_dn) Hashtbl.t;
future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
future_dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t;
} }
let db_lookup_signkey_data conn fname pub = let database_find_sk conn fname pub =
let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
match opt with match opt with
| None -> | None ->
@ -84,8 +76,7 @@ module Make (Conn : Pg.CONN) = struct
(Fpath.to_string fname) (Fpath.to_string fname)
| Some sk_data -> Ok sk_data | Some sk_data -> Ok sk_data
let db_lookup_denomination conn ~section_name priv = let database_find_dn conn ~section_name pub =
let pub = RsaPrivateKey.pub_of_priv priv in
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
match opt with match opt with
@ -96,39 +87,13 @@ module Make (Conn : Pg.CONN) = struct
section_name section_name
| Some dn_data -> Ok dn_data | Some dn_data -> Ok dn_data
let load_signkey conn fname = (*
let* opt = Data_file.read_eddsa fname in
match opt with
| None -> Ok None
| Some priv ->
let pub = EddsaPrivateKey.pub_of_priv priv in let pub = EddsaPrivateKey.pub_of_priv priv in
let* sk_data = db_lookup_signkey_data conn fname pub in let* sk = db_lookup_signkey_data conn fname pub in
let signkey = { priv; sk_data } in let signkey = { priv; sk_data } in
Ok (Some signkey) Ok (Some signkey)
*)
let load conn = (*
let error_invalid_state =
Fmt.error "secmod load error: invalid store state."
in
let* sm_key_priv =
Data_file.read_eddsa Fpath.(Config.secrets_dir / "sk_sm")
in
let* signkeys =
let l =
List.init 1 (fun i -> Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i))
in
let* l = list_map (fun fname -> load_signkey conn fname) l in
match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
in
let dn_section_name_ht = Hashtbl.create 0xff in
let* denoms =
let* l =
let open Config.Coin in
list_map
(fun coin ->
let section_name = coin.section_name in
let fname = Fpath.(Config.secrets_dir / section_name) in
let* opt = Data_file.read_rsa fname in
match opt with match opt with
| None -> Ok None | None -> Ok None
| Some priv -> | Some priv ->
@ -137,32 +102,89 @@ module Make (Conn : Pg.CONN) = struct
Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name; Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name;
let denom = { priv; dn_data } in let denom = { priv; dn_data } in
Ok (Some denom)) Ok (Some denom))
*)
let load conn =
let error_invalid_state =
Fmt.error "secmod load error: invalid store state."
in
let* sm_key = Data_file.read_eddsa Fpath.(Config.secrets_dir / "sk_sm") in
let* sk_keys =
let l =
List.init 1 (fun i -> Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i))
in
let* l =
list_map
(fun fname ->
let+ opt = Data_file.read_eddsa fname in
Option.map (fun priv -> (fname, priv)) opt)
l
in
match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
in
let* dn_keys =
let* l =
let open Config.Coin in
list_map
(fun coin ->
let section_name = coin.section_name in
let fname = Fpath.(Config.secrets_dir / section_name) in
let+ opt = Data_file.read_rsa fname in
Option.map (fun priv -> (section_name, priv)) opt)
all_coins all_coins
in in
match Syntax.opt_list l with match Syntax.opt_list l with
| Error () -> error_invalid_state | Error () -> error_invalid_state
| Ok opt -> Ok opt | Ok opt -> Ok opt
in in
match (sm_key_priv, signkeys, denoms) with match (sm_key, sk_keys, dn_keys) with
| None, None, None -> Ok None | None, None, None -> Ok None
| Some sm_key_priv, Some signkeys, Some denoms -> | Some sm_key, Some sk_keys, Some dn_keys ->
let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in
let lock = Miou.Mutex.create () in let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
let sk_ht = (* sk *)
signkeys let* l =
|> List.map (fun v -> (v.sk_data.pub, v)) list_map
|> List.to_seq (fun (fname, priv) ->
|> Hashtbl.of_seq let pub = EddsaPrivateKey.pub_of_priv priv in
let+ sk = database_find_sk conn fname pub in
((pub, sk), (pub, priv)))
sk_keys
in in
let dn_ht = let sk_ht, sk_key_ht =
denoms let sk_l, priv_l = List.split l in
|> List.map (fun v -> (v.dn_data.h_pub, v)) (list_to_ht sk_l, list_to_ht priv_l)
|> List.to_seq
|> Hashtbl.of_seq
in in
Ok (* dn *)
(Some let* l =
{ lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }) list_map
(fun (section_name, priv) ->
let pub = RsaPrivateKey.pub_of_priv priv in
let+ dn = database_find_dn conn ~section_name pub in
((pub, dn), (pub, priv)))
dn_keys
in
let dn_ht, dn_key_ht =
let dn_l, priv_l = List.split l in
(list_to_ht dn_l, list_to_ht priv_l)
in
(* future keys are not stored (until they are signed)
so we don't have any future key to load *)
let t =
{
sm_key;
sm_pubkey;
sk_ht;
dn_ht;
sk_key_ht;
dn_key_ht;
future_sk_ht= Hashtbl.create 0xff;
future_dn_ht= Hashtbl.create 0xff;
future_sk_key_ht= Hashtbl.create 0xff;
future_dn_key_ht= Hashtbl.create 0xff;
}
in
Ok (Some t)
| _, _, _ -> error_invalid_state | _, _, _ -> error_invalid_state
let make_new_signkey () = let make_new_signkey () =