583 lines
18 KiB
OCaml
583 lines
18 KiB
OCaml
open Syntax
|
|
open Api
|
|
open Hash
|
|
|
|
module Keys_get = struct
|
|
let jsont = FutureKeysResponse.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "GET /management/keys/");
|
|
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
|
|
let res =
|
|
let* v = Keys.make_future_keys_response () in
|
|
Api.encode jsont v
|
|
in
|
|
Respond.result res req
|
|
end
|
|
|
|
module Keys_post = struct
|
|
let verify (module Keys : Keys.S)
|
|
MasterSignatures.{ denom_sigs; signkey_sigs } =
|
|
let* () = list_iter Keys.verify_future_signkey signkey_sigs in
|
|
let* () = list_iter Keys.verify_future_denomination denom_sigs in
|
|
Ok ()
|
|
|
|
let do_ (module Keys : Keys.S) MasterSignatures.{ denom_sigs; signkey_sigs } =
|
|
let* () = list_iter Keys.certify_future_signkey signkey_sigs in
|
|
let* () = list_iter Keys.certify_future_denomination denom_sigs in
|
|
Ok ()
|
|
|
|
let jsont = MasterSignatures.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/keys/");
|
|
let keys = Vif.Server.device Devices.keys server in
|
|
let res =
|
|
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
|
let* () = verify keys v in
|
|
let* () = do_ keys v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Denom_revoke = struct
|
|
let verify (module Keys : Keys.S) h_denom_pub
|
|
DenomRevocationSignature.{ master_sig } =
|
|
let open Signatures.MasterDenominationKeyRevocation in
|
|
verify Config.master_public_key master_sig { h_denom_pub }
|
|
|
|
let do_ (module Keys : Keys.S) h_denom_pub
|
|
DenomRevocationSignature.{ master_sig } =
|
|
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 keys = Vif.Server.device Devices.keys server in
|
|
let res =
|
|
let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in
|
|
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
|
let* () = verify keys h_denom_pub v in
|
|
let* () = do_ keys h_denom_pub v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Signkey_revoke = struct
|
|
let verify (module Keys : Keys.S) exchange_pub
|
|
SignkeyRevocationSignature.{ master_sig } =
|
|
let open Signatures.MasterSigningKeyRevocation in
|
|
verify Config.master_public_key master_sig { exchange_pub }
|
|
|
|
let do_ (module Keys : Keys.S) exchange_pub
|
|
SignkeyRevocationSignature.{ master_sig } =
|
|
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 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 keys exchange_pub v in
|
|
let* () = do_ keys exchange_pub v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Auditors = struct
|
|
let verify (module Keys : Keys.S)
|
|
AuditorSetupMessage.
|
|
{
|
|
auditor_url;
|
|
auditor_name= _;
|
|
auditor_pub;
|
|
master_sig;
|
|
validity_start;
|
|
} =
|
|
let open Signatures.MasterAddAuditor in
|
|
verify Config.master_public_key master_sig
|
|
{
|
|
start_date= validity_start;
|
|
auditor_pub;
|
|
h_auditor_url= Hash.Cstring.H64.hash auditor_url;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let auditor_pub = v.AuditorSetupMessage.auditor_pub in
|
|
let validity_start = v.AuditorSetupMessage.validity_start in
|
|
let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
|
|
match opt with
|
|
| None ->
|
|
let auditor = Auditor.of_setup_message v in
|
|
let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
|
|
Logs.info (fun m -> m "enabled auditor");
|
|
()
|
|
| Some auditor ->
|
|
if Timestamp.compare validity_start auditor.last_change <= 0 then
|
|
Error "replay detected on enable-auditor"
|
|
else
|
|
let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
|
|
Logs.info (fun m -> m "updated auditor");
|
|
()
|
|
|
|
let jsont = AuditorSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/auditors/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Auditors_disable = struct
|
|
let verify (module Keys : Keys.S) auditor_pub
|
|
AuditorTeardownMessage.{ master_sig; validity_end } =
|
|
let open Signatures.MasterDelAuditor in
|
|
verify Config.master_public_key master_sig
|
|
{ end_date= validity_end; auditor_pub }
|
|
|
|
let do_ ~db_conn auditor_pub
|
|
AuditorTeardownMessage.{ master_sig= _; validity_end } =
|
|
let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
|
|
match opt with
|
|
| None -> Error "auditor not found"
|
|
| Some auditor -> (
|
|
if Timestamp.compare validity_end auditor.last_change <= 0 then
|
|
Error "replay detected on disable-auditor"
|
|
else
|
|
match auditor.is_active with
|
|
| false ->
|
|
Logs.info (fun m -> m "auditor was already revoked");
|
|
Ok ()
|
|
| true ->
|
|
let auditor =
|
|
{ auditor with last_change= validity_end; is_active= false }
|
|
in
|
|
let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
|
|
Logs.info (fun m ->
|
|
m "revoked auditor `%s`"
|
|
(Crypto.EddsaPublicKey.to_b32 auditor_pub));
|
|
())
|
|
|
|
let jsont = AuditorTeardownMessage.jsont
|
|
|
|
let f req auditor_pub server _env =
|
|
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/");
|
|
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 keys auditor_pub v in
|
|
let* () = do_ ~db_conn auditor_pub v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Wire_fee = struct
|
|
let verify (module Keys : Keys.S)
|
|
WireFeeSetupMessage.
|
|
{
|
|
wire_method;
|
|
master_sig_wire;
|
|
fee_start;
|
|
fee_end;
|
|
closing_fee;
|
|
wire_fee;
|
|
} =
|
|
let open Signatures.MasterWireFee in
|
|
verify Config.master_public_key master_sig_wire
|
|
{
|
|
h_wire_method= Hash.Cstring.H64.hash wire_method;
|
|
start_date= fee_start;
|
|
end_date= fee_end;
|
|
wire_fee;
|
|
closing_fee;
|
|
}
|
|
|
|
let do_ ~db_conn (v : WireFeeSetupMessage.t) =
|
|
let* wire_fees =
|
|
Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method
|
|
~start_date:v.fee_start ~end_date:v.fee_end
|
|
|> unwrap_err_caqti
|
|
in
|
|
match wire_fees with
|
|
| [] ->
|
|
let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in
|
|
Logs.info (fun m -> m "added wire fee");
|
|
()
|
|
| [ vv ] -> (
|
|
match v.master_sig_wire = vv.sig_ with
|
|
| false ->
|
|
Error "a different wire-fee was already setup for this time frame"
|
|
| true ->
|
|
Logs.info (fun m -> m "an identical wire-fee was already setup");
|
|
Ok ())
|
|
| _ ->
|
|
Error
|
|
"invalid database state, multiple wire-fee found in database for \
|
|
this time frame"
|
|
|
|
let jsont = WireFeeSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/wire-fee/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Global_fees = struct
|
|
let verify v = GlobalFees.verify_global_fees ~key:Config.master_public_key v
|
|
|
|
let do_ ~db_conn v =
|
|
let* global_fees =
|
|
let start_date = v.GlobalFees.start_date in
|
|
let end_date = v.GlobalFees.end_date in
|
|
Pg.get_global_fees_by_time db_conn ~start_date ~end_date
|
|
|> unwrap_err_caqti
|
|
in
|
|
match global_fees with
|
|
| [] ->
|
|
let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in
|
|
Logs.info (fun m -> m "added global fees");
|
|
()
|
|
| [ vv ] -> (
|
|
match v.master_sig = vv.master_sig with
|
|
| false ->
|
|
Error
|
|
"a different global-fees was already setup for this time frame"
|
|
| true ->
|
|
Logs.info (fun m -> m "an identical global-fees was already setup");
|
|
Ok ())
|
|
| _ ->
|
|
Error
|
|
"invalid database state, multiple global-fees found in database for \
|
|
this time frame"
|
|
|
|
let jsont = GlobalFees.jsont
|
|
|
|
(* TODO better global_fees
|
|
ensure it is defined for the current time.
|
|
there should be only one global_fees for each moment in time
|
|
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 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.result_no_content res req
|
|
end
|
|
|
|
module Wire = struct
|
|
let verify (module Keys : Keys.S)
|
|
WireSetupMessage.
|
|
{
|
|
payto_uri;
|
|
master_sig_wire;
|
|
master_sig_add;
|
|
conversion_url;
|
|
credit_restrictions;
|
|
debit_restrictions;
|
|
validity_start;
|
|
bank_label= _;
|
|
priority= _;
|
|
} =
|
|
(* TODO wire
|
|
hash over json, hash over string option? *)
|
|
let* () =
|
|
match (credit_restrictions, debit_restrictions) with
|
|
| [], [] -> Ok ()
|
|
| _ ->
|
|
Fmt.error
|
|
"wire setup: credit_restrictions and debit_restrictions are not \
|
|
supported"
|
|
in
|
|
let h_wire_details = Hash.FullPaytoHash.hash payto_uri in
|
|
let h_conversion_url =
|
|
Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url)
|
|
in
|
|
let h_credit_restrictions = Hash.Cstring.H64.hash "" in
|
|
let h_debit_restrictions = Hash.Cstring.H64.hash "" in
|
|
(* - *)
|
|
let* () =
|
|
let open Signatures.MasterWireDetails in
|
|
verify Config.master_public_key master_sig_wire
|
|
{
|
|
h_wire_details;
|
|
h_conversion_url;
|
|
h_credit_restrictions;
|
|
h_debit_restrictions;
|
|
}
|
|
in
|
|
let* () =
|
|
let open Signatures.MasterAddWire in
|
|
verify Config.master_public_key master_sig_add
|
|
{
|
|
start_date= validity_start;
|
|
h_wire= h_wire_details;
|
|
h_conversion_url;
|
|
h_credit_restrictions;
|
|
h_debit_restrictions;
|
|
}
|
|
in
|
|
Ok ()
|
|
|
|
let do_ ~db_conn
|
|
WireSetupMessage.
|
|
{
|
|
payto_uri;
|
|
master_sig_wire;
|
|
master_sig_add= _;
|
|
conversion_url;
|
|
credit_restrictions;
|
|
debit_restrictions;
|
|
validity_start;
|
|
bank_label;
|
|
priority;
|
|
} =
|
|
let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
|
|
match opt with
|
|
| None ->
|
|
let wire =
|
|
ExchangeWireAccount.
|
|
{
|
|
payto_uri;
|
|
conversion_url;
|
|
credit_restrictions;
|
|
debit_restrictions;
|
|
master_sig= master_sig_wire;
|
|
bank_label;
|
|
priority;
|
|
}
|
|
in
|
|
let+ () =
|
|
Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
|
|
wire
|
|
|> unwrap_err_caqti
|
|
in
|
|
Logs.info (fun m -> m "added wire method");
|
|
()
|
|
| Some (wire, _is_active, last_change) ->
|
|
if Timestamp.compare validity_start last_change <= 0 then
|
|
Error "replay detected on enable-wire"
|
|
else
|
|
let+ () =
|
|
Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
|
|
wire
|
|
|> unwrap_err_caqti
|
|
in
|
|
Logs.info (fun m -> m "updated wire method");
|
|
()
|
|
|
|
let jsont = WireSetupMessage.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/wire/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Wire_disable = struct
|
|
let verify (module Keys : Keys.S)
|
|
WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
|
|
let open Signatures.MasterDelWire in
|
|
verify Config.master_public_key master_sig_del
|
|
{ end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
|
|
|
|
let do_ ~db_conn
|
|
WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
|
|
let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
|
|
match opt with
|
|
| None -> Error "wire not found"
|
|
| Some (wire, _is_active, last_change) ->
|
|
if Timestamp.compare validity_end last_change <= 0 then
|
|
Error "replay detected on disable-wire"
|
|
else
|
|
let+ () =
|
|
Pg.update_wire db_conn ~is_active:false ~last_change:validity_end
|
|
wire
|
|
|> unwrap_err_caqti
|
|
in
|
|
Logs.info (fun m -> m "disabled wire method");
|
|
()
|
|
|
|
let jsont = WireTeardownMessage.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/wire/disable/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Drain = struct
|
|
let verify (module Keys : Keys.S)
|
|
DrainProfitsMessage.
|
|
{
|
|
debit_account_section;
|
|
credit_payto_uri;
|
|
wtid;
|
|
master_sig;
|
|
date;
|
|
amount;
|
|
} =
|
|
let open Signatures.MasterDrainProfit in
|
|
verify Config.master_public_key master_sig
|
|
{
|
|
wtid;
|
|
date;
|
|
amount;
|
|
h_section= Hash.Cstring.H64.hash debit_account_section;
|
|
h_payto= FullPaytoHash.hash credit_payto_uri;
|
|
}
|
|
|
|
let do_ ~db_conn v =
|
|
let* opt =
|
|
Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid
|
|
|> unwrap_err_caqti
|
|
in
|
|
match opt with
|
|
| Some _ ->
|
|
Logs.info (fun m -> m "drain profit message already added to database");
|
|
Ok ()
|
|
| None ->
|
|
let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
|
|
Logs.info (fun m -> m "added drain profit message to database");
|
|
()
|
|
|
|
let jsont = DrainProfitsMessage.jsont
|
|
|
|
let f req server _env =
|
|
Logs.info (fun m -> m "POST /management/drain/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module AmlOfficer = struct
|
|
let verify (module Keys : Keys.S)
|
|
AmlOfficerSetup.
|
|
{
|
|
officer_pub;
|
|
officer_name;
|
|
is_active;
|
|
read_only= _;
|
|
master_sig;
|
|
change_date;
|
|
} =
|
|
let open Signatures.MasterAmlOfficerStatus in
|
|
let is_active = match is_active with true -> 1_l | false -> 0_l in
|
|
verify Config.master_public_key master_sig
|
|
{
|
|
change_date;
|
|
officer_pub;
|
|
h_officer_name= Hash.Cstring.H64.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 =
|
|
Logs.info (fun m -> m "POST /management/aml-officers/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|
|
|
|
module Partners = struct
|
|
let verify (module Keys : Keys.S)
|
|
ExchangePartnerSetupRequest.
|
|
{
|
|
partner_base_url;
|
|
partner_pub;
|
|
wad_frequency;
|
|
master_sig;
|
|
start_date;
|
|
end_date;
|
|
wad_fee;
|
|
} =
|
|
let open Signatures.PartnerConfiguration in
|
|
verify Config.master_public_key master_sig
|
|
{
|
|
partner_pub;
|
|
start_date;
|
|
end_date;
|
|
wad_frequency;
|
|
wad_fee;
|
|
h_url= Hash.Cstring.H64.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 =
|
|
Logs.info (fun m -> m "POST /management/partners/");
|
|
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 keys v in
|
|
let* () = do_ ~db_conn v in
|
|
Ok ()
|
|
in
|
|
Respond.result_no_content res req
|
|
end
|