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

JJ: Description from the destination commit:

Browse source 
+ ok secmod.ml

JJ: Description from source commit:
done
This commit is contained in:
swrup 2025-12-15 16:02:40 +01:00
parent c6b197bde6
commit f57071b1af
5 changed files with 43 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/devices.ml
View file

@ -18,13 +18,7 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
Logs.info (fun m -> m "database connection initialized"); Logs.info (fun m -> m "database connection initialized");
conn) conn)
let secmod_signkey = let secmod =
let finally _key = () in let finally _key = () in
Vif.Device.v ~name:"secmod_signkey" ~finally Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
[ 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 ]
@@ fun conn (_env : env) -> Secmod.init conn @@ fun conn (_env : env) -> Secmod.init conn

7
src/keys.ml
View file

@ -4,7 +4,7 @@ open Syntax
open Api open Api
module String_map = Stdlib.Map.Make (Stdlib.String) 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 version = "0" in
let base_url = Config.base_url in let base_url = Config.base_url in
let currency = Config.currency in let currency = Config.currency in
@ -101,11 +101,10 @@ let jsont = ExchangeKeysResponse.jsont
let f req server _env = let f req server _env =
Logs.info (fun m -> m "GET /keys/"); Logs.info (fun m -> m "GET /keys/");
let db_conn = Vif.Server.device Devices.db_connection server in 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 sm_denom = Vif.Server.device Devices.secmod_denom server in
let res = let res =
let last_issue_date = Ptime_clock.now () |> Option.some in 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 let s = Api.encode_exn jsont v in
Ok s Ok s
in in

80
src/management.ml
View file

@ -2,7 +2,7 @@ open Syntax
open Api open Api
module Keys_get = struct module Keys_get = struct
let mk_future_denom ~sm_denom_priv let mk_future_denom ~sm_key_priv
({ ({
pub; pub;
priv= _; priv= _;
@ -32,7 +32,7 @@ module Keys_get = struct
let duration_withdraw = let duration_withdraw =
Timestamp.diff stamp_start stamp_expire_withdraw Timestamp.diff stamp_start stamp_expire_withdraw
in in
sign ~key:sm_denom_priv sign ~key:sm_key_priv
{ h_denom_pub; h_section_name; anchor_time; duration_withdraw } { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
in in
FutureDenom. FutureDenom.
@ -64,24 +64,24 @@ module Keys_get = struct
FutureSignKey. FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } { 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 = let future_signkeys =
Secmod.get_signkeys sm_signkey Secmod.get_signkeys sm
|> List.filter (fun k -> Option.is_none k.Signkey.master_sig) |> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
|> List.map (fun signkey -> |> 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) mk_future_signkey ~sm_signkey_priv signkey)
in in
let future_denoms = let future_denoms =
Secmod.get_denoms sm_denom Secmod.get_denoms sm
|> List.filter (fun k -> Option.is_none k.Denomination.master_sig) |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
|> List.map (fun denom -> |> List.map (fun denom ->
let sm_denom_priv = Secmod.get_sm_key_priv sm_denom in let sm_key_priv = Secmod.get_sm_key_priv sm in
mk_future_denom ~sm_denom_priv denom) mk_future_denom ~sm_key_priv denom)
in in
let master_pub = Config.Exchange.master_public_key in let master_pub = Config.Exchange.master_public_key in
let denom_secmod_public_key = Secmod.get_sm_key_pub sm_denom in let denom_secmod_public_key = Secmod.get_sm_key_pub sm in
let signkey_secmod_public_key = Secmod.get_sm_key_pub sm_signkey in let signkey_secmod_public_key = Secmod.get_sm_key_pub sm in
FutureKeysResponse. FutureKeysResponse.
{ {
future_denoms; future_denoms;
@ -95,10 +95,9 @@ module Keys_get = struct
let f req server _env = let f req server _env =
Logs.info (fun m -> m "GET /management/keys/"); Logs.info (fun m -> m "GET /management/keys/");
let sm_signkey = Vif.Server.device Devices.secmod_signkey server in let sm = Vif.Server.device Devices.secmod server in
let sm_denom = Vif.Server.device Devices.secmod_denom server in
let res = 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 let s = Api.encode_exn jsont v in
Ok s Ok s
in in
@ -106,11 +105,10 @@ module Keys_get = struct
end end
module Keys_post = struct module Keys_post = struct
let verify_denom_signature ~sm_denom let verify_denom_signature ~sm DenomSignature.{ h_denom_pub; master_sig } =
DenomSignature.{ h_denom_pub; master_sig } =
let denom_hash = HashCode.to_denomination_hash h_denom_pub in let denom_hash = HashCode.to_denomination_hash h_denom_pub in
let* denom = let* denom =
Secmod.get_denoms sm_denom Secmod.get_denoms sm
|> List.find_opt (fun (denom : Denomination.t) -> |> List.find_opt (fun (denom : Denomination.t) ->
denom.h_pub = denom_hash) denom.h_pub = denom_hash)
|> function |> function
@ -137,10 +135,9 @@ module Keys_post = struct
in in
verify ~key:Config.master_public_key master_sig r 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 = let* signkey =
Secmod.get_signkeys sm_signkey Secmod.get_signkeys sm
|> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key)
|> function |> function
| None -> | None ->
@ -160,15 +157,14 @@ module Keys_post = struct
in in
verify ~key:Config.master_public_key master_sig r verify ~key:Config.master_public_key master_sig r
let verify ~sm_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs } let verify ~sm MasterSignatures.{ denom_sigs; signkey_sigs } =
= let* () = list_iter (verify_denom_signature ~sm) denom_sigs in
let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in let* () = list_iter (verify_signkey_signature ~sm) signkey_sigs in
let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in
Ok () Ok ()
(* TODO move to test *) (* TODO move to test *)
let check_master_signatures_update ~db_conn ~sm_denom = let check_master_signatures_update ~db_conn ~sm =
Secmod.get_denoms sm_denom Secmod.get_denoms sm
|> list_iter (fun denom -> |> list_iter (fun denom ->
let error = Error "update_master_signatures sanity check failure" in let error = Error "update_master_signatures sanity check failure" in
let* opt = let* opt =
@ -196,22 +192,21 @@ module Keys_post = struct
let* () = check (age_mask = denom.age_mask) in let* () = check (age_mask = denom.age_mask) in
Ok ()) Ok ())
let do_ ~db_conn ~sm_signkey ~sm_denom let do_ ~db_conn ~sm MasterSignatures.{ denom_sigs; signkey_sigs } =
MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () = let* () =
signkey_sigs signkey_sigs
|> List.map (fun SignKeySignature.{ key; master_sig } -> |> List.map (fun SignKeySignature.{ key; master_sig } ->
(key, master_sig)) (key, master_sig))
|> Secmod.add_master_signatures db_conn sm_signkey |> Secmod.add_signkey_master_signatures db_conn sm
in in
let* () = let* () =
denom_sigs denom_sigs
|> List.map (fun DenomSignature.{ h_denom_pub; master_sig } -> |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
(h_denom_pub, master_sig)) (h_denom_pub, master_sig))
|> Secmod.add_master_signatures db_conn sm_denom |> Secmod.add_denom_master_signatures db_conn sm
in in
let* () = check_master_signatures_update ~db_conn ~sm_denom in let* () = check_master_signatures_update ~db_conn ~sm in
Ok () Ok ()
let jsont = MasterSignatures.jsont let jsont = MasterSignatures.jsont
@ -219,12 +214,11 @@ module Keys_post = struct
let f req server _env = let f req server _env =
Logs.info (fun m -> m "POST /management/keys/"); Logs.info (fun m -> m "POST /management/keys/");
let db_conn = Vif.Server.device Devices.db_connection server in 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 sm_denom = Vif.Server.device Devices.secmod_denom server in
let res = let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify ~sm_signkey ~sm_denom v in let* () = verify ~sm v in
let* () = do_ ~db_conn ~sm_signkey ~sm_denom v in let* () = do_ ~db_conn ~sm v in
Ok "" Ok ""
in in
Respond_util.respond_with_res res req Respond_util.respond_with_res res req
@ -235,9 +229,8 @@ module Denom_revoke = struct
let open Bin_sig.MasterDenominationKeyRevocation in let open Bin_sig.MasterDenominationKeyRevocation in
verify ~key:Config.Exchange.master_public_key master_sig { h_denom_pub } 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 do_ ~db_conn ~sm h_denom_pub DenomRevocationSignature.{ master_sig } =
= let* () = Secmod.revoke_denomination sm h_denom_pub master_sig in
let* () = Secmod.revoke_denomination sm_denom h_denom_pub master_sig in
let+ () = let+ () =
Pg.insert_denomination_revocation db_conn h_denom_pub master_sig Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
|> unwrap_err_caqti |> unwrap_err_caqti
@ -249,13 +242,13 @@ module Denom_revoke = struct
let f req h_denom_pub server _env = let f req h_denom_pub server _env =
Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
let db_conn = Vif.Server.device Devices.db_connection server in 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 res =
let* h_denom_pub = HashCode.of_b32 h_denom_pub in let* h_denom_pub = HashCode.of_b32 h_denom_pub in
let h_denom_pub = HashCode.to_denomination_hash 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* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify h_denom_pub v 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 "" Ok ""
in in
Respond_util.respond_with_res res req Respond_util.respond_with_res res req
@ -266,9 +259,8 @@ module Signkey_revoke = struct
let open Bin_sig.MasterSigningKeyRevocation in let open Bin_sig.MasterSigningKeyRevocation in
verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub } verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub }
let do_ ~db_conn ~sm_signkey exchange_pub let do_ ~db_conn ~sm exchange_pub SignkeyRevocationSignature.{ master_sig } =
SignkeyRevocationSignature.{ master_sig } = let* () = Secmod.revoke_signkey sm exchange_pub master_sig in
let* () = Secmod.revoke_signkey sm_signkey exchange_pub master_sig in
let+ () = let+ () =
Pg.insert_signkey_revocation db_conn exchange_pub master_sig Pg.insert_signkey_revocation db_conn exchange_pub master_sig
|> unwrap_err_caqti |> unwrap_err_caqti
@ -280,12 +272,12 @@ module Signkey_revoke = struct
let f req exchange_pub server _env = let f req exchange_pub server _env =
Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
let db_conn = Vif.Server.device Devices.db_connection server in 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 res =
let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
let* v = Vif.Request.of_json req |> unwrap_err_msg in let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify exchange_pub v 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 "" Ok ""
in in
Respond_util.respond_with_res res req Respond_util.respond_with_res res req

5
src/mte.ml
View file

@ -70,10 +70,7 @@ let () =
let env : Devices.env = let env : Devices.env =
{ caqti_switch; db_uri= Config.Exchangedb_postgres.config } { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
in in
let devices = let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
Vif.Devices.
[ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ]
in
let middlewares = Vif.Middlewares.[] in let middlewares = Vif.Middlewares.[] in
Logs.info (fun m -> Logs.info (fun m ->
m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");

2
src/secmod.ml
View file

@ -233,7 +233,7 @@ let load conn =
dn_ht; dn_ht;
dn_revoked_ht; dn_revoked_ht;
}) })
| _, _ -> error_invalid_state | _, _, _ -> error_invalid_state
let make_new () = let make_new () =
let lock = Miou.Mutex.create () in let lock = Miou.Mutex.create () in