mte/src/binary_formats.ml

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

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

open Include

let int32_size = 4
let int64_size = 8

(* -- Time -- *)

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

    let size = int64_size

    (* 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 nboBin =
      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 size = int64_size

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

    let nboBin =
      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 -- *)

(* MK_BASIC_XX functor for structs like:
   struct Foo { uint8t bar[XX]; } *)
module MKMK_BASIC (Size : sig
  val v : int
end) =
struct
  type t = { v: string }

  let size = Size.v

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

module SIZE_32 = struct
  let v = 32
end

module SIZE_64 = struct
  let v = 64
end

module MK_BASIC_32 () = MKMK_BASIC (SIZE_32)
module MK_BASIC_64 () = MKMK_BASIC (SIZE_64)

(* MK_XX functor for structs like:
   struct FooWrap { struct Foo { uint8t bar[XX]; } } *)
module MKMK (Size : sig
  val v : int
end) =
struct
  module H = MKMK_BASIC (Size)

  type t = { v: H.t }

  let size = H.size

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

module MK_32 () = MKMK (SIZE_32)
module MK_64 () = MKMK (SIZE_64)
(* - *)

module ShortHashCode = MK_BASIC_32 ()
module HashCode = MK_BASIC_64 ()
module DenominationHash = MK_64 ()
module PrivateContractHash = MK_64 ()
module ExtensionsPolicyHash = MK_64 ()
module MerchantWireHash = MK_64 ()

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

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

(* 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_CoinEvHash`
   in libtalerexchange for details. *)
module BlindedCoinHash = MK_64 ()
module CoinPubHash = MK_64 ()
module OutputCommitmentHash = MK_64 ()
module ReservePublicKeyP = MK_32 ()
module ReservePrivateKeyP = MK_32 ()
module ReserveSignatureP = MK_64 ()
module MerchantPublicKeyP = MK_32 ()
module MerchantPrivateKeyP = MK_32 ()
(*module MerchantSignatureP = MK_64 () *)

module TransfertPublicKeyP = MK_32 ()
module TransfertPrivateKeyP = MK_32 ()

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

module AmlOfficerPublicKeyP = MK_32 ()
module AmlOfficerPrivateKeyP = MK_32 ()
module ExchangePublicKeyP = MK_32 ()
module ExchangePrivateKeyP = MK_32 ()
module ExchangeSignatureP = MK_64 ()
module MasterPublicKeyP = MK_32 ()
module MasterPrivateKeyP = MK_32 ()
module MasterSignatureP = MK_64 ()
module WireTransfertIdentifierRawP = MK_BASIC_32 ()

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

  let size = 4 * int32_size

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

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

  let size = 6 * int32_size

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

(* TODO not sure what to do of union, probably not needed *)
(*
union TALER_CoinSpendPublicKeyP {
  uint8t eddsaPub[32];
  uint8t ecdhePub[32];
};
union TALER_CoinSpendPrivateKeyP {
  uint8t eddsaPriv[32];
  uint8t ecdhePriv[32];
};
*)
module CoinSpendPublicKeyP = MK_32 ()
module CoinSpendPrivateKeyP = MK_32 ()
module CoinSpendSignatureP = MK_64 ()

(* TODO padding: sizeof used here (assume no padding for now) *)
(*
struct TALER_TransferSecretP {
  uint8t key[sizeof (struct GNUNET_HashCode)];
};
  uint8t key[sizeof (struct GNUNET_HashCode)];
};
struct TALER_EncryptedLinkSecretP {
  uint8t enc[sizeof (struct TALER_LinkSecretP)];
};
*)
module TransfertSecretP = MK_64 ()
module LinkSecretP = MK_64 ()
module EncryptedLinkSecretP = MK_64 ()

(*
union TALER_TokenPublicKeyP {
  uint8t eddsaPub[32];
  uint8t ecdhePub[32];
};
*)
module TokenPublicKeyP = MK_32 ()

(* -- Signatures -- *)

(* EccSignaturePurpose *)
module 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 size = 2 * int32_size

  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

  let make ~size purpose = { size= Int32.of_int size; purpose }
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 HashPlanchetsP = MK_64 ()

(* 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 AgeMask = struct
  type t = { mask: int32 }

  let size = int32_size

  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/talerAmountLib.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").
 */
struct TALER_AmountNBO
{
  /**
   * Value in the main currency, in NBO.
   */
  uint64t value GNUNET_PACKED;

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

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

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

  /**
   * Fraction (integer multiples of #TALER_AMOUNT_FRAC_BASE).
   */
  uint32t 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;
  }

  let size = int64_size + int32_size + currency_len

  (* 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 size = int64_size + int32_size + currency_len

  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 BlindingMasterSeed = MK_BASIC_32 ()

(* Format used for to generate the signature on a request to withdraw
   coins from a reserve. *)
module WithdrawRequestPS = struct
  (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
  type 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 maxAge 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: HashPlanchetsP.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: BlindingMasterSeed.t;
    (* 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_GetMaxGroup() 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: AgeMask.t;
  }

  let size =
    Purpose.size
    + (2 * Amount.size)
    + HashPlanchetsP.size
    + BlindingMasterSeed.size
    + int32_size
    + AgeMask.size

  let purpose = Purpose.make ~size Taler_signatures.wallet_reserve_withdraw

  let bin =
    let open Bin in
    record
      (fun _urpose amount fee h_planchets blinding_seed max_age_group mask ->
        { amount; fee; h_planchets; blinding_seed; max_age_group; mask })
    |+ field Purpose.bin (Fun.const purpose)
    |+ field Amount.bin (fun t -> t.amount)
    |+ field Amount.bin (fun t -> t.fee)
    |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
    |+ field BlindingMasterSeed.bin (fun t -> t.blinding_seed)
    |+ field beint32 (fun t -> t.max_age_group)
    |+ field AgeMask.bin (fun t -> t.mask)
    |> sealr
end

module WithdrawConfirmationPS = struct
  (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW.
     Signed by a `struct TALER_ExchangePrivateKeyP` using EdDSA. *)
  type 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: HashPlanchetsP.t;
    (* If proof of age restriction is not required for to this
       withdrawal, (i.e. maxAge 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 size = Purpose.size + HashPlanchetsP.size + int32_size*)

  open Bin

  let bin =
    record (fun purpose h_planchets noreveal_index ->
        (purpose, { h_planchets; noreveal_index }))
    |+ field Purpose.bin (fun (purpose, _t) -> purpose)
    |+ field HashPlanchetsP.bin (fun (_p, t) -> t.h_planchets)
    |+ field beint32 (fun (_p, t) -> t.noreveal_index)
    |> sealr

  let size =
    match Size.of_value (Size.size_of bin) with
    | Dynamic _ | Unknown -> Fmt.failwith "size_of failure: size is not Static"
    | Static n -> n

  let purpose = Purpose.make ~size Taler_signatures.exchange_confirm_withdraw
  let bin = map bin (fun (_p, t) -> t) (fun t -> (purpose, t))
end