Shell: proper handling of uint{8,16} in Data_encoding

src/node/net/p2p.ml

@@ -418,7 +418,7 @@ let addr_encoding =
     ~json:
       (conv Ipaddr.to_string (Data_encoding.Json.wrap_error Ipaddr.of_string_exn) string)
     ~binary:
-      (union ~tag_size:`Int8
+      (union ~tag_size:`Uint8
          [ case ~tag:4
              (Fixed.string 4)
              (fun ip -> Utils.map_option Ipaddr.V4.to_bytes (Ipaddr.to_v4 ip) )

src/proto/bootstrap/contract_repr.ml

@@ -49,7 +49,7 @@ let encoding =
        as replied by the contract origination RPC." @@
   splitted
     ~binary:
-      (union ~tag_size:`Int8 [
+      (union ~tag_size:`Uint8 [
           case ~tag:0 Ed25519.public_key_hash_encoding
             (function Default k -> Some k | _ -> None)
             (fun k -> Default k) ;

src/proto/bootstrap/operation_repr.ml

@@ -152,7 +152,7 @@ module Encoding = struct
        (req "fee" Tez_repr.encoding)
        (req "counter" int32)
        (req "operations"
-          (list (union ~tag_size:`Int8 [
+          (list (union ~tag_size:`Uint8 [
                transaction_case 0 ;
                origination_case 1 ;
                issuance_case 2 ;

src/proto/bootstrap/script_repr.ml

@@ -61,7 +61,7 @@ let expr_encoding =
   mu "tezosScriptExpression" (fun expr_encoding ->
       describe
         ~title: "Script expression (data, type or code)" @@
-      union ~tag_size:`Int8
+      union ~tag_size:`Uint8
         [ case ~tag:0 int_encoding
             (function Int (_, v) -> Some v | _ -> None)
             (fun v -> Int (-1, v)) ;
@@ -155,7 +155,7 @@ type t =
 
 let encoding =
   let open Data_encoding in
-  union ~tag_size:`Int8 [
+  union ~tag_size:`Uint8 [
     case ~tag:0 empty
       (function No_script -> Some () | _ -> None)
       (fun () -> No_script) ;

src/proto/bootstrap/voting_period_repr.ml

@@ -42,7 +42,7 @@ type kind =
 
 let kind_encoding =
   let open Data_encoding in
-  union ~tag_size:`Int8 [
+  union ~tag_size:`Uint8 [
     case ~tag:0
       (constant "proposal")
       (function Proposal -> Some () | _ -> None)

src/proto/environment/data_encoding.mli

@@ -13,7 +13,7 @@ type json_schema
 exception No_case_matched
 exception Unexpected_tag of int
 exception Duplicated_tag of int
-exception Invalid_tag of int * [ `Int8 | `Int16 ]
+exception Invalid_tag of int * [ `Uint8 | `Uint16 ]
 exception Unexpected_enum of string * string list
 
 type 'a t
@@ -153,7 +153,7 @@ type 't case
 val case :
   ?tag:int -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
 val union :
-  ?tag_size:[ `Int8 | `Int16 ] -> 't case list -> 't encoding
+  ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
 
 val describe :
   ?title:string -> ?description:string ->

src/utils/data_encoding.ml

@@ -26,7 +26,7 @@ type json_schema = Json_schema.schema
 exception No_case_matched
 exception Unexpected_tag of int
 exception Duplicated_tag of int
-exception Invalid_tag of int * [ `Int8 | `Int16 ]
+exception Invalid_tag of int * [ `Uint8 | `Uint16 ]
 exception Unexpected_enum of string * string list
 
 let apply fs v =
@@ -41,18 +41,20 @@ let apply fs v =
 module Size = struct
   let bool = 1
   let int8 = 1
+  let uint8 = 1
   let int16 = 2
+  let uint16 = 2
   let int31 = 4
   let int32 = 4
   let int64 = 8
   let float = 8
 end
 
-type tag_size = [ `Int8 | `Int16 ]
+type tag_size = [ `Uint8 | `Uint16 ]
 
 let tag_size = function
-  | `Int8 -> Size.int8
+  | `Uint8 -> Size.uint8
-  | `Int16 -> Size.int16
+  | `Uint16 -> Size.uint16
 
 module Kind = struct
 
@@ -108,7 +110,9 @@ type 'a desc =
   | Constant : string -> unit desc
   | Bool : bool desc
   | Int8 : int desc
+  | Uint8 : int desc
   | Int16 : int desc
+  | Uint16 : int desc
   | Int31 : int desc
   | Int32 : Int32.t desc
   | Int64 : Int64.t desc
@@ -167,7 +171,9 @@ let rec classify : type a l. a t -> Kind.t = fun e ->
   | Constant _ -> `Fixed 0
   | Bool -> `Fixed Size.bool
   | Int8 -> `Fixed Size.int8
+  | Uint8 -> `Fixed Size.uint8
   | Int16 -> `Fixed Size.int16
+  | Uint16 -> `Fixed Size.uint16
   | Int31 -> `Fixed Size.int31
   | Int32 -> `Fixed Size.int32
   | Int64 -> `Fixed Size.int64
@@ -361,8 +367,10 @@ module Json = struct
     | Empty -> empty
     | Constant s -> string_enum [s, ()]
     | Ignore -> unit
-    | Int8 -> int
+    | Int8 -> ranged_int ~minimum:~-(1 lsl 7) ~maximum:((1 lsl 7) - 1) "int8"
-    | Int16 -> int
+    | Uint8 -> ranged_int ~minimum:0 ~maximum:((1 lsl 8) - 1) "uint8"
+    | Int16 -> ranged_int ~minimum:~-(1 lsl 15) ~maximum:((1 lsl 15) - 1) "int16"
+    | Uint16 -> ranged_int ~minimum:0 ~maximum:((1 lsl 16) - 1) "uint16"
     | Int31 -> int
     | Int32 -> int32
     | Int64 -> int64_encoding
@@ -470,7 +478,9 @@ module Encoding = struct
   let constant s = make @@ Constant s
   let bool = make @@ Bool
   let int8 = make @@ Int8
+  let uint8 = make @@ Uint8
   let int16 = make @@ Int16
+  let uint16 = make @@ Uint16
   let int31 = make @@ Int31
   let int32 = make @@ Int32
   let int64 = make @@ Int64
@@ -676,8 +686,8 @@ module Encoding = struct
       invalid_arg "Data_encoding.union: empty list of cases." ;
     let max_tag =
       match tag_size with
-      | `Int8 -> 256
+      | `Uint8 -> 256
-      | `Int16 -> 256 * 256 in
+      | `Uint16 -> 256 * 256 in
     ignore @@
     List.fold_left
       (fun others (Case { tag }) ->
@@ -691,7 +701,7 @@ module Encoding = struct
       )
       [] cases
 
-  let union ?(tag_size = `Int8) cases =
+  let union ?(tag_size = `Uint8) cases =
     check_cases tag_size cases ;
     let kinds =
       List.map (fun (Case { encoding }) -> classify encoding) cases in
@@ -700,7 +710,7 @@ module Encoding = struct
   let case ?tag encoding proj inj = Case { encoding ; proj ; inj ; tag }
   let option ty =
     union
-      ~tag_size:`Int8
+      ~tag_size:`Uint8
       [ case ~tag:1 ty
           (fun x -> x)
           (fun x -> Some x) ;
@@ -746,7 +756,9 @@ let rec length : type x. x t -> x -> int = fun e ->
     | Constant _ -> fun _ -> 0
     | Bool -> fun _ -> Size.bool
     | Int8 -> fun _ -> Size.int8
+    | Uint8 -> fun _ -> Size.uint8
     | Int16 -> fun _ -> Size.int16
+    | Uint16 -> fun _ -> Size.uint16
     | Int31 -> fun _ -> Size.int31
     | Int32 -> fun _ -> Size.int32
     | Int64 -> fun _ -> Size.int64
@@ -843,19 +855,35 @@ let rec length : type x. x t -> x -> int = fun e ->
   module Writer = struct
 
     let int8 v buf ofs =
+      if (v < - (1 lsl 7) || v >= 1 lsl 7) then
+        invalid_arg "Data_encoding.Binary.Writer.int8" ;
       MBytes.set_int8 buf ofs v;
       ofs + Size.int8
 
+    let uint8 v buf ofs =
+      if (v < 0 || v >= 1 lsl 8) then
+        invalid_arg "Data_encoding.Binary.Writer.uint8" ;
+      MBytes.set_int8 buf ofs v;
+      ofs + Size.uint8
+
     let char v buf ofs =
-      int8 (Char.code v) buf ofs
+      uint8 (Char.code v) buf ofs
 
     let bool v buf ofs =
-      int8 (if v then 255 else 0) buf ofs
+      uint8 (if v then 255 else 0) buf ofs
 
     let int16 v buf ofs =
+      if (v < - (1 lsl 15) || v >= 1 lsl 15) then
+        invalid_arg "Data_encoding.Binary.Writer.int16" ;
       MBytes.set_int16 buf ofs v;
       ofs + Size.int16
 
+    let uint16 v buf ofs =
+      if (v < 0 || v >= 1 lsl 16) then
+        invalid_arg "Data_encoding.Binary.Writer.uint16" ;
+      MBytes.set_int16 buf ofs v;
+      ofs + Size.uint16
+
     let int31 v buf ofs =
       MBytes.set_int32 buf ofs (Int32.of_int v);
       ofs + Size.int31
@@ -904,8 +932,8 @@ let rec length : type x. x t -> x -> int = fun e ->
       w (proj v) buf ofs
 
     let write_tag = function
-      | `Int8 -> int8
+      | `Uint8 -> uint8
-      | `Int16 -> int16
+      | `Uint16 -> uint16
 
     let union w sz cases =
       let writes_case = function
@@ -934,7 +962,9 @@ let rec length : type x. x t -> x -> int = fun e ->
     | Ignore -> (fun () _buf ofs -> ofs)
     | Bool -> bool
     | Int8 -> int8
+    | Uint8 -> uint8
     | Int16 -> int16
+    | Uint16 -> uint16
     | Int31 -> int31
     | Int32 -> int32
     | Int64 -> int64
@@ -997,6 +1027,9 @@ let rec length : type x. x t -> x -> int = fun e ->
     let int8 buf ofs _len =
       ofs + Size.int8, MBytes.get_int8 buf ofs
 
+    let uint8 buf ofs _len =
+      ofs + Size.uint8, MBytes.get_uint8 buf ofs
+
     let char buf ofs len =
       let ofs, v = int8 buf ofs len in
       ofs, Char.chr v
@@ -1008,6 +1041,9 @@ let rec length : type x. x t -> x -> int = fun e ->
     let int16 buf ofs _len =
       ofs + Size.int16, MBytes.get_int16 buf ofs
 
+    let uint16 buf ofs _len =
+      ofs + Size.uint16, MBytes.get_uint16 buf ofs
+
     let int31 buf ofs _len =
       ofs + Size.int31, Int32.to_int (MBytes.get_int32 buf ofs)
 
@@ -1074,8 +1110,8 @@ let rec length : type x. x t -> x -> int = fun e ->
       ofs, inj v
 
     let read_tag = function
-      | `Int8 -> int8
+      | `Uint8 -> uint8
-      | `Int16 -> int16
+      | `Uint16 -> uint16
 
     let union r sz cases =
       let read_cases =
@@ -1105,7 +1141,9 @@ let rec length : type x. x t -> x -> int = fun e ->
     | Ignore -> (fun _buf ofs len -> ofs + len, ())
     | Bool -> bool
     | Int8 -> int8
+    | Uint8 -> uint8
     | Int16 -> int16
+    | Uint16 -> uint16
     | Int31 -> int31
     | Int32 -> int32
     | Int64 -> int64

src/utils/data_encoding.mli

@@ -21,7 +21,7 @@ type json_schema = Json_schema.schema
 exception No_case_matched
 exception Unexpected_tag of int
 exception Duplicated_tag of int
-exception Invalid_tag of int * [ `Int8 | `Int16 ]
+exception Invalid_tag of int * [ `Uint8 | `Uint16 ]
 exception Unexpected_enum of string * string list
 
 type 'a t
@@ -35,7 +35,9 @@ val null : unit encoding
 val empty : unit encoding
 val constant : string -> unit encoding
 val int8 : int encoding
+val uint8 : int encoding
 val int16 : int encoding
+val uint16 : int encoding
 val int31 : int encoding
 val int32 : int32 encoding
 val int64 : int64 encoding
@@ -161,7 +163,7 @@ type 't case
 val case :
   ?tag:int -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
 val union :
-  ?tag_size:[ `Int8 | `Int16 ] -> 't case list -> 't encoding
+  ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
 
 val describe :
   ?title:string -> ?description:string ->

src/utils/error_monad.ml

@@ -158,7 +158,7 @@ module Make() = struct
       describe ~title: "A successful result" @@
       obj1 (req "result" t_encoding) in
     union
-      ~tag_size:`Int8
+      ~tag_size:`Uint8
       [ case ~tag:0 t_encoding
           (function Ok x -> Some x | _ -> None)
           (function res -> Ok res) ;

test/test_data_encoding.ml

@@ -29,13 +29,13 @@ let test_simple_bin ?msg ?(equal=Assert.equal) encoding value =
   let result = match opt with None -> assert false | Some v -> v in
   equal ?msg value result
 
-let test_json_exn ?msg ?(equal=Assert.equal) encoding value fail =
+let test_json_exn ?msg encoding value fail =
   let get_result () =
     let bin = Json.construct encoding value in
     Json.destruct encoding bin in
   Assert.test_fail ?msg get_result fail
 
-let test_bin_exn ?msg ?(equal=Assert.equal) encoding value fail =
+let test_bin_exn ?msg encoding value fail =
   let get_result () =
     let bin = Binary.to_bytes encoding value in
     Binary.of_bytes encoding bin in
@@ -45,28 +45,39 @@ let test_simple ~msg enc value =
   test_simple_json ~msg:(msg ^ ": json") enc value ;
   test_simple_bin ~msg:(msg ^ ": binary") enc value
 
-let test_simple_int ~msg ?(boundary=true) encoding i =
+let test_simple_exn ~msg enc value =
-  let pow y = int_of_float @@ (2. ** float_of_int y) in
+  test_json_exn ~msg:(msg ^ ": json") enc value (fun _ -> true) ;
-  let i = i - 1 in
+  test_bin_exn ~msg:(msg ^ ": json") enc value (fun _ -> true)
-  let range_min = - pow i in
+
-  let range_max = pow i - 1 in
+let test_simple_int ~msg encoding i =
-  let out_max = pow i in
+  let range_min = - (1 lsl (i-1)) in
-  let out_min = - pow i - 1 in
+  let range_max = (1 lsl (i-1)) - 1 in
+  let out_max = (1 lsl (i-1)) in
+  let out_min = - (1 lsl (i-1)) - 1 in
   test_simple ~msg encoding range_min ;
   test_simple ~msg encoding range_max ;
-  if boundary then begin
+  test_simple_exn ~msg encoding out_max ;
-    test_simple_bin ~msg ~equal:(Assert.not_equal) encoding out_max ;
+  test_simple_exn ~msg encoding out_min
-    test_simple_bin ~msg ~equal:(Assert.not_equal) encoding out_min
-  end
 
+let test_simple_uint ~msg encoding i =
+  let range_min = 0 in
+  let range_max = (1 lsl i) - 1 in
+  let out_max = 1 lsl i in
+  let out_min = - 1 in
+  test_simple ~msg encoding range_min ;
+  test_simple ~msg encoding range_max ;
+  test_simple_exn ~msg encoding out_max ;
+  test_simple_exn ~msg encoding out_min
 
 let test_simple_values _ =
   test_simple ~msg:__LOC__ null ();
   test_simple ~msg:__LOC__ empty ();
   test_simple ~msg:__LOC__ (constant "toto") ();
   test_simple_int ~msg:__LOC__ int8 8;
+  test_simple_uint ~msg:__LOC__ uint8 8;
   test_simple_int ~msg:__LOC__ int16 16;
-  test_simple_int ~msg:__LOC__ ~boundary:false int31 31;
+  test_simple_uint ~msg:__LOC__ uint16 16;
+  test_simple_int ~msg:__LOC__ int31 31;
   test_simple ~msg:__LOC__ int32 Int32.min_int;
   test_simple ~msg:__LOC__ int32 Int32.max_int;
   test_simple ~msg:__LOC__ int64 Int64.min_int;
@@ -135,7 +146,7 @@ let test_tag_errors _ =
           (fun i -> i)
           (fun i -> Some i)] in
     Assert.test_fail ~msg:__LOC__  invalid_tag
-      (function (Invalid_tag (_, `Int8)) -> true
+      (function (Invalid_tag (_, `Uint8)) -> true
               | _ -> false) ;
     Lwt.return_unit