add amount

src/dune

@@ -23,7 +23,11 @@
 (library
  (name types)
  (modules types)
- (libraries fmt syntax))
+ (libraries
+  angstrom
+  zarith ;
+  fmt
+  syntax))
 
 (library
  (name headers_lib)

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

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 <Currency>:<DecimalAmount>. 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 `<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.
 
-The following constrains apply for a valid amount:
-    - <Currency> part must be at most 11 characters long and may 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.
-
-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