From 7daa929b0b97d7e013b46c111b845a6f94baf70b Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 6 Dec 2025 23:25:29 +0100 Subject: [PATCH] wip lock --- src/database.ml | 2 +- src/devices.ml | 24 ++-------------- src/management.ml | 53 +++++++++++++++++----------------- src/secmod_denom.ml | 57 +++++++++++++++++++++++++++++++------ src/secmod_denom.mli | 6 ++++ src/secmod_signkey.ml | 64 ++++++++++++++++++++++++++++++++++-------- src/secmod_signkey.mli | 6 ++++ 7 files changed, 141 insertions(+), 71 deletions(-) create mode 100644 src/secmod_denom.mli create mode 100644 src/secmod_signkey.mli diff --git a/src/database.ml b/src/database.ml index 07f5661e..7ee23436 100644 --- a/src/database.ml +++ b/src/database.ml @@ -27,7 +27,7 @@ let dummy_master_sig = let test_activate req server _ = let db_conn = Vif.Server.device Devices.db_connection server in let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in - let sm_key = secmod_signkey.sm_key in + let sm_key = Secmod_signkey.get_sm_key secmod_signkey in let sm_key = { sm_key with master_sig= dummy_master_sig } in let res = Pg.activate_signing_key db_conn sm_key in Result.fold ~ok:(on_ok req) ~error:(on_error req) res diff --git a/src/devices.ml b/src/devices.ml index e91f0eb2..f5f5a4f7 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -22,29 +22,9 @@ let secmod_signkey = let finally _key = () in Vif.Device.v ~name:"secmod_signkey" ~finally [ Vif.Device.value db_connection ] - @@ fun conn (_env : env) -> - match Secmod_signkey.load conn with - | Ok None -> - let t = Secmod_signkey.make_new () in - Logs.info (fun m -> m "secmod_signkey initialized with fresh keys"); - t - | Ok (Some v) -> - Logs.info (fun m -> m "secmod_signkey initialized from storage"); - v - | Error _ -> - (* TODO error: pretty print *) - Fmt.failwith "secmod_signkey init failure." + @@ fun conn (_env : env) -> Secmod_signkey.init conn let secmod_denom = let finally _key = () in Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ] - @@ fun conn (_env : env) -> - match Secmod_denom.load conn with - | Ok None -> - let t = Secmod_denom.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." + @@ fun conn (_env : env) -> Secmod_denom.init conn diff --git a/src/management.ml b/src/management.ml index dc7e6331..993024e7 100644 --- a/src/management.ml +++ b/src/management.ml @@ -66,22 +66,25 @@ let mk_future_signkey ~sm_signkey_priv let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t) ~(sm_denom : Secmod_denom.t) = - let future_denoms = - sm_denom.keys - |> List.filter (fun k -> Option.is_none k.Denomination.master_sig) - |> List.map (fun denom -> - mk_future_denom ~sm_denom_priv:sm_denom.sm_key.Signkey.priv denom) - in let future_signkeys = - sm_signkey.keys + Secmod_signkey.get_signkeys sm_signkey |> List.filter (fun k -> Option.is_none k.Signkey.master_sig) |> List.map (fun signkey -> - mk_future_signkey ~sm_signkey_priv:sm_signkey.sm_key.Signkey.priv - signkey) + let sm_signkey_priv = + (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv + in + mk_future_signkey ~sm_signkey_priv signkey) + in + let future_denoms = + Secmod_denom.get_denoms sm_denom + |> List.filter (fun k -> Option.is_none k.Denomination.master_sig) + |> List.map (fun denom -> + let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in + mk_future_denom ~sm_denom_priv denom) in let master_pub = Config.Exchange.master_public_key in - let denom_secmod_public_key = sm_denom.sm_key.pub in - let signkey_secmod_public_key = sm_signkey.sm_key.pub in + let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in + let signkey_secmod_public_key = (Secmod_signkey.get_sm_key sm_signkey).pub in FutureKeysResponse. { future_denoms; @@ -93,7 +96,7 @@ let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t) (* - ** - *) -let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig } +let verify_denom_signature ~sm_denoms DenomSignature.{ h_denom_pub; master_sig } = let open Syntax in let denom_hash = @@ -103,7 +106,7 @@ let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig } let opt = List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash) - sm_denom.Secmod_denom.keys + sm_denoms in match opt with | None -> @@ -129,13 +132,11 @@ let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig } in verify ~key:Config.master_public_key master_sig r -let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig } = +let verify_signkey_signature ~sm_signkeys SignKeySignature.{ key; master_sig } = let open Syntax in let* signkey = let opt = - List.find_opt - (fun (signkey : Signkey.t) -> signkey.pub = key) - sm_signkey.Secmod_signkey.keys + List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) sm_signkeys in match opt with | None -> @@ -155,17 +156,11 @@ let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig } = in verify ~key:Config.master_public_key master_sig r -let verify_master_signatures ~sm_signkey ~sm_denom +let verify_master_signatures ~sm_signkeys ~sm_denoms MasterSignatures.{ denom_sigs; signkey_sigs } = let open Syntax in - let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in - let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in - Ok () - -(* --- *) - -let store_master_signatures _ = - (* TODO *) + let* () = list_iter (verify_denom_signature ~sm_denoms) denom_sigs in + let* () = list_iter (verify_signkey_signature ~sm_signkeys) signkey_sigs in Ok () (* --- *) @@ -215,9 +210,11 @@ let keys_post req server _env = Error msg in let* () = - verify_master_signatures ~sm_signkey ~sm_denom master_signatures + let sm_denoms = Secmod_denom.get_denoms sm_denom in + let sm_signkeys = Secmod_signkey.get_signkeys sm_signkey in + verify_master_signatures ~sm_signkeys ~sm_denoms master_signatures in - let* () = store_master_signatures () in + (* TODO let* () = update_master_signatures () in*) Ok "" in respond_with_res res req diff --git a/src/secmod_denom.ml b/src/secmod_denom.ml index 504e0755..a2d6d6ea 100644 --- a/src/secmod_denom.ml +++ b/src/secmod_denom.ml @@ -1,16 +1,29 @@ open Syntax type t = { + lock: Miou.Mutex.t; sm_key: Signkey.t; - (* TODO rename *) - keys: Denomination.t list; + denom_ht: (Bin_type.DenominationHash.t, Denomination.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 + +(* TODO *) +let update_denoms _conn t denoms = + Miou.Mutex.protect t.lock @@ fun () -> + List.iter + (fun denom -> Hashtbl.replace t.denom_ht denom.Denomination.h_pub denom) + denoms + let dir = Fpath.(v "data" / "secmod_signkey") -let store_secmod_data t = +let _store_secmod_data t = let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in - t.keys + get_denoms t |> List.mapi (fun i key -> let fname = Fpath.(dir / string_of_int i) in (fname, key.Denomination.priv)) @@ -21,7 +34,7 @@ let load conn = 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* keys = + let* denoms = let* l = let open Config.Coin in Syntax.list_map @@ -36,12 +49,38 @@ let load conn = | Error () -> error_invalid_state | Ok opt -> Ok opt in - match (sm_key, keys) with + match (sm_key, denoms) with | None, None -> Ok None - | Some sm_key, Some keys -> Ok (Some { sm_key; keys }) + | 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 + Ok (Some { lock; sm_key; denom_ht }) | _, _ -> error_invalid_state let make_new () = + let lock = Miou.Mutex.create () in let sm_key = Signkey.make () in - let keys = List.map Denomination.make Config.Coin.all_coins in - { sm_key; keys } + 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 + { lock; sm_key; denom_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." diff --git a/src/secmod_denom.mli b/src/secmod_denom.mli new file mode 100644 index 00000000..9c5b2413 --- /dev/null +++ b/src/secmod_denom.mli @@ -0,0 +1,6 @@ +type t + +val get_sm_key : t -> Signkey.t +val get_denoms : t -> Denomination.t list +val update_denoms : (module Pg.CONN) -> t -> Denomination.t list -> unit +val init : (module Pg.CONN) -> t diff --git a/src/secmod_signkey.ml b/src/secmod_signkey.ml index 128a38c0..d1a6067c 100644 --- a/src/secmod_signkey.ml +++ b/src/secmod_signkey.ml @@ -1,19 +1,33 @@ (* TODO - - key rotation - - how many signkey to use? - we just use 1 for now *) + - key rotation + - how many signkey to use? + we just use 1 for now *) open Syntax type t = { + lock: Miou.Mutex.t; sm_key: Signkey.t; - keys: Signkey.t list; + signkey_ht: (Crypto.EddsaPublicKey.t, Signkey.t) Hashtbl.t; } +let get_sm_key t = t.sm_key + +let get_signkeys t = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.to_seq_values t.signkey_ht |> List.of_seq + +(* TODO *) +let update_signkeys _conn t signkeys = + Miou.Mutex.protect t.lock @@ fun () -> + List.iter + (fun signkey -> Hashtbl.replace t.signkey_ht signkey.Signkey.pub signkey) + signkeys + let dir = Fpath.(v "data" / "secmod_signkey") -let store_secmod_data t = +let _store_secmod_data t = let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in - t.keys + get_signkeys t |> List.mapi (fun i key -> let fname = Fpath.(dir / string_of_int i) in (fname, key.Signkey.priv)) @@ -24,7 +38,7 @@ let load conn = Fmt.error_msg "secmod_signkey load error: invalid store state." in let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in - let* keys = + let* signkeys = let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in let* l = Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l @@ -33,12 +47,40 @@ let load conn = | Error () -> error_invalid_state | Ok opt -> Ok opt in - match (sm_key, keys) with + match (sm_key, signkeys) with | None, None -> Ok None - | Some sm_key, Some keys -> Ok (Some { sm_key; keys }) + | Some sm_key, Some signkeys -> + let lock = Miou.Mutex.create () in + let signkey_ht = + signkeys + |> List.map (fun v -> (v.Signkey.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + Ok (Some { lock; sm_key; signkey_ht }) | _, _ -> error_invalid_state let make_new () = + let lock = Miou.Mutex.create () in let sm_key = Signkey.make () in - let keys = [ Signkey.make () ] in - { sm_key; keys } + let signkeys = [ Signkey.make () ] in + let signkey_ht = + signkeys + |> List.map (fun v -> (v.Signkey.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + { lock; sm_key; signkey_ht } + +let init conn = + match load conn with + | Ok None -> + let t = make_new () in + Logs.info (fun m -> m "secmod_signkey initialized with fresh keys"); + t + | Ok (Some v) -> + Logs.info (fun m -> m "secmod_signkey initialized from storage"); + v + | Error _ -> + (* TODO error: pretty print *) + Fmt.failwith "secmod_signkey init failure." diff --git a/src/secmod_signkey.mli b/src/secmod_signkey.mli new file mode 100644 index 00000000..a80b07de --- /dev/null +++ b/src/secmod_signkey.mli @@ -0,0 +1,6 @@ +type t + +val get_sm_key : t -> Signkey.t +val get_signkeys : t -> Signkey.t list +val update_signkeys : (module Pg.CONN) -> t -> Signkey.t list -> unit +val init : (module Pg.CONN) -> t