Data_encoding: cosmetic fixes

src/lib_data_encoding/binary_description.ml

@@ -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)
+          (Seq (descr, len), references)
-      | List (_, data) ->
+      | 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

src/lib_data_encoding/binary_error.ml

@@ -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 ->
+  | List_too_long ->
-      Format.fprintf ppf "Size limit exceeded"
+      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 ->
+  | List_too_long ->
-      Format.fprintf ppf "Size limit exceeded"
+      Format.fprintf ppf "List length limit exceeded"
+  | Array_too_long ->
+      Format.fprintf ppf "Array length limit exceeded"
 
 exception Write_error of write_error

src/lib_data_encoding/binary_error.mli

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

src/lib_data_encoding/binary_length.ml

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

src/lib_data_encoding/binary_reader.ml

@@ -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
+and read_list : type a. read_error -> int -> a Encoding.t -> state -> a list
-  = fun max_length e state ->
+  = 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

src/lib_data_encoding/binary_schema.ml

@@ -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, len) ->
-    | Seq data -> Format.fprintf ppf "sequence of %a" pp_layout data
+        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

src/lib_data_encoding/binary_schema.mli

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

src/lib_data_encoding/binary_stream_reader.ml

@@ -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
+    read_error -> int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
-  = fun max_length e state k ->
+  = 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

src/lib_data_encoding/binary_writer.ml

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

src/lib_data_encoding/data_encoding.mli

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