Data_encoding: Adds ranged_int and ranged_float

This commit is contained in:
Milo Davis 2017-12-08 11:59:09 +01:00 committed by Benjamin Canou
parent dc7a023e22
commit b2918c1387
3 changed files with 152 additions and 1 deletions

View File

@ -24,6 +24,8 @@ exception Duplicated_tag of int
exception Invalid_tag of int * [ `Uint8 | `Uint16 ]
exception Unexpected_enum of string * string list
exception Invalid_size of int
exception Int_out_of_range of int * int * int
exception Float_out_of_range of float * float * float
let apply ?(error=No_case_matched) fs v =
let rec loop = function
@ -41,6 +43,8 @@ module Size = struct
let char = 1
let int16 = 2
let uint16 = 2
let uint32 = 4
let uint64 = 8
let int31 = 4
let int32 = 4
let int64 = 8
@ -122,6 +126,8 @@ type 'a desc =
| Int31 : int desc
| Int32 : Int32.t desc
| Int64 : Int64.t desc
| RangedInt : { minimum : int ; maximum : int } -> int desc
| RangedFloat : { minimum : float ; maximum : float } -> float desc
| Float : float desc
| Bytes : Kind.length -> MBytes.t desc
| String : Kind.length -> string desc
@ -167,6 +173,44 @@ and 'a t = {
mutable json_encoding: 'a Json_encoding.encoding option ;
}
type signed_integer = [ `Int64 | `Int32 | `Int16 | `Int8 ]
type unsigned_integer = [ `Int64 | `Int32 | `Uint16 | `Uint8 ]
type integer = [ signed_integer | unsigned_integer ]
let signed_range_to_size min max : [> signed_integer ] =
if min >= ~-128 && max <= 127
then `Int8
else if min >= ~-32_768 && max <= 32_767
then `Int16
else if min >= ~-2_147_483_648 && max <= 2_147_483_647
then `Int32
else `Int64
(* max should be centered at zero *)
let unsigned_range_to_size max : [> unsigned_integer ] =
if max <= 255
then `Uint8
else if max <= 65535
then `Uint16
else if max <= 2_147_483_647 (* Unsigned int32 and int64 are not supported *)
then `Int32
else `Int64
let integer_to_size = function
| `Int64 -> Size.int64
| `Int32 -> Size.int32
| `Int16 -> Size.int16
| `Int8 -> Size.int8
| `Uint64 -> Size.uint64
| `Uint32 -> Size.uint32
| `Uint16 -> Size.uint16
| `Uint8 -> Size.uint8
let range_to_size ~minimum ~maximum : integer =
if minimum < 0
then signed_range_to_size minimum maximum
else unsigned_range_to_size (maximum - minimum)
type 'a encoding = 'a t
let rec classify : type a. a t -> Kind.t = fun e ->
@ -183,7 +227,10 @@ let rec classify : type a. a t -> Kind.t = fun e ->
| Int31 -> `Fixed Size.int31
| Int32 -> `Fixed Size.int32
| Int64 -> `Fixed Size.int64
| RangedInt { minimum ; maximum } ->
`Fixed (integer_to_size @@ range_to_size ~minimum ~maximum)
| Float -> `Fixed Size.float
| RangedFloat _ -> `Fixed Size.float
(* Tagged *)
| Bytes kind -> (kind :> Kind.t)
| String kind -> (kind :> Kind.t)
@ -328,11 +375,13 @@ module Json = struct
| 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"
| RangedInt { minimum ; maximum } -> ranged_int ~minimum ~maximum "rangedInt"
| Int31 -> int
| Int32 -> int32
| Int64 -> int64_encoding
| Bool -> bool
| Float -> float
| RangedFloat { minimum; maximum } -> ranged_float ~minimum ~maximum "rangedFloat"
| String _ -> string (* TODO: check length *)
| Bytes _ -> bytes_jsont (* TODO check length *)
| String_enum (_, l) -> string_enum l
@ -458,6 +507,11 @@ module Encoding = struct
let uint16 = make @@ Uint16
let int31 = make @@ Int31
let int32 = make @@ Int32
let ranged_int minimum maximum = make @@ RangedInt { minimum = min minimum maximum ;
maximum = max minimum maximum }
let ranged_float minimum maximum = make @@ RangedFloat { minimum = min minimum maximum ;
maximum = max minimum maximum }
let int64 = make @@ Int64
let float = make @@ Float
@ -767,7 +821,10 @@ module Binary = struct
| Int31 -> fun _ -> Size.int31
| Int32 -> fun _ -> Size.int32
| Int64 -> fun _ -> Size.int64
| RangedInt { minimum ; maximum } ->
fun _ -> integer_to_size @@ range_to_size ~minimum ~maximum
| Float -> fun _ -> Size.float
| RangedFloat _ -> fun _ -> Size.float
| Bytes `Fixed n -> fun _ -> n
| String `Fixed n -> fun _ -> n
| String_enum (`Fixed n, _) -> fun _ -> n
@ -982,7 +1039,26 @@ module Binary = struct
| Int31 -> int31
| Int32 -> int32
| Int64 -> int64
| RangedInt { minimum ; maximum } ->
fun v ->
begin
if v < minimum || v > maximum
then invalid_arg (Printf.sprintf "Integer %d not in range [%d, %d]." v minimum maximum) ;
let v = if minimum >= 0 then v - minimum else v in
match range_to_size ~minimum ~maximum with
| `Uint16 -> uint16 v
| `Uint8 -> uint8 v
| `Int8 -> int8 v
| `Int64 -> int64 (Int64.of_int v)
| `Int16 -> int16 v
| `Int32 -> int32 (Int32.of_int v)
end
| Float -> float
| RangedFloat { minimum ; maximum } ->
fun v ->
if v < minimum || v > maximum
then invalid_arg (Printf.sprintf "Integer %f not in range [%f, %f]." v minimum maximum) ;
float v
| Bytes (`Fixed n) -> fixed_kind_bytes n
| String (`Fixed n) -> fixed_kind_string n
| Bytes `Variable -> variable_length_bytes
@ -1187,7 +1263,27 @@ module Binary = struct
| Int31 -> int31
| Int32 -> int32
| Int64 -> int64
| RangedInt { minimum ; maximum } ->
(fun buf ofs alpha ->
let ofs, value =
match range_to_size ~minimum ~maximum with
| `Int8 -> int8 buf ofs alpha
| `Int64 -> let ofs, int64 = int64 buf ofs alpha in (ofs, Int64.to_int int64)
| `Uint16 -> uint16 buf ofs alpha
| `Int16 -> int16 buf ofs alpha
| `Uint8 -> uint8 buf ofs alpha
| `Int32 -> let ofs, int32 = int32 buf ofs alpha in (ofs, Int32.to_int int32) in
let value = if minimum > 0 then value + minimum else value in
if value < minimum || value > maximum
then raise (Int_out_of_range (value, minimum, maximum)) ;
(ofs, value))
| Float -> float
| RangedFloat { minimum ; maximum } ->
(fun buf ofs len ->
let offset, value = float buf ofs len in
if value < minimum || value > maximum
then raise (Float_out_of_range (value, minimum, maximum)) ;
(offset, value))
| Bytes (`Fixed n) -> fixed_length_bytes n
| String (`Fixed n) -> fixed_length_string n
| Bytes `Variable -> fun buf ofs len -> fixed_length_bytes len buf ofs len
@ -1438,7 +1534,23 @@ module Binary = struct
| Int31 -> next_path path (fst (int31 buf))
| Int32 -> next_path path (fst (int32 buf))
| Int64 -> next_path path (fst (int64 buf))
| Float -> next_path path (fst (float buf))
| RangedInt { minimum ; maximum } ->
let (stream, ranged) =
(match range_to_size ~minimum ~maximum with
| `Int8 -> int8 buf
| `Int64 -> let stream, int = int64 buf in (stream, Int64.to_int int)
| `Uint16 -> uint16 buf
| `Int16 -> int16 buf
| `Uint8 -> uint8 buf
| `Int32 -> let stream, int = int32 buf in (stream, Int32.to_int int)) in
let ranged = if minimum > 0 then ranged + minimum else ranged in
assert (minimum < ranged && ranged < maximum) ;
next_path path stream
| Float -> next_path path (fst (float buf))
| RangedFloat { minimum ; maximum } ->
let stream, float = float buf in
assert (minimum < float && maximum > float) ;
next_path path stream
| Bytes (`Fixed n) ->
next_path path (fst (fixed_length_bytes n buf))

