mte/src/pg.ml

open Crypto

module Caqti_type = struct
  include Caqti_type

  (* TODO add a dune stanza like for prelude:
     "(flags (:standard -open Prelude))" *)
  (* 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 amount : Amount.t t =
    let open Amount in
    let intro value fraction =
      match make ~sign:None ~currency:Config.currency ~value ~fraction with
      | Error e -> raise (Caqti_type.Reject e)
      | Ok v -> v
    in
    let p1 t = t.value in
    let p2 t = t.fraction in
    product intro @@ proj int64 p1 @@ proj int32 p2 @@ proj_end

  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

  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

  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

  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

  include Caqti_request.Infix
end

module type CONN = Caqti_miou.CONNECTION

open Bin_type

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 : Caqti_miou.CONNECTION) ->
    Syntax.list_iter (fun p -> Conn.exec p ()) l

let lookup_signing_key =
  let lookup_signing_key =
    Caqti_type.(eddsa_public ->? 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 = Api_sig.ExchangeSigningKeyValidityPS.caqti in
    Caqti_type.(t5 eddsa_public 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)
    Signkey.{ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig }
  ->
    (* TODO master_sig *)
    let master_sig = master_sig |> Option.get in
    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 = Api_sig.DenominationKeyValidityPS.caqti in
    Caqti_type.(
      t12 denomination_hash rsa_public 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)"
  in
  fun (module Conn : CONN)
    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;
      }
  ->
    (* TODO master_sig *)
    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) )