balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source
This commit is contained in:
Grégoire Henry 2016-11-15 01:36:06 +01:00
parent 0e93a1dbde
commit cbca39d4ea
10 changed files with 93 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/node/net/p2p.ml
View File

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

2
src/proto/bootstrap/contract_repr.ml
View File

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

2
src/proto/bootstrap/operation_repr.ml
View File

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

4
src/proto/bootstrap/script_repr.ml
View File

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

2
src/proto/bootstrap/voting_period_repr.ml
View File

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

4
src/proto/environment/data_encoding.mli
View File

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

70
src/utils/data_encoding.ml
View File

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

6
src/utils/data_encoding.mli
View File

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

2
src/utils/error_monad.ml
View File

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

41
test/test_data_encoding.ml
View File

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