mte/src/amount.ml

(* TODO
     have safe amount arithmetic
     make type private
     redefine an Amount module with currency enforced to be Config.currency? *)
(* 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 sign =
  | Sign_plus
  | Sign_minus

type t = {
  sign: sign option;
  currency: string;
  value: Int64.t;
  fraction: Int32.t;
}

let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
let check_not msg = function false -> Ok () | true -> Error msg
let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64
let fraction_upper_bound = Int32.of_int 100_000_000

let make ~sign ~currency ~value ~fraction =
  let* () = check_not "value is negative" (value < Int64.zero) in
  let* () = check_not "fraction is negative" (fraction < Int32.zero) in
  let* () =
    check_not "value is greater than 2^52" (value > value_upper_bound)
  in
  let* () =
    check_not "fraction has more than 8 decimal digits"
      (fraction >= fraction_upper_bound)
  in
  Ok { sign; currency; value; fraction }

let pp =
  let open Fmt in
  let pp_sign ppf = function
    | Sign_plus -> char ppf '+'
    | Sign_minus -> char ppf '-'
  in
  fun ppf { sign; currency; value; fraction } ->
    pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction

let to_string = Fmt.str "%a" pp

let of_string =
  let open Angstrom in
  let parse_sign =
    choice
      [
        char '+' *> return (Some Sign_plus);
        char '-' *> return (Some Sign_minus);
        return None;
      ]
  in
  let parse_currency =
    (* TODO currency string constraint/format *)
    take_while1 (function
      | 'a' .. 'z' | 'A' .. 'Z' -> true
      | _ -> false)
  in
  let parse_int64 =
    take_while1 (function '0' .. '9' -> true | _ -> false)
    >>| Int64.of_string_opt
    >>= function
    | None -> fail "invalid integer"
    | Some n -> return n
  in
  let parse_int32 =
    take_while1 (function '0' .. '9' -> true | _ -> false)
    >>| Int32.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_int64)
      (char '.' *> parse_int32)
  in
  fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join

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

let pad_currency s =
  let len = String.length s in
  assert (len <= 11);
  let b = Bytes.make 12 '\x00' in
  Bytes.blit_string s 0 b 0 len;
  Bytes.to_string b

let bin =
  let open Bin in
  record (fun _value _fraction _currency ->
      (* no need to decode amount? *)
      assert false)
  |+ field neint64 (fun t -> t.value)
  |+ field neint32 (fun t -> t.fraction)
  |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
  |> sealr

let bin_nbo =
  let open Bin in
  record (fun _value _fraction _currency -> assert false)
  |+ field beint64 (fun t -> t.value)
  |+ field beint32 (fun t -> t.fraction)
  |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
  |> sealr

let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok