2025-11-22 21:40:24 +01:00
|
|
|
open Crypto
|
|
|
|
|
|
2025-11-16 05:33:06 +01:00
|
|
|
module Caqti_type = struct
|
|
|
|
|
include Caqti_type
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
(* TODO add a dune stanza like for prelude:
|
|
|
|
|
"(flags (:standard -open Prelude))" *)
|
2025-11-16 05:33:06 +01:00
|
|
|
(* we want to use int64 timestamps,
|
|
|
|
|
not postgresql built-in timestamp type *)
|
2025-11-22 21:40:24 +01:00
|
|
|
let ptime : Ptime.t t =
|
2025-11-16 05:33:06 +01:00
|
|
|
let encode i = Ok (Util.ptime_to_int64 i) in
|
|
|
|
|
let decode = Util.ptime_of_int64 in
|
2025-11-22 21:40:24 +01:00
|
|
|
custom ~encode ~decode int64
|
2025-11-16 05:33:06 +01:00
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
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)
|
2025-11-21 19:29:04 +01:00
|
|
|
|
2025-11-23 15:37:05 +01:00
|
|
|
let age_mask : int t = Caqti_type.int
|
|
|
|
|
|
|
|
|
|
let rsa_public : RsaPublicKey.t t =
|
|
|
|
|
let open RsaPublicKey in
|
|
|
|
|
custom
|
|
|
|
|
~encode:(fun v -> Ok (to_octets v))
|
|
|
|
|
~decode:(fun v -> Ok (of_octets v))
|
|
|
|
|
octets
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
let eddsa_public : EddsaPublicKey.t t =
|
|
|
|
|
let open EddsaPublicKey in
|
|
|
|
|
custom
|
|
|
|
|
~encode:(fun v -> Ok (to_octets v))
|
|
|
|
|
~decode:(fun v -> Ok (of_octets v))
|
|
|
|
|
octets
|
2025-11-16 05:33:06 +01:00
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
let eddsa_signature : EddsaSignature.t t =
|
|
|
|
|
let open EddsaSignature in
|
|
|
|
|
custom
|
|
|
|
|
~encode:(fun v -> Ok (to_octets v))
|
|
|
|
|
~decode:(fun s -> Ok (of_octets s))
|
|
|
|
|
octets
|
2025-11-21 19:29:04 +01:00
|
|
|
|
2025-11-23 15:37:05 +01:00
|
|
|
include struct
|
|
|
|
|
(* alias for hash *)
|
|
|
|
|
open Bin_type
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
include Caqti_request.Infix
|
|
|
|
|
end
|
2025-11-21 19:29:04 +01:00
|
|
|
|
2025-11-23 15:37:05 +01:00
|
|
|
module type CONN = Caqti_miou.CONNECTION
|
|
|
|
|
|
|
|
|
|
open Bin_type
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
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;";
|
|
|
|
|
]
|
2025-11-21 19:29:04 +01:00
|
|
|
in
|
2025-11-22 21:40:24 +01:00
|
|
|
fun (module Conn : Caqti_miou.CONNECTION) ->
|
|
|
|
|
Syntax.list_iter (fun p -> Conn.exec p ()) l
|
|
|
|
|
|
2025-11-23 15:37:05 +01:00
|
|
|
let _lookup_signing_key =
|
|
|
|
|
let lookup_signing_key =
|
|
|
|
|
Caqti_type.(eddsa_public ->? t3 ptime ptime ptime)
|
|
|
|
|
"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 _lookup_denomination_key =
|
|
|
|
|
let lookup_denomination_key =
|
|
|
|
|
Caqti_type.(
|
|
|
|
|
denomination_hash
|
|
|
|
|
->? t10 ptime ptime ptime ptime 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 =
|
|
|
|
|
Caqti_type.(
|
|
|
|
|
t12 denomination_hash rsa_public eddsa_signature ptime ptime ptime ptime
|
|
|
|
|
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)"
|
|
|
|
|
in
|
|
|
|
|
fun (module Conn : CONN) denom ->
|
|
|
|
|
let Denomination.
|
|
|
|
|
{
|
|
|
|
|
pub;
|
|
|
|
|
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;
|
|
|
|
|
sign= _;
|
|
|
|
|
master_sig;
|
|
|
|
|
} =
|
|
|
|
|
denom
|
|
|
|
|
in
|
|
|
|
|
let master_sig = master_sig |> Option.get in
|
|
|
|
|
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) )
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
let activate_signing_key =
|
|
|
|
|
let insert_signkey =
|
|
|
|
|
Caqti_type.(t5 eddsa_public ptime ptime ptime eddsa_signature ->. unit)
|
2025-11-21 19:29:04 +01:00
|
|
|
"INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
|
2025-11-23 15:37:05 +01:00
|
|
|
expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
|
2025-11-21 19:29:04 +01:00
|
|
|
in
|
2025-11-23 15:37:05 +01:00
|
|
|
fun (module Conn : CONN) exchange_signkey ->
|
2025-11-22 21:40:24 +01:00
|
|
|
let Signkey.
|
|
|
|
|
{ pub; stamp_start; stamp_expire; stamp_end; master_sig= _; sign= _ }
|
|
|
|
|
=
|
|
|
|
|
exchange_signkey
|
|
|
|
|
in
|
|
|
|
|
(*let master_sig = master_sig |> Option.get in*)
|
|
|
|
|
let master_sig = EddsaSignature.of_octets (String.make 64 'x') in
|
|
|
|
|
Conn.exec insert_signkey
|
|
|
|
|
(pub, stamp_start, stamp_expire, stamp_end, master_sig)
|
2025-11-16 15:55:32 +01:00
|
|
|
|
|
|
|
|
(* ----- *)
|
|
|
|
|
|
2025-11-22 21:40:24 +01:00
|
|
|
let pg_todo () = assert false
|
2025-11-16 05:33:06 +01:00
|
|
|
let lookup_signing_key = pg_todo
|
|
|
|
|
let iterate_active_signkeys = pg_todo
|
|
|
|
|
let insert_signkey_revocation = pg_todo
|
|
|
|
|
let lookup_signkey_revocation = pg_todo
|
|
|
|
|
|
|
|
|
|
(* denominations *)
|
|
|
|
|
let insert_denomination_info = pg_todo
|
|
|
|
|
let get_denomination_info = pg_todo
|
|
|
|
|
let get_denomination_by_serial = pg_todo
|
|
|
|
|
let iterate_denomination_info = pg_todo
|
|
|
|
|
let iterate_denominations = pg_todo
|
|
|
|
|
let get_coin_denomination = pg_todo
|
|
|
|
|
let insert_denomination_revocation = pg_todo
|
|
|
|
|
let get_denomination_revocation = pg_todo
|
|
|
|
|
let lookup_denomination_key = pg_todo
|
|
|
|
|
let add_denomination_key = pg_todo
|