mte/src/management.ml

open Api

let mk_future_denom ~sm_denom_priv
    ({
       pub;
       priv= _;
       section_name;
       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= _;
     } :
      Denomination.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 |> Timestamp.of_span_exn
    in
    sign ~key:sm_denom_priv
      { 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 ~sm_signkey_priv
    ({ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig= _ } :
      Signkey.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 |> Timestamp.of_span_exn
    in
    sign ~key:sm_signkey_priv { exchange_pub; anchor_time; duration }
  in
  FutureSignKey.
    { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }

let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t)
    ~(sm_denom : Secmod_denom.t) =
  let future_signkeys =
    Secmod_signkey.get_signkeys sm_signkey
    |> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
    |> List.map (fun signkey ->
        let sm_signkey_priv =
          (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv
        in
        mk_future_signkey ~sm_signkey_priv signkey)
  in
  let future_denoms =
    Secmod_denom.get_denoms sm_denom
    |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
    |> List.map (fun denom ->
        let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in
        mk_future_denom ~sm_denom_priv denom)
  in
  let master_pub = Config.Exchange.master_public_key in
  let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in
  let signkey_secmod_public_key = (Secmod_signkey.get_sm_key sm_signkey).pub in
  FutureKeysResponse.
    {
      future_denoms;
      future_signkeys;
      master_pub;
      denom_secmod_public_key;
      signkey_secmod_public_key;
    }

(* - ** - *)
open Syntax

let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig }
    =
  let denom_hash = HashCode.to_denomination_hash h_denom_pub in
  let* denom =
    Secmod_denom.get_denoms sm_denom
    |> List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash)
    |> function
    | 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;
    }
  in
  verify ~key:Config.master_public_key master_sig r

let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig } =
  let* signkey =
    Secmod_signkey.get_signkeys sm_signkey
    |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key)
    |> function
    | 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 ~key:Config.master_public_key master_sig r

let verify_master_signatures ~sm_signkey ~sm_denom
    MasterSignatures.{ denom_sigs; signkey_sigs } =
  let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in
  let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in
  Ok ()

(* --- *)

(* TODO move to test *)
let check_master_signatures_update ~db_conn ~sm_denom =
  Secmod_denom.get_denoms sm_denom
  |> list_iter (fun denom ->
      let error = Error "update_master_signatures sanity check failure" in
      let* opt =
        Pg.lookup_denomination_key db_conn denom.Denomination.h_pub
        |> unwrap_err_caqti
      in
      let* ( valid_from,
             _expire_withdraw,
             _expire_deposit,
             _expire_legal,
             coin,
             _fee_withdraw,
             _fee_deposit,
             _fee_refresh,
             fee_refund,
             age_mask ) =
        match opt with None -> error | Some v -> Ok v
      in
      let check = function false -> error | true -> Ok () in
      let* () =
        check (Timestamp.compare valid_from denom.stamp_start = Some 0)
      in
      let* () = check (coin = denom.value) in
      let* () = check (fee_refund = denom.fee_refund) in
      let* () = check (age_mask = denom.age_mask) in
      Ok ())

let update_master_signatures ~db_conn ~sm_signkey ~sm_denom
    MasterSignatures.{ denom_sigs; signkey_sigs } =
  let* () =
    signkey_sigs
    |> List.map (fun SignKeySignature.{ key; master_sig } -> (key, master_sig))
    |> Secmod_signkey.add_master_signatures db_conn sm_signkey
  in
  let* () =
    denom_sigs
    |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
        let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
        (h_denom_pub, master_sig))
    |> Secmod_denom.add_master_signatures db_conn sm_denom
  in
  let* () = check_master_signatures_update ~db_conn ~sm_denom in
  Ok ()

let verify_denom_revocation_sig h_denom_pub
    DenomRevocationSignature.{ master_sig } =
  let open Bin_sig.MasterDenominationKeyRevocation in
  verify ~key:Config.Exchange.master_public_key master_sig { h_denom_pub }

let update_denom_revocation ~db_conn ~sm_denom h_denom_pub
    DenomRevocationSignature.{ master_sig } =
  let* () = Secmod_denom.revoke_denomination sm_denom h_denom_pub master_sig in
  let* () =
    Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
    |> unwrap_err_caqti
  in
  Ok ()

let verify_signkey_revocation_sig exchange_pub
    SignkeyRevocationSignature.{ master_sig } =
  let open Bin_sig.MasterSigningKeyRevocation in
  verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub }

let update_signkey_revocation ~db_conn ~sm_signkey exchange_pub
    SignkeyRevocationSignature.{ master_sig } =
  let* () = Secmod_signkey.revoke_signkey sm_signkey exchange_pub master_sig in
  let* () =
    Pg.insert_signkey_revocation db_conn exchange_pub master_sig
    |> unwrap_err_caqti
  in
  Ok ()

