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

JJ: Description from the destination commit:

Browse source 
wip secmod

JJ: Description from source commit:
better secmod
This commit is contained in:
swrup 2026-02-17 09:30:20 +01:00
parent 77d5327745
commit 1ba0a41adc
24 changed files with 1231 additions and 1022 deletions
Download patch file Download diff file Expand all files Collapse all files

335
src/http_management.ml
View file

@ -3,109 +3,13 @@ open Api
open Hash
module Keys_get = struct
let mk_future_denom (module Sm : Secmod.S) ~section_name
({
pub;
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= _;
revoked_sig= _;
} :
Denom_data.t) =
let denom_pub =
DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub }
in
let denom_secmod_sig =
let open Signatures.DenominationKeyAnnouncement in
let h_denom_pub = h_pub in
let h_section_name = Hash.Cstring.H64.hash section_name in
let anchor_time = stamp_start in
let duration_withdraw =
Timestamp.diff stamp_start stamp_expire_withdraw
in
sign_f ~f:Sm.sign_with_sm_key
{ h_denom_pub; h_section_name; anchor_time; duration_withdraw }
in
FutureDenom.
{
section_name;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
denom_pub;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
denom_secmod_sig;
}
let mk_future_signkey (module Sm : Secmod.S)
({
pub;
stamp_start;
stamp_expire;
stamp_end;
master_sig= _;
revoked_sig= _;
} :
Signkey_data.t) =
let signkey_secmod_sig =
let open Signatures.SigningKeyAnnouncement in
let exchange_pub = pub in
let anchor_time = stamp_start in
let duration = Timestamp.diff stamp_start stamp_expire in
sign_f ~f:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
in
FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let mk_future_keys_response (module Sm : Secmod.S) =
let future_signkeys =
Sm.get_signkeys_data ()
|> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
|> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
in
let future_denoms =
Sm.get_denoms_data ()
|> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
|> List.map (fun dn_data ->
let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
match opt with
| None -> Fmt.failwith "section_name not found."
| Some section_name ->
mk_future_denom (module Sm) ~section_name dn_data)
in
let master_pub = Config.Exchange.master_public_key in
let denom_secmod_public_key = Sm.get_sm_key_pub () in
let signkey_secmod_public_key = Sm.get_sm_key_pub () in
FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub;
denom_secmod_public_key;
signkey_secmod_public_key;
}
let jsont = FutureKeysResponse.jsont
let f req server _env =
Logs.info (fun m -> m "GET /management/keys/");
let sm = Vif.Server.device Devices.secmod server in
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
let res =
let v = mk_future_keys_response sm in
let* v = Keys.make_future_keys_response () in
let s = Api.encode_exn jsont v in
Ok s
in
@ -113,75 +17,89 @@ module Keys_get = struct
end
module Keys_post = struct
let verify_denom_signature (module Sm : Secmod.S)
DenomSignature.{ h_denom_pub; master_sig } =
let* denom =
match Sm.find_denom_data h_denom_pub with
| None ->
Fmt.error
"404 not found, One of the keys for which a signature was provided \
is unknown to the exchange."
| Some denom -> Ok denom
in
let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig =
let open FutureDenom in
let open Signatures.DenominationKeyValidity in
let r : r =
let r =
{
master= Config.master_public_key;
start= denom.stamp_start;
expire_withdraw= denom.stamp_expire_withdraw;
expire_spend= denom.stamp_expire_deposit;
expire_legal= denom.stamp_expire_legal;
value= denom.value;
fee_withdraw= denom.fee_withdraw;
fee_deposit= denom.fee_deposit;
fee_refresh= denom.fee_refresh;
fee_refund= denom.fee_refund;
denom_hash= h_denom_pub;
R.master= Config.master_public_key;
start= fdn.stamp_start;
expire_withdraw= fdn.stamp_expire_withdraw;
expire_spend= fdn.stamp_expire_deposit;
expire_legal= fdn.stamp_expire_legal;
value= fdn.value;
fee_withdraw= fdn.fee_withdraw;
fee_deposit= fdn.fee_deposit;
fee_refresh= fdn.fee_refresh;
fee_refund= fdn.fee_refund;
denom_hash;
}
in
verify_f ~f:Sm.verify_with_master_key master_sig r
verify master_sig r
let verify_signkey_signature (module Sm : Secmod.S)
SignKeySignature.{ key; master_sig } =
let* signkey =
match Sm.find_signkey_data key with
| None ->
Fmt.error
"404 not found, One of the keys for which a signature was provided \
is unknown to the exchange."
| Some signkey -> Ok signkey
let verify_denom_sigs (module Keys : Keys.S) denom_sigs =
let* fdn_l = Keys.future_denominations () in
let fdn_l =
List.map
(fun fdn ->
let h_pub =
(* TODO DenominationHash.of_denom_pub *)
DenominationHash.hash
(DenominationKey.to_octets fdn.FutureDenom.denom_pub)
in
(h_pub, fdn))
fdn_l
in
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
match List.assoc_opt h_denom_pub fdn_l with
| None -> Error "future denomination not found"
| Some fdn -> verify_dn (module Keys) fdn h_denom_pub master_sig)
denom_sigs
let verify_sk (module Keys : Keys.S)
FutureSignKey.
{ key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ }
master_sig =
let open Signatures.ExchangeSigningKeyValidity in
let r : r =
let r =
{
start= signkey.stamp_start;
expire= signkey.stamp_expire;
end_= signkey.stamp_end;
signkey_pub= signkey.pub;
R.start= stamp_start;
expire= stamp_expire;
end_= stamp_end;
signkey_pub= key;
}
in
verify_f ~f:Sm.verify_with_master_key master_sig r
verify master_sig r
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
let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs =
let* fsk_l = Keys.future_signkeys () in
list_iter
(fun SignKeySignature.{ key; master_sig } ->
match List.find_opt (fun sk -> sk.FutureSignKey.key = key) fsk_l with
| None -> Error "future signkey not found"
| Some fsk -> verify_sk (module Keys) fsk master_sig)
signkey_sigs
let verify keys MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () = verify_signkey_sigs keys signkey_sigs in
let* () = verify_denom_sigs keys denom_sigs in
Ok ()
let do_ ~db_conn:_ (module Sm : Secmod.S)
let do_ ~db_conn:_ (module Keys : Keys.S)
MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () =
signkey_sigs
|> List.map (fun SignKeySignature.{ key; master_sig } ->
(key, master_sig))
|> Sm.add_signkey_master_signatures
list_iter
(fun SignKeySignature.{ key; master_sig } ->
Keys.certify_future_signkey key master_sig)
signkey_sigs
in
let* () =
denom_sigs
|> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
(h_denom_pub, master_sig))
|> Sm.add_denom_master_signatures
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
Keys.certify_future_denomination h_denom_pub master_sig)
denom_sigs
in
let* () = Sm.store () in
Ok ()
let jsont = MasterSignatures.jsont
@ -189,80 +107,70 @@ 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 = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = do_ ~db_conn sm v in
let* () = verify keys v in
let* () = do_ ~db_conn keys v in
Ok ""
in
Respond.result res req
end
module Denom_revoke = struct
let verify (module Sm : Secmod.S) h_denom_pub
let verify (module Keys : Keys.S) h_denom_pub
DenomRevocationSignature.{ master_sig } =
let open Signatures.MasterDenominationKeyRevocation in
verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
verify master_sig { h_denom_pub }
let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
let do_ (module Keys : Keys.S) h_denom_pub
DenomRevocationSignature.{ master_sig } =
let* () = Sm.revoke_denomination h_denom_pub master_sig in
let+ () =
Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
|> unwrap_err_caqti
in
let+ () = Keys.revoke_denomination h_denom_pub master_sig in
()
let jsont = DenomRevocationSignature.jsont
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 = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let res =
let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm h_denom_pub v in
let* () = do_ ~db_conn sm h_denom_pub v in
let* () = verify keys h_denom_pub v in
let* () = do_ keys h_denom_pub v in
Ok ""
in
Respond.result res req
end
module Signkey_revoke = struct
let verify (module Sm : Secmod.S) exchange_pub
let verify (module Keys : Keys.S) exchange_pub
SignkeyRevocationSignature.{ master_sig } =
let open Signatures.MasterSigningKeyRevocation in
verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
verify master_sig { exchange_pub }
let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
let do_ (module Keys : Keys.S) exchange_pub
SignkeyRevocationSignature.{ master_sig } =
let* () = Sm.revoke_signkey exchange_pub master_sig in
let+ () =
Pg.insert_signkey_revocation db_conn exchange_pub master_sig
|> unwrap_err_caqti
in
let+ () = Keys.revoke_signkey exchange_pub master_sig in
()
let jsont = SignkeyRevocationSignature.jsont
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 = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys 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 sm exchange_pub v in
let* () = do_ ~db_conn sm exchange_pub v in
let* () = verify keys exchange_pub v in
let* () = do_ keys exchange_pub v in
Ok ""
in
Respond.result res req
end
module Auditors = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
AuditorSetupMessage.
{
auditor_url;
@ -272,7 +180,7 @@ module Auditors = struct
validity_start;
} =
let open Signatures.MasterAddAuditor in
verify_f ~f:Sm.verify_with_master_key master_sig
verify master_sig
{
start_date= validity_start;
auditor_pub;
@ -304,11 +212,11 @@ module Auditors = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/auditors/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -316,11 +224,10 @@ module Auditors = struct
end
module Auditors_disable = struct
let verify (module Sm : Secmod.S) auditor_pub
let verify (module Keys : Keys.S) auditor_pub
AuditorTeardownMessage.{ master_sig; validity_end } =
let open Signatures.MasterDelAuditor in
verify_f ~f:Sm.verify_with_master_key master_sig
{ end_date= validity_end; auditor_pub }
verify master_sig { end_date= validity_end; auditor_pub }
let do_ ~db_conn auditor_pub
AuditorTeardownMessage.{ master_sig= _; validity_end } =
@ -344,12 +251,12 @@ module Auditors_disable = struct
let f req auditor_pub server _env =
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm auditor_pub v in
let* () = verify keys auditor_pub v in
let* () = do_ ~db_conn auditor_pub v in
Ok ""
in
@ -357,7 +264,7 @@ module Auditors_disable = struct
end
module Wire_fee = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
WireFeeSetupMessage.
{
wire_method;
@ -368,7 +275,7 @@ module Wire_fee = struct
wire_fee;
} =
let open Signatures.MasterWireFee in
verify_f ~f:Sm.verify_with_master_key master_sig_wire
verify master_sig_wire
{
h_wire_method= Hash.Cstring.H64.hash wire_method;
start_date= fee_start;
@ -404,11 +311,11 @@ module Wire_fee = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire-fee/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -416,7 +323,7 @@ module Wire_fee = struct
end
module Global_fees = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
GlobalFees.
{
start_date;
@ -430,7 +337,7 @@ module Global_fees = struct
master_sig;
} =
let open Signatures.GlobalFees in
verify_f ~f:Sm.verify_with_master_key master_sig
verify master_sig
{
start_date;
end_date;
@ -475,11 +382,11 @@ module Global_fees = struct
and once set for a timeframe, it should not change. *)
let f req server _env =
Logs.info (fun m -> m "POST /management/global-fees/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -487,7 +394,7 @@ module Global_fees = struct
end
module Wire = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
WireSetupMessage.
{
payto_uri;
@ -503,7 +410,7 @@ module Wire = struct
let debit_restrictions = "" in
let* () =
let open Signatures.MasterWireDetails in
verify_f ~f:Sm.verify_with_master_key master_sig_wire
verify master_sig_wire
{
h_wire_details= FullPaytoHash.hash payto_uri;
h_conversion_url= Hash.Cstring.H64.hash conversion_url;
@ -513,7 +420,7 @@ module Wire = struct
in
let* () =
let open Signatures.MasterAddWire in
verify_f ~f:Sm.verify_with_master_key master_sig_add
verify master_sig_add
{
start_date= validity_start;
h_wire= FullPaytoHash.hash payto_uri;
@ -554,11 +461,11 @@ module Wire = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -566,10 +473,10 @@ module Wire = struct
end
module Wire_disable = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
let open Signatures.MasterDelWire in
verify_f ~f:Sm.verify_with_master_key master_sig_del
verify master_sig_del
{ end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
let do_ ~db_conn
@ -589,11 +496,11 @@ module Wire_disable = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire/disable/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -601,7 +508,7 @@ module Wire_disable = struct
end
module Drain = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
DrainProfitsMessage.
{
debit_account_section;
@ -612,7 +519,7 @@ module Drain = struct
amount;
} =
let open Signatures.MasterDrainProfit in
verify_f ~f:Sm.verify_with_master_key master_sig
verify master_sig
{
wtid;
date;
@ -629,11 +536,11 @@ module Drain = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/drain/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -641,7 +548,7 @@ module Drain = struct
end
module AmlOfficer = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
AmlOfficerSetup.
{
officer_pub;
@ -653,7 +560,7 @@ module AmlOfficer = struct
} =
let open Signatures.MasterAmlOfficerStatus in
let is_active = match is_active with true -> 1_l | false -> 0_l in
verify_f ~f:Sm.verify_with_master_key master_sig
verify master_sig
{
change_date;
officer_pub;
@ -669,11 +576,11 @@ module AmlOfficer = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/aml-officers/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in
@ -681,7 +588,7 @@ module AmlOfficer = struct
end
module Partners = struct
let verify (module Sm : Secmod.S)
let verify (module Keys : Keys.S)
ExchangePartnerSetupRequest.
{
partner_base_url;
@ -693,7 +600,7 @@ module Partners = struct
wad_fee;
} =
let open Signatures.PartnerConfiguration in
verify_f ~f:Sm.verify_with_master_key master_sig
verify master_sig
{
partner_pub;
start_date;
@ -711,11 +618,11 @@ module Partners = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/partners/");
let sm = Vif.Server.device Devices.secmod server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify sm v in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ""
in