mte/src/handler.ml

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