Data_encoding: add bounded strings and bytes

src/lib_data_encoding/binary_size.ml

@@ -40,6 +40,7 @@ let signed_range_to_size min max : [> signed_integer ] =
 
 (* max should be centered at zero *)
 let unsigned_range_to_size max : [> unsigned_integer ] =
+  assert (max >= 0) ;
   if max <= 255
   then `Uint8
   else if max <= 65535

src/lib_data_encoding/binary_size.mli

@@ -37,5 +37,6 @@ val min_int: [< integer ] -> int
 val max_int: [< integer ] -> int
 
 val range_to_size: minimum:int -> maximum:int -> integer
+val unsigned_range_to_size: int -> unsigned_integer
 
 val enum_size: 'a array -> [> unsigned_integer ]

src/lib_data_encoding/data_encoding.ml

@@ -15,10 +15,57 @@ struct
     let json = Json_encoding.assoc (Json.convert enc) in
     let binary = list (tup2 string enc) in
     raw_splitted ~json ~binary
+
+  module Bounded = struct
+
+    let string length =
+      raw_splitted
+        ~binary: begin
+          let kind = Binary_size.unsigned_range_to_size length in
+          check_size (length + Binary_size.integer_to_size kind) @@
+          dynamic_size ~kind Variable.string
+        end
+        ~json: begin
+          let open Json_encoding in
+          conv
+            (fun s ->
+               if String.length s > length then invalid_arg "oversized string" ;
+               s)
+            (fun s ->
+               if String.length s > length then
+                 raise (Cannot_destruct ([], Invalid_argument "oversized string")) ;
+               s)
+            string
+        end
+
+    let bytes length =
+      raw_splitted
+        ~binary: begin
+          let kind = Binary_size.unsigned_range_to_size length in
+          check_size (length + Binary_size.integer_to_size kind) @@
+          dynamic_size ~kind Variable.bytes
+        end
+        ~json: begin
+          let open Json_encoding in
+          conv
+            (fun s ->
+               if MBytes.length s > length then invalid_arg "oversized string" ;
+               s)
+            (fun s ->
+               if MBytes.length s > length then
+                 raise (Cannot_destruct ([], Invalid_argument "oversized string")) ;
+               s)
+            Json.bytes_jsont
+        end
+
+  end
+
 end
 
 include Encoding
 
+
+
 module Json = Json
 module Bson = Bson
 module Binary = struct

src/lib_data_encoding/data_encoding.mli

@@ -412,6 +412,18 @@ module Encoding: sig
     val list : 'a encoding -> 'a list encoding
   end
 
+  module Bounded : sig
+    (** Encoding of a string whose length does not exceed the specified length
+        Attempting to construct a string with a length that is too long causes
+        an invalid_argument exception, however the size field will use the minimum
+        integer that can accomidate the maximum size.
+        - default variable in width
+        - encoded as a byte sequence in binary
+        - encoded as a string in JSON. *)
+    val string : int -> string encoding
+    val bytes : int -> MBytes.t encoding
+  end
+
   (** Mark an encoding as being of dynamic size.
       Forces the size to be stored alongside content when needed.
       Typically used to combine two variable encodings in a same

src/lib_data_encoding/json.mli

@@ -52,3 +52,5 @@ val from_string : string -> (json, string) result
 val from_stream : string Lwt_stream.t -> (json, string) result Lwt_stream.t
 val to_string : ?minify:bool -> json -> string
 val pp : Format.formatter -> json -> unit
+
+val bytes_jsont: MBytes.t Json_encoding.encoding

src/lib_data_encoding/test/read_failure.ml

@@ -175,8 +175,10 @@ let tests =
   all_ranged_float ~-. 100. 300. @
   all "string.fixed" ~expected:invalid_string_length
     string (Fixed.string 4) "turlututu" @
+  all "string.bounded" string (Bounded.string 4) "turlututu" @
   all "bytes.fixed"  ~expected:invalid_string_length
     bytes (Fixed.bytes 4) (MBytes.of_string "turlututu") @
+  all "bytes.bounded" bytes (Bounded.bytes 4) (MBytes.of_string "turlututu") @
   all "unknown_case.B" ~expected:missing_case union_enc mini_union_enc (B "2") @
   all "unknown_case.E" ~expected:missing_case union_enc mini_union_enc E @
   all "enum.missing" ~expected:missing_enum enum_enc mini_enum_enc 4 @

src/lib_data_encoding/test/success.ml

@@ -163,11 +163,15 @@ let tests =
   all "string" Alcotest.string string "tutu" @
   all "string.fixed" Alcotest.string (Fixed.string 4) "tutu" @
   all "string.variable" Alcotest.string Variable.string "tutu" @
+  all "string.bounded1" Alcotest.string (Bounded.string 4) "tu" @
+  all "string.bounded2" Alcotest.string (Bounded.string 4) "tutu" @
   all "bytes" Alcotest.bytes bytes (MBytes.of_string "titi") @
   all "bytes.fixed" Alcotest.bytes (Fixed.bytes 4)
     (MBytes.of_string "titi") @
   all "bytes.variable" Alcotest.bytes Variable.bytes
     (MBytes.of_string "titi") @
+  all "bytes.bounded1" Alcotest.bytes (Bounded.bytes 4) (MBytes.of_string "tu") @
+  all "bytes.bounded2" Alcotest.bytes (Bounded.bytes 4) (MBytes.of_string "tutu") @
   all "float" Alcotest.float float 42. @
   all "float.max" Alcotest.float float max_float @
   all "float.min" Alcotest.float float min_float @

src/lib_data_encoding/test/write_failure.ml

@@ -75,7 +75,9 @@ let tests =
   all_ranged_int ~-300_000_000 300_000_000 @
   all_ranged_float ~-. 100. 300. @
   all "string.fixed" (Fixed.string 4) "turlututu" @
+  all "string.bounded" (Bounded.string 4) "turlututu" @
   all "bytes.fixed" (Fixed.bytes 4) (MBytes.of_string "turlututu") @
+  all "bytes.bounded" (Bounded.bytes 4) (MBytes.of_string "turlututu") @
   all "unknown_case.B" mini_union_enc (B "2") @
   all "unknown_case.E" mini_union_enc E @
   test_bounded_string_list @

src/lib_protocol_environment/sigs/v1/data_encoding.mli

@@ -57,6 +57,11 @@ module Variable : sig
   val list : 'a encoding -> 'a list encoding
 end
 
+module Bounded : sig
+  val string : int -> string encoding
+  val bytes : int -> MBytes.t encoding
+end
+
 val dynamic_size :
   ?kind: [ `Uint30 | `Uint16 | `Uint8 ] ->
   'a encoding -> 'a encoding