fix amount fractions

src/amount.ml

@@ -3,6 +3,8 @@
    and specialize amount.ml to Config.currency??
 
    have safe amount arithmetic *)
+open Syntax
+
 type sign =
   | Sign_plus
   | Sign_minus
@@ -14,78 +16,117 @@ type t = {
   fraction: Int32.t;
 }
 
-let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
+let currency_length_limit = 12
+let value_limit = Int64.add 1_L (Int64.of_float (Float.pow 2. 52.))
+let fraction_nb_digits = 8
 
-(* 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 fraction_limit =
+  Int32.of_float (Float.pow 10. (Int.to_float fraction_nb_digits))
+
+let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
+let is_digit = function '0' .. '9' -> true | _ -> false
+
+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 < currency_length_limit then Ok ()
+    else
+      Fmt.error "currency is more than %d characters long" currency_length_limit
+
+let check_value v =
+  if Int64.unsigned_compare v value_limit < 0 then Ok ()
+  else Error "value is greater than 2^52"
+
+let check_fraction v =
+  if Int32.unsigned_compare v fraction_limit < 0 then Ok ()
+  else Fmt.error "fraction has more than %d digits" fraction_nb_digits
 
 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 }
+  let* () = check_currency currency in
+  let* () = check_value value in
+  let* () = check_fraction fraction in
+  let currency = String.uppercase_ascii currency in
+  Ok { sign; currency; value; fraction }
 
-module Parse = struct
+module Parser = struct
   open Angstrom
 
+  let letters = take_while1 is_letter
+  let digits = take_while1 is_digit
+
   let sign =
-    char '+' *> return (Some Sign_plus)
-    <|> char '-' *> return (Some Sign_minus)
-    <|> return None
+    choice
+      [
+        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"
+  let value =
+    digits >>= fun s ->
+    match Int64.of_string_opt s with
+    | None -> fail "not a valid int64"
     | 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 fraction =
+    digits >>= fun s ->
+    let len = String.length s in
+    match len <= fraction_nb_digits with
+    | false ->
+        fail (Fmt.str "fraction has more than %d digits" fraction_nb_digits)
+    | true -> (
+        match Int32.of_string_opt s with
+        | None -> fail "not a valid int32"
+        | Some n ->
+            let magnitude =
+              let exp = Int.to_float (fraction_nb_digits - len) in
+              Int32.of_float @@ Float.pow 10. exp
+            in
+            let n = Int32.mul n magnitude in
+            return n)
 
   let amount =
     lift4
       (fun sign currency value fraction ->
         make ~sign ~currency ~value ~fraction)
-      sign currency
-      (char ':' *> int64)
-      (char '.' *> int32 <|> return 0_l)
+      sign letters
+      (char ':' *> value)
+      (option 0_l (char '.' *> fraction))
     <* end_of_input
 
-  let f s = parse_string ~consume:Consume.All amount s |> Result.join
+  let parse s =
+    Angstrom.parse_string ~consume:Consume.All amount s |> Result.join
 end
 
-let of_string = Parse.f
+let of_string = Parser.parse
 
 let pp =
   let open Fmt in
-  let pp_sign ppf = function
-    | Sign_plus -> char ppf '+'
-    | Sign_minus -> char ppf '-'
+  let pp_sign =
+    let pp ppf = function
+      | Sign_plus -> char ppf '+'
+      | Sign_minus -> char ppf '-'
+    in
+    Fmt.option pp
+  in
+  let rec rm_trailing_zeros count x =
+    if x <> 0_l && Int32.rem x 10_l = 0_l then
+      rm_trailing_zeros (succ count) (Int32.div x 10_l)
+    else (count, x)
+  in
+  let pp_fraction ppf fraction =
+    match fraction = 0_l with
+    | true -> Fmt.nop ppf ()
+    | false ->
+        let count, x = rm_trailing_zeros 0 fraction in
+        let nb_leading_zeros = fraction_nb_digits - count in
+        pf ppf ".%0*lu" nb_leading_zeros x
   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
+    pf ppf "%a%s:%Lu%a" pp_sign sign currency value pp_fraction fraction
 
 let to_string = Fmt.str "%a" pp
 
@@ -93,17 +134,16 @@ 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
+  match len < currency_length_limit with
+  | false -> Fmt.failwith "amount with invalid currency"
+  | true ->
+      let b = Bytes.make currency_length_limit '\x00' in
+      Bytes.blit_string s 0 b 0 len;
+      Bytes.unsafe_to_string b
 
-(* binary decoding unused? *)
+(* binary decoding never unused *)
 let make_exn value fraction currency =
   match make ~sign:None ~currency ~value ~fraction with
   | Error _ -> Fmt.failwith "Amount of binary data failure"
@@ -113,6 +153,7 @@ 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)
+  |+ field beint32 (fun t -> t.fraction)
+  |+ field (bytes currency_length_limit) (fun t ->
+      pad_currency_string t.currency)
   |> sealr

test/test.ml

@@ -35,14 +35,9 @@ let () =
   check_bad Timestamp.jsont {|{"t_s": "123456780"}|};
   check_bad Timestamp.jsont {|{"t_s": "agagou"}|};
 
-  (* CS not implemented *)
+  (* TODO CS not implemented *)
   check_bad DenominationKey.jsont
     {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|};
-
-  (* TODO test with a valid rsa_pub value *)
-  (* TODO handle "rsa pub_of_octets failure" correctly *)
-  (* check_bad DenominationKey.jsont
-    {|{"cipher": "RSA", "age_mask": 18, "rsa_pub": "agagouh"}|}; *)
   ()
 
 let () =