diff --git a/src/lib_data_encoding/binary_description.ml b/src/lib_data_encoding/binary_description.ml index b74a0b956..62f776d8d 100644 --- a/src/lib_data_encoding/binary_description.ml +++ b/src/lib_data_encoding/binary_description.ml @@ -295,12 +295,12 @@ 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 (_, { encoding }) -> let (layout, references) = layout None recursives references encoding in ([ Anonymous_field (`Variable, Seq layout) ], references) - | Array { encoding } -> + | Array (_, { encoding }) -> let (layout, references) = layout None recursives references encoding in ([ Anonymous_field (`Variable, Seq layout) ], @@ -436,11 +436,11 @@ 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 (_, data) -> let (descr, references) = layout None recursives references data.encoding in (Seq descr, references) - | List data -> + | List (_, data) -> let layout, references = layout None recursives references data.encoding in (Seq layout, references) diff --git a/src/lib_data_encoding/binary_error.ml b/src/lib_data_encoding/binary_error.ml index 6677d3e70..c45fd148a 100644 --- a/src/lib_data_encoding/binary_error.ml +++ b/src/lib_data_encoding/binary_error.ml @@ -17,6 +17,7 @@ type read_error = | Invalid_float of { min : float ; v : float ; max : float } | Trailing_zero | Size_limit_exceeded + | Oversized_list let pp_read_error ppf = function | Not_enough_data -> @@ -37,6 +38,8 @@ 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" exception Read_error of read_error @@ -48,6 +51,7 @@ type write_error = | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } | Invalid_natural + | Oversized_list let pp_write_error ppf = function | Size_limit_exceeded -> @@ -68,5 +72,7 @@ let pp_write_error ppf = function expected found | Invalid_natural -> Format.fprintf ppf "Negative natural" + | Oversized_list -> + Format.fprintf ppf "Size limit exceeded" exception Write_error of write_error diff --git a/src/lib_data_encoding/binary_error.mli b/src/lib_data_encoding/binary_error.mli index 51b0122bd..565a29366 100644 --- a/src/lib_data_encoding/binary_error.mli +++ b/src/lib_data_encoding/binary_error.mli @@ -20,6 +20,7 @@ type read_error = | Invalid_float of { min : float ; v : float ; max : float } | Trailing_zero | Size_limit_exceeded + | Oversized_list exception Read_error of read_error val pp_read_error: Format.formatter -> read_error -> unit @@ -31,6 +32,7 @@ type write_error = | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } | Invalid_natural + | Oversized_list val pp_write_error : Format.formatter -> write_error -> unit diff --git a/src/lib_data_encoding/binary_length.ml b/src/lib_data_encoding/binary_length.ml index 92ba5bd93..2cb1dbe90 100644 --- a/src/lib_data_encoding/binary_length.ml +++ b/src/lib_data_encoding/binary_length.ml @@ -71,11 +71,15 @@ let rec length : type x. x Encoding.t -> x -> int = | Ignore -> 0 | Bytes `Variable -> MBytes.length value | String `Variable -> String.length value - | Array e -> + | Array (Some max_length, _e) when Array.length value > max_length -> + raise (Write_error Oversized_list) + | Array (_, e) -> Array.fold_left (fun acc v -> length e v + acc) 0 value - | List e -> + | List (Some max_length, _e) when List.length value > max_length -> + raise (Write_error Oversized_list) + | List (_, e) -> List.fold_left (fun acc v -> length e v + acc) 0 value diff --git a/src/lib_data_encoding/binary_reader.ml b/src/lib_data_encoding/binary_reader.ml index e08f05fcf..1241bd46c 100644 --- a/src/lib_data_encoding/binary_reader.ml +++ b/src/lib_data_encoding/binary_reader.ml @@ -190,10 +190,13 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret Atom.ranged_float ~minimum ~maximum state | String_enum (_, arr) -> Atom.string_enum arr state - | Array e -> - let l = read_list e state in + | Array (max_length, e) -> + let max_length = Option.unopt ~default:max_int max_length in + let l = read_list max_length e state in Array.of_list l - | List e -> read_list e state + | List (max_length, e) -> + let max_length = Option.unopt ~default:max_int max_length in + read_list 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 })) -> @@ -300,15 +303,17 @@ and read_variable_pair (left, right) | _ -> assert false (* Should be rejected by [Encoding.Kind.combine] *) -and read_list : type a. a Encoding.t -> state -> a list - = fun e state -> - let rec loop acc = +and read_list : type a. int -> a Encoding.t -> state -> a list + = fun 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 else let v = read_rec e state in - loop (v :: acc) in - loop [] + loop (max_length - 1) (v :: acc) in + loop max_length [] diff --git a/src/lib_data_encoding/binary_stream_reader.ml b/src/lib_data_encoding/binary_stream_reader.ml index f322cd49b..e1d399ce6 100644 --- a/src/lib_data_encoding/binary_stream_reader.ml +++ b/src/lib_data_encoding/binary_stream_reader.ml @@ -259,10 +259,13 @@ let rec read_rec Atom.ranged_float ~minimum ~maximum resume state k | String_enum (_, arr) -> Atom.string_enum arr resume state k - | Array e -> - read_list e state @@ fun (l, state) -> + | Array (max_length, e) -> + let max_length = Option.unopt ~default:max_int max_length in + read_list max_length e state @@ fun (l, state) -> k (Array.of_list l, state) - | List e -> read_list e state k + | List (max_length, e) -> + let max_length = Option.unopt ~default:max_int max_length in + read_list 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 })) -> @@ -395,16 +398,18 @@ and read_variable_pair and read_list : type a ret. - a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status - = fun e state k -> - let rec loop state acc = + int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status + = fun 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 else read_rec false e state @@ fun (v, state) -> - loop state (v :: acc) in - loop state [] + loop state (v :: acc) (max_length - 1) in + loop state [] max_length let read_rec e state k = try read_rec false e state k diff --git a/src/lib_data_encoding/binary_writer.ml b/src/lib_data_encoding/binary_writer.ml index 7ff235fc2..bd2064af3 100644 --- a/src/lib_data_encoding/binary_writer.ml +++ b/src/lib_data_encoding/binary_writer.ml @@ -225,9 +225,13 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit = Atom.ranged_float ~minimum ~maximum state value | String_enum (tbl, arr) -> Atom.string_enum tbl arr state value - | Array e -> + | Array (Some max_length, _e) when Array.length value > max_length -> + raise Oversized_list + | Array (_, e) -> Array.iter (write_rec e state) value - | List e -> + | List (Some max_length, _e) when List.length value > max_length -> + raise Oversized_list + | List (_, e) -> List.iter (write_rec e state) value | Obj (Req { encoding = e }) -> write_rec e state value | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index cf41e6617..3822fecb0 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -170,7 +170,7 @@ module Encoding: sig prefixed its length in bytes @raise [Invalid_argument] if the inner encoding is variable. *) - val array : 'a encoding -> 'a array encoding + val array : ?max_length:int -> 'a encoding -> 'a array encoding (** List combinator. - encoded as an array in JSON @@ -178,7 +178,7 @@ module Encoding: sig prefixed its length in bytes @raise [Invalid_argument] if the inner encoding is also variable. *) - val list : 'a encoding -> 'a list encoding + val list : ?max_length:int -> 'a encoding -> 'a list encoding (** Provide a transformer from one encoding to a different one. @@ -419,16 +419,18 @@ module Encoding: sig (** Create encodings that produce data of a variable length when binary encoded. See the preamble for an explanation. *) module Variable : sig + val string : string encoding val bytes : MBytes.t encoding (** @raises [Invalid_argument] if the encoding argument is variable length or may lead to zero-width representation in binary. *) - val array : 'a encoding -> 'a array encoding + val array : ?max_length:int -> 'a encoding -> 'a array encoding (** @raises [Invalid_argument] if the encoding argument is variable length or may lead to zero-width representation in binary. *) - val list : 'a encoding -> 'a list encoding + val list : ?max_length:int -> 'a encoding -> 'a list encoding + end module Bounded : sig @@ -631,6 +633,7 @@ module Binary: sig | Invalid_float of { min : float ; v : float ; max : float } | Trailing_zero | Size_limit_exceeded + | Oversized_list exception Read_error of read_error val pp_read_error: Format.formatter -> read_error -> unit @@ -643,6 +646,7 @@ module Binary: sig | Invalid_bytes_length of { expected : int ; found : int } | Invalid_string_length of { expected : int ; found : int } | Invalid_natural + | Oversized_list val pp_write_error : Format.formatter -> write_error -> unit exception Write_error of write_error diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index 73060c00c..704ff48ca 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -85,8 +85,8 @@ type 'a desc = | String : Kind.length -> string desc | Padded : 'a t * int -> 'a desc | String_enum : ('a, string * int) Hashtbl.t * 'a array -> 'a desc - | Array : 'a t -> 'a array desc - | List : 'a t -> 'a list desc + | Array : int option * 'a t -> 'a array desc + | List : int option * 'a t -> 'a list desc | Obj : 'a field -> 'a desc | Objs : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc | Tup : 'a t -> 'a desc @@ -303,14 +303,24 @@ module Variable = struct "Cannot insert potentially zero-sized element in %s." name else () - let array e = + let array ?max_length e = check_not_variable "an array" e ; check_not_zeroable "an array" e ; - make @@ Array e - let list e = + let encoding = make @@ Array (max_length, e) in + match classify e, max_length with + | `Fixed n, Some max_length -> + let limit = n * max_length in + make @@ Check_size { limit ; encoding } + | _, _ -> encoding + let list ?max_length e = check_not_variable "a list" e ; check_not_zeroable "a list" e ; - make @@ List e + let encoding = make @@ List (max_length, e) in + match classify e, max_length with + | `Fixed n, Some max_length -> + let limit = n * max_length in + make @@ Check_size { limit ; encoding } + | _, _ -> encoding end let dynamic_size ?(kind = `Uint30) e = @@ -350,8 +360,8 @@ let float = make @@ Float let string = dynamic_size Variable.string let bytes = dynamic_size Variable.bytes -let array e = dynamic_size (Variable.array e) -let list e = dynamic_size (Variable.list e) +let array ?max_length e = dynamic_size (Variable.array ?max_length e) +let list ?max_length e = dynamic_size (Variable.list ?max_length e) let string_enum = function | [] -> invalid_arg "data_encoding.string_enum: cannot have zero cases" diff --git a/src/lib_data_encoding/encoding.mli b/src/lib_data_encoding/encoding.mli index de74a3ecb..d56e5aa0e 100644 --- a/src/lib_data_encoding/encoding.mli +++ b/src/lib_data_encoding/encoding.mli @@ -43,8 +43,8 @@ type 'a desc = | String : Kind.length -> string desc | Padded : 'a t * int -> 'a desc | String_enum : ('a, string * int) Hashtbl.t * 'a array -> 'a desc - | Array : 'a t -> 'a array desc - | List : 'a t -> 'a list desc + | Array : int option * 'a t -> 'a array desc + | List : int option * 'a t -> 'a list desc | Obj : 'a field -> 'a desc | Objs : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc | Tup : 'a t -> 'a desc @@ -154,8 +154,8 @@ end module Variable : sig val string : string encoding val bytes : MBytes.t encoding - val array : 'a encoding -> 'a array encoding - val list : 'a encoding -> 'a list encoding + val array : ?max_length:int -> 'a encoding -> 'a array encoding + val list : ?max_length:int -> 'a encoding -> 'a list encoding end val dynamic_size : ?kind:Binary_size.unsigned_integer -> 'a encoding -> 'a encoding @@ -248,8 +248,8 @@ val tup10 : val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding val merge_tups : 'a1 encoding -> 'a2 encoding -> ('a1 * 'a2) encoding -val array : 'a encoding -> 'a array encoding -val list : 'a encoding -> 'a list encoding +val array : ?max_length:int -> 'a encoding -> 'a array encoding +val list : ?max_length:int -> 'a encoding -> 'a list encoding val case : title:string -> diff --git a/src/lib_data_encoding/json.ml b/src/lib_data_encoding/json.ml index 247c72186..2891142e5 100644 --- a/src/lib_data_encoding/json.ml +++ b/src/lib_data_encoding/json.ml @@ -199,8 +199,8 @@ let rec json : type a. a Encoding.desc -> a Json_encoding.encoding = conv check check bytes_jsont | Bytes _ -> bytes_jsont | String_enum (tbl, _) -> string_enum (Hashtbl.fold (fun a (str, _) acc -> (str, a) :: acc) tbl []) - | Array e -> array (get_json e) - | List e -> list (get_json e) + | Array (_, e) -> array (get_json e) (* FIXME TODO enforce max_length *) + | List (_, e) -> list (get_json e) | Obj f -> obj1 (field_json f) | Objs { left ; right } -> merge_objs (get_json left) (get_json right) diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli index 6abd1d811..99ee369be 100644 --- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli +++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli @@ -54,8 +54,8 @@ end module Variable : sig val string : string encoding val bytes : MBytes.t encoding - val array : 'a encoding -> 'a array encoding - val list : 'a encoding -> 'a list encoding + val array : ?max_length: int -> 'a encoding -> 'a array encoding + val list : ?max_length: int -> 'a encoding -> 'a list encoding end module Bounded : sig @@ -159,8 +159,8 @@ val tup10 : val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding val merge_tups : 'a1 encoding -> 'a2 encoding -> ('a1 * 'a2) encoding -val array : 'a encoding -> 'a array encoding -val list : 'a encoding -> 'a list encoding +val array : ?max_length: int -> 'a encoding -> 'a array encoding +val list : ?max_length: int -> 'a encoding -> 'a list encoding val assoc : 'a encoding -> (string * 'a) list encoding