Utils: add Data_encoding.delayed

This allows a better representation for `Error_monad.error_encoding`,
capturing the side-effect of new error registration.

src/environment/v1/error_monad.mli

@@ -16,7 +16,7 @@ type error = ..
 val pp : Format.formatter -> error -> unit
 
 (** A JSON error serializer *)
-val error_encoding : unit -> error Data_encoding.t
+val error_encoding : error Data_encoding.t
 val json_of_error : error -> Data_encoding.json
 val error_of_json : Data_encoding.json -> error
 

src/minutils/data_encoding.ml

@@ -152,6 +152,7 @@ type 'a desc =
       { encoding : 'a t ;
         json_encoding : 'a Json_encoding.encoding } -> 'a desc
   | Dynamic_size : 'a t -> 'a desc
+  | Delayed : (unit -> 'a t) -> 'a desc
 
 and _ field =
   | Req : string * 'a t -> 'a field
@@ -209,6 +210,7 @@ let rec classify : type a l. a t -> Kind.t = fun e ->
   | Def { encoding } -> classify encoding
   | Splitted { encoding } -> classify encoding
   | Dynamic_size _ -> `Dynamic
+  | Delayed f -> classify (f ())
 
 let make ?json_encoding encoding = { encoding ; json_encoding }
 
@@ -357,6 +359,7 @@ module Json = struct
     | Union (_tag_size, _, cases) -> union (List.map case_json cases)
     | Splitted { json_encoding } -> json_encoding
     | Dynamic_size e -> get_json e
+    | Delayed f -> get_json (f ())
 
   and field_json
     : type a l. a field -> a Json_encoding.field =
@@ -434,6 +437,9 @@ module Encoding = struct
   let dynamic_size e =
     make @@ Dynamic_size e
 
+  let delayed f =
+    make @@ Delayed f
+
   let null = make @@ Null
   let empty = make @@ Empty
   let unit = make @@ Ignore
@@ -838,6 +844,7 @@ let rec length : type x. x t -> x -> int = fun e ->
     | Dynamic_size e ->
         let length = length e in
         fun v -> Size.int32 + length v
+    | Delayed f -> length (f ())
 
   (** Writer *)
 
@@ -1000,6 +1007,7 @@ let rec length : type x. x t -> x -> int = fun e ->
         and write = write_rec e in
         fun v buf ofs ->
           int32 (Int32.of_int @@ length v) buf ofs |> write v buf
+    | Delayed f -> write_rec (f ())
 
   let write t v buf ofs =
     try Some (write_rec t v buf ofs)
@@ -1217,6 +1225,7 @@ let rec length : type x. x t -> x -> int = fun e ->
           let sz = Int32.to_int sz in
           if sz < 0 then raise (Invalid_size sz);
           read buf ofs sz
+    | Delayed f -> read_rec (f ())
 
   let read t buf ofs len =
     try Some (read_rec t buf ofs len)
@@ -1513,6 +1522,8 @@ let rec length : type x. x t -> x -> int = fun e ->
               if sz < 0 then raise (Invalid_size sz) ;
               data_checker path e buf sz
 
+          | Delayed f -> data_checker path (f ()) buf len
+
         with Need_more_data ->
           P_await { path ; encoding = e ; data_len = len }, buf
 

src/minutils/data_encoding.mli

@@ -64,6 +64,8 @@ end
 
 val dynamic_size : 'a encoding -> 'a encoding
 
+val delayed : (unit -> 'a encoding) -> 'a encoding
+
 val json : json encoding
 val json_schema : json_schema encoding
 

src/node/shell/node_rpc.ml

@@ -427,7 +427,7 @@ let build_rpc_directory node =
   let dir =
     let implementation () =
       RPC.Answer.return
-        Data_encoding.Json.(schema (Error_monad.error_encoding ())) in
+        Data_encoding.Json.(schema Error_monad.error_encoding) in
     RPC.register0 dir Services.Error.service implementation in
   let dir =
     RPC.register1 dir Services.complete

src/node/updater/updater.ml

@@ -183,7 +183,7 @@ module WrapProtocol
             "@[<v 2>Economic error:@ %a@]"
             (Format.pp_print_list Env.Error_monad.pp))
       Data_encoding.(obj1 (req "ecoproto"
-                             (list (Env.Error_monad.error_encoding ()))))
+                             (list Env.Error_monad.error_encoding)))
       (function Ecoproto_error ecoerrors -> Some ecoerrors
               | _ -> None )
       (function ecoerrors -> Ecoproto_error ecoerrors)

src/proto/alpha/services_registration.ml

@@ -139,7 +139,7 @@ let () =
 let () =
   register1_noctxt Services.Constants.errors
     (fun () ->
-       Lwt.return (Data_encoding.Json.(schema (error_encoding ()))))
+       Lwt.return (Data_encoding.Json.(schema error_encoding)))
 
 (*-- Context -----------------------------------------------------------------*)
 

src/utils/error_monad.ml

@@ -117,10 +117,12 @@ module Make() = struct
         encoding
     | Some encoding -> encoding
 
+  let error_encoding = Data_encoding.delayed error_encoding
+
   let json_of_error error =
-    Data_encoding.Json.(construct (error_encoding ())) error
+    Data_encoding.Json.construct error_encoding error
   let error_of_json json =
-    Data_encoding.Json.(destruct (error_encoding ())) json
+    Data_encoding.Json.destruct error_encoding json
 
   let classify_error error =
     let rec find e = function
@@ -166,7 +168,7 @@ module Make() = struct
     let open Data_encoding in
     let errors_encoding =
       describe ~title: "An erroneous result" @@
-      obj1 (req "error" (list (error_encoding ()))) in
+      obj1 (req "error" (list error_encoding)) in
     let t_encoding =
       describe ~title: "A successful result" @@
       obj1 (req "result" t_encoding) in

src/utils/error_monad_sig.ml

@@ -22,7 +22,7 @@ module type S = sig
   val pp_print_error: Format.formatter -> error list -> unit
 
   (** An error serializer *)
-  val error_encoding : unit -> error Data_encoding.t
+  val error_encoding : error Data_encoding.t
   val json_of_error : error -> Data_encoding.json
   val error_of_json : Data_encoding.json -> error