719 lines
21 KiB
OCaml
719 lines
21 KiB
OCaml
open Syntax
|
|
open Api
|
|
|
|
module Keys_get = struct
|
|
let mk_future_denom ~sm_denom_priv
|
|
({
|
|
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= _;
|
|
} :
|
|
Denomination.t) =
|
|
let denom_pub =
|
|
DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub }
|
|
in
|
|
let denom_secmod_sig =
|
|
let open Bin_sig.DenominationKeyAnnouncement in
|
|
let h_denom_pub = h_pub in
|
|
let h_section_name = Bin_type.Hash_64_cstr.hash section_name in
|
|
let anchor_time = stamp_start in
|
|
let duration_withdraw =
|
|
Timestamp.diff stamp_start stamp_expire_withdraw
|
|
in
|
|
sign ~key:sm_denom_priv
|
|
{ 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 ~sm_signkey_priv
|
|
({ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig= _ } :
|
|
Signkey.t) =
|
|
let signkey_secmod_sig =
|
|
let open Bin_sig.SigningKeyAnnouncement in
|
|
let exchange_pub = pub in
|
|
let anchor_time = stamp_start in
|
|
let duration = Timestamp.diff stamp_start stamp_expire in
|
|
sign ~key:sm_signkey_priv { exchange_pub; anchor_time; duration }
|
|
in
|
|
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 future_signkeys =
|
|
Secmod_signkey.get_signkeys sm_signkey
|
|
|> 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
|
|
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 = (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;
|
|
future_signkeys;
|
|
master_pub;
|
|
denom_secmod_public_key;
|
|
signkey_secmod_public_key;
|
|
}
|
|
|
|
let jsont = FutureKeysResponse.jsont
|
|
|
|
let f req server _env =
|
|
let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
|
|
let sm_denom = Vif.Server.device Devices.secmod_denom server in
|
|
let res =
|
|
let v = mk_future_keys_response ~sm_signkey ~sm_denom in
|
|
let s = Api.encode_exn jsont v in
|
|
Ok s
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Keys_post = struct
|
|
let verify_denom_signature ~sm_denom
|
|
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
|
|
|> List.find_opt (fun (denom : Denomination.t) ->
|
|
denom.h_pub = denom_hash)
|
|
|> function
|
|
| 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 open Bin_sig.DenominationKeyValidity in
|
|
let r : 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;
|
|
denom_hash;
|
|
}
|
|
in
|
|
verify ~key:Config.master_public_key master_sig r
|
|
|
|
let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig }
|
|
=
|
|
let* signkey =
|
|
Secmod_signkey.get_signkeys sm_signkey
|
|
|> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key)
|
|
|> function
|
|
| 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
|
|
in
|
|
let open Bin_sig.ExchangeSigningKeyValidity in
|
|
let r : r =
|
|
{
|
|
start= signkey.stamp_start;
|
|
expire= signkey.stamp_expire;
|
|
end_= signkey.stamp_end;
|
|
signkey_pub= signkey.pub;
|
|
}
|
|
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
|
|
Ok ()
|
|
|
|
(* TODO move to test *)
|
|
let check_master_signatures_update ~db_conn ~sm_denom =
|
|
Secmod_denom.get_denoms sm_denom
|
|
|> list_iter (fun denom ->
|
|
let error = Error "update_master_signatures sanity check failure" in
|
|
let* opt =
|
|
Pg.lookup_denomination_key db_conn denom.Denomination.h_pub
|
|
|> unwrap_err_caqti
|
|
in
|
|
let* ( valid_from,
|
|
_expire_withdraw,
|
|
_expire_deposit,
|
|
_expire_legal,
|
|
coin,
|
|
_fee_withdraw,
|
|
_fee_deposit,
|
|
_fee_refresh,
|
|
fee_refund,
|
|
age_mask ) =
|
|
match opt with None -> error | Some v -> Ok v
|
|
in
|
|
let check = function false -> error | true -> Ok () in
|
|
let* () =
|
|
check (Timestamp.compare valid_from denom.stamp_start = Some 0)
|
|
in
|
|
let* () = check (coin = denom.value) in
|
|
let* () = check (fee_refund = denom.fee_refund) in
|
|
let* () = check (age_mask = denom.age_mask) in
|
|
Ok ())
|
|
|
|
let do_ ~db_conn ~sm_signkey ~sm_denom
|
|
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
|
|
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
|
|
in
|
|
let* () = check_master_signatures_update ~db_conn ~sm_denom in
|
|
Ok ()
|
|
|
|
let jsont = MasterSignatures.jsont
|
|
|
|
let f req server _env =
|
|
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 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
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Denom_revoke = struct
|
|
let verify h_denom_pub DenomRevocationSignature.{ master_sig } =
|
|
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+ () =
|
|
Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
|
|
|> unwrap_err_caqti
|
|
in
|
|
()
|
|
|
|
let jsont = DenomRevocationSignature.jsont
|
|
|
|
let f req h_denom_pub server _env =
|
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
|
let sm_denom = Vif.Server.device Devices.secmod_denom 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
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Signkey_revoke = struct
|
|
let verify exchange_pub SignkeyRevocationSignature.{ master_sig } =
|
|
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+ () =
|
|
Pg.insert_signkey_revocation db_conn exchange_pub master_sig
|
|
|> unwrap_err_caqti
|
|
in
|
|
()
|
|
|
|
let jsont = SignkeyRevocationSignature.jsont
|
|
|
|
let f req exchange_pub server _env =
|
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
|
let sm_signkey = Vif.Server.device Devices.secmod_signkey 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
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Auditors = struct
|
|
let verify
|
|
AuditorSetupMessage.
|
|
{
|
|
auditor_url;
|
|
auditor_name= _;
|
|
auditor_pub;
|
|
master_sig;
|
|
validity_start;
|
|
} =
|
|
let open Bin_sig.MasterAddAuditor in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{
|
|
start_date= validity_start;
|
|
auditor_pub;
|
|
h_auditor_url= Bin_type.Hash_64_cstr.hash auditor_url;
|
|
}
|
|
|
|
(* TODO timestamps last_change +/- checks *)
|
|
(* todo: there is something about use of monotonic time
|
|
+ protection against replay attack that I don't understand *)
|
|
let do_ ~db_conn v =
|
|
let auditor_pub = v.AuditorSetupMessage.auditor_pub in
|
|
let validity_start = v.AuditorSetupMessage.validity_start in
|
|
let* last_date_opt =
|
|
Pg.lookup_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
|
|
in
|
|
match last_date_opt with
|
|
| None ->
|
|
let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
|
|
()
|
|
| Some last_date ->
|
|
let cmp = Timestamp.compare last_date validity_start |> Option.get in
|
|
if cmp > 0 then Error "more recent management auditor already present"
|
|
else
|
|
let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = AuditorSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Auditors_disable = struct
|
|
let verify auditor_pub AuditorTeardownMessage.{ master_sig; validity_end } =
|
|
let open Bin_sig.MasterDelAuditor in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{ end_date= validity_end; auditor_pub }
|
|
|
|
let do_ ~db_conn auditor_pub
|
|
AuditorTeardownMessage.{ master_sig= _; validity_end } =
|
|
let* last_date_opt =
|
|
Pg.lookup_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
|
|
in
|
|
match last_date_opt with
|
|
| None -> Error "auditor not found"
|
|
| Some last_date ->
|
|
let cmp = Timestamp.compare last_date validity_end |> Option.get in
|
|
if cmp > 0 then Error "more recent management auditor already present"
|
|
else
|
|
let+ () =
|
|
Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
|
|
|> unwrap_err_caqti
|
|
in
|
|
()
|
|
|
|
let jsont = AuditorTeardownMessage.jsont
|
|
|
|
let f req auditor_pub server _env =
|
|
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 auditor_pub v in
|
|
let* () = do_ ~db_conn auditor_pub v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Wire_fee = struct
|
|
let verify
|
|
WireFeeSetupMessage.
|
|
{
|
|
wire_method;
|
|
master_sig_wire;
|
|
fee_start;
|
|
fee_end;
|
|
closing_fee;
|
|
wire_fee;
|
|
} =
|
|
let open Bin_sig.MasterWireFee in
|
|
verify ~key:Config.Exchange.master_public_key master_sig_wire
|
|
{
|
|
h_wire_method= Bin_type.Hash_64_cstr.hash wire_method;
|
|
start_date= fee_start;
|
|
end_date= fee_end;
|
|
wire_fee;
|
|
closing_fee;
|
|
}
|
|
|
|
let do_ ~db_conn
|
|
WireFeeSetupMessage.
|
|
{
|
|
wire_method;
|
|
master_sig_wire;
|
|
fee_start;
|
|
fee_end;
|
|
closing_fee;
|
|
wire_fee;
|
|
} =
|
|
let* wire_fee_opt =
|
|
Pg.lookup_wire_fee_by_time db_conn ~wire_method ~start_date:fee_start
|
|
~end_date:fee_end
|
|
|> unwrap_err_caqti
|
|
in
|
|
match wire_fee_opt with
|
|
| Some (_wire_fee, _closing_fee) -> Error "wire-fee already setup"
|
|
| None ->
|
|
let+ () =
|
|
Pg.insert_wire_fee db_conn ~wire_method ~start_date:fee_start
|
|
~end_date:fee_end ~wire_fee ~closing_fee ~master_sig:master_sig_wire
|
|
|> unwrap_err_caqti
|
|
in
|
|
()
|
|
|
|
let jsont = WireFeeSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Global_fees = struct
|
|
let verify
|
|
GlobalFees.
|
|
{
|
|
start_date;
|
|
end_date;
|
|
history_fee;
|
|
account_fee;
|
|
purse_fee;
|
|
history_expiration;
|
|
purse_account_limit;
|
|
purse_timeout;
|
|
master_sig;
|
|
} =
|
|
(* TODO what is kyc_timeout, kyc_fee ? *)
|
|
let dummy_amount =
|
|
Amount.make ~sign:None ~currency:"EUR" ~value:0_L ~fraction:0_l
|
|
|> Result.get_ok
|
|
in
|
|
let kyc_timeout = None in
|
|
let kyc_fee = dummy_amount in
|
|
(* * *)
|
|
let open Bin_sig.GlobalFees in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{
|
|
start_date;
|
|
end_date;
|
|
purse_timeout;
|
|
kyc_timeout;
|
|
history_expiration;
|
|
history_fee;
|
|
kyc_fee;
|
|
account_fee;
|
|
purse_fee;
|
|
purse_account_limit;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let* global_fees_opt =
|
|
let start_date = v.GlobalFees.start_date in
|
|
let end_date = v.GlobalFees.end_date in
|
|
Pg.lookup_global_fee_by_time db_conn ~start_date ~end_date
|
|
|> unwrap_err_caqti
|
|
in
|
|
match global_fees_opt with
|
|
| Some _ -> Error "global-fees already setup"
|
|
| None ->
|
|
let+ () = Pg.insert_global_fee db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = GlobalFees.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Wire = struct
|
|
let verify
|
|
WireSetupMessage.
|
|
{
|
|
payto_uri;
|
|
master_sig_wire;
|
|
master_sig_add;
|
|
validity_start;
|
|
bank_label= _;
|
|
priority= _;
|
|
} =
|
|
(* TODO wire *)
|
|
let conversion_url = "" in
|
|
let credit_restrictions = "" in
|
|
let debit_restrictions = "" in
|
|
let open Bin_type in
|
|
let* () =
|
|
let open Bin_sig.MasterWireDetails in
|
|
verify ~key:Config.Exchange.master_public_key master_sig_wire
|
|
{
|
|
h_wire_details= FullPaytoHash.hash payto_uri;
|
|
h_conversion_url= Hash_64_cstr.hash conversion_url;
|
|
h_credit_restrictions= Hash_64_cstr.hash credit_restrictions;
|
|
h_debit_restrictions= Hash_64_cstr.hash debit_restrictions;
|
|
}
|
|
in
|
|
let* () =
|
|
let open Bin_sig.MasterAddWire in
|
|
verify ~key:Config.Exchange.master_public_key master_sig_add
|
|
{
|
|
start_date= validity_start;
|
|
h_wire= FullPaytoHash.hash payto_uri;
|
|
h_conversion_url= Hash_64_cstr.hash conversion_url;
|
|
h_credit_restrictions= Hash_64_cstr.hash credit_restrictions;
|
|
h_debit_restrictions= Hash_64_cstr.hash debit_restrictions;
|
|
}
|
|
in
|
|
Ok ()
|
|
|
|
let do_ ~db_conn v =
|
|
let* last_change_opt =
|
|
let payto_uri = v.WireSetupMessage.payto_uri in
|
|
Pg.lookup_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
|
|
in
|
|
match last_change_opt with
|
|
| Some _ -> Error "wire already setup"
|
|
| None ->
|
|
let+ () = Pg.insert_wire db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = WireSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Wire_disable = struct
|
|
let verify WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
|
|
let open Bin_sig.MasterDelWire in
|
|
verify ~key:Config.Exchange.master_public_key master_sig_del
|
|
{ end_date= validity_end; h_wire= Bin_type.FullPaytoHash.hash payto_uri }
|
|
|
|
let do_ ~db_conn
|
|
WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
|
|
let* last_change_opt =
|
|
Pg.lookup_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
|
|
in
|
|
match last_change_opt with
|
|
| None -> Error "wire not found"
|
|
| Some _ ->
|
|
let+ () =
|
|
Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
|
|
in
|
|
()
|
|
|
|
let jsont = WireTeardownMessage.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Drain = struct
|
|
let verify
|
|
DrainProfitsMessage.
|
|
{
|
|
debit_account_section;
|
|
credit_payto_uri;
|
|
wtid;
|
|
master_sig;
|
|
date;
|
|
amount;
|
|
} =
|
|
let open Bin_sig.MasterDrainProfit in
|
|
let open Bin_type in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{
|
|
wtid;
|
|
date;
|
|
amount;
|
|
h_section= Hash_64_cstr.hash debit_account_section;
|
|
h_payto= FullPaytoHash.hash credit_payto_uri;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = DrainProfitsMessage.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module AmlOfficer = struct
|
|
let verify
|
|
AmlOfficerSetup.
|
|
{
|
|
officer_pub;
|
|
officer_name;
|
|
is_active;
|
|
read_only= _;
|
|
master_sig;
|
|
change_date;
|
|
} =
|
|
let open Bin_sig.MasterAmlOfficerStatus in
|
|
let is_active = match is_active with true -> 1_l | false -> 0_l in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{
|
|
change_date;
|
|
officer_pub;
|
|
h_officer_name= Bin_type.Hash_64_cstr.hash officer_name;
|
|
is_active;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = AmlOfficerSetup.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|
|
|
|
module Partners = struct
|
|
let verify
|
|
ExchangePartnerSetupRequest.
|
|
{
|
|
partner_base_url;
|
|
partner_pub;
|
|
wad_frequency;
|
|
master_sig;
|
|
start_date;
|
|
end_date;
|
|
wad_fee;
|
|
} =
|
|
let open Bin_sig.PartnerConfiguration in
|
|
verify ~key:Config.Exchange.master_public_key master_sig
|
|
{
|
|
partner_pub;
|
|
start_date;
|
|
end_date;
|
|
wad_frequency;
|
|
wad_fee;
|
|
h_url= Bin_type.Hash_64_cstr.hash partner_base_url;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in
|
|
()
|
|
|
|
let jsont = ExchangePartnerSetupRequest.jsont
|
|
|
|
let f req server _env =
|
|
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 v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ""
|
|
in
|
|
Respond_util.respond_with_res res req
|
|
end
|