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 not in doc
   dummy impl
   struct TALER_BlindingMasterSecretP blinding_seed; *)
module Blinding_master_secret_p = MAKE_H (Hash_code)

(* TODO not in doc
   struct TALER_Amount amount; *)
module Amount = MAKE_H (Hash_code)

(* 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. *)
    blinding_seed: Blinding_master_secret_p.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_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 Blinding_master_secret_p.bin (fun t -> t.blinding_seed)
    |+ field beint32 (fun t -> t.max_age_group)
    |+ field Age_mask.bin (fun t -> t.mask)
    |> sealr
end