mte/src/types.ml

module Config_types = struct
  module Currency = struct
    type t = {
      enabled: [ `YES | `NO ];
      code: string;
      name: string;
      fractional_input_digits: int;
      fractional_normal_digits: int;
      fractional_trailing_zero_digits: int;
      alt_unit_names: (int * string) list;
    }
  end

  module Coin = struct
    type t = {
      (* section_name: Name in the configuration file that defines this denomination *)
      section_name: string;
      value: Amount.t;
      duration_withdraw: Ptime.Span.t;
      duration_spend: Ptime.Span.t;
      duration_legal: Ptime.Span.t;
      fee_withdraw: Amount.t;
      fee_deposit: Amount.t;
      fee_refresh: Amount.t;
      fee_refund: Amount.t;
      cipher: [ (* `CS |*) `RSA ];
      rsa_keysize: int; (* : int option (only if `RSA) *)
      age_restricted: [ (*`YES|*) `NO ];
    }
  end
end

module Amount = struct
  include Amount

  let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
end

(* TODO key format
   - check what is the exact format in GNUNET
   - endianess issue? *)
module EddsaPublicKey = struct
  (* EdDSA and ECDHE public keys always point on Curve25519
     and represented  using the standard 256 bits Ed25519 compact format,
     converted to Crockford Base32. *)
  open Mirage_crypto_ec.Ed25519

  type t = pub

  let to_octets t = pub_to_octets t
  let of_octets t = pub_of_octets t

  let of_b32 s =
    let open Syntax in
    let* octets = B32.decode s in
    match pub_of_octets octets with
    | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
    | Ok pub -> Ok pub

  let to_b32 t = B32.encode (to_octets t)
  let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
end

module EddsaSignature : sig
  type t

  val to_octets : t -> string
  val sign : key:Mirage_crypto_ec.Ed25519.priv -> string -> t
  val of_b32 : string -> (t, string) result
  val to_b32 : t -> string
  val jsont : t Jsont.t
end = struct
  (* TODO key format
     endianess issue? *)
  (* 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 t = string

  let to_octets t = t

  let sign ~key s =
    (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
    Mirage_crypto_ec.Ed25519.sign ~key s

  let check_size t =
    match String.length t = 64 with
    | false -> Error "EddsaSignature: invalid string length"
    | true -> Ok ()

  let of_b32 s =
    let open Syntax in
    let* t = B32.decode s in
    let+ () = check_size t in
    t

  let to_b32 = B32.encode
  let jsont = Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
end

module RsaPublicKey = struct
  module Binary = struct
    (* https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html
     format: { uint16_be: n size; uint16_be: e size; n; e}

    integer in big-endian format (MSB first)
    leading zeroes are stripped unless they are required to keep a value positive
    no 0-termination *)

    let rev_string len s = String.init len (fun i -> s.[len - 1 - i])

    (* todo: need to strip leading zeros or something? *)
    (* reverse bytes because Z.of_bits reads bytes in little endian *)
    let z_of_bits_be src pos len =
      String.sub src pos len |> rev_string len |> Z.of_bits

    let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
      let n_len = Z.size n in
      let e_len = Z.size e in
      let len = 4 + n_len + e_len in
      let b = Bytes.make len '\x00' in
      Bytes.set_uint16_be b 0 n_len;
      Bytes.set_uint16_be b 2 e_len;
      let n = Z.to_bits n |> rev_string n_len in
      let e = Z.to_bits e |> rev_string e_len in
      Bytes.blit_string n 0 b 4 n_len;
      Bytes.blit_string e 0 b (4 + n_len) e_len;
      Bytes.unsafe_to_string b

    let of_octets =
      let check = function
        | false -> Error "RsaPublicKey.of_octets: invalid data"
        | true -> Ok ()
      in
      fun s ->
        let open Syntax in
        let len = String.length s in
        let* () = check (len >= 4) in
        let n_len = String.get_uint16_be s 0 in
        let e_len = String.get_uint16_be s 2 in
        let* () = check (len = n_len + e_len + 4) in
        let n = z_of_bits_be s 4 n_len in
        let e = z_of_bits_be s (4 + n_len) e_len in
        Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg
  end

  include Binary
  open Mirage_crypto_pk

  type t = Rsa.pub

  let of_b32 s =
    let open Syntax in
    let* s = B32.decode s in
    let* v = of_octets s in
    let+ v = Rsa.pub ~n:v.n ~e:v.e |> unwrap_err_msg in
    v

  let to_b32 t = B32.encode (to_octets t)
  let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
end

module RsaSignature : sig
  type t

  val to_octets : t -> string
  val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
  val of_b32 : string -> (t, string) result
  val to_b32 : t -> string
  val jsont : t Jsont.t
end = struct
  type t = string

  let to_octets t = t

  (* TODO rsa sign *)
  let sign ~key s =
    Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s

  let of_b32 s = B32.decode s
  let to_b32 t = B32.encode t
  let jsont = Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
end