swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2026-02-17 10:48:31 +01:00
parent f6cf06591b
commit 3af6a62540
1 changed files with 95 additions and 73 deletions
Download patch file Download diff file Expand all files Collapse all files

168
src/secmod.ml
View file

@ -44,37 +44,29 @@ module type S = sig
end
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 Crypto
type signkey = {
priv: eddsa_priv;
sk_data: Signkey.t;
}
type denom = {
priv: rsa_priv;
dn_data: Denomination.t;
}
type sk = Signkey.t
type future_sk = Api.FutureSignKey.t
type dn = Denomination.t
type future_dn = Api.FutureDenom.t
(* TODO use lock *)
type t = {
lock: Miou.Mutex.t;
sm_key_priv: eddsa_priv;
sm_key_pub: eddsa_pub;
sk_ht: (eddsa_pub, signkey) Hashtbl.t;
dn_ht: (denomination_hash, denom) Hashtbl.t;
dn_section_name_ht: (denomination_hash, string) Hashtbl.t;
sm_key: eddsa_priv;
sm_pubkey: eddsa_pub;
sk_ht: (eddsa_pub, sk) Hashtbl.t;
dn_ht: (rsa_pub, dn) Hashtbl.t;
sk_key_ht: (eddsa_pub, eddsa_priv) 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
match opt with
| None ->
@ -84,8 +76,7 @@ module Make (Conn : Pg.CONN) = struct
(Fpath.to_string fname)
| Some sk_data -> Ok sk_data
let db_lookup_denomination conn ~section_name priv =
let pub = RsaPrivateKey.pub_of_priv priv in
let database_find_dn conn ~section_name pub =
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
match opt with
@ -96,39 +87,13 @@ module Make (Conn : Pg.CONN) = struct
section_name
| 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* 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
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
| None -> Ok None
| Some priv ->
@ -137,32 +102,89 @@ module Make (Conn : Pg.CONN) = struct
Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name;
let denom = { priv; dn_data } in
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
in
match Syntax.opt_list l with
| Error () -> error_invalid_state
| Ok opt -> Ok opt
in
match (sm_key_priv, signkeys, denoms) with
match (sm_key, sk_keys, dn_keys) with
| None, None, None -> Ok None
| Some sm_key_priv, Some signkeys, Some denoms ->
let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
let lock = Miou.Mutex.create () in
let sk_ht =
signkeys
|> List.map (fun v -> (v.sk_data.pub, v))
|> List.to_seq
|> Hashtbl.of_seq
| Some sm_key, Some sk_keys, Some dn_keys ->
let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in
let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
(* sk *)
let* l =
list_map
(fun (fname, priv) ->
let pub = EddsaPrivateKey.pub_of_priv priv in
let+ sk = database_find_sk conn fname pub in
((pub, sk), (pub, priv)))
sk_keys
in
let dn_ht =
denoms
|> List.map (fun v -> (v.dn_data.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
let sk_ht, sk_key_ht =
let sk_l, priv_l = List.split l in
(list_to_ht sk_l, list_to_ht priv_l)
in
Ok
(Some
{ lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht })
(* dn *)
let* l =
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
let make_new_signkey () =