mte/src/binary_formats.ml

(* https://docs.taler.net/core/api-common.html#binary-formats

   - numeric values are in network byte order (big endian) *)

(* TODO
   less boilerplate?
     - type t abstract
     - type t = { v = string }
   padding issues?
   how to encode union? not really needed?
   test *)

(* -- Time -- *)

module Time = struct
  module Absolute = struct
    type t = { timestamp_us: int64 }
    type t_nbo = { abs_value_us__: int64 }

    (* not BE here? never used? *)
    let bin =
      let open Bin in
      record (fun timestamp_us -> { timestamp_us })
      |+ field neint64 (fun t -> t.timestamp_us)
      |> sealr

    let nbo_bin =
      let open Bin in
      record (fun abs_value_us__ -> { abs_value_us__ })
      |+ field beint64 (fun t -> t.abs_value_us__)
      |> sealr
  end

  module Relative = struct
    type t = { timestamp_us: int64 }
    type t_nbo = { rel_value_us__: int64 }

    let bin =
      let open Bin in
      record (fun timestamp_us -> { timestamp_us })
      |+ field neint64 (fun t -> t.timestamp_us)
      |> sealr

    let nbo_bin =
      let open Bin in
      record (fun rel_value_us__ -> { rel_value_us__ })
      |+ field beint64 (fun t -> t.rel_value_us__)
      |> sealr
  end
end

(* -- Cryptographic primitives -- *)

module Hash_code = struct
  (* usually SHA-512 *)
  type t = { hash: string (* = uint8_t hash[64] *) }

  let bin =
    let open Bin in
    record (fun hash -> { hash }) |+ field (bytes 64) (fun t -> t.hash) |> sealr
end

module Short_hash_code = struct
  type t = { hash: string }

  let bin =
    let open Bin in
    record (fun hash -> { hash }) |+ field (bytes 32) (fun t -> t.hash) |> sealr
end

module MAKE_H (H : sig
  type t

  val bin : t Bin.t
end) =
struct
  type t = { hash: H.t }

  let bin =
    let open Bin in
    record (fun hash -> { hash }) |+ field H.bin (fun t -> t.hash) |> sealr
end

module Denomination_hash = MAKE_H (Hash_code)
module Private_contract_hash = MAKE_H (Hash_code)
module Extensions_policy_hash = MAKE_H (Hash_code)
module Merchant_wire_hash = MAKE_H (Hash_code)

(* Hash over a full payto://-URI, including receiver-name
   (and possibly BIC and other optional fields). *)
module Full_payto_hash = MAKE_H (Short_hash_code)

(* Hash over a normalized payto://-URI, including all optional
   fields and also with account-part canonicalized (so no BIC). *)
module Normalized_payto_hash = MAKE_H (Short_hash_code)

(* Hash over:
     a) the hash of the denomination's public key,
     b) an enum value identifying the cipher, and
     c) cipher-dependant blinded information.
   See implementation of `TALER_coin_ev_hash`
   in libtalerexchange for details. *)
module Blinded_coin_hash = MAKE_H (Hash_code)
module Coin_pub_hash = MAKE_H (Hash_code)
module Output_commitment_hash = MAKE_H (Hash_code)

module MAKE_EDDSA_PUB () = struct
  type t = { eddsa_pub: string }

  let bin =
    let open Bin in
    record (fun eddsa_pub -> { eddsa_pub })
    |+ field (bytes 32) (fun t -> t.eddsa_pub)
    |> sealr
end

module MAKE_EDDSA_PRIV () = struct
  type t = { eddsa_priv: string }

  let bin =
    let open Bin in
    record (fun eddsa_priv -> { eddsa_priv })
    |+ field (bytes 32) (fun t -> t.eddsa_priv)
    |> sealr
end

module MAKE_EDDSA_SIG () = struct
  (* 64 bytes *)
  type t = { eddsa_signature: string }

  let bin =
    let open Bin in
    record (fun eddsa_signature -> { eddsa_signature })
    |+ field (bytes 64) (fun t -> t.eddsa_signature)
    |> sealr
end

