Data_encoding: cosmetic fixes

This commit is contained in:
Benjamin Canou 2018-06-12 21:27:45 +02:00
parent 6f4a98f6fd
commit 2d8ca36f12
10 changed files with 66 additions and 41 deletions

View File

@ -58,7 +58,7 @@ let fixup_references uf =
let rec fixup_layout = function
| Ref s -> Ref (UF.find uf s).title
| Enum (i, name) -> Enum (i, (UF.find uf name).title)
| Seq layout -> Seq (fixup_layout layout)
| Seq (layout, len) -> Seq (fixup_layout layout, len)
| (Zero_width
| Int _
| Bool
@ -295,15 +295,15 @@ let describe (type x) (encoding : x Encoding.t) =
fields ref_name recursives references encoding.encoding
| Delayed func ->
fields ref_name recursives references (func ()).encoding
| List (_, { encoding }) ->
| List (len, { encoding }) ->
let (layout, references) =
layout None recursives references encoding in
([ Anonymous_field (`Variable, Seq layout) ],
([ Anonymous_field (`Variable, Seq (layout, len)) ],
references)
| Array (_, { encoding }) ->
| Array (len, { encoding }) ->
let (layout, references) =
layout None recursives references encoding in
([ Anonymous_field (`Variable, Seq layout) ],
([ Anonymous_field (`Variable, Seq (layout, len)) ],
references)
| Bytes kind ->
([ Anonymous_field ((kind :> Kind.t), Bytes) ], references)
@ -436,14 +436,14 @@ let describe (type x) (encoding : x Encoding.t) =
let size, cases = enum tbl encoding_array in
let references = add_reference name (Int_enum { size ; cases }) references in
(Enum (size, name), references)
| Array (_, data) ->
| Array (len, data) ->
let (descr, references) =
layout None recursives references data.encoding in
(Seq descr, references)
| List (_, data) ->
(Seq (descr, len), references)
| List (len, data) ->
let layout, references =
layout None recursives references data.encoding in
(Seq layout, references)
(Seq (layout, len), references)
| Obj (Req { encoding = { encoding } })
| Obj (Dft { encoding = { encoding } }) ->
layout ref_name recursives references encoding

View File

@ -17,7 +17,8 @@ type read_error =
| Invalid_float of { min : float ; v : float ; max : float }
| Trailing_zero
| Size_limit_exceeded
| Oversized_list
| List_too_long
| Array_too_long
let pp_read_error ppf = function
| Not_enough_data ->
@ -38,8 +39,10 @@ let pp_read_error ppf = function
Format.fprintf ppf "Trailing zero in Z"
| Size_limit_exceeded ->
Format.fprintf ppf "Size limit exceeded"
| Oversized_list ->
Format.fprintf ppf "Size limit exceeded"
| List_too_long ->
Format.fprintf ppf "List length limit exceeded"
| Array_too_long ->
Format.fprintf ppf "Array length limit exceeded"
exception Read_error of read_error
@ -51,7 +54,8 @@ type write_error =
| Invalid_bytes_length of { expected : int ; found : int }
| Invalid_string_length of { expected : int ; found : int }
| Invalid_natural
| Oversized_list
| List_too_long
| Array_too_long
let pp_write_error ppf = function
| Size_limit_exceeded ->
@ -72,7 +76,9 @@ let pp_write_error ppf = function
expected found
| Invalid_natural ->
Format.fprintf ppf "Negative natural"
| Oversized_list ->
Format.fprintf ppf "Size limit exceeded"
| List_too_long ->
Format.fprintf ppf "List length limit exceeded"
| Array_too_long ->
Format.fprintf ppf "Array length limit exceeded"
exception Write_error of write_error

View File

@ -20,7 +20,8 @@ type read_error =
| Invalid_float of { min : float ; v : float ; max : float }
| Trailing_zero
| Size_limit_exceeded
| Oversized_list
| List_too_long
| Array_too_long
exception Read_error of read_error
val pp_read_error: Format.formatter -> read_error -> unit
@ -32,7 +33,8 @@ type write_error =
| Invalid_bytes_length of { expected : int ; found : int }
| Invalid_string_length of { expected : int ; found : int }
| Invalid_natural
| Oversized_list
| List_too_long
| Array_too_long
val pp_write_error : Format.formatter -> write_error -> unit

View File

@ -72,13 +72,13 @@ let rec length : type x. x Encoding.t -> x -> int =
| Bytes `Variable -> MBytes.length value
| String `Variable -> String.length value
| Array (Some max_length, _e) when Array.length value > max_length ->
raise (Write_error Oversized_list)
raise (Write_error Array_too_long)
| Array (_, e) ->
Array.fold_left
(fun acc v -> length e v + acc)
0 value
| List (Some max_length, _e) when List.length value > max_length ->
raise (Write_error Oversized_list)
raise (Write_error List_too_long)
| List (_, e) ->
List.fold_left
(fun acc v -> length e v + acc)

View File

@ -192,11 +192,11 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret
Atom.string_enum arr state
| Array (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
let l = read_list max_length e state in
let l = read_list List_too_long max_length e state in
Array.of_list l
| List (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
read_list max_length e state
read_list Array_too_long max_length e state
| (Obj (Req { encoding = e })) -> read_rec e state
| (Obj (Dft { encoding = e })) -> read_rec e state
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
@ -303,13 +303,13 @@ and read_variable_pair
(left, right)
| _ -> assert false (* Should be rejected by [Encoding.Kind.combine] *)
and read_list : type a. int -> a Encoding.t -> state -> a list
= fun max_length e state ->
and read_list : type a. read_error -> int -> a Encoding.t -> state -> a list
= fun error max_length e state ->
let rec loop max_length acc =
if state.remaining_bytes = 0 then
List.rev acc
else if max_length = 0 then
raise Oversized_list
raise error
else
let v = read_rec e state in
loop (max_length - 1) (v :: acc) in

View File

@ -27,7 +27,7 @@ and layout =
| Bytes
| String
| Enum of Binary_size.integer * string
| Seq of layout (* For arrays and lists *)
| Seq of layout * int option (* For arrays and lists *)
| Ref of string
| Padding
@ -115,8 +115,16 @@ module Printer_ast = struct
Format.fprintf ppf "%a encoding an enumeration (see %s)"
pp_int (size :> integer_extended)
reference
| Seq (Ref reference) -> Format.fprintf ppf "sequence of $%s" reference
| Seq data -> Format.fprintf ppf "sequence of %a" pp_layout data
| Seq (data, len) ->
Format.fprintf ppf "sequence of " ;
begin match len with
| None -> ()
| Some len -> Format.fprintf ppf "at most %d " len
end ;
begin match data with
| Ref reference -> Format.fprintf ppf "$%s" reference
| _ -> pp_layout ppf data
end
let pp_tag_size ppf tag =
@ -387,13 +395,14 @@ module Encoding = struct
(fun (size, cases, _) -> Enum (size, cases)) ;
case ~title:"Seq"
(Tag 9)
(obj2
(obj3
(req "layout" layout)
(req "kind" (constant "Seq")))
(req "kind" (constant "Seq"))
(opt "max_length" int31))
(function
| Seq layout -> Some (layout, ())
| Seq (layout, len) -> Some (layout, (), len)
| _ -> None)
(fun (layout, ()) -> Seq layout) ;
(fun (layout, (), len) -> Seq (layout, len)) ;
case ~title:"Ref"
(Tag 10)
(obj2

View File

@ -27,7 +27,7 @@ and layout =
| Bytes
| String
| Enum of Binary_size.integer * string
| Seq of layout (* For arrays and lists *)
| Seq of layout * int option (* For arrays and lists *)
| Ref of string
| Padding

View File

@ -261,11 +261,11 @@ let rec read_rec
Atom.string_enum arr resume state k
| Array (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
read_list max_length e state @@ fun (l, state) ->
read_list Array_too_long max_length e state @@ fun (l, state) ->
k (Array.of_list l, state)
| List (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
read_list max_length e state k
read_list List_too_long max_length e state k
| (Obj (Req { encoding = e })) -> read_rec whole e state k
| (Obj (Dft { encoding = e })) -> read_rec whole e state k
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
@ -398,14 +398,14 @@ and read_variable_pair
and read_list
: type a ret.
int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
= fun max_length e state k ->
read_error -> int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
= fun error max_length e state k ->
let rec loop state acc max_length =
let size = remaining_bytes state in
if size = 0 then
k (List.rev acc, state)
else if max_length = 0 then
raise Oversized_list
raise error
else
read_rec false e state @@ fun (v, state) ->
loop state (v :: acc) (max_length - 1) in

View File

@ -226,11 +226,11 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
| String_enum (tbl, arr) ->
Atom.string_enum tbl arr state value
| Array (Some max_length, _e) when Array.length value > max_length ->
raise Oversized_list
raise Array_too_long
| Array (_, e) ->
Array.iter (write_rec e state) value
| List (Some max_length, _e) when List.length value > max_length ->
raise Oversized_list
raise List_too_long
| List (_, e) ->
List.iter (write_rec e state) value
| Obj (Req { encoding = e }) -> write_rec e state value

View File

@ -169,6 +169,9 @@ module Encoding: sig
- encoded as the concatenation of all the element in binary
prefixed its length in bytes
If [max_length] is passed and the encoding of elements has fixed
size, a {!check_size} is automatically added for earlier rejection.
@raise [Invalid_argument] if the inner encoding is variable. *)
val array : ?max_length:int -> 'a encoding -> 'a array encoding
@ -177,6 +180,9 @@ module Encoding: sig
- encoded as the concatenation of all the element in binary
prefixed its length in bytes
If [max_length] is passed and the encoding of elements has fixed
size, a {!check_size} is automatically added for earlier rejection.
@raise [Invalid_argument] if the inner encoding is also variable. *)
val list : ?max_length:int -> 'a encoding -> 'a list encoding
@ -633,7 +639,8 @@ module Binary: sig
| Invalid_float of { min : float ; v : float ; max : float }
| Trailing_zero
| Size_limit_exceeded
| Oversized_list
| List_too_long
| Array_too_long
exception Read_error of read_error
val pp_read_error: Format.formatter -> read_error -> unit
@ -646,7 +653,8 @@ module Binary: sig
| Invalid_bytes_length of { expected : int ; found : int }
| Invalid_string_length of { expected : int ; found : int }
| Invalid_natural
| Oversized_list
| List_too_long
| Array_too_long
val pp_write_error : Format.formatter -> write_error -> unit
exception Write_error of write_error