This commit is contained in:
parent
e65b3b7b0c
commit
97bf85d559
4 changed files with 719 additions and 710 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 open Vif.Type in
|
||||||
let get_ path = get (path /?? nil) in
|
let get_ path = get (path /?? nil) in
|
||||||
let post path jsont = post (json_encoding jsont) (path /?? nil) in
|
let post path jsont = post (json_encoding jsont) (path /?? nil) in
|
||||||
let v s = rel / s in
|
let static =
|
||||||
let open Handler in
|
let v s = rel / s in
|
||||||
[
|
[
|
||||||
get_ rel --> hello;
|
get_ rel --> hello;
|
||||||
get_ (v "terms") --> Static.terms;
|
get_ (v "terms") --> Static.terms;
|
||||||
get_ (v "privacy") --> Static.privacy;
|
get_ (v "privacy") --> Static.privacy;
|
||||||
get_ (v "management" / "keys") --> management_keys_get;
|
]
|
||||||
post (v "management" / "keys") management_keys_post_jsont
|
in
|
||||||
--> management_keys_post;
|
let management =
|
||||||
post
|
let open Management in
|
||||||
(v "management" / "denominations" /% string `Path / "revoke")
|
let v s = rel / "management" / s in
|
||||||
management_denom_revoke_jsont
|
[
|
||||||
--> management_denom_revoke;
|
get_ (v "keys") --> Keys_get.f;
|
||||||
post
|
post (v "keys") Keys_post.jsont --> Keys_post.f;
|
||||||
(v "management" / "signkeys" /% string `Path / "revoke")
|
post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
|
||||||
management_signkey_revoke_jsont
|
--> Denom_revoke.f;
|
||||||
--> management_signkey_revoke;
|
post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
|
||||||
post (v "management" / "auditors") management_auditors_jsont
|
--> Signkey_revoke.f;
|
||||||
--> management_auditors;
|
post (v "auditors") Auditors.jsont --> Auditors.f;
|
||||||
post
|
post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
|
||||||
(v "management" / "auditors" /% string `Path / "disable")
|
--> Auditors_disable.f;
|
||||||
management_auditors_disable_jsont
|
post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
|
||||||
--> management_auditors_disable;
|
post (v "global-fees") Global_fees.jsont --> Global_fees.f;
|
||||||
post (v "management" / "wire-fee") management_wire_fee_jsont
|
post (v "wire") Wire.jsont --> Wire.f;
|
||||||
--> management_wire_fee;
|
post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
|
||||||
post (v "management" / "global-fees") management_global_fees_jsont
|
post (v "drain") Drain.jsont --> Drain.f;
|
||||||
--> management_global_fees;
|
post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
|
||||||
post (v "management" / "wire") management_wire_jsont --> management_wire;
|
post (v "partners") Partners.jsont --> Partners.f;
|
||||||
post (v "management" / "wire" / "disable") management_wire_disable_jsont
|
]
|
||||||
--> management_wire_disable;
|
in
|
||||||
post (v "management" / "drain") management_drain_jsont --> management_drain;
|
static @ management
|
||||||
post (v "management" / "aml-officers") management_aml_officers_jsont
|
|
||||||
--> management_aml_officers;
|
|
||||||
post (v "management" / "partners") management_partners_jsont
|
|
||||||
--> management_partners;
|
|
||||||
]
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Util.Log_reporter.setup ();
|
Util.Log_reporter.setup ();
|
||||||
|
|
|
||||||
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