(* 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) let aggregate_transfer_fee = let master_sig = Bin_sig.MasterWireFee.caqti in Caqti_type.custom ~encode:(fun AggregateTransferFee. { wire_fee; closing_fee; start_date; end_date; sig_ } -> Ok (wire_fee, closing_fee, start_date, end_date, sig_)) ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) -> Ok AggregateTransferFee. { wire_fee; closing_fee; start_date; end_date; sig_ }) Caqti_type.(t5 amount amount time time 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) let get_wire_fees_by_time = let lookup_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 lookup_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 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 *)