From b3b059eddbad8859c4978a6046d5d0d32971acec Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 2 Mar 2026 23:44:32 +0100 Subject: [PATCH] +wip amount --- src/amount.ml | 176 +++++++++++++++++++++++++++----------------------- test/test.ml | 7 +- 2 files changed, 96 insertions(+), 87 deletions(-) diff --git a/src/amount.ml b/src/amount.ml index 473fb4ec..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,14 +16,15 @@ type t = { fraction: Int32.t; } -let maximum_currency_length = 11 -let value_upper_bound = Int64.of_float @@ Float.pow 2. 52. -let fraction_max_number_of_digits = 8 +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 choose to either include or exclude upper limit for all bounds - need a -1 here *) -let fraction_upper_bound = - Int32.of_float @@ Float.pow 10. (Int.to_float fraction_max_number_of_digits) +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 @@ -29,108 +32,118 @@ let check_currency s = else let len = String.length s in if len = 0 then Error "currency is empty string" - else if len > maximum_currency_length then - Fmt.error "currency is more than %d characters long" - maximum_currency_length - else Ok () + 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_upper_bound > 0 then - Error "value is greater than 2^52" - else Ok 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_upper_bound > 0 then - Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits - else Ok 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 = + 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 } -open Angstrom +module Parser = struct + open Angstrom -let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false -let is_digit = function '0' .. '9' -> true | _ -> false -let letters = take_while1 is_letter -let digits = take_while1 is_digit + let letters = take_while1 is_letter + let digits = take_while1 is_digit -let sign = - choice - [ - char '+' *> return (Some Sign_plus); - char '-' *> return (Some Sign_minus); - return None; - ] + let sign = + choice + [ + char '+' *> return (Some Sign_plus); + char '-' *> return (Some Sign_minus); + return None; + ] -let currency_of_string s = - if not @@ String.for_all is_letter s then - Error "currency contains forbidden character" - else if String.length s > maximum_currency_length then - Fmt.error "currency is more than %d characters long" maximum_currency_length - else Ok (String.uppercase_ascii s) - -let value_of_string s = - if not @@ String.for_all is_digit s then - Error "value contains forbidden character" - else + let value = + digits >>= fun s -> match Int64.of_string_opt s with - | None -> Error "value is not a valid integer" - | Some v -> - if v > value_upper_bound then Error "value is greater than 2^52" - else if v < Int64.zero then Error "value is negative" - else Ok v + | None -> fail "not a valid int64" + | Some n -> return n -let fraction_of_string s = - if not @@ String.for_all is_digit s then - Error "fraction contains forbidden character" - else if String.length s > fraction_max_number_of_digits then - Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits - else - match Int32.of_string_opt s with - | None -> Error "fraction is not a valid integer" - | Some v -> if v < Int32.zero then Error "fraction is negative" else Ok v + 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 -> - let open Syntax in - let* currency = currency_of_string currency in - let* value = value_of_string value in - let* fraction = fraction_of_string fraction in - Ok { sign; currency; value; fraction }) - sign letters - (char ':' *> digits) - (option "" (char '.' *> digits)) - <* end_of_input + let amount = + lift4 + (fun sign currency value fraction -> + make ~sign ~currency ~value ~fraction) + sign letters + (char ':' *> value) + (option 0_l (char '.' *> fraction)) + <* end_of_input -let of_string 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 = 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 (* - *) let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string -let currency_length = 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" @@ -140,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 () =