mte/src/pg.ml

(* TODO

   check there is no issues with signed/unsigned integers

   how to fix postgres/caqti tuple type?
   try something with OID?
   need to add boilerplate in each query for amounts

   GNU Taler db-events?
   it seems caqti/pgx does not support it

   transaction *)

module type CONN = Caqti_miou.CONNECTION

open Crypto
open Bin_type
open Api

module Caqti_type = struct
  include Caqti_type

  let amount : Amount.t t =
    let open Amount in
    custom
      ~encode:(fun amount -> Ok (amount.value, amount.fraction))
      ~decode:(fun (value, fraction) ->
        Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
      (t2 int64 int32)

  (* we want to use int64 timestamps,
     not postgresql built-in timestamp type *)
  let ptime : Ptime.t option t = Timestamp.caqti
  let time = Timestamp.caqti
  let time_span = Timestamp.Span.caqti
  let age_mask : int t = Caqti_type.int
  let rsa_pub = RsaPublicKey.caqti
  let eddsa_pub = EddsaPublicKey.caqti
  let eddsa_sig = EddsaSignature.caqti

  (* todo: enum type for wire_method? *)
  let wire_method = Caqti_type.string
  let payto_uri = Caqti_type.string

  include struct
    (* alias for hash *)

    let fullpayto_hash = FullPaytoHash.caqti
    let nomalizaedpayto_hash = NormalizedPaytoHash.caqti
    let denomination_hash = DenominationHash.caqti
    let privatecontract_hash = PrivateContractHash.caqti
    let extensionspolicy_hash = ExtensionsPolicyHash.caqti
    let merchantwire_hash = MerchantWireHash.caqti
    let agecommitment_hash = AgeCommitmentHash.caqti
    let blindedcoin_hash = BlindedCoinHash.caqti
    let coinpub_hash = CoinPubHash.caqti
    let outputcommitment_hash = OutputCommitmentHash.caqti
    let planchets_hash = HashPlanchetsP.caqti
  end

  let signkey_data =
    let master_sig = Bin_sig.ExchangeSigningKeyValidity.caqti in
    custom
      ~encode:(fun
          Signkey_data.{ pub; stamp_start; stamp_expire; stamp_end; master_sig }
        ->
        match master_sig with
        | None -> Error "signkey_data master_sig is none"
        | Some master_sig ->
            Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig))
      ~decode:(fun (pub, stamp_start, stamp_expire, stamp_end, master_sig) ->
        Ok
          {
            pub;
            stamp_start;
            stamp_expire;
            stamp_end;
            master_sig= Some master_sig;
          })
      (t5 eddsa_pub time time time master_sig)

  let denom_data =
    let master_sig = Bin_sig.DenominationKeyValidity.caqti in
    custom
      ~encode:(fun
          Denom_data.
            {
              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;
            }
        ->
        match master_sig with
        | None -> Error "denom_data master_sig is none"
        | Some master_sig ->
            Ok
              ( 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) ))
      ~decode:(fun
          ( 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) )
        ->
        Ok
          {
            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= Some master_sig;
          })
      (t12 rsa_pub amount time time time time amount amount amount amount int
         (t2 denomination_hash master_sig))

  let account_restrictions =
    custom
      ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l)
      ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s)
      string

  let global_fee =
    let master_sig = Bin_sig.GlobalFees.caqti in
    custom
      ~encode:(fun
          GlobalFees.
            {
              start_date;
              end_date;
              history_fee;
              account_fee;
              purse_fee;
              history_expiration;
              purse_account_limit;
              purse_timeout;
              master_sig;
            }
        ->
        Ok
          ( start_date,
            end_date,
            history_fee,
            account_fee,
            purse_fee,
            history_expiration,
            purse_account_limit,
            purse_timeout,
            master_sig ))
      ~decode:(fun
          ( start_date,
            end_date,
            history_fee,
            account_fee,
            purse_fee,
            history_expiration,
            purse_account_limit,
            purse_timeout,
            master_sig )
        ->
        Ok
          {
            start_date;
            end_date;
            history_fee;
            account_fee;
            purse_fee;
            history_expiration;
            purse_account_limit;
            purse_timeout;
            master_sig;
          })
      Caqti_type.(
        t9 time time amount amount amount time_span int32 time_span master_sig)

  include Caqti_request.Infix
end

let preflight =
  let l =
    List.map
      Caqti_type.(unit ->. unit)
      [
        "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
         SERIALIZABLE;";
        "SET enable_sort=OFF;";
        "SET enable_seqscan=OFF;";
        "SET enable_mergejoin=OFF;";
        "SET search_path TO exchange;";
      ]
  in
  fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l

let find_signkey =
  let find_signkey =
    Caqti_type.(eddsa_pub ->? signkey_data)
      "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \
       FROM exchange_sign_keys WHERE exchange_pub=$1"
  in
  fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
    Conn.find_opt find_signkey exchange_pub

let insert_signkey =
  let insert_signkey =
    Caqti_type.(signkey_data ->. unit)
      "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
       expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
  in
  fun (module Conn : CONN) v -> Conn.exec insert_signkey v

let find_denom =
  let find_denom =
    Caqti_type.(denomination_hash ->? denom_data)
      "SELECT denom_pub, (coin).*, valid_from, expire_withdraw, \
       expire_deposit, expire_legal, (fee_withdraw).*, (fee_deposit).*, \
       (fee_refresh).*, (fee_refund).*, age_mask, denom_pub_hash, master_sig \
       FROM denominations WHERE denom_pub_hash=$1"
  in
  fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub

let insert_denom =
  let insert_denom =
    Caqti_type.(denom_data ->. unit)
      "INSERT INTO denominations (denom_pub, (coin).*, valid_from, \
       expire_withdraw, expire_deposit, expire_legal, (fee_withdraw).*, \
       (fee_deposit).*, (fee_refresh).*, (fee_refund).*, age_mask, \
       denom_pub_hash, master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, \
       ($8,$9), ($10,$11), ($12,$13), ($14,$15), $18, $19, $18)"
  in
  fun (module Conn : CONN) v -> Conn.exec insert_denom v

let insert_denomination_revocation =
  let denomination_revocation_insert =
    let master_sig = Bin_sig.MasterDenominationKeyRevocation.caqti in
    Caqti_type.(t2 denomination_hash master_sig ->. unit)
      "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
       SELECT denominations_serial, $2 FROM denominations WHERE \
       denom_pub_hash=$1"
  in
  fun (module Conn : CONN) h_denom_pub master_sig ->
    Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)

let insert_signkey_revocation =
  let signkey_revocation_insert =
    let master_sig = Bin_sig.MasterSigningKeyRevocation.caqti in
    Caqti_type.(t2 eddsa_pub master_sig ->. unit)
      "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
       esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
  in
  fun (module Conn : CONN) exchange_pub master_sig ->
    Conn.exec signkey_revocation_insert (exchange_pub, master_sig)

let lookup_auditor_timestamp =
  let lookup_auditor_timestamp =
    Caqti_type.(eddsa_pub ->? time)
      "SELECT last_change FROM auditors WHERE auditor_pub=$1"
  in
  fun (module Conn : CONN) auditor_pub ->
    Conn.find_opt lookup_auditor_timestamp auditor_pub

let insert_auditor =
  let insert_auditor =
    Caqti_type.(t4 eddsa_pub string string time ->. unit)
      "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
       is_active, last_change) VALUES ($1, $2, $3, true, $4)"
  in
  fun (module Conn : CONN)
    AuditorSetupMessage.
      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
  ->
    Conn.exec insert_auditor
      (auditor_pub, auditor_name, auditor_url, validity_start)

let update_auditor =
  let update_auditor =
    Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
      "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
       last_change=$5 WHERE auditor_pub=$1"
  in
  fun (module Conn : CONN)
    AuditorSetupMessage.
      { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
  ->
    Conn.exec update_auditor
      (auditor_pub, auditor_url, auditor_name, true, validity_start)

let disable_auditor =
  let update_auditor =
    Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
      "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
       last_change=$5 WHERE auditor_pub=$1"
  in
  fun (module Conn : CONN) ~auditor_pub ~change_date ->
    Conn.exec update_auditor (auditor_pub, "", "", false, change_date)

let insert_wire_fee =
  let insert_wire_fee =
    let master_sig = Bin_sig.MasterWireFee.caqti in
    Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
      "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
       closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)"
  in
  fun (module Conn : CONN)
    WireFeeSetupMessage.
      {
        wire_method;
        master_sig_wire;
        fee_start;
        fee_end;
        closing_fee;
        wire_fee;
      }
  ->
    Conn.exec insert_wire_fee
      (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)