let verify_auditor_add_sig
    AuditorSetupMessage.
      { auditor_url; auditor_name= _; auditor_pub; master_sig; validity_start }
    =
  let open Bin_sig.MasterAddAuditor in
  verify ~key:Config.Exchange.master_public_key master_sig
    {
      start_date= validity_start;
      auditor_pub;
      h_auditor_url= Bin_type.Hash_64_cstr.hash auditor_url;
    }

(* todo: there is something about use of monotonic time + protection against replay attack that I don't understand *)
let update_auditor ~db_conn
    AuditorSetupMessage.
      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
    =
  let* last_date_opt =
    Pg.lookup_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
  in
  match last_date_opt with
  | None ->
      let+ () =
        Pg.insert_auditor db_conn ~auditor_pub ~auditor_url ~auditor_name
          ~start_date:validity_start
        |> unwrap_err_caqti
      in
      ()
  | Some last_date ->
      let cmp = Timestamp.compare last_date validity_start |> Option.get in
      if cmp > 0 then Error "more recent management auditor already present"
      else
        let enabled = true in
        let+ () =
          Pg.update_auditor db_conn ~auditor_pub ~auditor_url ~auditor_name
            ~enabled ~change_date:validity_start
          |> unwrap_err_caqti
        in
        ()

let verify_auditor_disable_sig auditor_pub
    AuditorTeardownMessage.{ master_sig; validity_end } =
  let open Bin_sig.MasterDelAuditor in
  verify ~key:Config.Exchange.master_public_key master_sig
    { end_date= validity_end; auditor_pub }

let auditor_disable ~db_conn auditor_pub
    AuditorTeardownMessage.{ master_sig= _; validity_end } =
  let* last_date_opt =
    Pg.lookup_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 "more recent management auditor already present"
      else
        let enabled = false in
        let+ () =
          Pg.update_auditor db_conn ~auditor_pub ~auditor_url:""
            ~auditor_name:"" ~enabled ~change_date:validity_end
          |> unwrap_err_caqti
        in
        ()

let verify_wire_fee_setup_sig
    WireFeeSetupMessage.
      {
        wire_method;
        master_sig_wire;
        fee_start;
        fee_end;
        closing_fee;
        wire_fee;
      } =
  let open Bin_sig.MasterWireFee in
  verify ~key:Config.Exchange.master_public_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 update_wire_fee_setup ~db_conn
    WireFeeSetupMessage.
      {
        wire_method;
        master_sig_wire;
        fee_start;
        fee_end;
        closing_fee;
        wire_fee;
      } =
  let* wire_fee_opt =
    Pg.lookup_wire_fee_by_time db_conn ~wire_method ~start_date:fee_start
      ~end_date:fee_end
    |> unwrap_err_caqti
  in
  match wire_fee_opt with
  | Some (_wire_fee, _closing_fee) -> Error "wire-fee already setup"
  | None ->
      let+ () =
        Pg.insert_wire_fee db_conn ~wire_method ~start_date:fee_start
          ~end_date:fee_end ~wire_fee ~closing_fee ~master_sig:master_sig_wire
        |> unwrap_err_caqti
      in
      ()

let verify_global_fees
    GlobalFees.
      {
        start_date;
        end_date;
        history_fee;
        account_fee;
        purse_fee;
        history_expiration= _;
        purse_account_limit;
        purse_timeout= _;
        master_sig;
      } =
  (* TODO time..... *)
  let dummy_relative_time = None in
  let dummy_amount =
    Amount.make ~sign:None ~currency:"EUR" ~value:0_L ~fraction:0_l
    |> Result.get_ok
  in
  (* TODO what is kyc_timeout, kyc_fee ? *)
  let kyc_timeout = dummy_relative_time in
  let kyc_fee = dummy_amount in
  (* * *)
  let open Bin_sig.GlobalFees in
  verify ~key:Config.Exchange.master_public_key master_sig
    {
      start_date;
      end_date;
      purse_timeout= dummy_relative_time;
      kyc_timeout;
      history_expiration= dummy_relative_time;
      history_fee;
      kyc_fee;
      account_fee;
      purse_fee;
      purse_account_limit;
    }

let update_global_fees ~db_conn v =
  let* global_fees_opt =
    let start_date = v.GlobalFees.start_date in
    let end_date = v.GlobalFees.end_date in
    Pg.lookup_global_fee_by_time db_conn ~start_date ~end_date
    |> unwrap_err_caqti
  in
  match global_fees_opt with
  | Some _ -> Error "global-fees already setup"
  | None ->
      let+ () = Pg.insert_global_fee db_conn v |> unwrap_err_caqti in
      ()