Data_encoding: allow to add padding

src/lib_data_encoding/binary_description.ml

@@ -66,7 +66,8 @@ let fixup_references uf =
       | RangedFloat (_, _)
       | Float
       | Bytes
-      | String) as enc -> enc in
+      | String
+      | Padding) as enc -> enc in
   let field = function
     | Named_field (name, kind, layout) ->
         Named_field (name, kind, fixup_layout layout)
@@ -308,6 +309,9 @@ let describe (type x) (encoding : x Encoding.t) =
           ([ Anonymous_field ((kind :> Kind.t), Bytes) ], references)
       | String kind ->
           ([ Anonymous_field ((kind :> Kind.t), String) ], references)
+      | Padded ({ encoding = e }, n) ->
+          let fields, references = fields ref_name recursives references e in
+          (fields @ [ Named_field ("padding", `Fixed n, Padding) ], references)
       | (String_enum (tbl, encoding_array) as encoding) ->
           let size, cases = enum tbl encoding_array in
           let name = may_new_reference ref_name in
@@ -422,6 +426,11 @@ let describe (type x) (encoding : x Encoding.t) =
           (Bytes, references)
       | String _kind ->
           (String, references)
+      | Padded _ as enc ->
+          let name = may_new_reference ref_name in
+          let fields, references = fields None recursives references enc in
+          let references = add_reference name (obj fields) references in
+          (Ref name, references)
       | String_enum (tbl, encoding_array) ->
           let name = may_new_reference ref_name in
           let size, cases = enum tbl encoding_array in

src/lib_data_encoding/binary_length.ml

@@ -39,6 +39,7 @@ let rec length : type x. x Encoding.t -> x -> int =
     | RangedFloat _ -> Binary_size.float
     | Bytes `Fixed n -> n
     | String `Fixed n -> n
+    | Padded (e, n) -> length e value + n
     | String_enum (_, arr) ->
         Binary_size.integer_to_size @@ Binary_size.enum_size arr
     | Objs { kind = `Fixed n } -> n

src/lib_data_encoding/binary_reader.ml

@@ -180,6 +180,10 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret
     | String (`Fixed n) -> Atom.fixed_length_string n state
     | String `Variable ->
         Atom.fixed_length_string state.remaining_bytes state
+    | Padded (e, n) ->
+        let v = read_rec e state in
+        ignore (Atom.fixed_length_string n state : string) ;
+        v
     | RangedInt { minimum ; maximum }  ->
         Atom.ranged_int ~minimum ~maximum state
     | RangedFloat { minimum ; maximum } ->

src/lib_data_encoding/binary_schema.ml

@@ -29,6 +29,7 @@ and layout =
   | Enum of Binary_size.integer * string
   | Seq of layout (* For arrays and lists *)
   | Ref of string
+  | Padding
 
 and fields = field_descr list
 
@@ -108,6 +109,8 @@ module Printer_ast = struct
         Format.fprintf ppf "bytes"
     | Ref reference ->
         Format.fprintf ppf "$%s" reference
+    | Padding ->
+        Format.fprintf ppf "padding"
     | Enum (size, reference) ->
         Format.fprintf ppf "%a encoding an enumeration (see %s)"
           pp_int (size :> integer_extended)
@@ -395,11 +398,19 @@ module Encoding = struct
              (Tag 10)
              (obj2
                 (req "name" string)
-                (req "kind" (constant "Float")))
+                (req "kind" (constant "Ref")))
              (function
                | Ref layout -> Some (layout, ())
                | _ -> None)
-             (fun (name, ()) -> Ref name)
+             (fun (name, ()) -> Ref name) ;
+           case ~title:"Padding"
+             (Tag 11)
+             (obj1
+                (req "kind" (constant "Padding")))
+             (function
+               | Padding -> Some ()
+               | _ -> None)
+             (fun () -> Padding) ;
          ])
 
   let kind_enum_cases =

src/lib_data_encoding/binary_schema.mli

@@ -29,6 +29,7 @@ and layout =
   | Enum of Binary_size.integer * string
   | Seq of layout (* For arrays and lists *)
   | Ref of string
+  | Padding
 
 and fields = field_descr list
 

src/lib_data_encoding/binary_stream_reader.ml

@@ -207,6 +207,14 @@ module Atom = struct
 
 end
 
+let rec skip n state k =
+  let resume buffer =
+    let stream = Binary_stream.push buffer state.stream in
+    try skip n { state with stream } k
+    with Read_error err -> Error err in
+  Atom.fixed_length_string n resume state @@ fun (_, state : string * _) ->
+  k state
+
 (** Main recursive reading function, in continuation passing style. *)
 let rec read_rec
   : type next ret.
