better amount.ml

dune-project

@@ -34,7 +34,6 @@
    fmt
    bin
    angstrom
-   zarith
    mirage-crypto
    digestif
    duration

mte.opam

@@ -21,7 +21,6 @@ depends: [
   "fmt"
   "bin"
   "angstrom"
-  "zarith"
   "mirage-crypto"
   "digestif"
   "duration"

src/amount.ml

@@ -1,16 +1,8 @@
 (* TODO
-     have safe amount arithmetic
+   have a currency agnostic amount_lib.ml
-     make type private
+   and specialize amount.ml to Config.currency??
-     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.
+   have safe amount arithmetic *)
-     When no sign is present, the amount is assumed to be positive. *)
 type sign =
   | Sign_plus
   | Sign_minus
@@ -22,22 +14,67 @@ type t = {
   fraction: Int32.t;
 }
 
-let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
-let check_not msg = function false -> Ok () | true -> Error msg
+
-let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64
+(* 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 =
-  let* () = check_not "value is negative" (value < Int64.zero) in
+  if value < Int64.zero then Error "value is negative"
-  let* () = check_not "fraction is negative" (fraction < Int32.zero) in
+  else if fraction < Int32.zero then Error "fraction is negative"
-  let* () =
+  else if value > value_upper_bound then Error "value is greater than 2^52-1"
-    check_not "value is greater than 2^52" (value > value_upper_bound)
+  else if fraction >= fraction_upper_bound then
-  in
+    Error "fraction has more than 8 decimal digits"
-  let* () =
+  else Ok { sign; currency; value; fraction }
-    check_not "fraction has more than 8 decimal digits"
+
-      (fraction >= fraction_upper_bound)
+module Parse = struct
-  in
+  open Angstrom
-  Ok { sign; currency; value; fraction }
+
+  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
@@ -46,76 +83,45 @@ let pp =
     | Sign_minus -> char ppf '-'
   in
   fun ppf { sign; currency; value; fraction } ->
+    (* TODO
+       depends on the currency's number of fraction digits
+       assumes value and fraction are in bounds *)
     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
+
+(* byte length of currency string *)
 let currency_len = 12
 
-let pad_currency s =
+let pad_currency_string s =
   let len = String.length s in
-  assert (len <= 11);
+  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 (fun _value _fraction _currency ->
+  record make_exn
-      (* 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)
+  |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
   |> sealr
 
 let bin_nbo =
   let open Bin in
-  record (fun _value _fraction _currency -> assert false)
+  record make_exn
   |+ field beint64 (fun t -> t.value)
   |+ field beint32 (fun t -> t.fraction)
-  |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
+  |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
   |> sealr
-
-let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok

src/amount.mli

@@ -1,6 +1,3 @@
-(* TODO
-   ? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *)
-
 type sign =
   | Sign_plus
   | Sign_minus
@@ -22,13 +19,9 @@ val make :
 val pp : Format.formatter -> t -> unit
 val to_string : t -> string
 val of_string : string -> (t, string) result
-val currency_len : int
-val jsont : t Jsont.t
 
-(* only for encoding *)
+(* - *)
+val jsont : t Jsont.t
 val bin : t Bin.t
 val bin_nbo : t Bin.t
-
+(* [caqti] is in pg_type.ml *)
-(* TODO
-   dummy value to use as placeholder for WIP *)
-val dummy_value : t