diff --git a/src/amount.ml b/src/amount.ml index 9b8b34ff..3caeaf68 100644 --- a/src/amount.ml +++ b/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 diff --git a/test/test.ml b/test/test.ml index c9af9bd5..b2462f9b 100644 --- a/test/test.ml +++ b/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 () =