diff --git a/src/lib_data_encoding/binary_error.ml b/src/lib_data_encoding/binary_error.ml index 683c8f534..6677d3e70 100644 --- a/src/lib_data_encoding/binary_error.ml +++ b/src/lib_data_encoding/binary_error.ml @@ -47,6 +47,7 @@ type write_error = | Invalid_float of { min : float ; v : float ; max : float } | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } + | Invalid_natural let pp_write_error ppf = function | Size_limit_exceeded -> @@ -65,5 +66,7 @@ let pp_write_error ppf = function Format.fprintf ppf "Invalid string length (expected: %d ; found %d)" expected found + | Invalid_natural -> + Format.fprintf ppf "Negative natural" exception Write_error of write_error diff --git a/src/lib_data_encoding/binary_error.mli b/src/lib_data_encoding/binary_error.mli index dc01588c8..51b0122bd 100644 --- a/src/lib_data_encoding/binary_error.mli +++ b/src/lib_data_encoding/binary_error.mli @@ -30,6 +30,7 @@ type write_error = | Invalid_float of { min : float ; v : float ; max : float } | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } + | Invalid_natural val pp_write_error : Format.formatter -> write_error -> unit diff --git a/src/lib_data_encoding/binary_length.ml b/src/lib_data_encoding/binary_length.ml index feecf5fef..a6374c6a1 100644 --- a/src/lib_data_encoding/binary_length.ml +++ b/src/lib_data_encoding/binary_length.ml @@ -9,6 +9,11 @@ open Binary_error +let n_length value = + let bits = Z.numbits value in + if bits = 0 then 1 else (bits + 6) / 7 +let z_length value = (Z.numbits value + 1 + 6) / 7 + let rec length : type x. x Encoding.t -> x -> int = fun e value -> let open Encoding in @@ -25,7 +30,8 @@ let rec length : type x. x Encoding.t -> x -> int = | Int31 -> Binary_size.int31 | Int32 -> Binary_size.int32 | Int64 -> Binary_size.int64 - | Z -> (Z.numbits value + 1 + 6) / 7 + | N -> n_length value + | Z -> z_length value | RangedInt { minimum ; maximum } -> Binary_size.integer_to_size @@ Binary_size.range_to_size ~minimum ~maximum diff --git a/src/lib_data_encoding/binary_length.mli b/src/lib_data_encoding/binary_length.mli index 163221326..b38d07d38 100644 --- a/src/lib_data_encoding/binary_length.mli +++ b/src/lib_data_encoding/binary_length.mli @@ -13,3 +13,6 @@ val length : 'a Encoding.t -> 'a -> int val fixed_length : 'a Encoding.t -> int option val fixed_length_exn : 'a Encoding.t -> int + +val z_length : Z.t -> int +val n_length : Z.t -> int diff --git a/src/lib_data_encoding/binary_reader.ml b/src/lib_data_encoding/binary_reader.ml index a17ba53cc..1b669befb 100644 --- a/src/lib_data_encoding/binary_reader.ml +++ b/src/lib_data_encoding/binary_reader.ml @@ -83,33 +83,43 @@ module Atom = struct raise (Invalid_float { min = minimum ; v = ranged ; max = maximum }) ; ranged - let z state = - let res = Buffer.create 100 in + let rec read_z res value bit_in_value state = + let byte = uint8 state in + let value = value lor ((byte land 0x7F) lsl bit_in_value) in + let bit_in_value = bit_in_value + 7 in + let bit_in_value, value = + if bit_in_value < 8 then + (bit_in_value, value) + else begin + Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ; + bit_in_value - 8, value lsr 8 + end in + if byte land 0x80 = 0x80 then + read_z res value bit_in_value state + else begin + if bit_in_value > 0 then Buffer.add_char res (Char.unsafe_chr value) ; + if byte = 0x00 then raise Trailing_zero ; + Z.of_bits (Buffer.contents res) + end + + let n state = let first = uint8 state in - if first = 0 then - Z.zero + let first_value = first land 0x7F in + if first land 0x80 = 0x80 then + read_z (Buffer.create 100) first_value 7 state else - let first_value = first land 0x3F in - let sign = (first land 0x40) <> 0 in - let rec read prev value bit state = - if prev land 0x80 = 0x00 then begin - if bit > 0 then Buffer.add_char res (Char.unsafe_chr value) ; - if prev = 0x00 then raise Trailing_zero ; - let bits = Buffer.contents res in - let res = Z.of_bits bits in - if sign then Z.neg res else res - end else - let byte = uint8 state in - let value = value lor ((byte land 0x7F) lsl bit) in - let bit = bit + 7 in - let bit, value = - if bit >= 8 then begin - Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ; - bit - 8, value lsr 8 - end else - bit, value in - read byte value bit state in - read first first_value 6 state + Z.of_int first_value + + let z state = + let first = uint8 state in + let first_value = first land 0x3F in + let sign = (first land 0x40) <> 0 in + if first land 0x80 = 0x80 then + let n = read_z (Buffer.create 100) first_value 6 state in + if sign then Z.neg n else n + else + let n = Z.of_int first_value in + if sign then Z.neg n else n let string_enum arr state = let read_index = @@ -153,6 +163,7 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret | Int31 -> Atom.int31 state | Int32 -> Atom.int32 state | Int64 -> Atom.int64 state + | N -> Atom.n state | Z -> Atom.z state | Float -> Atom.float state | Bytes (`Fixed n) -> Atom.fixed_length_bytes n state diff --git a/src/lib_data_encoding/binary_stream_reader.ml b/src/lib_data_encoding/binary_stream_reader.ml index 9543560c6..07d079cb9 100644 --- a/src/lib_data_encoding/binary_stream_reader.ml +++ b/src/lib_data_encoding/binary_stream_reader.ml @@ -132,38 +132,46 @@ module Atom = struct else k (ranged, state) - let z resume state k = - let res = Buffer.create 100 in + let rec read_z res value bit_in_value state k = + let resume buffer = + let stream = Binary_stream.push buffer state.stream in + read_z res value bit_in_value { state with stream } k in + uint8 resume state @@ fun (byte, state) -> + let value = value lor ((byte land 0x7F) lsl bit_in_value) in + let bit_in_value = bit_in_value + 7 in + let bit_in_value, value = + if bit_in_value < 8 then + (bit_in_value, value) + else begin + Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ; + bit_in_value - 8, value lsr 8 + end in + if byte land 0x80 = 0x80 then + read_z res value bit_in_value state k + else begin + if bit_in_value > 0 then Buffer.add_char res (Char.unsafe_chr value) ; + if byte = 0x00 then raise Trailing_zero ; + k (Z.of_bits (Buffer.contents res), state) + end + + let n resume state k = uint8 resume state @@ fun (first, state) -> - if first = 0 then - k (Z.zero, state) + let first_value = first land 0x7F in + if first land 0x80 = 0x80 then + read_z (Buffer.create 100) first_value 7 state k else - let first_value = first land 0x3F in - let sign = (first land 0x40) <> 0 in - let rec read prev value bit state = - if prev land 0x80 = 0x00 then begin - if bit > 0 then Buffer.add_char res (Char.unsafe_chr value) ; - if prev = 0x00 then raise Trailing_zero ; - let bits = Buffer.contents res in - let res = Z.of_bits bits in - let res = if sign then Z.neg res else res in - k (res, state) - end else - let resume buffer = - let stream = Binary_stream.push buffer state.stream in - uint8 resume { state with stream } (read_next value bit) in - uint8 resume state (read_next value bit) - and read_next value bit (byte, state) = - let value = value lor ((byte land 0x7F) lsl bit) in - let bit = bit + 7 in - let bit, value = - if bit >= 8 then begin - Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ; - bit - 8, value lsr 8 - end else - bit, value in - read byte value bit state in - read first first_value 6 state + k (Z.of_int first_value, state) + + let z resume state k = + uint8 resume state @@ fun (first, state) -> + let first_value = first land 0x3F in + let sign = (first land 0x40) <> 0 in + if first land 0x80 = 0x80 then + read_z (Buffer.create 100) first_value 6 state @@ fun (n, state) -> + k ((if sign then Z.neg n else n), state) + else + let n = Z.of_int first_value in + k ((if sign then Z.neg n else n), state) let string_enum arr resume state k = let read_index = @@ -215,6 +223,7 @@ let rec read_rec | Int31 -> Atom.int31 resume state k | Int32 -> Atom.int32 resume state k | Int64 -> Atom.int64 resume state k + | N -> Atom.n resume state k | Z -> Atom.z resume state k | Float -> Atom.float resume state k | Bytes (`Fixed n) -> Atom.fixed_length_bytes n resume state k diff --git a/src/lib_data_encoding/binary_writer.ml b/src/lib_data_encoding/binary_writer.ml index f6e23882f..06c607cce 100644 --- a/src/lib_data_encoding/binary_writer.ml +++ b/src/lib_data_encoding/binary_writer.ml @@ -124,6 +124,24 @@ module Atom = struct | `Int16 -> int16 state v | `Int31 -> int31 state v + let n state v = + if (Z.sign v < 0) then raise Invalid_natural ; + if Z.equal v Z.zero then + uint8 state 0x00 + else + let bits = Z.numbits v in + let get_chunk pos len = Z.to_int (Z.extract v pos len) in + let length = Binary_length.n_length v in + let offset = state.offset in + may_resize state length ; + for i = 0 to length - 1 do + let pos = i * 7 in + let chunk_len = if i = length - 1 then bits - pos else 7 in + MBytes.set_int8 state.buffer (offset + i) + ((if i = length - 1 then 0x00 else 0x80) + lor (get_chunk pos chunk_len)) + done + let z state v = let sign = Z.sign v < 0 in let bits = Z.numbits v in @@ -132,7 +150,7 @@ module Atom = struct else let v = Z.abs v in let get_chunk pos len = Z.to_int (Z.extract v pos len) in - let length = (bits + 1 + 6) / 7 in + let length = Binary_length.z_length v in let offset = state.offset in may_resize state length ; MBytes.set_int8 state.buffer offset @@ -143,7 +161,7 @@ module Atom = struct let pos = 6 + (i - 1) * 7 in let chunk_len = if i = length - 1 then bits - pos else 7 in MBytes.set_int8 state.buffer (offset + i) - ((if i = bits / 7 then 0x00 else 0x80) + ((if i = length - 1 then 0x00 else 0x80) lor (get_chunk pos chunk_len)) done @@ -204,6 +222,7 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit = | Int31 -> Atom.int31 state value | Int32 -> Atom.int32 state value | Int64 -> Atom.int64 state value + | N -> Atom.n state value | Z -> Atom.z state value | Float -> Atom.float state value | Bytes (`Fixed n) -> Atom.fixed_kind_bytes n state value diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index 8394078bb..6e7634a66 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -127,6 +127,9 @@ module Encoding: sig absolute value of the number in little endian order. *) val z : Z.t encoding + (** Positive big number, sedd [z]. *) + val n : Z.t encoding + (** Encoding of floating point number (encoded as a floating point number in JSON and a double in binary). *) val float : float encoding @@ -576,6 +579,7 @@ module Binary: sig | Invalid_float of { min : float ; v : float ; max : float } | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } + | Invalid_natural val pp_write_error : Format.formatter -> write_error -> unit exception Write_error of write_error diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index 2556b116b..a9e7b2c4a 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -76,6 +76,7 @@ type 'a desc = | Int31 : int desc | Int32 : Int32.t desc | Int64 : Int64.t desc + | N : Z.t desc | Z : Z.t desc | RangedInt : { minimum : int ; maximum : int } -> int desc | RangedFloat : { minimum : float ; maximum : float } -> float desc @@ -143,6 +144,7 @@ let rec classify : type a. a t -> Kind.t = fun e -> | Int31 -> `Fixed Binary_size.int31 | Int32 -> `Fixed Binary_size.int32 | Int64 -> `Fixed Binary_size.int64 + | N -> `Dynamic | Z -> `Dynamic | RangedInt { minimum ; maximum } -> `Fixed Binary_size.(integer_to_size @@ range_to_size ~minimum ~maximum) @@ -208,6 +210,7 @@ let rec is_zeroable: type t. t encoding -> bool = fun e -> | Int31 -> false | Int32 -> false | Int64 -> false + | N -> false | Z -> false | RangedInt _ -> false | RangedFloat _ -> false @@ -297,6 +300,7 @@ let ranged_float minimum maximum = and maximum = max minimum maximum in make @@ RangedFloat { minimum ; maximum } let int64 = make @@ Int64 +let n = make @@ N let z = make @@ Z let float = make @@ Float @@ -546,6 +550,7 @@ let rec is_nullable: type t. t encoding -> bool = fun e -> | Int31 -> false | Int32 -> false | Int64 -> false + | N -> false | Z -> false | RangedInt _ -> false | RangedFloat _ -> false diff --git a/src/lib_data_encoding/encoding.mli b/src/lib_data_encoding/encoding.mli index 29a95cb49..22d317c86 100644 --- a/src/lib_data_encoding/encoding.mli +++ b/src/lib_data_encoding/encoding.mli @@ -34,6 +34,7 @@ type 'a desc = | Int31 : int desc | Int32 : Int32.t desc | Int64 : Int64.t desc + | N : Z.t desc | Z : Z.t desc | RangedInt : { minimum : int ; maximum : int } -> int desc | RangedFloat : { minimum : float ; maximum : float } -> float desc @@ -99,6 +100,7 @@ val uint16 : int encoding val int31 : int encoding val int32 : int32 encoding val int64 : int64 encoding +val n : Z.t encoding val z : Z.t encoding val ranged_int : int -> int -> int encoding val ranged_float : float -> float -> float encoding diff --git a/src/lib_data_encoding/json.ml b/src/lib_data_encoding/json.ml index 32bd760d8..b68354533 100644 --- a/src/lib_data_encoding/json.ml +++ b/src/lib_data_encoding/json.ml @@ -44,6 +44,24 @@ let int64_encoding = Int64.of_string ] +let n_encoding = + let open Json_encoding in + def "positive_bignum" @@ + describe + ~title: "Positive big number" + ~description: "Decimal representation of a positive big number" @@ + conv + (fun z -> + if Z.sign z < 0 then + raise (Json_encoding.Cannot_destruct ([], Failure "negative natural")) ; + Z.to_string z) + (fun s -> + let n = Z.of_string s in + if Z.sign n < 0 then + raise (Json_encoding.Cannot_destruct ([], Failure "negative natural")) ; + n) + string + let z_encoding = let open Json_encoding in def "bignum" @@ @@ -155,6 +173,7 @@ let rec json : type a. a Encoding.desc -> a Json_encoding.encoding = | Int31 -> int | Int32 -> int32 | Int64 -> int64_encoding + | N -> n_encoding | Z -> z_encoding | Bool -> bool | Float -> float diff --git a/src/lib_data_encoding/test/read_failure.ml b/src/lib_data_encoding/test/read_failure.ml index bab95be44..8752e1995 100644 --- a/src/lib_data_encoding/test/read_failure.ml +++ b/src/lib_data_encoding/test/read_failure.ml @@ -181,7 +181,13 @@ let tests = all "unknown_case.E" ~expected:missing_case union_enc mini_union_enc E @ all "enum.missing" ~expected:missing_enum enum_enc mini_enum_enc 4 @ test_bounded_string_list @ - [ "z.truncated", `Quick, + [ "n.truncated", `Quick, + binary ~expected:not_enough_data n (MBytes.of_string "\x83") ; + "n.trailing_zero", `Quick, + binary ~expected:trailing_zero n (MBytes.of_string "\x83\x00") ; + "n.trailing_zero2", `Quick, + binary ~expected:trailing_zero n (MBytes.of_string "\x83\x00") ; + "z.truncated", `Quick, binary ~expected:not_enough_data z (MBytes.of_string "\x83") ; "z.trailing_zero", `Quick, binary ~expected:trailing_zero z (MBytes.of_string "\x83\x00") ; diff --git a/src/lib_data_encoding/test/success.ml b/src/lib_data_encoding/test/success.ml index a3c338c58..2d1d64b7e 100644 --- a/src/lib_data_encoding/test/success.ml +++ b/src/lib_data_encoding/test/success.ml @@ -99,6 +99,13 @@ let all_ranged_float minimum maximum = all (name ^ ".mean") Alcotest.float encoding ((minimum +. maximum) /. 2.) @ all (name ^ ".max") Alcotest.float encoding maximum +let test_n_sequence () = + let test i = + binary Alcotest.z z i () ; + stream Alcotest.z z i () in + for i = 0 to 10_000 do test (Z.of_int i) done ; + for i = 100_000_000 to 100_010_000 do test (Z.of_int i) done + let test_z_sequence () = let test i = binary Alcotest.z z i () ; @@ -171,6 +178,25 @@ let tests = all "float.epsilon" Alcotest.float float epsilon_float @ all "float.nan" Alcotest.float float nan @ all_ranged_float ~-. 100. 300. @ + all "n.zero" Alcotest.n n (Z.zero) @ + all "n.one" Alcotest.n n (Z.one) @ + [ "n.sequence", `Quick, test_n_sequence ] @ + let rec fact i l = + if i < 1 then + [] + else + let l = Z.mul l (Z.of_int i) in + fact (i - 1) l @ + all (Format.asprintf "n.fact.%d" i) Alcotest.n n l in + fact 35 Z.one @ + all "n.a" Alcotest.n n + (Z.of_string "123574503164821730218493275982143254986574985328") @ + all "n.b" Alcotest.n n + (Z.of_string "8493275982143254986574985328") @ + all "n.c" Alcotest.n n + (Z.of_string "123574503164821730218474985328") @ + all "n.d" Alcotest.n n + (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") @ all "z.zero" Alcotest.z z (Z.zero) @ all "z.one" Alcotest.z z (Z.one) @ [ "z.sequence", `Quick, test_z_sequence ] @ diff --git a/src/lib_data_encoding/test/types.ml b/src/lib_data_encoding/test/types.ml index 04190a813..71657bb0f 100644 --- a/src/lib_data_encoding/test/types.ml +++ b/src/lib_data_encoding/test/types.ml @@ -182,6 +182,7 @@ module Alcotest = struct testable (Fmt.of_to_string Z.to_string) Z.equal + let n = z let record = testable (Fmt.of_to_string record_to_string) diff --git a/src/lib_data_encoding/test/write_failure.ml b/src/lib_data_encoding/test/write_failure.ml index 3e2c66ec3..9446c218f 100644 --- a/src/lib_data_encoding/test/write_failure.ml +++ b/src/lib_data_encoding/test/write_failure.ml @@ -79,4 +79,5 @@ let tests = all "unknown_case.B" mini_union_enc (B "2") @ all "unknown_case.E" mini_union_enc E @ test_bounded_string_list @ + all "n" n (Z.of_string "-12") @ [] diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli index c7fb45053..b55eed69e 100644 --- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli +++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli @@ -36,6 +36,7 @@ val uint16 : int encoding val int31 : int encoding val int32 : int32 encoding val int64 : int64 encoding +val n : Z.t encoding val z : Z.t encoding val bool : bool encoding val string : string encoding