~
This commit is contained in:
parent
625c194fff
commit
5dec579179
5 changed files with 727 additions and 719 deletions
206
src/handler.ml
206
src/handler.ml
|
|
@ -1,206 +0,0 @@
|
|||
module Respond_util = struct
|
||||
let respond_with_plain_text_error ?status e req =
|
||||
let open Vif.Response in
|
||||
let open Syntax in
|
||||
let status = Option.value ~default:`Bad_request status in
|
||||
let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
|
||||
let* () = with_string req e in
|
||||
respond status
|
||||
|
||||
let respond_with_ok_json content req =
|
||||
let open Vif.Response in
|
||||
let open Syntax in
|
||||
let* () = add ~field:"content-type" "application/json" in
|
||||
let* () = with_string req content in
|
||||
respond `OK
|
||||
|
||||
let respond_with_res res req =
|
||||
match res with
|
||||
| Error err ->
|
||||
Logs.err (fun m -> m "%s." err);
|
||||
let err = Fmt.str "%s@." err in
|
||||
respond_with_plain_text_error err req
|
||||
| Ok content -> respond_with_ok_json content req
|
||||
end
|
||||
|
||||
include Respond_util
|
||||
open Syntax
|
||||
open Api
|
||||
|
||||
let management_keys_get 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 = Management.mk_future_keys_response ~sm_signkey ~sm_denom in
|
||||
let s = Api.encode_exn Api.FutureKeysResponse.jsont v in
|
||||
Ok s
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_keys_post_jsont = MasterSignatures.jsont
|
||||
|
||||
let management_keys_post req server _env =
|
||||
let open Management 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_denom = Vif.Server.device Devices.secmod_denom server in
|
||||
let res =
|
||||
let* master_signatures = Vif.Request.of_json req |> unwrap_err_msg in
|
||||
let* () =
|
||||
verify_master_signatures ~sm_signkey ~sm_denom master_signatures
|
||||
in
|
||||
let* () =
|
||||
update_master_signatures ~db_conn ~sm_signkey ~sm_denom master_signatures
|
||||
in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_denom_revoke_jsont = DenomRevocationSignature.jsont
|
||||
|
||||
let management_denom_revoke req h_denom_pub server _env =
|
||||
let open Management in
|
||||
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_denom_revocation_sig h_denom_pub v in
|
||||
let* () = update_denom_revocation ~db_conn ~sm_denom h_denom_pub v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_signkey_revoke_jsont = SignkeyRevocationSignature.jsont
|
||||
|
||||
let management_signkey_revoke req exchange_pub server _env =
|
||||
let open Management in
|
||||
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_signkey_revocation_sig exchange_pub v in
|
||||
let* () = update_signkey_revocation ~db_conn ~sm_signkey exchange_pub v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_auditors_jsont = AuditorSetupMessage.jsont
|
||||
|
||||
let management_auditors req server _env =
|
||||
let open Management 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_auditor_add_sig v in
|
||||
let* () = update_auditor ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_auditors_disable_jsont = AuditorTeardownMessage.jsont
|
||||
|
||||
let management_auditors_disable req auditor_pub server _env =
|
||||
let open Management 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_auditor_disable_sig auditor_pub v in
|
||||
let* () = auditor_disable ~db_conn auditor_pub v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_wire_fee_jsont = WireFeeSetupMessage.jsont
|
||||
|
||||
let management_wire_fee req server _env =
|
||||
let open Management 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_wire_fee_setup_sig v in
|
||||
let* () = update_wire_fee_setup ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_global_fees_jsont = GlobalFees.jsont
|
||||
|
||||
let management_global_fees req server _env =
|
||||
let open Management 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_global_fees v in
|
||||
let* () = update_global_fees ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_wire_jsont = WireSetupMessage.jsont
|
||||
|
||||
let management_wire req server _env =
|
||||
let open Management 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_wire v in
|
||||
let* () = update_wire ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_wire_disable_jsont = WireTeardownMessage.jsont
|
||||
|
||||
let management_wire_disable req server _env =
|
||||
let open Management 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_wire_disable v in
|
||||
let* () = update_wire_disable ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_drain_jsont = DrainProfitsMessage.jsont
|
||||
|
||||
let management_drain req server _env =
|
||||
let open Management 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_drain v in
|
||||
let* () = update_drain ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_aml_officers_jsont = AmlOfficerSetup.jsont
|
||||
|
||||
let management_aml_officers req server _env =
|
||||
let open Management 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_aml_officier v in
|
||||
let* () = update_aml_officier ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
|
||||
let management_partners_jsont = ExchangePartnerSetupRequest.jsont
|
||||
|
||||
let management_partners req server _env =
|
||||
let open Management 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_partner v in
|
||||
let* () = update_partner ~db_conn v in
|
||||
Ok ""
|
||||
in
|
||||
respond_with_res res req
|
||||
1134
src/management.ml
1134
src/management.ml
File diff suppressed because it is too large
Load diff
67
src/mte.ml
67
src/mte.ml
|
|
@ -26,42 +26,37 @@ let routes =
|
|||
let open Vif.Type in
|
||||
let get_ path = get (path /?? nil) in
|
||||
let post path jsont = post (json_encoding jsont) (path /?? nil) in
|
||||
let v s = rel / s in
|
||||
let open Handler in
|
||||
[
|
||||
get_ rel --> hello;
|
||||
get_ (v "terms") --> Static.terms;
|
||||
get_ (v "privacy") --> Static.privacy;
|
||||
get_ (v "management" / "keys") --> management_keys_get;
|
||||
post (v "management" / "keys") management_keys_post_jsont
|
||||
--> management_keys_post;
|
||||
post
|
||||
(v "management" / "denominations" /% string `Path / "revoke")
|
||||
management_denom_revoke_jsont
|
||||
--> management_denom_revoke;
|
||||
post
|
||||
(v "management" / "signkeys" /% string `Path / "revoke")
|
||||
management_signkey_revoke_jsont
|
||||
--> management_signkey_revoke;
|
||||
post (v "management" / "auditors") management_auditors_jsont
|
||||
--> management_auditors;
|
||||
post
|
||||
(v "management" / "auditors" /% string `Path / "disable")
|
||||
management_auditors_disable_jsont
|
||||
--> management_auditors_disable;
|
||||
post (v "management" / "wire-fee") management_wire_fee_jsont
|
||||
--> management_wire_fee;
|
||||
post (v "management" / "global-fees") management_global_fees_jsont
|
||||
--> management_global_fees;
|
||||
post (v "management" / "wire") management_wire_jsont --> management_wire;
|
||||
post (v "management" / "wire" / "disable") management_wire_disable_jsont
|
||||
--> management_wire_disable;
|
||||
post (v "management" / "drain") management_drain_jsont --> management_drain;
|
||||
post (v "management" / "aml-officers") management_aml_officers_jsont
|
||||
--> management_aml_officers;
|
||||
post (v "management" / "partners") management_partners_jsont
|
||||
--> management_partners;
|
||||
]
|
||||
let static =
|
||||
let v s = rel / s in
|
||||
[
|
||||
get_ rel --> hello;
|
||||
get_ (v "terms") --> Static.terms;
|
||||
get_ (v "privacy") --> Static.privacy;
|
||||
]
|
||||
in
|
||||
let management =
|
||||
let open Management in
|
||||
let v s = rel / "management" / s in
|
||||
[
|
||||
get_ (v "keys") --> Keys_get.f;
|
||||
post (v "keys") Keys_post.jsont --> Keys_post.f;
|
||||
post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
|
||||
--> Denom_revoke.f;
|
||||
post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
|
||||
--> Signkey_revoke.f;
|
||||
post (v "auditors") Auditors.jsont --> Auditors.f;
|
||||
post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
|
||||
--> Auditors_disable.f;
|
||||
post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
|
||||
post (v "global-fees") Global_fees.jsont --> Global_fees.f;
|
||||
post (v "wire") Wire.jsont --> Wire.f;
|
||||
post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
|
||||
post (v "drain") Drain.jsont --> Drain.f;
|
||||
post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
|
||||
post (v "partners") Partners.jsont --> Partners.f;
|
||||
]
|
||||
in
|
||||
static @ management
|
||||
|
||||
let () =
|
||||
Util.Log_reporter.setup ();
|
||||
|
|
|
|||
17
src/pg.ml
17
src/pg.ml
|
|
@ -13,6 +13,7 @@ module type CONN = Caqti_miou.CONNECTION
|
|||
|
||||
open Crypto
|
||||
open Bin_type
|
||||
open Api
|
||||
|
||||
module Caqti_type = struct
|
||||
include Caqti_type
|
||||
|
|
@ -205,7 +206,7 @@ let insert_auditor =
|
|||
is_active, last_change) VALUES ($1, $2, $3, true, $4)"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.AuditorSetupMessage.
|
||||
AuditorSetupMessage.
|
||||
{ auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
|
||||
->
|
||||
Conn.exec insert_auditor
|
||||
|
|
@ -218,7 +219,7 @@ let update_auditor =
|
|||
last_change=$5 WHERE auditor_pub=$1"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.AuditorSetupMessage.
|
||||
AuditorSetupMessage.
|
||||
{ auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
|
||||
->
|
||||
Conn.exec update_auditor
|
||||
|
|
@ -285,7 +286,7 @@ let insert_global_fee =
|
|||
$12)"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.GlobalFees.
|
||||
GlobalFees.
|
||||
{
|
||||
start_date;
|
||||
end_date;
|
||||
|
|
@ -330,7 +331,7 @@ let insert_wire =
|
|||
($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,true,$6,$7,$8)"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.WireSetupMessage.
|
||||
WireSetupMessage.
|
||||
{
|
||||
payto_uri;
|
||||
master_sig_wire;
|
||||
|
|
@ -368,7 +369,7 @@ let update_wire =
|
|||
bank_label=$8, priority=$9 WHERE payto_uri=$1"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.WireSetupMessage.
|
||||
WireSetupMessage.
|
||||
{
|
||||
payto_uri;
|
||||
master_sig_wire;
|
||||
|
|
@ -417,7 +418,7 @@ let insert_drain_profit =
|
|||
trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.DrainProfitsMessage.
|
||||
DrainProfitsMessage.
|
||||
{
|
||||
debit_account_section;
|
||||
credit_payto_uri;
|
||||
|
|
@ -438,7 +439,7 @@ let insert_aml_officer =
|
|||
$4, $5, $6)"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.AmlOfficerSetup.
|
||||
AmlOfficerSetup.
|
||||
{
|
||||
officer_pub;
|
||||
officer_name;
|
||||
|
|
@ -461,7 +462,7 @@ let insert_partner =
|
|||
$3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
|
||||
in
|
||||
fun (module Conn : CONN)
|
||||
Api.ExchangePartnerSetupRequest.
|
||||
ExchangePartnerSetupRequest.
|
||||
{
|
||||
partner_base_url;
|
||||
partner_pub;
|
||||
|
|
|
|||
22
src/respond_util.ml
Normal file
22
src/respond_util.ml
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
let respond_with_plain_text_error ?status e req =
|
||||
let open Vif.Response in
|
||||
let open Syntax in
|
||||
let status = Option.value ~default:`Bad_request status in
|
||||
let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
|
||||
let* () = with_string req e in
|
||||
respond status
|
||||
|
||||
let respond_with_ok_json content req =
|
||||
let open Vif.Response in
|
||||
let open Syntax in
|
||||
let* () = add ~field:"content-type" "application/json" in
|
||||
let* () = with_string req content in
|
||||
respond `OK
|
||||
|
||||
let respond_with_res res req =
|
||||
match res with
|
||||
| Error err ->
|
||||
Logs.err (fun m -> m "%s." err);
|
||||
let err = Fmt.str "%s@." err in
|
||||
respond_with_plain_text_error err req
|
||||
| Ok content -> respond_with_ok_json content req
|
||||
Loading…
Add table
Add a link
Reference in a new issue