(* TODO return type, use AggregateTransferFee.t *)
let get_wire_fees_by_time =
  let lookup_wire_fee_by_time =
    Caqti_type.(t3 wire_method time time ->* t2 amount amount)
      "SELECT (wire_fee).*, (closing_fee).* FROM wire_fee WHERE wire_method=$1 \
       AND end_date > $2 AND start_date < $3"
  in
  fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
    Conn.collect_list lookup_wire_fee_by_time (wire_method, start_date, end_date)

let get_wire_fees =
  let get_wire_fees =
    let master_sig = Bin_sig.MasterWireFee.caqti in
    Caqti_type.(string ->* t5 amount amount time time master_sig)
      "SELECT wire_fee, closing_fee, start_date, end_date, master_sig FROM \
       wire_fee WHERE wire_method=$1"
  in
  fun (module Conn : CONN) ~wire_method ->
    let open Syntax in
    let+ l = Conn.collect_list get_wire_fees wire_method in
    List.map
      (fun (wire_fee, closing_fee, start_date, end_date, sig_) ->
        AggregateTransferFee.
          { wire_fee; closing_fee; start_date; end_date; sig_ })
      l

let get_global_fees =
  let get_global_fees =
    Caqti_type.(time ->* global_fee)
      "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
       (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
       master_sig FROM global_fee WHERE start_date >= $1"
  in
  fun (module Conn : CONN) ~start_date ->
    Conn.collect_list get_global_fees start_date

let lookup_global_fees_by_time =
  let lookup_global_fees_by_time =
    Caqti_type.(t2 time time ->* global_fee)
      "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
       (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
       master_sig FROM global_fee WHERE end_date > $1 AND start_date < $2"
  in
  fun (module Conn : CONN) ~start_date ~end_date ->
    Conn.collect_list lookup_global_fees_by_time (start_date, end_date)

let insert_global_fee =
  let insert_global_fee =
    Caqti_type.(global_fee ->. unit)
      "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
       purse_fee, history_expiration, purse_account_limit, purse_timeout, \
       master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
       $12)"
  in
  fun (module Conn : CONN) v -> Conn.exec insert_global_fee v

let lookup_wire_timestamp =
  let lookup_wire_timestamp =
    Caqti_type.(payto_uri ->? time)
      "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
  in
  fun (module Conn : CONN) ~payto_uri ->
    Conn.find_opt lookup_wire_timestamp payto_uri

let insert_wire =
  let insert_wire =
    let master_sig = Bin_sig.MasterWireDetails.caqti in
    Caqti_type.(
      t8 payto_uri (option string) account_restrictions account_restrictions
        master_sig time (option string) (option int)
      ->. unit)
      "INSERT INTO wire_accounts (payto_uri, conversion_url, \
       debit_restrictions, credit_restrictions, master_sig, is_active, \
       last_change, bank_label, priority) VALUES \
       ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,true,$6,$7,$8)"
  in
  fun (module Conn : CONN)
    ~last_change
    ExchangeWireAccount.
      {
        payto_uri;
        conversion_url;
        debit_restrictions;
        credit_restrictions;
        master_sig;
        bank_label;
        priority;
      }
  ->
    Conn.exec insert_wire
      ( payto_uri,
        conversion_url,
        debit_restrictions,
        credit_restrictions,
        master_sig,
        last_change,
        bank_label,
        priority )

let update_wire =
  let update_wire =
    let master_sig = Bin_sig.MasterWireDetails.caqti in
    Caqti_type.(
      t9 payto_uri bool (option string) account_restrictions
        account_restrictions time master_sig (option string) (option int)
      ->. unit)
      "UPDATE wire_accounts SET is_active=$2, conversion_url=$3, \
       debit_restrictions=$4::TEXT::JSONB, \
       credit_restrictions=$5::TEXT::JSONB, last_change=$6, master_sig=$7, \
       bank_label=$8, priority=$9 WHERE payto_uri=$1"
  in
  fun (module Conn : CONN)
    ~last_change
    ExchangeWireAccount.
      {
        payto_uri;
        conversion_url;
        debit_restrictions;
        credit_restrictions;
        master_sig;
        bank_label;
        priority;
      }
  ->
    let enabled = true in
    Conn.exec update_wire
      ( payto_uri,
        enabled,
        conversion_url,
        debit_restrictions,
        credit_restrictions,
        last_change,
        master_sig,
        bank_label,
        priority )

let disable_wire =
  let disable_wire =
    (* TODO
       check syntax on this
       don't erase old values with null and just change `is_active` and `last_change`?
       or re-use the update query *)
    Caqti_type.(t2 payto_uri time ->. unit)
      "UPDATE wire_accounts SET is_active=false, conversion_url=NULL, \
       debit_restrictions=NULL::TEXT::JSONB, \
       credit_restrictions=NULL::TEXT::JSONB, last_change=$2, master_sig=NULL, \
       bank_label=NULL, priority=NULL WHERE payto_uri=$1"
  in
  fun (module Conn : CONN) ~payto_uri ~validity_end ->
    Conn.exec disable_wire (payto_uri, validity_end)

let insert_drain_profit =
  let insert_drain_profit =
    let master_sig = Bin_sig.MasterDrainProfit.caqti in
    Caqti_type.(t6 string string payto_uri time amount master_sig ->. unit)
      "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
       trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
  in
  fun (module Conn : CONN)
    DrainProfitsMessage.
      {
        debit_account_section;
        credit_payto_uri;
        wtid;
        master_sig;
        date;
        amount;
      }
  ->
    Conn.exec insert_drain_profit
      (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)

let insert_aml_officer =
  let exchange_do_insert_aml_officer =
    let master_sig = Bin_sig.MasterAmlOfficerStatus.caqti in
    Caqti_type.(t6 eddsa_pub master_sig string bool bool time ->! time)
      "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
       $4, $5, $6)"
  in
  fun (module Conn : CONN)
    AmlOfficerSetup.
      {
        officer_pub;
        officer_name;
        is_active;
        read_only;
        master_sig;
        change_date;
      }
  ->
    Conn.find exchange_do_insert_aml_officer
      (officer_pub, master_sig, officer_name, is_active, read_only, change_date)

