mte/src/secmod_denom.ml
2025-12-07 19:01:09 +01:00

112 lines
3.4 KiB
OCaml

open Syntax
type h_denom_pub = Bin_type.DenominationHash.t
type t = {
lock: Miou.Mutex.t;
sm_key: Signkey.t;
denom_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
revoked_ht:
( h_denom_pub,
Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
Hashtbl.t;
}
let get_sm_key t = t.sm_key
let get_denoms t =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.denom_ht |> List.of_seq
let add_master_signatures conn t l =
Miou.Mutex.protect t.lock @@ fun () ->
list_iter
(fun (h_denom_pub, master_sig) ->
match Hashtbl.find_opt t.denom_ht h_denom_pub with
| None -> Error "secmod_denom failure: denomination hash not found."
| Some denom ->
let denom = { denom with master_sig= Some master_sig } in
let* () =
Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
in
Hashtbl.replace t.denom_ht h_denom_pub denom;
Ok ())
l
let revoke_denomination t h_denom_pub master_sig =
Miou.Mutex.protect t.lock @@ fun () ->
match Hashtbl.find_opt t.denom_ht h_denom_pub with
| None -> Error "secmod_denom failure: denomination hash not found."
| Some denom ->
Hashtbl.remove t.denom_ht h_denom_pub;
Hashtbl.replace t.revoked_ht h_denom_pub (denom, master_sig);
Ok ()
let dir = Fpath.(v "data" / "secmod_signkey")
(* TODO secmod store *)
let _store_secmod_data t =
let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
get_denoms t
|> List.mapi (fun i key ->
let fname = Fpath.(dir / string_of_int i) in
(fname, key.Denomination.priv))
|> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
let load conn =
let error_invalid_state =
Fmt.error_msg "secmod_denom load error: invalid store state."
in
let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
let* denoms =
let* l =
let open Config.Coin in
Syntax.list_map
(fun coin ->
let section_name = coin.section_name in
let fname = Fpath.(dir / section_name) in
(* todo: could check that coin config match db values *)
Data_file.load_denom conn ~section_name fname)
all_coins
in
match Syntax.opt_list l with
| Error () -> error_invalid_state
| Ok opt -> Ok opt
in
match (sm_key, denoms) with
| None, None -> Ok None
| Some sm_key, Some denoms ->
let lock = Miou.Mutex.create () in
let denom_ht =
denoms
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
Ok (Some { lock; sm_key; denom_ht; revoked_ht })
| _, _ -> error_invalid_state
let make_new () =
let lock = Miou.Mutex.create () in
let sm_key = Signkey.make () in
let denoms = List.map Denomination.make Config.Coin.all_coins in
let denom_ht =
denoms
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
{ lock; sm_key; denom_ht; revoked_ht }
let init conn =
match load conn with
| Ok None ->
let t = make_new () in
Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
t
| Ok (Some v) ->
Logs.info (fun m -> m "secmod_denom initialized from storage");
v
| Error _ -> Fmt.failwith "secmod_denom init failure."