module MAKE_ECDHE_PUB () = struct
  type t = { ecdhe_pub: string }

  let bin =
    let open Bin in
    record (fun ecdhe_pub -> { ecdhe_pub })
    |+ field (bytes 32) (fun t -> t.ecdhe_pub)
    |> sealr
end

module MAKE_ECDHE_PRIV () = struct
  type t = { ecdhe_priv: string }

  let bin =
    let open Bin in
    record (fun ecdhe_priv -> { ecdhe_priv })
    |+ field (bytes 32) (fun t -> t.ecdhe_priv)
    |> sealr
end

module Ecdh_ephemeral_public_key_p = struct
  type t = { ecdh_pub: string (* = uint8_t ecdh_pub[32] *) }

  let bin =
    let open Bin in
    record (fun ecdh_pub -> { ecdh_pub })
    |+ field (bytes 32) (fun t -> t.ecdh_pub)
    |> sealr
end

module Reserve_public_key_p = MAKE_EDDSA_PUB ()
module Reserve_private_key_p = MAKE_EDDSA_PRIV ()
module Reserve_signature_p = MAKE_EDDSA_SIG ()
module Merchant_public_key_p = MAKE_EDDSA_PUB ()
module Merchant_private_key_p = MAKE_EDDSA_PRIV ()
(*module Merchant_signature_p = MAKE_EDDSA_SIG ()*)

module Transfert_public_key_p = MAKE_ECDHE_PUB ()
module Transfert_private_key_p = MAKE_ECDHE_PRIV ()

(*
enum TALER_AmlDecisionState {
  NORMAL, PENDING, FROZEN
};
*)

module Aml_officer_public_key_p = MAKE_EDDSA_PUB ()
module Aml_officer_private_key_p = MAKE_EDDSA_PRIV ()
module Exchange_public_key_p = MAKE_EDDSA_PUB ()
module Exchange_private_key_p = MAKE_EDDSA_PRIV ()
module Exchange_signature_p = MAKE_EDDSA_SIG ()
module Master_public_key_p = MAKE_EDDSA_PUB ()
module Master_private_key_p = MAKE_EDDSA_PRIV ()
module Master_signature_p = MAKE_EDDSA_SIG ()

module Wire_transfert_identifier_raw_p = struct
  (* uint8_t raw[32]; *)
  type t = { raw: string }

  let bin =
    let open Bin in
    record (fun raw -> { raw }) |+ field (bytes 32) (fun t -> t.raw) |> sealr
end

module UUID = struct
  (* uint32_t value[4]; *)
  type t = { value: string }

  let bin =
    let open Bin in
    record (fun value -> { value })
    |+ field (bytes (4 * 4)) (fun t -> t.value)
    |> sealr
end

module Wad_id = struct
  (* uint32_t value[6]; *)
  type t = { raw: string }

  let bin =
    let open Bin in
    record (fun raw -> { raw })
    |+ field (bytes (4 * 6)) (fun t -> t.raw)
    |> sealr
end

(* TODO not sure what to do of union, probably not needed *)
(*
union TALER_CoinSpendPublicKeyP {
  uint8_t eddsa_pub[32];
  uint8_t ecdhe_pub[32];
};
union TALER_CoinSpendPrivateKeyP {
  uint8_t eddsa_priv[32];
  uint8_t ecdhe_priv[32];
};
*)
module Coin_spend_public_key_p = MAKE_EDDSA_PUB ()
module Coin_spend_private_key_p = MAKE_EDDSA_PRIV ()
module Coin_spend_signature_p = MAKE_EDDSA_SIG ()

(* TODO padding: sizeof used here (assume no padding for now) *)
(*
struct TALER_TransferSecretP {
  uint8_t key[sizeof (struct GNUNET_HashCode)];
};
  uint8_t key[sizeof (struct GNUNET_HashCode)];
};
struct TALER_EncryptedLinkSecretP {
  uint8_t enc[sizeof (struct TALER_LinkSecretP)];
};
*)
module Transfert_secret_p = MAKE_H (Hash_code)
module Link_secret_p = MAKE_H (Hash_code)
module Encrypted_link_secret_p = MAKE_H (Hash_code)

