(* 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 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 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_span time_span 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_span time_span 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; } -> Conn.exec insert_global_fee ( start_date, end_date, history_fee, account_fee, purse_fee, purse_timeout, history_expiration, purse_account_limit, master_sig )