mte/src/amount.ml

(* TODO
   have a currency agnostic amount_lib.ml
   and specialize amount.ml to Config.currency??

   have safe amount arithmetic *)
type sign =
  | Sign_plus
  | Sign_minus

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

let maximum_currency_length = 11
let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
let fraction_max_number_of_digits = 8

(* TODO choose to either include or exclude upper limit for all bounds
   need a -1 here *)
let fraction_upper_bound =
  Int32.of_float @@ Float.pow 10. (Int.to_float fraction_max_number_of_digits)

let check_currency s =
  if not @@ String.for_all is_letter s then
    Error "currency contains forbidden character"
  else
    let len = String.length s in
    if len = 0 then Error "currency is empty string"
    else if len > maximum_currency_length then
      Fmt.error "currency is more than %d characters long"
        maximum_currency_length
    else Ok ()

let check_value v =
  if Int64.unsigned_compare v value_upper_bound > 0 then
    Error "value is greater than 2^52"
  else Ok v

let check_fraction v =
  if Int32.unsigned_compare v fraction_upper_bound > 0 then
    Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
  else Ok v

let make ~sign ~currency ~value ~fraction =
  Ok { sign; currency; value; fraction }

open Angstrom

let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
let is_digit = function '0' .. '9' -> true | _ -> false
let letters = take_while1 is_letter
let digits = take_while1 is_digit

let sign =
  choice
    [
      char '+' *> return (Some Sign_plus);
      char '-' *> return (Some Sign_minus);
      return None;
    ]

let currency_of_string s =
  if not @@ String.for_all is_letter s then
    Error "currency contains forbidden character"
  else if String.length s > maximum_currency_length then
    Fmt.error "currency is more than %d characters long" maximum_currency_length
  else Ok (String.uppercase_ascii s)

let value_of_string s =
  if not @@ String.for_all is_digit s then
    Error "value contains forbidden character"
  else
    match Int64.of_string_opt s with
    | None -> Error "value is not a valid integer"
    | Some v ->
        if v > value_upper_bound then Error "value is greater than 2^52"
        else if v < Int64.zero then Error "value is negative"
        else Ok v

let fraction_of_string s =
  if not @@ String.for_all is_digit s then
    Error "fraction contains forbidden character"
  else if String.length s > fraction_max_number_of_digits then
    Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
  else
    match Int32.of_string_opt s with
    | None -> Error "fraction is not a valid integer"
    | Some v -> if v < Int32.zero then Error "fraction is negative" else Ok v

let amount =
  lift4
    (fun sign currency value fraction ->
      let open Syntax in
      let* currency = currency_of_string currency in
      let* value = value_of_string value in
      let* fraction = fraction_of_string fraction in
      Ok { sign; currency; value; fraction })
    sign letters
    (char ':' *> digits)
    (option "" (char '.' *> digits))
  <* end_of_input

let of_string s = parse_string ~consume:Consume.All amount s |> Result.join

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 } ->
    (* TODO
       depends on the currency's number of fraction digits *)
    pf ppf "%a%s:%Lu.%02lu" (Fmt.option pp_sign) sign currency value fraction

let to_string = Fmt.str "%a" pp

(* - *)

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

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

(* binary decoding unused? *)
let make_exn value fraction currency =
  match make ~sign:None ~currency ~value ~fraction with
  | Error _ -> Fmt.failwith "Amount of binary data failure"
  | Ok v -> v

let bin =
  let open Bin in
  record make_exn
  |+ field beint64 (fun t -> t.value)
  |+ field beint32 (fun t -> Int32.mul t.fraction 1_000_000_l)
  |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
  |> sealr