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