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 value_upper_bound = Int64.of_float @@ Float.pow 2. 52.

(* TODO
   the constraint is on the number of digits,
   so this wrong if leading 0s
   this depends on currency..? *)
let fraction_upper_bound = Int32.of_int 100_000_000

let make ~sign ~currency ~value ~fraction =
  if value < Int64.zero then Error "value is negative"
  else if fraction < Int32.zero then Error "fraction is negative"
  else if value > value_upper_bound then Error "value is greater than 2^52-1"
  else if fraction >= fraction_upper_bound then
    Error "fraction has more than 8 decimal digits"
  else Ok { sign; currency; value; fraction }

module Parse = struct
  open Angstrom

  let sign =
    char '+' *> return (Some Sign_plus)
    <|> char '-' *> return (Some Sign_minus)
    <|> return None

  let currency =
    take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false)
    >>= fun s ->
    match String.length s < 12 with
    | false -> fail "currency is more than 11 characters"
    | true -> return s

  let int64 =
    take_while1 (function '0' .. '9' -> true | _ -> false)
    >>| Int64.of_string_opt
    >>= function
    | None -> fail "value is not a valid int64"
    | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1"
    | Some n -> return n

  let int32 =
    take_while1 (function '0' .. '9' -> true | _ -> false)
    >>| Int32.of_string_opt
    >>= function
    | None -> fail "fraction is not a valid int32"
    | Some n when n >= fraction_upper_bound ->
        fail "fraction is greater than 10^8-1"
    | Some n -> return n

  let amount =
    lift4
      (fun sign currency value fraction ->
        make ~sign ~currency ~value ~fraction)
      sign currency
      (char ':' *> int64)
      (char '.' *> int32 <|> return 0_l)
    <* end_of_input

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

let of_string = Parse.f

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
       this depends on the currency's number of fraction digits *)
    pf ppf "%a%s:%Ld.%02ld" (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

(* byte length of currency string *)
let currency_len = 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 neint64 (fun t -> t.value)
  |+ field neint32 (fun t -> t.fraction)
  |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
  |> sealr

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