let insert_partner =
  let insert_partner =
    let master_sig = Bin_sig.PartnerConfiguration.caqti in
    Caqti_type.(
      t7 eddsa_pub time time time_span amount master_sig string ->. unit)
      "INSERT INTO partners (partner_master_pub, start_date, end_date, \
       wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
       $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
  in
  fun (module Conn : CONN)
    ExchangePartnerSetupRequest.
      {
        partner_base_url;
        partner_pub;
        wad_frequency;
        master_sig;
        start_date;
        end_date;
        wad_fee;
      }
  ->
    Conn.exec insert_partner
      ( partner_pub,
        start_date,
        end_date,
        wad_frequency,
        wad_fee,
        master_sig,
        partner_base_url )

let get_wire_accouts =
  let get_wire_accounts =
    let master_sig = Bin_sig.MasterWireDetails.caqti in
    Caqti_type.(
      unit
      ->* t7 string (option string) account_restrictions account_restrictions
            master_sig (option string) (option int))
      "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
       credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
       wire_accounts WHERE is_active"
  in
  fun (module Conn : CONN) ->
    let open Syntax in
    let+ l = Conn.collect_list get_wire_accounts () in
    List.map
      (fun ( payto_uri,
             conversion_url,
             debit_restrictions,
             credit_restrictions,
             master_sig,
             bank_label,
             priority ) ->
        ExchangeWireAccount.
          {
            payto_uri;
            conversion_url;
            debit_restrictions;
            credit_restrictions;
            master_sig;
            bank_label;
            priority;
          })
      l

(* TODO
iterate_denominations
iterate_active_signkeys
iterate_auditor_denominations
iterate_active_auditors
*)