From d5eaf6d92fbdc2dc7543283084e670aa4a681e15 Mon Sep 17 00:00:00 2001 From: Swrup Date: Fri, 3 Oct 2025 19:54:18 +0200 Subject: [PATCH] add amount --- src/dune | 6 +++- src/json.ml | 5 +-- src/types.ml | 87 ++++++++++++++++++++++++++++++++++++++++++++-------- test/test.ml | 15 +++++++++ 4 files changed, 98 insertions(+), 15 deletions(-) diff --git a/src/dune b/src/dune index 9ff5b85a..c5d29ca9 100644 --- a/src/dune +++ b/src/dune @@ -23,7 +23,11 @@ (library (name types) (modules types) - (libraries fmt syntax)) + (libraries + angstrom + zarith ; + fmt + syntax)) (library (name headers_lib) diff --git a/src/json.ml b/src/json.ml index 698d5774..580128df 100644 --- a/src/json.ml +++ b/src/json.ml @@ -4,8 +4,6 @@ let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok let encode jsont v = Jsont_bytesrw.encode_string jsont v let decode jsont v = Jsont_bytesrw.decode_string jsont v -(* JavaScript numbers restricted to integers. *) - module Error_detail = struct open Error_detail @@ -74,3 +72,6 @@ module Relative_time = struct |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id |> Jsont.Object.finish end + +let amount_jsont = + Jsont.of_of_string ~kind:"Amount" Amount.of_string ~enc:Amount.to_string diff --git a/src/types.ml b/src/types.ml index e9903a99..d401b9bf 100644 --- a/src/types.ml +++ b/src/types.ml @@ -31,21 +31,84 @@ module Relative_time = struct end module Amount = struct - (* Amounts of currency are always expressed in terms of a base value, a fractional value and the denomination of the currency. -Amounts of currency are serialized as a string of the format :. Taler treats monetary amounts as fixed-precision numbers, with 8 decimal places. Unlike floating point numbers, this allows accurate representation of monetary amounts. + (* TODO + have safe amount arithmetic + make type private *) + (* Amounts of currency, serialized as `:.` + Fixed-precision numbers with 8 decimal places. + - must be at most 11 characters long + only consist of ASCII letters (a-zA-Z). + - integer part of may be at most 2^52. + - fractional part of may contain at most 8 decimal digits. -The following constrains apply for a valid amount: - - part must be at most 11 characters long and may only consist of ASCII letters (a-zA-Z). - - integer part of may be at most 2^52. - - fractional part of may contain at most 8 decimal digits. - -An amount that is prefixed with a + or - character is also used in certain contexts. When no sign is present, the amount is assumed to be positive. *) + Prefixed with '+' or '-' in certain contexts. + When no sign is present, the amount is assumed to be positive. *) type t = { - currency: [ `Eur ] - ; value: int - ; fraction: int - ; sign: [ `Plus | `Minus | `None ] + sign: [ `Plus | `Minus ] option + ; currency: [ `Eur ] + ; value: Int64.t + ; fraction: Int64.t } + + let make ~sign ~currency ~value ~fraction = + let open Syntax in + let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64 in + let fraction_upper_bound = Int64.of_int 99_999_999 in + let* () = if value < Int64.zero then Error "value is negative" else Ok () in + let* () = + if fraction < Int64.zero then Error "fraction is negative" else Ok () + in + let* () = + if value > value_upper_bound then Error "value is greater than 2^52" + else Ok () + in + let* () = + if fraction > fraction_upper_bound then + Error "fraction have more than 8 decimal digits" + else Ok () + in + Ok { sign; currency; value; fraction } + + let to_string = + let pp = + let open Fmt in + let pp_sign ppf = function + | `Plus -> char ppf '+' + | `Minus -> char ppf '-' + in + let pp_currency ppf = function `Eur -> string ppf "EUR" in + fun ppf { sign; currency; value; fraction } -> + pf ppf "%a%a:%Ld.%Ld" (Fmt.option pp_sign) sign pp_currency currency + value fraction + in + Fmt.str "%a" pp + + let of_string = + let open Angstrom in + let parse_sign = + choice + [ + char '+' *> return (Some `Plus); char '-' *> return (Some `Minus) + ; return None + ] + in + let parse_currency = string "EUR" *> return `Eur in + let parse_int = + take_while1 (function '0' .. '9' -> true | _ -> false) + >>| Int64.of_string + in + let parse_t = + lift4 + (fun sign currency value fraction -> + { sign; currency; value; fraction }) + parse_sign parse_currency + (char ':' *> parse_int) + (char '.' *> parse_int) + in + fun s -> + match parse_string ~consume:Consume.All parse_t s with + | Ok v -> Ok v + | Error e -> Error e end module Eddsa = struct diff --git a/test/test.ml b/test/test.ml index 35da8b25..19816d84 100644 --- a/test/test.ml +++ b/test/test.ml @@ -18,3 +18,18 @@ let () = check_bad Timestamp.jsont {|{"t_s": "123456780"}|}; check_bad Timestamp.jsont {|{"t_s": "agagou"}|}; () + +let () = + let open Types.Amount in + let v = + { + sign= Some `Plus + ; currency= `Eur + ; value= Int64.of_int 25 + ; fraction= Int64.of_int 678 + } + in + let s = to_string v in + let v' = of_string s |> Result.get_ok in + assert (v = v'); + ()