mte/.jjconflict-side-0/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

   should check validity of signatures got from db, for /management at least

   clean up caqti error type *)
(* TODO time
   fix comparison with timestamp footgun *)

module type CONN = Caqti_miou.CONNECTION

module Caqti_type = struct
  include Caqti_type
  include Pg_type
  include Caqti_request.Infix
end

open Crypto
open Api

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 esk.exchange_pub, esk.valid_from, esk.expire_sign, \
       esk.expire_legal, esk.master_sig, skr.master_sig FROM \
       exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \
       esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
  in
  fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
    Conn.find_opt find_signkey exchange_pub

let get_active_signkeys =
  let get_active_signkeys =
    Caqti_type.(time ->* signkey_data)
      "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
       esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
       WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
       signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
  in
  fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now

(* note: does not update revocation *)
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 dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
       dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
       (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
       dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
       dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
       = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
  in
  fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub

let get_denominations =
  let get_denominations =
    Caqti_type.(unit ->* denom_data)
      "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
       dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
       (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
       dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
       dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
       = dnr.denominations_serial"
  in
  fun (module Conn : CONN) -> Conn.collect_list get_denominations ()

(* note: does not update revocation *)
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), $16, $17, $18)"
  in
  fun (module Conn : CONN) v -> Conn.exec insert_denom v

let insert_denomination_revocation =
  let denomination_revocation_insert =
    let master_sig = Signatures.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 = Signatures.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 get_auditor_timestamp =
  let get_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 get_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_auditor_denom_sig =
  let insert_auditor_denom_sig =
    let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
    Caqti_type.(t3 eddsa_pub denomination_hash auditor_sig ->. unit)
      "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
       INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \
       auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \
       denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \
       NOTHING"
  in
  fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
    Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)

(* todo auditors
   maybe check that url and name are unique/same for each auditor_pub
   and do the ht logic out of pg.ml? *)
(* this does not return auditors that are not auditing any denom *)
let get_auditor_keys =
  let get_auditor_keys =
    let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
    Caqti_type.(
      unit ->* t5 eddsa_pub string string denomination_hash auditor_sig)
      "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
       ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \
       (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \
       WHERE a.is_active"
  in
  fun (module Conn : CONN) ->
    let open Syntax in
    let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
    let ht = Hashtbl.create 0xff in
    List.iter
      (fun (pub, url, name, denom_pub_h, auditor_sig) ->
        let k = (pub, url, name) in
        match Hashtbl.find_opt ht k with
        | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ]
        | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l))
      l;
    let l = Hashtbl.to_seq ht |> List.of_seq in
    let l =
      List.map
        (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) ->
          let denomination_keys =
            List.map
              (fun (denom_pub_h, auditor_sig) ->
                AuditorDenominationKey.{ denom_pub_h; auditor_sig })
              auditor_denoms
          in
          AuditorKeys.
            { auditor_pub; auditor_url; auditor_name; denomination_keys })
        l
    in
    Ok l

let insert_wire_fee =
  let insert_wire_fee =
    let master_sig = Signatures.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)

let get_wire_fees_by_time =
  let get_wire_fee_by_time =
    Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
      "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
       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 get_wire_fee_by_time (wire_method, start_date, end_date)

let get_wire_fees =
  let get_wire_fees =
    Caqti_type.(string ->* aggregate_transfer_fee)
      "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 ->
    Conn.collect_list get_wire_fees wire_method

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 get_global_fees_by_time =
  let get_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 start_date >= $1 AND end_date <= $2"
  in
  fun (module Conn : CONN) ~start_date ~end_date ->
    Conn.collect_list get_global_fees_by_time (start_date, end_date)

let insert_global_fees =
  let insert_global_fees =
    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_fees v

let get_wire_timestamp =
  let get_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 get_wire_timestamp payto_uri

let insert_wire =
  let insert_wire =
    Caqti_type.(t3 exchange_wire_account bool time ->. unit)
      "INSERT INTO wire_accounts (payto_uri, conversion_url, \
       credit_restrictions, debit_restrictions, master_sig, bank_label, \
       priority, is_active, last_change) VALUES \
       ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
  in
  fun (module Conn : CONN) ~last_change v ->
    let is_active = true in
    Conn.exec insert_wire (v, is_active, last_change)

let update_wire =
  let update_wire =
    Caqti_type.(t3 exchange_wire_account bool time ->. unit)
      "UPDATE wire_accounts SET conversion_url=$2, \
       debit_restrictions=$3::TEXT::JSONB, \
       credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
       priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
  in
  fun (module Conn : CONN) ~is_active ~last_change v ->
    Conn.exec update_wire (v, is_active, last_change)

let disable_wire =
  let disable_wire =
    (* TODO check syntax on this *)
    Caqti_type.(t2 payto_uri time ->. unit)
      "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
       credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
       priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
  in
  fun (module Conn : CONN) ~payto_uri ~validity_end ->
    Conn.exec disable_wire (payto_uri, validity_end)

let get_wire_accounts =
  let get_wire_accounts =
    Caqti_type.(unit ->* exchange_wire_account)
      "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) -> Conn.collect_list get_wire_accounts ()

let insert_drain_profit =
  let insert_drain_profit =
    Caqti_type.(drain_profit_message ->. 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) v -> Conn.exec insert_drain_profit v

let insert_aml_officer =
  let exchange_do_insert_aml_officer =
    Caqti_type.(aml_officer_setup ->! time)
      "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
       $4, $5, $6)"
  in
  fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v

let insert_partner =
  let insert_partner =
    Caqti_type.(exchange_partner_setup ->. 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) v -> Conn.exec insert_partner v