mte/src/pg.ml

(* TODO

   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 *)

module type CONN = Caqti_miou.CONNECTION

open Crypto
open Bin_type

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 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

  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

  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 lookup_signing_key =
  let lookup_signing_key =
    Caqti_type.(eddsa_pub ->? t3 time time time)
      "SELECT valid_from, expire_sign, expire_legal FROM exchange_sign_keys \
       WHERE exchange_pub=$1"
  in
  fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
    Conn.find_opt lookup_signing_key exchange_pub

let activate_signing_key =
  let insert_signkey =
    let master_sig = Bin_sig.ExchangeSigningKeyValidity.caqti in
    Caqti_type.(t5 eddsa_pub time time time master_sig ->. 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)
    ~master_sig
    Signkey.
      {
        pub;
        priv= _;
        stamp_start;
        stamp_expire;
        stamp_end;
        master_sig= master_sig_opt;
      }
  ->
    assert (master_sig_opt = Some master_sig);
    Conn.exec insert_signkey
      (pub, stamp_start, stamp_expire, stamp_end, master_sig)

let lookup_denomination_key =
  let lookup_denomination_key =
    Caqti_type.(
      denomination_hash
      ->? t10 time time time time amount amount amount amount amount age_mask)
      "SELECT valid_from, expire_withdraw, expire_deposit, expire_legal, \
       (coin).*, (fee_withdraw).*, (fee_deposit).*, (fee_refresh).*, \
       (fee_refund).*, age_mask FROM denominations WHERE denom_pub_hash=$1"
  in
  fun (module Conn : CONN) (h_denom_pub : DenominationHash.t) ->
    Conn.find_opt lookup_denomination_key h_denom_pub

let add_denomination_key =
  let denomination_insert =
    let master_sig = Bin_sig.DenominationKeyValidity.caqti in
    Caqti_type.(
      t12 denomination_hash rsa_pub master_sig time time time time amount amount
        amount amount (t2 amount age_mask)
      ->. unit)
      "INSERT INTO denominations (denom_pub_hash, denom_pub, master_sig, \
       valid_from, expire_withdraw, expire_deposit, expire_legal, coin, \
       fee_withdraw, fee_deposit, fee_refresh, fee_refund, age_mask) VALUES \
       ($1, $2, $3, $4, $5, $6, $7, ($8,$9), ($10,$11),($12,$13), ($14,$15), \
       ($16,$17), $18)"
  in
  fun (module Conn : CONN)
    ~master_sig
    Denomination.
      {
        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= master_sig_opt;
      }
  ->
    assert (master_sig_opt = Some master_sig);
    Conn.exec denomination_insert
      ( h_pub,
        pub,
        master_sig,
        stamp_start,
        stamp_expire_withdraw,
        stamp_expire_deposit,
        stamp_expire_legal,
        value,
        fee_withdraw,
        fee_deposit,
        fee_refresh,
        (fee_refund, age_mask) )

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)
    ~auditor_pub
    ~auditor_url
    ~auditor_name
    ~start_date
  ->
    Conn.exec insert_auditor (auditor_pub, auditor_name, auditor_url, start_date)

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)
    ~auditor_pub
    ~auditor_url
    ~auditor_name
    ~change_date
    ~enabled
  ->
    Conn.exec update_auditor
      (auditor_pub, auditor_url, auditor_name, enabled, change_date)

let lookup_wire_fee_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.find_opt lookup_wire_fee_by_time (wire_method, start_date, end_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)
    ~wire_method
    ~start_date
    ~end_date
    ~wire_fee
    ~closing_fee
    ~master_sig
  ->
    Conn.exec insert_wire_fee
      (wire_method, start_date, end_date, wire_fee, closing_fee, master_sig)

let lookup_global_fee_by_time =
  let lookup_global_fee_by_time =
    let global_fee = Caqti_type.(t6 amount amount amount time time int32) in
    Caqti_type.(t2 time time ->? global_fee)
      "SELECT (history_fee).*, (account_fee).*, (purse_fee).*, purse_timeout, \
       history_expiration, purse_account_limit FROM global_fee WHERE end_date \
       > $1 AND start_date < $2;"
  in
  fun (module Conn : CONN) ~start_date ~end_date ->
    Conn.find_opt lookup_global_fee_by_time (start_date, end_date)

let insert_global_fee =
  let insert_global_fee =
    let master_sig = Bin_sig.GlobalFees.caqti in
    Caqti_type.(
      t9 time time amount amount amount time time int32 master_sig ->. unit)
      "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
       purse_fee, purse_timeout, history_expiration, purse_account_limit, \
       master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
       $12)"
  in
  fun (module Conn : CONN)
    Api.GlobalFees.
      {
        start_date;
        end_date;
        history_fee;
        account_fee;
        purse_fee;
        history_expiration= _;
        purse_account_limit;
        purse_timeout= _;
        master_sig;
      }
  ->
    (* TODO time *)
    let purse_timeout = None in
    let history_expiration = None in
    Conn.exec insert_global_fee
      ( start_date,
        end_date,
        history_fee,
        account_fee,
        purse_fee,
        purse_timeout,
        history_expiration,
        purse_account_limit,
        master_sig )