This commit is contained in:
parent
f35950dbf0
commit
0209d2a375
3 changed files with 87 additions and 95 deletions
112
src/amount.ml
112
src/amount.ml
|
|
@ -16,14 +16,12 @@ 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
|
||||
|
|
@ -34,20 +32,17 @@ 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 ()
|
||||
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 ()
|
||||
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
|
||||
|
|
@ -56,24 +51,13 @@ let make ~sign ~currency ~value ~fraction =
|
|||
let currency = String.uppercase_ascii currency in
|
||||
Ok { sign; currency; value; fraction }
|
||||
|
||||
(*
|
||||
let config_currency =
|
||||
match check_currency Config.currency with
|
||||
| Error e -> Fmt.failwith "Invalid currency name configuration: %s@." e
|
||||
| Ok () -> String.uppercase_ascii Config.currency
|
||||
module Parser = struct
|
||||
open Angstrom
|
||||
|
||||
let make_config_currency ~value ~fraction =
|
||||
let* () = check_value value in
|
||||
let* () = check_fraction fraction in
|
||||
Ok { sign= None; currency= config_currency; value; fraction }
|
||||
*)
|
||||
let letters = take_while1 is_letter
|
||||
let digits = take_while1 is_digit
|
||||
|
||||
open Angstrom
|
||||
|
||||
let letters = take_while1 is_letter
|
||||
let digits = take_while1 is_digit
|
||||
|
||||
let sign =
|
||||
let sign =
|
||||
choice
|
||||
[
|
||||
char '+' *> return (Some Sign_plus);
|
||||
|
|
@ -81,68 +65,85 @@ let sign =
|
|||
return None;
|
||||
]
|
||||
|
||||
let value =
|
||||
let value =
|
||||
digits >>= fun s ->
|
||||
match Int64.of_string_opt s with
|
||||
| None -> fail "not a valid int64"
|
||||
| Some n -> return n
|
||||
|
||||
let fraction =
|
||||
let fraction =
|
||||
digits >>= fun s ->
|
||||
let len = String.length s in
|
||||
match len <= fraction_max_number_of_digits with
|
||||
match len <= fraction_nb_digits with
|
||||
| false ->
|
||||
fail
|
||||
(Fmt.str "fraction has more than %d digits"
|
||||
fraction_max_number_of_digits)
|
||||
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_max_number_of_digits - len) in
|
||||
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 =
|
||||
let amount =
|
||||
lift4
|
||||
(fun sign currency value fraction -> make ~sign ~currency ~value ~fraction)
|
||||
(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
|
||||
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.%0*lu" (Fmt.option pp_sign) sign currency value
|
||||
fraction_max_number_of_digits 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_length);
|
||||
let b = Bytes.make currency_length '\x00' in
|
||||
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.to_string b
|
||||
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"
|
||||
|
|
@ -152,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_length) (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
|
||||
|
|
|
|||
|
|
@ -16,11 +16,6 @@ val make :
|
|||
fraction:Int32.t ->
|
||||
(t, string) result
|
||||
|
||||
(* dependency cycle with config.ml ...
|
||||
val make_config_currency :
|
||||
value:Int64.t -> fraction:Int32.t -> (t, string) result
|
||||
*)
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
val to_string : t -> string
|
||||
val of_string : string -> (t, string) result
|
||||
|
|
|
|||
|
|
@ -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 () =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue