From 15c132829ee1326799173975a49e786b457854de Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 15 Dec 2025 15:01:40 +0100 Subject: [PATCH] merge secmod --- src/data_file.ml | 26 ---- src/devices.ml | 12 +- src/keys.ml | 7 +- src/management.ml | 89 ++++++-------- src/mte.ml | 5 +- src/secmod.ml | 269 +++++++++++++++++++++++++++++++++++++++++ src/secmod.mli | 36 ++++++ src/secmod_denom.ml | 166 ------------------------- src/secmod_denom.mli | 18 --- src/secmod_signkey.ml | 105 ---------------- src/secmod_signkey.mli | 19 --- 11 files changed, 348 insertions(+), 404 deletions(-) create mode 100644 src/secmod.ml create mode 100644 src/secmod.mli delete mode 100644 src/secmod_denom.ml delete mode 100644 src/secmod_denom.mli delete mode 100644 src/secmod_signkey.ml delete mode 100644 src/secmod_signkey.mli diff --git a/src/data_file.ml b/src/data_file.ml index a95f5817..44b98908 100644 --- a/src/data_file.ml +++ b/src/data_file.ml @@ -30,29 +30,3 @@ let read_rsa fname = RsaPrivateKey.of_octets data |> function | Error e -> Error (`Msg e) | Ok v -> Ok (Some v)) - -(* todo: move this *) -let db_lookup_signkey_data conn fname priv = - let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in - let* opt = Pg.lookup_signing_key conn pub in - match opt with - | None -> - Fmt.error_msg - "load_signkey error no associated metadata found in database for \ - signkey `%s`." - (Fpath.to_string fname) - | Some (stamp_start, stamp_expire, stamp_end) -> - (* TODO master_sig *) - let master_sig = None in - let v = - Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig } - in - Ok v - -let load_signkey conn fname = - let* opt = read_eddsa fname in - match opt with - | None -> Ok None - | Some priv -> - let* signkey_data = db_lookup_signkey_data conn fname priv in - Ok (Some signkey_data) diff --git a/src/devices.ml b/src/devices.ml index f5f5a4f7..5ad777d8 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -18,13 +18,7 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device = Logs.info (fun m -> m "database connection initialized"); conn) -let secmod_signkey = +let secmod = let finally _key = () in - Vif.Device.v ~name:"secmod_signkey" ~finally - [ Vif.Device.value db_connection ] - @@ 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) -> Secmod_denom.init conn + Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ] + @@ fun conn (_env : env) -> Secmod.init conn diff --git a/src/keys.ml b/src/keys.ml index 3d9f66aa..9ed1de5b 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -4,7 +4,7 @@ open Syntax open Api module String_map = Stdlib.Map.Make (Stdlib.String) -let mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date = +let mk_keys ~db_conn ~sm ~last_issue_date = let version = "0" in let base_url = Config.base_url in let currency = Config.currency in @@ -101,11 +101,10 @@ let jsont = ExchangeKeysResponse.jsont let f req server _env = Logs.info (fun m -> m "GET /keys/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm_signkey = Vif.Server.device Devices.secmod_signkey server in - let sm_denom = Vif.Server.device Devices.secmod_denom server in + let sm = Vif.Server.device Devices.secmod server in let res = let last_issue_date = Ptime_clock.now () |> Option.some in - let* v = mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date in + let* v = mk_keys ~db_conn ~sm ~last_issue_date in let s = Api.encode_exn jsont v in Ok s in diff --git a/src/management.ml b/src/management.ml index 09c64427..42f3c129 100644 --- a/src/management.ml +++ b/src/management.ml @@ -2,7 +2,7 @@ open Syntax open Api module Keys_get = struct - let mk_future_denom ~sm_denom_priv + let mk_future_denom ~sm_key_priv ({ pub; priv= _; @@ -32,7 +32,7 @@ module Keys_get = struct let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw in - sign ~key:sm_denom_priv + sign ~key:sm_key_priv { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in FutureDenom. @@ -64,29 +64,24 @@ module Keys_get = struct FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t) - ~(sm_denom : Secmod_denom.t) = + let mk_future_keys_response ~sm = let future_signkeys = - Secmod_signkey.get_signkeys sm_signkey + Secmod.get_signkeys sm |> List.filter (fun k -> Option.is_none k.Signkey.master_sig) |> List.map (fun signkey -> - let sm_signkey_priv = - (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv - in + let sm_signkey_priv = Secmod.get_sm_key_priv sm in mk_future_signkey ~sm_signkey_priv signkey) in let future_denoms = - Secmod_denom.get_denoms sm_denom + Secmod.get_denoms sm |> 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) + let sm_key_priv = Secmod.get_sm_key_priv sm in + mk_future_denom ~sm_key_priv denom) in let master_pub = Config.Exchange.master_public_key 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 + let denom_secmod_public_key = Secmod.get_sm_key_pub sm in + let signkey_secmod_public_key = Secmod.get_sm_key_pub sm in FutureKeysResponse. { future_denoms; @@ -100,10 +95,9 @@ module Keys_get = struct let f req server _env = Logs.info (fun m -> m "GET /management/keys/"); - let sm_signkey = Vif.Server.device Devices.secmod_signkey server in - let sm_denom = Vif.Server.device Devices.secmod_denom server in + let sm = Vif.Server.device Devices.secmod server in let res = - let v = mk_future_keys_response ~sm_signkey ~sm_denom in + let v = mk_future_keys_response ~sm in let s = Api.encode_exn jsont v in Ok s in @@ -111,11 +105,10 @@ module Keys_get = struct end module Keys_post = struct - let verify_denom_signature ~sm_denom - DenomSignature.{ h_denom_pub; master_sig } = + let verify_denom_signature ~sm DenomSignature.{ h_denom_pub; master_sig } = let denom_hash = HashCode.to_denomination_hash h_denom_pub in let* denom = - Secmod_denom.get_denoms sm_denom + Secmod.get_denoms sm |> List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash) |> function @@ -142,10 +135,9 @@ module Keys_post = struct 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 SignKeySignature.{ key; master_sig } = let* signkey = - Secmod_signkey.get_signkeys sm_signkey + Secmod.get_signkeys sm |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) |> function | None -> @@ -165,15 +157,14 @@ module Keys_post = struct in verify ~key:Config.master_public_key master_sig r - let verify ~sm_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs } - = - let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in - let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in + let verify ~sm MasterSignatures.{ denom_sigs; signkey_sigs } = + let* () = list_iter (verify_denom_signature ~sm) denom_sigs in + let* () = list_iter (verify_signkey_signature ~sm) signkey_sigs in Ok () (* TODO move to test *) - let check_master_signatures_update ~db_conn ~sm_denom = - Secmod_denom.get_denoms sm_denom + let check_master_signatures_update ~db_conn ~sm = + Secmod.get_denoms sm |> list_iter (fun denom -> let error = Error "update_master_signatures sanity check failure" in let* opt = @@ -201,22 +192,21 @@ module Keys_post = struct let* () = check (age_mask = denom.age_mask) in Ok ()) - let do_ ~db_conn ~sm_signkey ~sm_denom - MasterSignatures.{ denom_sigs; signkey_sigs } = + let do_ ~db_conn ~sm MasterSignatures.{ denom_sigs; signkey_sigs } = let* () = signkey_sigs |> List.map (fun SignKeySignature.{ key; master_sig } -> (key, master_sig)) - |> Secmod_signkey.add_master_signatures db_conn sm_signkey + |> Secmod.add_signkey_master_signatures db_conn sm in let* () = denom_sigs |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } -> let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in (h_denom_pub, master_sig)) - |> Secmod_denom.add_master_signatures db_conn sm_denom + |> Secmod.add_denom_master_signatures db_conn sm in - let* () = check_master_signatures_update ~db_conn ~sm_denom in + let* () = check_master_signatures_update ~db_conn ~sm in Ok () let jsont = MasterSignatures.jsont @@ -224,12 +214,11 @@ module Keys_post = struct let f req server _env = Logs.info (fun m -> m "POST /management/keys/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm_signkey = Vif.Server.device Devices.secmod_signkey server in - let sm_denom = Vif.Server.device Devices.secmod_denom server in + let sm = Vif.Server.device Devices.secmod server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify ~sm_signkey ~sm_denom v in - let* () = do_ ~db_conn ~sm_signkey ~sm_denom v in + let* () = verify ~sm v in + let* () = do_ ~db_conn ~sm v in Ok "" in Respond_util.respond_with_res res req @@ -240,11 +229,8 @@ module Denom_revoke = struct let open Bin_sig.MasterDenominationKeyRevocation in verify ~key:Config.Exchange.master_public_key master_sig { h_denom_pub } - let do_ ~db_conn ~sm_denom h_denom_pub DenomRevocationSignature.{ master_sig } - = - let* () = - Secmod_denom.revoke_denomination sm_denom h_denom_pub master_sig - in + let do_ ~db_conn ~sm h_denom_pub DenomRevocationSignature.{ master_sig } = + let* () = Secmod.revoke_denomination sm h_denom_pub master_sig in let+ () = Pg.insert_denomination_revocation db_conn h_denom_pub master_sig |> unwrap_err_caqti @@ -256,13 +242,13 @@ module Denom_revoke = struct let f req h_denom_pub server _env = Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm_denom = Vif.Server.device Devices.secmod_denom server in + let sm = Vif.Server.device Devices.secmod server in let res = let* h_denom_pub = HashCode.of_b32 h_denom_pub in let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify h_denom_pub v in - let* () = do_ ~db_conn ~sm_denom h_denom_pub v in + let* () = do_ ~db_conn ~sm h_denom_pub v in Ok "" in Respond_util.respond_with_res res req @@ -273,11 +259,8 @@ module Signkey_revoke = struct let open Bin_sig.MasterSigningKeyRevocation in verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub } - let do_ ~db_conn ~sm_signkey exchange_pub - SignkeyRevocationSignature.{ master_sig } = - let* () = - Secmod_signkey.revoke_signkey sm_signkey exchange_pub master_sig - in + let do_ ~db_conn ~sm exchange_pub SignkeyRevocationSignature.{ master_sig } = + let* () = Secmod.revoke_signkey sm exchange_pub master_sig in let+ () = Pg.insert_signkey_revocation db_conn exchange_pub master_sig |> unwrap_err_caqti @@ -289,12 +272,12 @@ module Signkey_revoke = struct let f req exchange_pub server _env = Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm_signkey = Vif.Server.device Devices.secmod_signkey server in + let sm = Vif.Server.device Devices.secmod server in let res = let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify exchange_pub v in - let* () = do_ ~db_conn ~sm_signkey exchange_pub v in + let* () = do_ ~db_conn ~sm exchange_pub v in Ok "" in Respond_util.respond_with_res res req diff --git a/src/mte.ml b/src/mte.ml index 39a9d7bc..0aa7e3bd 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -70,10 +70,7 @@ let () = let env : Devices.env = { caqti_switch; db_uri= Config.Exchangedb_postgres.config } in - let devices = - Vif.Devices. - [ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ] - in + let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in let middlewares = Vif.Middlewares.[] in Logs.info (fun m -> m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); diff --git a/src/secmod.ml b/src/secmod.ml new file mode 100644 index 00000000..20aef05c --- /dev/null +++ b/src/secmod.ml @@ -0,0 +1,269 @@ +(* TODO + - key rotation + - how many signkey to use? + we just use 1 for now + - does the secmod's key as metadata/expiration date? *) +open Syntax + +type eddsa_priv = Crypto.EddsaPrivateKey.t +type eddsa_pub = Crypto.EddsaPublicKey.t +type h_denom_pub = Bin_type.DenominationHash.t + +type t = { + lock: Miou.Mutex.t; + sm_key_priv: eddsa_priv; + sm_key_pub: eddsa_pub; + sk_ht: (eddsa_pub, Signkey.t) Hashtbl.t; + sk_revoked_ht: + (eddsa_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t; + dn_ht: (h_denom_pub, Denomination.t) Hashtbl.t; + dn_revoked_ht: + ( h_denom_pub, + Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t ) + Hashtbl.t; +} + +let get_sm_key_priv t = t.sm_key_priv +let get_sm_key_pub t = t.sm_key_pub + +let get_signkeys t = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.to_seq_values t.sk_ht |> List.of_seq + +let get_denoms t = + Miou.Mutex.protect t.lock @@ fun () -> + Hashtbl.to_seq_values t.dn_ht |> List.of_seq + +let add_signkey_master_signatures conn t l = + Miou.Mutex.protect t.lock @@ fun () -> + list_iter + (fun (pub, master_sig) -> + match Hashtbl.find_opt t.sk_ht pub with + | None -> Error "secmod failure: public key not found." + | Some signkey -> + let signkey = { signkey with master_sig= Some master_sig } in + let* () = + Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti + in + Hashtbl.replace t.sk_ht pub signkey; + Ok ()) + l + +let add_denom_master_signatures conn t l = + Miou.Mutex.protect t.lock @@ fun () -> + list_iter + (fun (h_denom_pub, master_sig) -> + match Hashtbl.find_opt t.dn_ht h_denom_pub with + | None -> Error "secmod 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.dn_ht h_denom_pub denom; + Ok ()) + l + +let revoke_signkey t exchange_pub master_sig = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.sk_ht exchange_pub with + | None -> Error "secmod failure: denomination hash not found." + | Some signkey -> + Hashtbl.remove t.sk_ht exchange_pub; + Hashtbl.replace t.sk_revoked_ht exchange_pub (signkey, master_sig); + Ok () + +let revoke_denomination t h_denom_pub master_sig = + Miou.Mutex.protect t.lock @@ fun () -> + match Hashtbl.find_opt t.dn_ht h_denom_pub with + | None -> Error "secmod failure: denomination hash not found." + | Some denom -> + Hashtbl.remove t.dn_ht h_denom_pub; + Hashtbl.replace t.dn_revoked_ht h_denom_pub (denom, master_sig); + Ok () + +let dir = Fpath.(v "data" / "secmod ") + +let db_lookup_signkey_data conn fname priv = + let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in + let* opt = Pg.lookup_signing_key conn pub in + match opt with + | None -> + Fmt.error_msg + "load_signkey error no associated metadata found in database for \ + signkey `%s`." + (Fpath.to_string fname) + | Some (stamp_start, stamp_expire, stamp_end) -> + (* TODO master_sig *) + let master_sig = None in + let v = + Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig } + in + Ok v + +let db_lookup_denom_data conn ~section_name priv = + let pub = Crypto.RsaPrivateKey.pub_of_priv priv in + let h_pub = + Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub) + in + let* opt = Pg.lookup_denomination_key conn h_pub in + match opt with + | None -> + Fmt.error_msg + "load_denom error no associated metadata found in database for \ + denomination `%s`." + section_name + | Some + ( stamp_start, + stamp_expire_withdraw, + stamp_expire_deposit, + stamp_expire_legal, + value, + fee_withdraw, + fee_deposit, + fee_refresh, + fee_refund, + age_mask ) -> + let master_sig = None in + let v = + Denomination. + { + pub; + priv; + section_name; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask; + h_pub; + master_sig; + } + in + Ok v + +let load_signkey conn fname = + let* opt = Data_file.read_eddsa fname in + match opt with + | None -> Ok None + | Some priv -> + let* signkey_data = db_lookup_signkey_data conn fname priv in + Ok (Some signkey_data) + +let _store t = + let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in + let* () = + get_signkeys t + |> List.mapi (fun i key -> + let fname = Fpath.(dir / string_of_int i) in + (fname, key.Signkey.priv)) + |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) + in + let* () = + 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) + in + Ok () + +let load conn = + let error_invalid_state = + Fmt.error_msg "secmod load error: invalid store state." + in + let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sm_key") in + let* signkeys = + let l = List.init 1 (fun i -> Fpath.(dir / string_of_int 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* denoms = + let* l = + let open Config.Coin in + list_map + (fun coin -> + let section_name = coin.section_name in + let fname = Fpath.(dir / section_name) in + let* opt = Data_file.read_rsa fname in + match opt with + | None -> Ok None + | Some priv -> + (* todo: could check that coin config match db values *) + let* denom_data = db_lookup_denom_data conn ~section_name priv in + Ok (Some denom_data)) + 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 + | None, None, None -> Ok None + | Some sm_key_priv, Some signkeys, Some denoms -> + let sm_key_pub = Crypto.EddsaPrivateKey.pub_of_priv sm_key_priv in + let lock = Miou.Mutex.create () in + let sk_ht = + signkeys + |> List.map (fun v -> (v.Signkey.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let dn_ht = + denoms + |> List.map (fun v -> (v.Denomination.h_pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let sk_revoked_ht = Hashtbl.create 0xff in + let dn_revoked_ht = Hashtbl.create 0xff in + Ok + (Some + { + lock; + sm_key_priv; + sm_key_pub; + sk_ht; + sk_revoked_ht; + dn_ht; + dn_revoked_ht; + }) + | _, _, _ -> error_invalid_state + +let make_new () = + let lock = Miou.Mutex.create () in + let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in + let sk_ht = + [ Signkey.make () ] + |> List.map (fun v -> (v.Signkey.pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let dn_ht = + Config.Coin.all_coins + |> List.map Denomination.make + |> List.map (fun v -> (v.Denomination.h_pub, v)) + |> List.to_seq + |> Hashtbl.of_seq + in + let sk_revoked_ht = Hashtbl.create 0xff in + let dn_revoked_ht = Hashtbl.create 0xff in + { lock; sm_key_priv; sm_key_pub; sk_ht; sk_revoked_ht; dn_ht; dn_revoked_ht } + +let init conn = + match load conn with + | Ok None -> + let t = make_new () in + Logs.info (fun m -> m "secmod initialized with fresh keys"); + t + | Ok (Some v) -> + Logs.info (fun m -> m "secmod initialized from storage"); + v + | Error _ -> + (* TODO error: pretty print *) + Fmt.failwith "secmod init failure." diff --git a/src/secmod.mli b/src/secmod.mli new file mode 100644 index 00000000..2da919ef --- /dev/null +++ b/src/secmod.mli @@ -0,0 +1,36 @@ +type eddsa_priv = Crypto.EddsaPrivateKey.t +type eddsa_pub = Crypto.EddsaPublicKey.t +type h_denom_pub = Bin_type.DenominationHash.t +type t + +val get_sm_key_priv : t -> eddsa_priv +val get_sm_key_pub : t -> eddsa_pub +val get_signkeys : t -> Signkey.t list +val get_denoms : t -> Denomination.t list +val init : (module Pg.CONN) -> t + +(* - management operations - *) + +val add_signkey_master_signatures : + (module Pg.CONN) -> + t -> + (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list -> + (unit, string) result + +val add_denom_master_signatures : + (module Pg.CONN) -> + t -> + (h_denom_pub * Bin_sig.DenominationKeyValidity.t) list -> + (unit, string) result + +val revoke_signkey : + t -> + eddsa_pub -> + Bin_sig.MasterSigningKeyRevocation.t -> + (unit, string) result + +val revoke_denomination : + t -> + h_denom_pub -> + Bin_sig.MasterDenominationKeyRevocation.t -> + (unit, string) result diff --git a/src/secmod_denom.ml b/src/secmod_denom.ml deleted file mode 100644 index 582d1ef7..00000000 --- a/src/secmod_denom.ml +++ /dev/null @@ -1,166 +0,0 @@ -(* TODO - have something better to represent initialization state - (missing master_sig for fresh denom) *) -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 db_lookup_denom_data conn ~section_name priv = - let pub = Crypto.RsaPrivateKey.pub_of_priv priv in - let h_pub = - Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub) - in - let* opt = Pg.lookup_denomination_key conn h_pub in - match opt with - | None -> - Fmt.error_msg - "load_denom error no associated metadata found in database for \ - denomination `%s`." - section_name - | Some - ( stamp_start, - stamp_expire_withdraw, - stamp_expire_deposit, - stamp_expire_legal, - value, - fee_withdraw, - fee_deposit, - fee_refresh, - fee_refund, - age_mask ) -> - let master_sig = None in - let v = - Denomination. - { - pub; - priv; - section_name; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask; - h_pub; - master_sig; - } - in - Ok v - -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 - list_map - (fun coin -> - let section_name = coin.section_name in - let fname = Fpath.(dir / section_name) in - let* opt = Data_file.read_rsa fname in - match opt with - | None -> Ok None - | Some priv -> - (* todo: could check that coin config match db values *) - let* denom_data = db_lookup_denom_data conn ~section_name priv in - Ok (Some denom_data)) - 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." diff --git a/src/secmod_denom.mli b/src/secmod_denom.mli deleted file mode 100644 index 117e1c97..00000000 --- a/src/secmod_denom.mli +++ /dev/null @@ -1,18 +0,0 @@ -open Bin_sig - -type h_denom_pub = Bin_type.DenominationHash.t -type t - -val get_sm_key : t -> Signkey.t -val get_denoms : t -> Denomination.t list - -val add_master_signatures : - (module Pg.CONN) -> - t -> - (h_denom_pub * DenominationKeyValidity.t) list -> - (unit, string) result - -val revoke_denomination : - t -> h_denom_pub -> MasterDenominationKeyRevocation.t -> (unit, string) result - -val init : (module Pg.CONN) -> t diff --git a/src/secmod_signkey.ml b/src/secmod_signkey.ml deleted file mode 100644 index 8ca280fc..00000000 --- a/src/secmod_signkey.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* TODO - - key rotation - - how many signkey to use? - we just use 1 for now *) -open Syntax - -type exchange_pub = Crypto.EddsaPublicKey.t - -type t = { - lock: Miou.Mutex.t; - sm_key: Signkey.t; - signkey_ht: (exchange_pub, Signkey.t) Hashtbl.t; - revoked_ht: - (exchange_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.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 - -let add_master_signatures conn t l = - Miou.Mutex.protect t.lock @@ fun () -> - list_iter - (fun (pub, master_sig) -> - match Hashtbl.find_opt t.signkey_ht pub with - | None -> Error "secmod_signkey failure: public key not found." - | Some signkey -> - let signkey = { signkey with master_sig= Some master_sig } in - let* () = - Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti - in - Hashtbl.replace t.signkey_ht pub signkey; - Ok ()) - l - -let revoke_signkey t exchange_pub master_sig = - Miou.Mutex.protect t.lock @@ fun () -> - match Hashtbl.find_opt t.signkey_ht exchange_pub with - | None -> Error "secmod_denom failure: denomination hash not found." - | Some signkey -> - Hashtbl.remove t.signkey_ht exchange_pub; - Hashtbl.replace t.revoked_ht exchange_pub (signkey, master_sig); - Ok () - -let dir = Fpath.(v "data" / "secmod_signkey") - -let _store_secmod_data t = - let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in - get_signkeys t - |> List.mapi (fun i key -> - let fname = Fpath.(dir / string_of_int i) in - (fname, key.Signkey.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) - -let load conn = - let error_invalid_state = - 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* signkeys = - let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in - let* l = list_map (fun fname -> Data_file.load_signkey conn fname) l in - match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt - in - match (sm_key, signkeys) with - | None, None -> Ok None - | 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 - let revoked_ht = Hashtbl.create 0xff in - Ok (Some { lock; sm_key; signkey_ht; revoked_ht }) - | _, _ -> error_invalid_state - -let make_new () = - let lock = Miou.Mutex.create () in - let sm_key = Signkey.make () in - let signkeys = [ Signkey.make () ] in - let signkey_ht = - signkeys - |> List.map (fun v -> (v.Signkey.pub, v)) - |> List.to_seq - |> Hashtbl.of_seq - in - let revoked_ht = Hashtbl.create 0xff in - { lock; sm_key; signkey_ht; revoked_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 deleted file mode 100644 index 6d97f2f5..00000000 --- a/src/secmod_signkey.mli +++ /dev/null @@ -1,19 +0,0 @@ -type t -type exchange_pub = Crypto.EddsaPublicKey.t - -val get_sm_key : t -> Signkey.t -val get_signkeys : t -> Signkey.t list - -val add_master_signatures : - (module Pg.CONN) -> - t -> - (exchange_pub * Bin_sig.ExchangeSigningKeyValidity.t) list -> - (unit, string) result - -val revoke_signkey : - t -> - exchange_pub -> - Bin_sig.MasterSigningKeyRevocation.t -> - (unit, string) result - -val init : (module Pg.CONN) -> t