diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index 635b10f1f..488c8687c 100644 --- a/src/node/net/p2p.ml +++ b/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) ) diff --git a/src/proto/bootstrap/contract_repr.ml b/src/proto/bootstrap/contract_repr.ml index 3959aac3b..cf0ab4db9 100644 --- a/src/proto/bootstrap/contract_repr.ml +++ b/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) ; diff --git a/src/proto/bootstrap/operation_repr.ml b/src/proto/bootstrap/operation_repr.ml index 78241df9b..9b0559940 100644 --- a/src/proto/bootstrap/operation_repr.ml +++ b/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 ; diff --git a/src/proto/bootstrap/script_repr.ml b/src/proto/bootstrap/script_repr.ml index 0d658b2f8..da69098a2 100644 --- a/src/proto/bootstrap/script_repr.ml +++ b/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) ; diff --git a/src/proto/bootstrap/voting_period_repr.ml b/src/proto/bootstrap/voting_period_repr.ml index 39c9701a2..48d2f5f99 100644 --- a/src/proto/bootstrap/voting_period_repr.ml +++ b/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) diff --git a/src/proto/environment/data_encoding.mli b/src/proto/environment/data_encoding.mli index 32320d469..b70ef5506 100644 --- a/src/proto/environment/data_encoding.mli +++ b/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 -> diff --git a/src/utils/data_encoding.ml b/src/utils/data_encoding.ml index e1c0f6798..f106d869b 100644 --- a/src/utils/data_encoding.ml +++ b/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 - | `Int16 -> Size.int16 + | `Uint8 -> Size.uint8 + | `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 - | Int16 -> int + | Int8 -> ranged_int ~minimum:~-(1 lsl 7) ~maximum:((1 lsl 7) - 1) "int8" + | 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 - | `Int16 -> 256 * 256 in + | `Uint8 -> 256 + | `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 - | `Int16 -> int16 + | `Uint8 -> uint8 + | `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 - | `Int16 -> int16 + | `Uint8 -> uint8 + | `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 diff --git a/src/utils/data_encoding.mli b/src/utils/data_encoding.mli index 176d9edf1..86ba4403f 100644 --- a/src/utils/data_encoding.mli +++ b/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 -> diff --git a/src/utils/error_monad.ml b/src/utils/error_monad.ml index ae32a6cc2..4aeaf2cea 100644 --- a/src/utils/error_monad.ml +++ b/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) ; diff --git a/test/test_data_encoding.ml b/test/test_data_encoding.ml index ea935debc..8a7b187ed 100644 --- a/test/test_data_encoding.ml +++ b/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 pow y = int_of_float @@ (2. ** float_of_int y) in - let i = i - 1 in - let range_min = - pow i in - let range_max = pow i - 1 in - let out_max = pow i in - let out_min = - pow i - 1 in +let test_simple_exn ~msg enc value = + test_json_exn ~msg:(msg ^ ": json") enc value (fun _ -> true) ; + test_bin_exn ~msg:(msg ^ ": json") enc value (fun _ -> true) + +let test_simple_int ~msg encoding i = + let range_min = - (1 lsl (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_bin ~msg ~equal:(Assert.not_equal) encoding out_max ; - test_simple_bin ~msg ~equal:(Assert.not_equal) encoding out_min - end + test_simple_exn ~msg encoding out_max ; + test_simple_exn ~msg encoding out_min +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