@@ -242,6 +250,9 @@ let rec read_rec
     | String `Variable ->
         let size = remaining_bytes state in
         Atom.fixed_length_string size resume state k
+    | Padded (e, n) ->
+        read_rec e state @@ fun (v, state) ->
+        skip n state @@ (fun state -> k (v, state))
     | RangedInt { minimum ; maximum }  ->
         Atom.ranged_int ~minimum ~maximum resume state k
     | RangedFloat { minimum ; maximum } ->

src/lib_data_encoding/binary_writer.ml

@@ -216,6 +216,9 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
     | String `Variable ->
         let length = String.length value in
         Atom.fixed_kind_string length state value
+    | Padded (e, n) ->
+        write_rec e state value ;
+        Atom.fixed_kind_string n state (String.make n '\000')
     | RangedInt { minimum ; maximum } ->
         Atom.ranged_int ~minimum ~maximum state value
     | RangedFloat { minimum ; maximum } ->

src/lib_data_encoding/data_encoding.mli

@@ -402,6 +402,7 @@ module Encoding: sig
   module Fixed : sig
     val string : int -> string encoding
     val bytes : int -> MBytes.t encoding
+    val add_padding : 'a encoding -> int -> 'a encoding
   end
 
   (** Create encodings that produce data of a variable length when binary encoded.

src/lib_data_encoding/encoding.ml

@@ -83,6 +83,7 @@ type 'a desc =
   | Float : float desc
   | Bytes : Kind.length -> MBytes.t 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
@@ -187,6 +188,11 @@ and classify_desc : type a. a desc -> Kind.t = fun e ->
   (* Tagged *)
   | Bytes kind -> (kind :> Kind.t)
   | String kind -> (kind :> Kind.t)
+  | Padded ({ encoding }, n) -> begin
+      match classify_desc encoding with
+      | `Fixed m -> `Fixed (n+m)
+      | _ -> assert false (* by construction (see [Fixed.padded]) *)
+    end
   | String_enum (_, cases) ->
       `Fixed Binary_size.(integer_to_size @@ enum_size cases)
   | Obj (Opt { kind }) -> (kind :> Kind.t)
@@ -214,14 +220,19 @@ let make ?json_encoding encoding = { encoding ; json_encoding }
 module Fixed = struct
   let string n =
     if n <= 0 then
-      invalid_arg "Cannot create a string encoding fo negative or null fixed length."
+      invalid_arg "Cannot create a string encoding of negative or null fixed length." ;
-    else
+    make @@ String (`Fixed n)
-      make @@ String (`Fixed n)
   let bytes n =
     if n <= 0 then
-      invalid_arg "Cannot create a byte encoding fo negative or null fixed length."
+      invalid_arg "Cannot create a byte encoding of negative or null fixed length." ;
-    else
+    make @@ Bytes (`Fixed n)
-      make @@ Bytes (`Fixed n)
+  let add_padding e n =
+    if n <= 0 then
+      invalid_arg "Cannot create a padding of negative or null fixed length." ;
+    match classify e with
+    | `Fixed _ ->
+        make @@ Padded (e, n)
+    | _ -> invalid_arg "Cannot pad non-fixed size encoding"
 end
 
 let rec is_zeroable: type t. t encoding -> bool = fun e ->
@@ -250,6 +261,7 @@ let rec is_zeroable: type t. t encoding -> bool = fun e ->
   | Float -> false
   | Bytes _ -> false
   | String _ -> false
+  | Padded _ -> false
   | String_enum _ -> false
   (* true in some cases, but in practice always protected by Dynamic *)
   | Array _ -> true (* 0-element array *)
@@ -584,6 +596,7 @@ let rec is_nullable: type t. t encoding -> bool = fun e ->
   | Float -> false
   | Bytes _ -> false
   | String _ -> false
+  | Padded (e, _) -> is_nullable e
   | String_enum _ -> false
   | Array _ -> false
   | List _ -> false

src/lib_data_encoding/encoding.mli

@@ -41,6 +41,7 @@ type 'a desc =
   | Float : float desc
   | Bytes : Kind.length -> MBytes.t 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
@@ -148,6 +149,7 @@ val is_tup : 'a encoding -> bool
 module Fixed : sig
   val string : int -> string encoding
   val bytes : int -> MBytes.t encoding
+  val add_padding : 'a encoding -> int -> 'a encoding
 end
 module Variable : sig
   val string : string encoding

src/lib_data_encoding/json.ml

@@ -186,6 +186,7 @@ let rec json : type a. a Encoding.desc -> a Json_encoding.encoding =
         s in
       conv check check string
   | String _ -> string
+  | Padded (e, _) -> get_json e
   | Bytes (`Fixed expected) ->
       let check s =
         let found = MBytes.length s in

src/lib_protocol_environment/sigs/v1/data_encoding.mli

@@ -48,6 +48,7 @@ val string_enum : (string * 'a) list -> 'a encoding
 module Fixed : sig
   val string : int -> string encoding
   val bytes : int -> MBytes.t encoding
+  val add_padding : 'a encoding -> int -> 'a encoding
 end
 
 module Variable : sig