init

src/amount.ml

@@ -0,0 +1,119 @@
+(* 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