(*
union TALER_TokenPublicKeyP {
  uint8_t eddsa_pub[32];
  uint8_t ecdhe_pub[32];
};
*)
module Token_public_key_p = MAKE_EDDSA_PUB ()

(* -- Signatures -- *)

module Ecc_signature_purpose = struct
  type t = {
    (* This field equals the number of bytes being signed,
       namely 'sizeof (struct Data)'. *)
    size: int32;
    (* This field is used to express the context in
       which the signature is made, ensuring that a
       signature cannot be lifted from one part of the protocol
       to another. *)
    purpose: int32;
  }

  let bin =
    let open Bin in
    record (fun size purpose -> { size; purpose })
    |+ field beint32 (fun t -> t.size)
    |+ field beint32 (fun t -> t.purpose)
    |> sealr
end

(* This is the running SHA512-hash over all
   `TALER_BlindedCoinHashP` values of an array of coins.
   Note that each `TALER_BlindedCoinHashP` itself
   captures the hash of the corresponding denomination's
   public key. *)
module Hash_planchets_p = MAKE_H (Hash_code)

(* Binary representation of the age groups.
   The bits set in the mask mark the edges at the beginning of a next age
   group.  F.e. for the age groups
       0-7, 8-9, 10-11, 12-13, 14-15, 16-17, 18-20, 21-*
   the following bits are set:

     31     24        16        8         0
     |      |         |         |         |
     oooooooo  oo1oo1o1  o1o1o1o1  ooooooo1

   A value of 0 means that the exchange does not support the extension for
   age-restriction. *)
module Age_mask = struct
  type t = { mask: int32 }

  let bin =
    let open Bin in
    record (fun mask -> { mask }) |+ field beint32 (fun t -> t.mask) |> sealr
end

(* TODO TALER doc
   should be in doc
   found in src/include/taler/taler_amount_lib.h

   why is the non-NBO version only used in TALER_WithdrawRequestPS?
   GNUNET_PACKED?

   can be set to "invalid" if currency = all 0 *)
(*
/**
 * @brief Number of characters (plus 1 for 0-termination) we use to
 * represent currency names (i.e. EUR, USD, etc.).  We use 8+4 for
 * alignment in the `struct TALER_Amount`.  The amount is typically an
 * ISO 4217 currency code when an alphanumeric 3-digit code is used.
 * For regional currencies, the first character should be a "*" followed
 * by a region-specific name (i.e. "*BRETAGNEFR").
 */
#define TALER_CURRENCY_LEN 12

struct TALER_AmountNBO
{
  /**
   * Value in the main currency, in NBO.
   */
  uint64_t value GNUNET_PACKED;

  /**
   * Fraction (integer multiples of #TALER_AMOUNT_FRAC_BASE), in NBO.
   */
  uint32_t fraction GNUNET_PACKED;

  /**
   * Type of the currency being represented.
   */
  char currency[TALER_CURRENCY_LEN];
};

struct TALER_Amount
{
  /**
   * Value (numerator of fraction)
   */
  uint64_t value;

  /**
   * Fraction (integer multiples of #TALER_AMOUNT_FRAC_BASE).
   */
  uint32_t fraction;

  /**
   * Currency string, left adjusted and padded with zeros.  All zeros
   * for "invalid" values.
   */
  char currency[TALER_CURRENCY_LEN];
};
*)
let currency_len = 12

module Amount = struct
  type t = {
    value: int64;
    fraction: int32;
    currency: string;
  }

  (* TODO BE here? *)
  let bin =
    let open Bin in
    record (fun value fraction currency -> { value; fraction; currency })
    |+ field beint64 (fun t -> t.value)
    |+ field beint32 (fun t -> t.fraction)
    |+ field (bytes currency_len) (fun t -> t.currency)
    |> sealr
end

module AmountNBO = struct
  type t = {
    value: int64;
    fraction: int32;
    currency: string;
  }

  let bin =
    let open Bin in
    record (fun value fraction currency -> { value; fraction; currency })
    |+ field beint64 (fun t -> t.value)
    |+ field beint32 (fun t -> t.fraction)
    |+ field (bytes currency_len) (fun t -> t.currency)
    |> sealr
