(* TODO transaction GNU Taler use of db-events? it seems caqti/pgx does not support it *) 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 req = Caqti_type.(eddsa_pub ->? signkey) "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 req exchange_pub let get_signkeys = let req = Caqti_type.(time ->* signkey) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig FROM exchange_sign_keys esk WHERE \ esk.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 req now let insert_signkey = let req = Caqti_type.(signkey ->. 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 req v let find_denom = let req = Caqti_type.(denom_hash ->? denom) "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 req h_denom_pub let get_denominations = let req = Caqti_type.(unit ->* denom) "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 FROM denominations AS dn WHERE NOT \ EXISTS (SELECT dn.denominations_serial FROM denomination_revocations AS \ dnr WHERE dn.denominations_serial = dnr.denominations_serial)" in fun (module Conn : CONN) () -> Conn.collect_list req () (* note: does not update revocation *) let insert_denom = let req = Caqti_type.(denom ->. 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 req v let insert_denomination_revocation = let req = let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in Caqti_type.(t2 denom_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 req (h_denom_pub, master_sig) let insert_signkey_revocation = let req = 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 req (exchange_pub, master_sig) let find_auditor = let req = Caqti_type.(eddsa_pub ->? auditor) "SELECT auditor_pub, auditor_name, auditor_url, last_change, is_active \ FROM auditors WHERE auditor_pub=$1" in fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub let update_auditor = let req = Caqti_type.(auditor ->. unit) "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \ last_change, is_active) VALUES ($1, $2, $3, $4, $5) ON CONFLICT \ (auditor_pub) DO UPDATE SET auditor_name=$2, auditor_url=$3, \ last_change=$4, is_active=$5" in fun (module Conn : CONN) auditor -> Conn.exec req auditor let insert_auditor_denom_sig = let req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in Caqti_type.(t3 eddsa_pub denom_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 req (auditor_pub, h_denom_pub, auditor_sig) (* todo auditors map to Auditor.t record 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 req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in Caqti_type.(unit ->* t5 eddsa_pub string string denom_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 req () |> unwrap_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 req = 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 req (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire) let get_wire_fees_by_time = let req = 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 req (wire_method, start_date, end_date) let get_wire_fees = let req = 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 req wire_method let get_global_fees = let req = 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 req start_date let get_global_fees_by_time = let req = 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 req (start_date, end_date) let insert_global_fees = let req = 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 req v let find_wire = let req = Caqti_type.(payto_uri ->? t3 exchange_wire_account bool time) "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ credit_restrictions::TEXT, master_sig, bank_label, priority, is_active, \ last_change FROM wire_accounts WHERE payto_uri=$1" in fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri let update_wire = let req = 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,$8,$9) ON CONFLICT \ (payto_uri) DO UPDATE SET conversion_url=$2, \ credit_restrictions=$3::TEXT::JSONB, \ debit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \ priority=$7, is_active=$8, last_change=$9" in fun (module Conn : CONN) ~is_active ~last_change v -> Conn.exec req (v, is_active, last_change) let get_wire_accounts = let req = 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 req () let find_drain_profit = let req = Caqti_type.(Bytes32.caqti ->? drain_profit_message) "SELECT wtid, account_section, payto_uri, trigger_date, (amount).*, \ master_sig FROM profit_drains WHERE wtid=$1" in fun (module Conn : CONN) wtid -> Conn.find_opt req wtid let insert_drain_profit = let req = Caqti_type.(drain_profit_message ->. unit) "INSERT INTO profit_drains (wtid, account_section, payto_uri, \ trigger_date, amount, master_sig) VALUES ($1::BYTEA, $2, $3, $4, \ ($5,$6), $7)" in fun (module Conn : CONN) v -> Conn.exec req v let insert_aml_officer = let req = 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 req v let insert_partner = let req = 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 req v