Data_encoding: add combinator for positive big number

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

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
 

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

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

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

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

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

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
 

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

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

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

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") ;

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 ] @

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)

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") @
   []

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