View File

@ -109,6 +109,12 @@ val int32 : int32 encoding
(data is encodedas a 64-bit int in binary and a decimal string in JSON). *)
val int64 : int64 encoding
(** Integer with bounds in a given range. Both bounds are inclusive *)
val ranged_int : int -> int -> int encoding
(** Float with bounds in a given range. Both bounds are inclusive *)
val ranged_float : float -> float -> float encoding
(** Encoding of a boolean
(data is encoded as a byte in binary and a boolean in JSON). *)
val bool : bool encoding

View File

@ -80,6 +80,14 @@ let test_simple_values _ =
test_simple ~msg:__LOC__ int32 Int32.max_int;
test_simple ~msg:__LOC__ int64 Int64.min_int;
test_simple ~msg:__LOC__ int64 Int64.max_int;
test_simple ~msg:__LOC__ (ranged_int 100 400) 399;
test_simple ~msg:__LOC__ (ranged_int 19000 19254) 19000;
test_simple ~msg:__LOC__ (ranged_int 19000 19254) 19254;
test_simple ~msg:__LOC__ (ranged_int ~-100 300) 200;
test_simple ~msg:__LOC__ (ranged_int ~-3_000_000_000 3_000_000_000) 200;
test_simple ~msg:__LOC__ (ranged_int ~-3_000_000_000 3_000_000_000) 2_000_000_000;
test_simple ~msg:__LOC__ (ranged_float 100. 200.) 150.;
test_simple ~msg:__LOC__ (ranged_float ~-.100. 200.) ~-.75.;
test_simple ~msg:__LOC__ bool true;
test_simple ~msg:__LOC__ bool false;
test_simple ~msg:__LOC__ string "tutu";
@ -332,6 +340,30 @@ let test_wrapped_binary _ =
let decoded = Data_encoding.Binary.of_bytes_exn enc encoded in
Lwt.return @@ Assert.equal data decoded
let test_out_of_range _ =
let assert_exception enc x =
begin try
ignore (Data_encoding.Json.construct enc x) ;
assert false
with Invalid_argument _ ->
Assert.is_true true
end ;
begin
try
ignore (Data_encoding.Binary.to_bytes enc x) ;
assert false
with Invalid_argument _ ->
Assert.is_true true
end in
let enc_int = Data_encoding.ranged_int ~-30 100 in
let enc_float = Data_encoding.ranged_float ~-.30. 100. in
assert_exception enc_int 101 ;
assert_exception enc_int ~-32 ;
assert_exception enc_float ~-.31. ;
assert_exception enc_float 101. ;
assert_exception enc_float 100.1 ;
Lwt.return_unit
let tests = [
"simple", test_simple_values ;
"json", test_json ;
@ -340,6 +372,7 @@ let tests = [
"json.input", test_json_input ;
"tags", test_tag_errors ;
"wrapped_binary", test_wrapped_binary ;
"out_of_range", test_out_of_range ;
]
let () =