end

(* Format used for to generate the signature on a request to withdraw
   coins from a reserve. *)
module Withdraw_request_ps = struct
  type t = {
    (* TODO set it in encode/decode *)
    (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
    purpose: Ecc_signature_purpose.t;
    (* Amount to withdraw, excluding fees, i.e.
       the total sum of the denominations of the coins.
       Note that the reserve must have a value of at least amount+fee. *)
    amount: Amount.t;
    (* Total fee for the withdrawal.
       Note that the reserve must have a value of at least amount+fee. *)
    fee: Amount.t;
    (* This is the running SHA512-hash over all
       `TALER_BlindedCoinHashP` values of the coins.
       Note that each `TALER_BlindedCoinHashP` itself
       captures the hash of the corresponding denomination's
       public key.
       If max_age was set in the withdraw request, there will be
       n*κ many such values. The iteration MUST be first over
       all coins belonging to κ index=0, then all coins
       to κ index=1 etc:
       h[0][0]…h[0][n-1]h[1][0]…h[1][n-1] … h[κ-1][0]…h[κ-1][n-1]

       Note also that this value is required for /recoup and
       -- in case of a withdraw request with required age proof --
       in the subsequent call to /reveal-withdraw *)
    h_planchets: Hash_planchets_p.t;
    (* The master seed that was used in the call to /blinding-prepare blinding,
       or all zeros, if no denomination of cipher type Clause-Schnorr is used. *)
    (* TODO TALER doc
       `TALER_BlindingMasterSecretP` in doc, but probably TALER_BlindingMasterSeed *)
    blinding_seed: string;
    (* If age restriction proof is required, the maximum age _group_
       to commit to, 0 otherwise. Note that in this case, all
       denominations for all coins MUST support age restriction.
       Also note that this is not an age (in years), but the age group
       (an index) according to list of age groups in the configuration
       of the exchange.  See TALER_get_max_group() how to calculate
       the age group to a given age (in years). *)
    max_age_group: int32;
    (* The age groups as configured for the exchange, represented as a mask.
       If max_age_group is > 0, the mask MUST be non-zero, too. *)
    mask: Age_mask.t;
  }

  let bin =
    let open Bin in
    record
      (fun purpose amount fee h_planchets blinding_seed max_age_group mask ->
        {
          purpose;
          amount;
          fee;
          h_planchets;
          blinding_seed;
          max_age_group;
          mask;
        })
    |+ field Ecc_signature_purpose.bin (fun t -> t.purpose)
    |+ field Amount.bin (fun t -> t.amount)
    |+ field Amount.bin (fun t -> t.fee)
    |+ field Hash_planchets_p.bin (fun t -> t.h_planchets)
    |+ field cstring (fun t -> t.blinding_seed)
    |+ field beint32 (fun t -> t.max_age_group)
    |+ field Age_mask.bin (fun t -> t.mask)
    |> sealr
end

module Withdraw_confirmation_ps = struct
  type t = {
    (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW.
       Signed by a `struct TALER_ExchangePrivateKeyP` using EdDSA. *)
    purpose: Ecc_signature_purpose.t;
    (* Commitment made in the /withdraw request.
       Also needed for the /reveal-withdraw endpoint (in case
       of required proof of age restriction) and for /recoup *)
    (* TODO TALER doc
       missing TALER_HashBlindedPlanchetsP*)
    h_planchets: Hash_planchets_p.t;
    (* If proof of age restriction is not required for to this
       withdrawal, (i.e. max_age was not set during the request)
       MUST be 0xFFFFFFFF.
       Otherwise (i.e. proof of age restriction required):
       index that the client will not have to reveal, in NBO,
       MUST be smaller than #TALER_CNC_KAPPA. *)
    noreveal_index: int32;
  }

  let bin =
    let open Bin in
    record (fun purpose h_planchets noreveal_index ->
        { purpose; h_planchets; noreveal_index })
    |+ field Ecc_signature_purpose.bin (fun t -> t.purpose)
    |+ field Hash_planchets_p.bin (fun t -> t.h_planchets)
    |+ field beint32 (fun t -> t.noreveal_index)
    |> sealr
end