~~~

src/http_management.ml

@@ -0,0 +1,752 @@
+open Syntax
+open Api
+
+module Keys_get = struct
+  let mk_future_denom (module Sm : Secmod.S) ~section_name
+      ({
+         pub;
+         value;
+         stamp_start;
+         stamp_expire_withdraw;
+         stamp_expire_deposit;
+         stamp_expire_legal;
+         fee_withdraw;
+         fee_deposit;
+         fee_refresh;
+         fee_refund;
+         age_mask;
+         h_pub;
+         master_sig= _;
+         revoked_sig= _;
+       } :
+        Denom_data.t) =
+    let denom_pub =
+      DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub }
+    in
+    let denom_secmod_sig =
+      let open Bin_sig.DenominationKeyAnnouncement in
+      let h_denom_pub = h_pub in
+      let h_section_name = Bin_type.Hash_64_cstr.hash section_name in
+      let anchor_time = stamp_start in
+      let duration_withdraw =
+        Timestamp.diff stamp_start stamp_expire_withdraw
+      in
+      sign_f ~f:Sm.sign_with_sm_key
+        { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+    in
+    FutureDenom.
+      {
+        section_name;
+        value;
+        stamp_start;
+        stamp_expire_withdraw;
+        stamp_expire_deposit;
+        stamp_expire_legal;
+        denom_pub;
+        fee_withdraw;
+        fee_deposit;
+        fee_refresh;
+        fee_refund;
+        denom_secmod_sig;
+      }
+
+  let mk_future_signkey (module Sm : Secmod.S)
+      ({
+         pub;
+         stamp_start;
+         stamp_expire;
+         stamp_end;
+         master_sig= _;
+         revoked_sig= _;
+       } :
+        Signkey_data.t) =
+    let signkey_secmod_sig =
+      let open Bin_sig.SigningKeyAnnouncement in
+      let exchange_pub = pub in
+      let anchor_time = stamp_start in
+      let duration = Timestamp.diff stamp_start stamp_expire in
+      sign_f ~f:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
+    in
+    FutureSignKey.
+      { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+  let mk_future_keys_response (module Sm : Secmod.S) =
+    let future_signkeys =
+      Sm.get_signkeys_data ()
+      |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
+      |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
+    in
+    let future_denoms =
+      Sm.get_denoms_data ()
+      |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
+      |> List.map (fun dn_data ->
+          let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
+          match opt with
+          | None -> Fmt.failwith "section_name not found."
+          | Some section_name ->
+              mk_future_denom (module Sm) ~section_name dn_data)
+    in
+    let master_pub = Config.Exchange.master_public_key in
+    let denom_secmod_public_key = Sm.get_sm_key_pub () in
+    let signkey_secmod_public_key = Sm.get_sm_key_pub () in
+    FutureKeysResponse.
+      {
+        future_denoms;
+        future_signkeys;
+        master_pub;
+        denom_secmod_public_key;
+        signkey_secmod_public_key;
+      }
+
+  let jsont = FutureKeysResponse.jsont
+
+  let f req server _env =
+    Logs.info (fun m -> m "GET /management/keys/");
+    let sm = Vif.Server.device Devices.secmod server in
+    let res =
+      let v = mk_future_keys_response sm in
+      let s = Api.encode_exn jsont v in
+      Ok s
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Keys_post = struct
+  let verify_denom_signature (module Sm : Secmod.S)
+      DenomSignature.{ h_denom_pub; master_sig } =
+    let* denom =
+      match Sm.find_denom_data h_denom_pub with
+      | None ->
+          Fmt.error
+            "404 not found, One of the keys for which a signature was provided \
+             is unknown to the exchange."
+      | Some denom -> Ok denom
+    in
+    let open Bin_sig.DenominationKeyValidity in
+    let r : r =
+      {
+        master= Config.master_public_key;
+        start= denom.stamp_start;
+        expire_withdraw= denom.stamp_expire_withdraw;
+        expire_spend= denom.stamp_expire_deposit;
+        expire_legal= denom.stamp_expire_legal;
+        value= denom.value;
+        fee_withdraw= denom.fee_withdraw;
+        fee_deposit= denom.fee_deposit;
+        fee_refresh= denom.fee_refresh;
+        denom_hash= h_denom_pub;
+      }
+    in
+    verify_f ~f:Sm.verify_with_master_key master_sig r
+
+  let verify_signkey_signature (module Sm : Secmod.S)
+      SignKeySignature.{ key; master_sig } =
+    let* signkey =
+      match Sm.find_signkey_data key with
+      | None ->
+          Fmt.error
+            "404 not found, One of the keys for which a signature was provided \
+             is unknown to the exchange."
+      | Some signkey -> Ok signkey
+    in
+    let open Bin_sig.ExchangeSigningKeyValidity in
+    let r : r =
+      {
+        start= signkey.stamp_start;
+        expire= signkey.stamp_expire;
+        end_= signkey.stamp_end;
+        signkey_pub= signkey.pub;
+      }
+    in
+    verify_f ~f:Sm.verify_with_master_key master_sig r
+
+  let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
+    let* () = list_iter (verify_denom_signature sm) denom_sigs in
+    let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
+    Ok ()
+
+  (* TODO move to test *)
+  let check_master_signatures_update ~db_conn (module Sm : Secmod.S) =
+    Sm.get_denoms_data ()
+    |> list_iter (fun denom ->
+        let error = Error "update_master_signatures sanity check failure" in
+        let* opt =
+          Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti
+        in
+        let* v = match opt with None -> error | Some v -> Ok v in
+        let check = function false -> error | true -> Ok () in
+        let* () =
+          check (Timestamp.compare v.stamp_start denom.stamp_start = Some 0)
+        in
+        let* () = check (v.value = denom.value) in
+        let* () = check (v.fee_refund = denom.fee_refund) in
+        let* () = check (v.age_mask = denom.age_mask) in
+        Ok ())
+
+  let do_ ~db_conn (module Sm : Secmod.S)
+      MasterSignatures.{ denom_sigs; signkey_sigs } =
+    let* () =
+      signkey_sigs
+      |> List.map (fun SignKeySignature.{ key; master_sig } ->
+          (key, master_sig))
+      |> Sm.add_signkey_master_signatures
+    in
+    let* () =
+      denom_sigs
+      |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
+          (h_denom_pub, master_sig))
+      |> Sm.add_denom_master_signatures
+    in
+    let* () = Sm.store () in
+    let* () = check_master_signatures_update ~db_conn (module Sm) in
+    Ok ()
+
+  let jsont = MasterSignatures.jsont
+
+  let f req server _env =
+    Logs.info (fun m -> m "POST /management/keys/");
+    let db_conn = Vif.Server.device Devices.db_connection server in
+    let sm = Vif.Server.device Devices.secmod server in
+    let res =
+      let* v = Vif.Request.of_json req |> unwrap_err_msg in
+      let* () = verify sm v in
+      let* () = do_ ~db_conn sm v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Denom_revoke = struct
+  let verify (module Sm : Secmod.S) h_denom_pub
+      DenomRevocationSignature.{ master_sig } =
+    let open Bin_sig.MasterDenominationKeyRevocation in
+    verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+
+  let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+      DenomRevocationSignature.{ master_sig } =
+    let* () = Sm.revoke_denomination h_denom_pub master_sig in
+    let+ () =
+      Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
+      |> unwrap_err_caqti
+    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 db_conn = Vif.Server.device Devices.db_connection server in
+    let sm = Vif.Server.device Devices.secmod server in
+    let res =
+      let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
+      let* v = Vif.Request.of_json req |> unwrap_err_msg in
+      let* () = verify sm h_denom_pub v in
+      let* () = do_ ~db_conn sm h_denom_pub v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Signkey_revoke = struct
+  let verify (module Sm : Secmod.S) exchange_pub
+      SignkeyRevocationSignature.{ master_sig } =
+    let open Bin_sig.MasterSigningKeyRevocation in
+    verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+
+  let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+      SignkeyRevocationSignature.{ master_sig } =
+    let* () = Sm.revoke_signkey exchange_pub master_sig in
+    let+ () =
+      Pg.insert_signkey_revocation db_conn exchange_pub master_sig
+      |> unwrap_err_caqti
+    in
+    ()
+
+  let jsont = SignkeyRevocationSignature.jsont
+
+  let f req exchange_pub server _env =
+    Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
+    let db_conn = Vif.Server.device Devices.db_connection server in
+    let sm = Vif.Server.device Devices.secmod 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 sm exchange_pub v in
+      let* () = do_ ~db_conn sm exchange_pub v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Auditors = struct
+  let verify (module Sm : Secmod.S)
+      AuditorSetupMessage.
+        {
+          auditor_url;
+          auditor_name= _;
+          auditor_pub;
+          master_sig;
+          validity_start;
+        } =
+    let open Bin_sig.MasterAddAuditor in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      {
+        start_date= validity_start;
+        auditor_pub;
+        h_auditor_url= Bin_type.Hash_64_cstr.hash auditor_url;
+      }
+
+  (* TODO timestamps last_change +/- checks *)
+  (* todo: there is something about use of monotonic time
+   + protection against replay attack that I don't understand *)
+  let do_ ~db_conn v =
+    let auditor_pub = v.AuditorSetupMessage.auditor_pub in
+    let validity_start = v.AuditorSetupMessage.validity_start in
+    let* last_date_opt =
+      Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+    in
+    match last_date_opt with
+    | None ->
+        let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
+        Logs.info (fun m -> m "enabled auditor");
+        ()
+    | Some last_date ->
+        let cmp = Timestamp.compare last_date validity_start |> Option.get in
+        if cmp > 0 then
+          Error
+            "database has more recent auditor data for this auditor public key"
+        else
+          let+ () = Pg.update_auditor db_conn v |> 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 sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Auditors_disable = struct
+  let verify (module Sm : Secmod.S) auditor_pub
+      AuditorTeardownMessage.{ master_sig; validity_end } =
+    let open Bin_sig.MasterDelAuditor in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      { end_date= validity_end; auditor_pub }
+
+  let do_ ~db_conn auditor_pub
+      AuditorTeardownMessage.{ master_sig= _; validity_end } =
+    let* last_date_opt =
+      Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+    in
+    match last_date_opt with
+    | None -> Error "auditor not found"
+    | Some last_date ->
+        let cmp = Timestamp.compare last_date validity_end |> Option.get in
+        if cmp > 0 then
+          Error
+            "database has more recent auditor data for this auditor public key"
+        else
+          let+ () =
+            Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
+            |> unwrap_err_caqti
+          in
+          ()
+
+  let jsont = AuditorTeardownMessage.jsont
+
+  let f req auditor_pub server _env =
+    Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
+    let sm = Vif.Server.device Devices.secmod 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 sm auditor_pub v in
+      let* () = do_ ~db_conn auditor_pub v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Wire_fee = struct
+  let verify (module Sm : Secmod.S)
+      WireFeeSetupMessage.
+        {
+          wire_method;
+          master_sig_wire;
+          fee_start;
+          fee_end;
+          closing_fee;
+          wire_fee;
+        } =
+    let open Bin_sig.MasterWireFee in
+    verify_f ~f:Sm.verify_with_master_key master_sig_wire
+      {
+        h_wire_method= Bin_type.Hash_64_cstr.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 sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Global_fees = struct
+  let verify (module Sm : Secmod.S)
+      GlobalFees.
+        {
+          start_date;
+          end_date;
+          history_fee;
+          account_fee;
+          purse_fee;
+          history_expiration;
+          purse_account_limit;
+          purse_timeout;
+          master_sig;
+        } =
+    (* TODO KYC
+       what is kyc_timeout, kyc_fee ? *)
+    let kyc_timeout = None in
+    let kyc_fee = Amount.dummy_value in
+    (* * *)
+    let open Bin_sig.GlobalFees in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      {
+        start_date;
+        end_date;
+        purse_timeout;
+        kyc_timeout;
+        history_expiration;
+        history_fee;
+        kyc_fee;
+        account_fee;
+        purse_fee;
+        purse_account_limit;
+      }
+
+  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 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 sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Wire = struct
+  let verify (module Sm : Secmod.S)
+      WireSetupMessage.
+        {
+          payto_uri;
+          master_sig_wire;
+          master_sig_add;
+          validity_start;
+          bank_label= _;
+          priority= _;
+        } =
+    (* TODO wire *)
+    let conversion_url = "" in
+    let credit_restrictions = "" in
+    let debit_restrictions = "" in
+    let open Bin_type in
+    let* () =
+      let open Bin_sig.MasterWireDetails in
+      verify_f ~f:Sm.verify_with_master_key master_sig_wire
+        {
+          h_wire_details= FullPaytoHash.hash payto_uri;
+          h_conversion_url= Hash_64_cstr.hash conversion_url;
+          h_credit_restrictions= Hash_64_cstr.hash credit_restrictions;
+          h_debit_restrictions= Hash_64_cstr.hash debit_restrictions;
+        }
+    in
+    let* () =
+      let open Bin_sig.MasterAddWire in
+      verify_f ~f:Sm.verify_with_master_key master_sig_add
+        {
+          start_date= validity_start;
+          h_wire= FullPaytoHash.hash payto_uri;
+          h_conversion_url= Hash_64_cstr.hash conversion_url;
+          h_credit_restrictions= Hash_64_cstr.hash credit_restrictions;
+          h_debit_restrictions= Hash_64_cstr.hash debit_restrictions;
+        }
+    in
+    Ok ()
+
+  let do_ ~db_conn v =
+    let* last_change_opt =
+      let payto_uri = v.WireSetupMessage.payto_uri in
+      Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+    in
+    match last_change_opt with
+    | Some _ -> Error "wire already setup"
+    | None ->
+        (* TODO wire *)
+        let last_change = Ptime_clock.now () |> Option.some in
+        let v =
+          ExchangeWireAccount.
+            {
+              payto_uri= v.payto_uri;
+              conversion_url= None;
+              debit_restrictions= [];
+              credit_restrictions= [];
+              master_sig= v.master_sig_wire;
+              bank_label= v.bank_label;
+              priority= v.priority;
+            }
+        in
+        let+ () = Pg.insert_wire db_conn ~last_change v |> unwrap_err_caqti in
+        ()
+
+  let jsont = WireSetupMessage.jsont
+
+  let f req server _env =
+    Logs.info (fun m -> m "POST /management/wire/");
+    let sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Wire_disable = struct
+  let verify (module Sm : Secmod.S)
+      WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
+    let open Bin_sig.MasterDelWire in
+    verify_f ~f:Sm.verify_with_master_key master_sig_del
+      { end_date= validity_end; h_wire= Bin_type.FullPaytoHash.hash payto_uri }
+
+  let do_ ~db_conn
+      WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
+    let* last_change_opt =
+      Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+    in
+    match last_change_opt with
+    | None -> Error "wire not found"
+    | Some _ ->
+        let+ () =
+          Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
+        in
+        ()
+
+  let jsont = WireTeardownMessage.jsont
+
+  let f req server _env =
+    Logs.info (fun m -> m "POST /management/wire/disable/");
+    let sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Drain = struct
+  let verify (module Sm : Secmod.S)
+      DrainProfitsMessage.
+        {
+          debit_account_section;
+          credit_payto_uri;
+          wtid;
+          master_sig;
+          date;
+          amount;
+        } =
+    let open Bin_sig.MasterDrainProfit in
+    let open Bin_type in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      {
+        wtid;
+        date;
+        amount;
+        h_section= Hash_64_cstr.hash debit_account_section;
+        h_payto= FullPaytoHash.hash credit_payto_uri;
+      }
+
+  let do_ ~db_conn v =
+    let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
+    ()
+
+  let jsont = DrainProfitsMessage.jsont
+
+  let f req server _env =
+    Logs.info (fun m -> m "POST /management/drain/");
+    let sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module AmlOfficer = struct
+  let verify (module Sm : Secmod.S)
+      AmlOfficerSetup.
+        {
+          officer_pub;
+          officer_name;
+          is_active;
+          read_only= _;
+          master_sig;
+          change_date;
+        } =
+    let open Bin_sig.MasterAmlOfficerStatus in
+    let is_active = match is_active with true -> 1_l | false -> 0_l in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      {
+        change_date;
+        officer_pub;
+        h_officer_name= Bin_type.Hash_64_cstr.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 sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end
+
+module Partners = struct
+  let verify (module Sm : Secmod.S)
+      ExchangePartnerSetupRequest.
+        {
+          partner_base_url;
+          partner_pub;
+          wad_frequency;
+          master_sig;
+          start_date;
+          end_date;
+          wad_fee;
+        } =
+    let open Bin_sig.PartnerConfiguration in
+    verify_f ~f:Sm.verify_with_master_key master_sig
+      {
+        partner_pub;
+        start_date;
+        end_date;
+        wad_frequency;
+        wad_fee;
+        h_url= Bin_type.Hash_64_cstr.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 sm = Vif.Server.device Devices.secmod 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 sm v in
+      let* () = do_ ~db_conn v in
+      Ok ""
+    in
+    Respond_util.respond_with_res res req
+end