mte/src/types.ml

(* https://docs.taler.net/core/api-common.html#tsref-type-ErrorDetail *)
module Error_detail = struct
  (* TODO GANA error codes
     https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
  type t = {
    code: int;
    hint: string option;
  }
end

(* TODO number
   - number is "float", but we probably want int everywhere instead
   - numeric values capped at 2^53 -1 inclusive because json
   - have a type for seconds/microseconds/..? *)
module Timestamp = struct
  (* Seconds since epoch, or the special
     value "never" to represent an event that will
     never happen. *)
  type t =
    | Seconds of float
    | Never
end

module Relative_time = struct
  (* Duration in microseconds or "forever"
     to represent an infinite duration. Numeric
     values are capped at 2^53 - 1 inclusive. *)
  type t =
    | Microseconds of float
    | Forever
end

module Amount = struct
  (* TODO
     have safe amount arithmetic
     make type private *)
  (* Amounts of currency, serialized as `<Currency>:<IntegerPart>.<FractionalPart>`
     Fixed-precision numbers with 8 decimal places.
     - <Currency> must be at most 11 characters long
       only consist of ASCII letters (a-zA-Z).
     - integer part of <DecimalAmount> may be at most 2^52.
     - fractional part of <DecimalAmount> may contain at most 8 decimal digits.

     Prefixed with '+' or '-' in certain contexts.
     When no sign is present, the amount is assumed to be positive. *)
  type t = {
    sign: [ `Plus | `Minus ] option;
    currency: [ `Eur ];
    value: Int64.t;
    fraction: Int64.t;
  }

  let make ~sign ~currency ~value ~fraction =
    let open Syntax in
    let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64 in
    let fraction_upper_bound = Int64.of_int 99_999_999 in
    let* () = if value < Int64.zero then Error "value is negative" else Ok () in
    let* () =
      if fraction < Int64.zero then Error "fraction is negative" else Ok ()
    in
    let* () =
      if value > value_upper_bound then Error "value is greater than 2^52"
      else Ok ()
    in
    let* () =
      if fraction > fraction_upper_bound then
        Error "fraction have more than 8 decimal digits"
      else Ok ()
    in
    Ok { sign; currency; value; fraction }

  let to_string =
    let pp =
      let open Fmt in
      let pp_sign ppf = function
        | `Plus -> char ppf '+'
        | `Minus -> char ppf '-'
      in
      let pp_currency ppf = function `Eur -> string ppf "EUR" in
      fun ppf { sign; currency; value; fraction } ->
        pf ppf "%a%a:%Ld.%Ld" (Fmt.option pp_sign) sign pp_currency currency
          value fraction
    in
    Fmt.str "%a" pp

  let of_string =
    let open Angstrom in
    let parse_sign =
      choice
        [
          char '+' *> return (Some `Plus); char '-' *> return (Some `Minus);
          return None;
        ]
    in
    let parse_currency = string "EUR" *> return `Eur in
    let parse_int =
      take_while1 (function '0' .. '9' -> true | _ -> false)
      >>| Int64.of_string_opt
      >>= function
      | None -> fail "invalid integer"
      | Some n -> return n
    in
    let parse_t =
      lift4
        (fun sign currency value fraction ->
          make ~sign ~currency ~value ~fraction)
        parse_sign parse_currency
        (char ':' *> parse_int)
        (char '.' *> parse_int)
    in
    fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join
end

module Eddsa = struct
  (* TODO test *)
  (* EdDSA and ECDHE public keys always point on Curve25519
     and represented  using the standard 256 bits Ed25519 compact format,
     converted to Crockford Base32. *)
  type pub = Mirage_crypto_ec.Ed25519.pub

  let pub_of_string s =
    let open Mirage_crypto_ec in
    match Base_32.decode s with
    | Error _ as err -> err
    | Ok octets -> (
        match Ed25519.pub_of_octets octets with
        | Error e -> Fmt.error "%a" pp_error e
        | Ok pub -> Ok pub)

  let pub_to_string pub =
    pub |> Mirage_crypto_ec.Ed25519.pub_to_octets |> Base_32.encode

  (* EdDSA signatures are transmitted as 64-bytes base32
     binary-encoded objects with just the R and S values (base32_ binary-only).

     They are signature over a c-struct like `TALER_xxxPS` + with a purpose *)
  type signature = string
end

module Rsa = struct
  (* TODO
     GNUNET_CRYPTO custom encode/decode *)
  (* RSA public key converted to Crockford Base32. *)
  type pub = Mirage_crypto_pk.Rsa.pub

  let pub_of_string _s = assert false
  let pub_to_string _pub = assert false
end

module Hash_code = struct
  (* 32-byte value representing a point on Curve25519. *)
  type cs25519Point = string
end

module Rsa_denomination_key = struct
  type t = {
    age_mask: int;
    rsa_pub: string; (* Rsa.pub *)
  }
end

module CS_denomination_key = struct
  (* Clause Schnorr *)
  type t = {
    age_mask: int;
    cs_pub: string;
  }
end

module Denomination_key = struct
  type t =
    | Rsa of Rsa_denomination_key.t
    | CS of CS_denomination_key.t
end

module Future_sign_key = struct
  type t = {
    (* The actual exchange's EdDSA signing public key *)
    key: Eddsa.pub;
    (* Initial validity date for the signing key. *)
    stamp_start: Timestamp.t;
    (* Date when the exchange will stop using the signing key, allowed to overlap
       slightly with the next signing key's validity to allow for clock skew. *)
    stamp_expire: Timestamp.t;
    (* Date when all signatures made by the signing key expire and should
       henceforth no longer be considered valid in legal disputes. *)
    stamp_end: Timestamp.t;
    (* Signature over TALER_SigningKeyAnnouncementPS
       for this signing key by the signkey security
       module using purpose TALER_SIGNATURE_SM_SIGNING_KEY. *)
    signkey_secmod_sig: Eddsa.signature;
  }
end