From d041dd057333730935b24a5b6256d7b56baf9c75 Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 15 Dec 2025 16:09:11 +0100 Subject: [PATCH] done --- src/devices.ml | 10 ++---- src/keys.ml | 7 ++--- src/management.ml | 80 +++++++++++++++++++++-------------------------- src/mte.ml | 5 +-- 4 files changed, 42 insertions(+), 60 deletions(-) diff --git a/src/devices.ml b/src/devices.ml index f285c5b2..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.init conn - -let secmod_denom = - let finally _key = () in - Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ] + 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 598e3e69..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,24 +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.t) ~(sm_denom : Secmod.t) = + let mk_future_keys_response ~sm = let future_signkeys = - Secmod.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.get_sm_key_priv sm_signkey in + let sm_signkey_priv = Secmod.get_sm_key_priv sm in mk_future_signkey ~sm_signkey_priv signkey) in let future_denoms = - Secmod.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.get_sm_key_priv sm_denom 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.get_sm_key_pub sm_denom in - let signkey_secmod_public_key = Secmod.get_sm_key_pub sm_signkey 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; @@ -95,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 @@ -106,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.get_denoms sm_denom + Secmod.get_denoms sm |> List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash) |> function @@ -137,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.get_signkeys sm_signkey + Secmod.get_signkeys sm |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) |> function | None -> @@ -160,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.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 = @@ -196,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.add_signkey_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.add_denom_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 @@ -219,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 @@ -235,9 +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.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 @@ -249,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 @@ -266,9 +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.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 @@ -280,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");