Client refactor: use the error_monad for all RPC services

src/lib_base/protocol_environment.ml

@@ -182,32 +182,11 @@ module MakeV1
   module Data_encoding = Data_encoding
   module Time = Time
   module Ed25519 = Ed25519
-  module S = struct
+  module S = S
-    include S
-  end
-  module Block_hash = Block_hash
-  module Operation_hash = Operation_hash
-  module Operation_list_hash = Operation_list_hash
-  module Operation_list_list_hash = Operation_list_list_hash
-  module Context_hash = Context_hash
-  module Protocol_hash = Protocol_hash
-  module Blake2B = Blake2B
-  module Fitness = Fitness
-  module Operation = Operation
-  module Block_header = Block_header
-  module Protocol = Protocol
-  module RPC_arg = RPC_arg
-  module RPC_path = RPC_path
-  module RPC_query = RPC_query
-  module RPC_service = RPC_service
-  module RPC_answer = RPC_answer
-  module RPC_directory = RPC_directory
   module Error_monad = struct
     type error_category = [ `Branch | `Temporary | `Permanent ]
     include Error_monad.Make()
   end
-  module Micheline = Micheline
-  module Logging = Logging.Make(Param)
 
   type error += Ecoproto_error of Error_monad.error list
 
@@ -231,6 +210,114 @@ module MakeV1
     | Ok _ as ok -> ok
     | Error errors -> Error [Ecoproto_error errors]
 
+  module Block_hash = Block_hash
+  module Operation_hash = Operation_hash
+  module Operation_list_hash = Operation_list_hash
+  module Operation_list_list_hash = Operation_list_list_hash
+  module Context_hash = Context_hash
+  module Protocol_hash = Protocol_hash
+  module Blake2B = Blake2B
+  module Fitness = Fitness
+  module Operation = Operation
+  module Block_header = Block_header
+  module Protocol = Protocol
+  module RPC_arg = RPC_arg
+  module RPC_path = RPC_path
+  module RPC_query = RPC_query
+  module RPC_service = RPC_service
+  module RPC_answer = struct
+
+    type 'o t =
+      [ `Ok of 'o (* 200 *)
+      | `OkStream of 'o stream (* 200 *)
+      | `Created of string option (* 201 *)
+      | `No_content (* 204 *)
+      | `Unauthorized of Error_monad.error list option (* 401 *)
+      | `Forbidden of Error_monad.error list option (* 403 *)
+      | `Not_found of Error_monad.error list option (* 404 *)
+      | `Conflict of Error_monad.error list option (* 409 *)
+      | `Error of Error_monad.error list option (* 500 *)
+      ]
+
+    and 'a stream = 'a Resto_directory.Answer.stream = {
+      next: unit -> 'a option Lwt.t ;
+      shutdown: unit -> unit ;
+    }
+
+    let return x = Lwt.return (`Ok x)
+    let return_stream x = Lwt.return (`OkStream x)
+    let not_found = Lwt.return (`Not_found None)
+
+    let fail err = Lwt.return (`Error (Some err))
+  end
+  module RPC_directory = struct
+    include RPC_directory
+    let register dir service handler =
+      gen_register dir service
+        (fun p q i ->
+           handler p q i >>= function
+           | `Ok o -> RPC_answer.return o
+           | `OkStream s -> RPC_answer.return_stream s
+           | `Created s -> Lwt.return (`Created s)
+           | `No_content -> Lwt.return (`No_content)
+           | `Unauthorized e ->
+               let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
+               Lwt.return (`Unauthorized e)
+           | `Forbidden e ->
+               let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
+               Lwt.return (`Forbidden e)
+           | `Not_found e ->
+               let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
+               Lwt.return (`Not_found e)
+           | `Conflict e ->
+               let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
+               Lwt.return (`Conflict e)
+           | `Error e ->
+               let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
+               Lwt.return (`Error e))
+
+    (*
+    let tz_register dir service handler =
+      register dir service
+        (fun p q i ->
+           handler p q i >>= function
+           | Ok o -> RPC_answer.return o
+           | Error e -> RPC_answer.fail e)
+
+    let lwt_register dir service handler =
+      register dir service
+        (fun p q i ->
+           handler p q i >>= fun o ->
+           RPC_answer.return o)
+*)
+    open Curry
+
+    let register0 root s f = register root s (curry Z f)
+    let register1 root s f = register root s (curry (S Z) f)
+    let register2 root s f = register root s (curry (S (S Z)) f)
+    let register3 root s f = register root s (curry (S (S (S Z))) f)
+    let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
+    let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
+
+    (*
+    let tz_register0 root s f = tz_register root s (curry Z f)
+    let tz_register1 root s f = tz_register root s (curry (S Z) f)
+    let tz_register2 root s f = tz_register root s (curry (S (S Z)) f)
+    let tz_register3 root s f = tz_register root s (curry (S (S (S Z))) f)
+    let tz_register4 root s f = tz_register root s (curry (S (S (S (S Z)))) f)
+    let tz_register5 root s f = tz_register root s (curry (S (S (S (S (S Z))))) f)
+
+    let lwt_register0 root s f = lwt_register root s (curry Z f)
+    let lwt_register1 root s f = lwt_register root s (curry (S Z) f)
+    let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f)
+    let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f)
+    let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f)
+    let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f)
+*)
+  end
+  module Micheline = Micheline
+  module Logging = Logging.Make(Param)
+
   module Updater = struct
 
     include Updater

src/lib_client_base/client_generic_rpcs.ml

@@ -193,7 +193,7 @@ let rec count =
 
 let list url (cctxt : Client_commands.full_context) =
   let args = String.split '/' url in
-  Shell_services.describe cctxt
+  RPC_description.describe cctxt
     ~recurse:true args >>=? fun tree ->
   let open RPC_description in
   let collected_args = ref [] in
@@ -293,7 +293,7 @@ let list url (cctxt : Client_commands.full_context) =
 let schema url (cctxt : Client_commands.full_context) =
   let args = String.split '/' url in
   let open RPC_description in
-  Shell_services.describe cctxt ~recurse:false args >>=? function
+  RPC_description.describe cctxt ~recurse:false args >>=? function
   | Static { services } -> begin
       match RPC_service.MethMap.find `POST services with
       | exception Not_found ->
@@ -318,7 +318,7 @@ let schema url (cctxt : Client_commands.full_context) =
 let format url (cctxt : #Client_commands.logging_rpcs) =
   let args = String.split '/' url in
   let open RPC_description in
-  Shell_services.describe cctxt ~recurse:false args >>=? function
+  RPC_description.describe cctxt ~recurse:false args >>=? function
   | Static { services } -> begin
       match RPC_service.MethMap.find `POST services with
       | exception Not_found ->
@@ -369,7 +369,7 @@ let display_answer (cctxt : #Client_commands.full_context) = function
 let call raw_url (cctxt : #Client_commands.full_context) =
   let uri = Uri.of_string raw_url in
   let args = String.split_path (Uri.path uri) in
-  Shell_services.describe cctxt ~recurse:false args >>=? function
+  RPC_description.describe cctxt ~recurse:false args >>=? function
   | Static { services } -> begin
       match RPC_service.MethMap.find `POST services with
       | exception Not_found ->

src/lib_protocol_environment_sigs/v1/RPC_answer.mli

@@ -13,11 +13,11 @@ type 'o t =
   | `OkStream of 'o stream (* 200 *)
   | `Created of string option (* 201 *)
   | `No_content (* 204 *)
-  | `Unauthorized of unit option (* 401 *)
+  | `Unauthorized of error list option (* 401 *)
-  | `Forbidden of unit option (* 403 *)
+  | `Forbidden of error list option (* 403 *)
-  | `Not_found of unit option (* 404 *)
+  | `Not_found of error list option (* 404 *)
-  | `Conflict of unit option (* 409 *)
+  | `Conflict of error list option (* 409 *)
-  | `Error of unit option (* 500 *)
+  | `Error of error list option (* 500 *)
   ]
 
 and 'a stream = {
@@ -27,3 +27,5 @@ and 'a stream = {
 
 val return: 'o -> 'o t Lwt.t
 val return_stream: 'o stream -> 'o t Lwt.t
+val not_found: 'o t Lwt.t
+val fail: error list -> 'a t Lwt.t

src/lib_protocol_environment_sigs/v1/RPC_service.mli

@@ -16,33 +16,11 @@ type meth = [
   | `PATCH
 ]
 
-module MethMap : Map.S with type key = meth
-
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t
   constraint 'meth = [< meth ]
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
   ('meth, 'prefix, 'params, 'query, 'input, 'output) t
 
-val query:
-  ('meth, 'prefix, 'params, 'query, 'input, 'output) service ->
-  'query RPC_query.t
-
-type _ input =
-  | No_input : unit input
-  | Input : 'input Data_encoding.t -> 'input input
-
-val input_encoding:
-  ('meth, 'prefix, 'params, 'query, 'input, 'output) service ->
-  'input input
-
-val output_encoding:
-  ('meth, 'prefix, 'params, 'query, 'input, 'output) service ->
-  'output Data_encoding.t
-
-val error_encoding:
-  ('meth, 'prefix, 'params, 'query, 'input, 'output) service ->
-  unit Data_encoding.t
-
 val get_service:
   ?description: string ->
   query: 'query RPC_query.t ->

src/lib_rpc/RPC_answer.ml

@@ -13,11 +13,11 @@ type 'o t =
   | `OkStream of 'o stream (* 200 *)
   | `Created of string option (* 201 *)
   | `No_content (* 204 *)
-  | `Unauthorized of unit option (* 401 *)
+  | `Unauthorized of RPC_service.error option (* 401 *)
-  | `Forbidden of unit option (* 403 *)
+  | `Forbidden of RPC_service.error option (* 403 *)
-  | `Not_found of unit option (* 404 *)
+  | `Not_found of RPC_service.error option (* 404 *)
-  | `Conflict of unit option (* 409 *)
+  | `Conflict of RPC_service.error option (* 409 *)
-  | `Error of unit option (* 500 *)
+  | `Error of RPC_service.error option (* 500 *)
   ]
 
 and 'a stream = 'a Resto_directory.Answer.stream = {
@@ -27,3 +27,6 @@ and 'a stream = 'a Resto_directory.Answer.stream = {
 
 let return x = Lwt.return (`Ok x)
 let return_stream x = Lwt.return (`OkStream x)
+
+let not_found = Lwt.return (`Not_found None)
+let fail err = Lwt.return (`Error (Some err))

src/lib_rpc/RPC_answer.mli

@@ -13,11 +13,11 @@ type 'o t =
   | `OkStream of 'o stream (* 200 *)
   | `Created of string option (* 201 *)
   | `No_content (* 204 *)
-  | `Unauthorized of unit option (* 401 *)
+  | `Unauthorized of RPC_service.error option (* 401 *)
-  | `Forbidden of unit option (* 403 *)
+  | `Forbidden of RPC_service.error option (* 403 *)
-  | `Not_found of unit option (* 404 *)
+  | `Not_found of RPC_service.error option (* 404 *)
-  | `Conflict of unit option (* 409 *)
+  | `Conflict of RPC_service.error option (* 409 *)
-  | `Error of unit option (* 500 *)
+  | `Error of RPC_service.error option (* 500 *)
   ]
 
 and 'a stream = 'a Resto_directory.Answer.stream = {
@@ -27,3 +27,6 @@ and 'a stream = 'a Resto_directory.Answer.stream = {
 
 val return: 'o -> 'o t Lwt.t
 val return_stream: 'o stream -> 'o t Lwt.t
+val not_found: 'o t Lwt.t
+
+val fail: Error_monad.error list -> 'a t Lwt.t

src/lib_rpc/RPC_context.ml

@@ -60,12 +60,16 @@ let of_directory (dir : unit RPC_directory.t) : t = object
           | None -> shutdown () ; not_found s p q
         end
       | `Not_found None -> not_found s p q
-      | `Unauthorized _
+      | `Unauthorized (Some err)
-      | `Error _
+      | `Forbidden (Some err)
-      | `Not_found _
+      | `Not_found (Some err)
-      | `Forbidden _
+      | `Conflict (Some err)
+      | `Error (Some err) -> Lwt.return_error err
+      | `Unauthorized None
+      | `Error None
+      | `Forbidden None
       | `Created _
-      | `Conflict _
+      | `Conflict None
       | `No_content -> generic_error s p q
   method call_streamed_service : 'm 'p 'q 'i 'o.
     ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
@@ -85,12 +89,16 @@ let of_directory (dir : unit RPC_directory.t) : t = object
           on_chunk v ; on_close () ;
           return (fun () -> ())
       | `Not_found None -> not_found s p q
-      | `Unauthorized _
+      | `Unauthorized (Some err)
-      | `Error _
+      | `Forbidden (Some err)
-      | `Not_found (Some _)
+      | `Not_found (Some err)
-      | `Forbidden _
+      | `Conflict (Some err)
+      | `Error (Some err) -> Lwt.return_error err
+      | `Unauthorized None
+      | `Error None
+      | `Forbidden None
       | `Created _
-      | `Conflict _
+      | `Conflict None
       | `No_content -> generic_error s p q
 end
 
@@ -99,11 +107,6 @@ let make_call1 s ctxt x = make_call s ctxt ((), x)
 let make_call2 s ctxt x y = make_call s ctxt (((), x), y)
 let make_call3 s ctxt x y z = make_call s ctxt ((((), x), y), z)
 
-let make_err_call s ctxt p q i =
-  make_call s ctxt p q i >>=? Lwt.return
-let make_err_call1 s ctxt x = make_err_call s ctxt ((), x)
-let make_err_call2 s ctxt x y = make_err_call s ctxt (((), x), y)
-
 type stopper = unit -> unit
 
 let make_streamed_call s (ctxt : #streamed) p q i =

src/lib_rpc/RPC_context.mli

@@ -54,18 +54,6 @@ val make_call3 :
   ([< Resto.meth ], unit, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
   #simple -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
 
-val make_err_call :
-  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o tzresult) RPC_service.t ->
-  #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
-
-val make_err_call1 :
-  ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o tzresult) RPC_service.t ->
-  #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
-
-val make_err_call2 :
-  ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o tzresult) RPC_service.t ->
-  #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
-
 type stopper = unit -> unit
 
 val make_streamed_call :

src/lib_rpc/RPC_description.ml

@@ -9,3 +9,6 @@
 
 include Resto.Description
 
+let describe ctxt ?(recurse = false) path =
+  RPC_context.make_call1
+    RPC_service.description_service ctxt path { recurse } ()

src/lib_rpc/RPC_description.mli

@@ -7,4 +7,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 include (module type of struct include Resto.Description end)
+
+val describe:
+  #RPC_context.simple ->
+  ?recurse:bool ->
+  string list ->
+  Json_schema.schema directory tzresult Lwt.t
+

src/lib_rpc/RPC_directory.ml

@@ -7,4 +7,56 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 include Resto_directory.Make(RPC_encoding)
+
+let gen_register dir service handler =
+  register dir service
+    (fun p q i ->
+       Lwt.catch
+         (fun () -> handler p q i)
+         (function
+           | Not_found -> RPC_answer.not_found
+           | exn -> RPC_answer.fail [Exn exn]))
+
+let gen_register =
+  (gen_register
+   : _ -> _ -> (_ -> _ -> _ -> _ RPC_answer.t Lwt.t) -> _
+   :> _ -> _ -> (_ -> _ -> _ -> [< _ RPC_answer.t ] Lwt.t) -> _)
+
+let register dir service handler =
+  gen_register dir service
+    (fun p q i ->
+       handler p q i >>= function
+       | Ok o -> RPC_answer.return o
+       | Error e -> RPC_answer.fail e)
+
+let lwt_register dir service handler =
+  gen_register dir service
+    (fun p q i ->
+       handler p q i >>= fun o ->
+       RPC_answer.return o)
+
+open Curry
+
+let register0 root s f = register root s (curry Z f)
+let register1 root s f = register root s (curry (S Z) f)
+let register2 root s f = register root s (curry (S (S Z)) f)
+let register3 root s f = register root s (curry (S (S (S Z))) f)
+let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
+let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
+
+let gen_register0 root s f = gen_register root s (curry Z f)
+let gen_register1 root s f = gen_register root s (curry (S Z) f)
+let gen_register2 root s f = gen_register root s (curry (S (S Z)) f)
+let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f)
+let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f)
+let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f)
+
+let lwt_register0 root s f = lwt_register root s (curry Z f)
+let lwt_register1 root s f = lwt_register root s (curry (S Z) f)
+let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f)
+let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f)
+let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f)
+let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f)

src/lib_rpc/RPC_directory.mli

@@ -7,48 +7,139 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 include module type of (struct include Resto_directory.Make(RPC_encoding) end)
 
 (** Registring handler in service tree. *)
 val register:
+  'prefix directory ->
+  ([< Resto.meth ], 'prefix, 'p, 'q, 'i, 'o) RPC_service.t ->
+  ('p -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val gen_register:
   'prefix directory ->
   ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
   ('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) ->
   'prefix directory
 
+val lwt_register:
+  'prefix directory ->
+  ([< Resto.meth ], 'prefix, 'p, 'q, 'i, 'o) RPC_service.t ->
+  ('p -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
 (** Registring handler in service tree. Curryfied variant.  *)
+
 val register0:
   unit directory ->
   ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
-  ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  ('q -> 'i -> 'o tzresult Lwt.t) ->
   unit directory
 
 val register1:
   'prefix directory ->
   ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
-  ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  ('a -> 'q -> 'i -> 'o tzresult Lwt.t) ->
   'prefix directory
 
 val register2:
   'prefix directory ->
   ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
-  ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  ('a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t) ->
   'prefix directory
 
 val register3:
   'prefix directory ->
   ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
-  ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t) ->
   'prefix directory
 
 val register4:
   'prefix directory ->
   ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
-  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o tzresult Lwt.t) ->
   'prefix directory
 
 val register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+
+val gen_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  unit directory
+
+val gen_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register5:
   'prefix directory ->
   ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
   ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
   'prefix directory
+
+
+val lwt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o Lwt.t) ->
+  unit directory
+
+val lwt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+

src/lib_rpc/RPC_error.ml

@@ -7,44 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let service =
+let list ctxt =
-  RPC_service.post_service
+  RPC_context.make_call RPC_service.error_service ctxt () () ()
-    ~description: "Schema for all the RPC errors from the shell"
-    ~query: RPC_query.empty
-    ~input: Data_encoding.empty
-    ~output: Data_encoding.json_schema
-    RPC_path.(root / "errors")
 
-let encoding =
+let encoding = RPC_service.error_encoding
-  let { RPC_service.meth ; uri ; _ } =
-    RPC_service.forge_request service () () in
-  let open Data_encoding in
-  describe
-    ~description:
-      (Printf.sprintf
-         "The full list of error is available with \
-          the global RPC `%s %s`"
-         (RPC_service.string_of_meth meth) (Uri.path_and_query uri))
-    (conv
-       ~schema:Json_schema.any
-       (fun exn -> `A (List.map Error_monad.json_of_error exn))
-       (function `A exns -> List.map Error_monad.error_of_json exns | _ -> [])
-       json)
-
-let wrap param_encoding =
-  let open Data_encoding in
-  union [
-    case (Tag 0)
-      (obj1 (req "ok" param_encoding))
-      (function Ok x -> Some x | _ -> None)
-      (fun x -> Ok x) ;
-    case (Tag 1)
-      (obj1 (req "error" encoding))
-      (function Error x -> Some x | _ -> None)
-      (fun x -> Error x) ;
-  ]
-
-module F = struct
-  open RPC_context
-  let schema ctxt = make_call service ctxt () () ()
-end

src/lib_rpc/RPC_error.mli

@@ -9,12 +9,6 @@
 
 open Error_monad
 
-val service:
+val list: #RPC_context.simple -> Json_schema.schema tzresult Lwt.t
-  ([ `POST ], unit, unit, unit, unit, Json_schema.schema) RPC_service.t
-val encoding: error list Data_encoding.t
-val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
 
-module F : sig
+val encoding: error list Data_encoding.t
-  open RPC_context
-  val schema: #simple -> Json_schema.schema tzresult Lwt.t
-end

src/lib_rpc/RPC_service.ml

@@ -28,12 +28,14 @@ type (+'m,'pr,'p,'q,'i,'o, 'e) raw =
   ('m,'pr,'p,'q,'i,'o, 'e) Resto.MakeService(RPC_encoding).t
   constraint 'meth = [< meth ]
 
+type error = Error_monad.error list
+
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t =
-  ('meth, 'prefix, 'params, 'query, 'input, 'output, unit) raw
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
   constraint 'meth = [< meth ]
 
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
-  ('meth, 'prefix, 'params, 'query, 'input, 'output, unit) raw
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
   constraint 'meth = [< meth ]
 
 include (Resto.MakeService(RPC_encoding)
@@ -42,8 +44,47 @@ include (Resto.MakeService(RPC_encoding)
               and type (+'m,'pr,'p,'q,'i,'o, 'e) service := ('m,'pr,'p,'q,'i,'o, 'e) raw)
         )
 
-let get_service = get_service ~error:Data_encoding.empty
+
-let post_service = post_service ~error:Data_encoding.empty
+let error_path = ref None
-let delete_service = delete_service ~error:Data_encoding.empty
+
-let patch_service = patch_service ~error:Data_encoding.empty
+let error_encoding =
-let put_service = put_service ~error:Data_encoding.empty
+  let open Data_encoding in
+  delayed begin fun () ->
+    let { meth ; uri ; _ } =
+      match !error_path with
+      | None -> assert false
+      | Some p -> p in
+    describe
+      ~description:
+        (Printf.sprintf
+           "The full list of error is available with \
+            the global RPC `%s %s`"
+           (string_of_meth meth) (Uri.path_and_query uri))
+      (conv
+         ~schema:Json_schema.any
+         (fun exn -> `A (List.map Error_monad.json_of_error exn))
+         (function `A exns -> List.map Error_monad.error_of_json exns | _ -> [])
+         json)
+  end
+
+let get_service = get_service ~error:error_encoding
+let post_service = post_service ~error:error_encoding
+let delete_service = delete_service ~error:error_encoding
+let patch_service = patch_service ~error:error_encoding
+let put_service = put_service ~error:error_encoding
+
+let error_service =
+  post_service
+    ~description: "Schema for all the RPC errors from the shell"
+    ~query: RPC_query.empty
+    ~input: Data_encoding.empty
+    ~output: Data_encoding.json_schema
+    RPC_path.(root / "errors")
+
+let () = error_path := Some (forge_request error_service () ())
+
+let description_service =
+  description_service
+    ~description: "RPCs documentation and input/output schema"
+    error_encoding
+    RPC_path.(root / "describe")

src/lib_rpc/RPC_service.mli

@@ -19,12 +19,14 @@ type (+'m,'pr,'p,'q,'i,'o, 'e) raw =
   ('m,'pr,'p,'q,'i,'o, 'e) Resto.MakeService(RPC_encoding).t
   constraint 'meth = [< meth ]
 
+type error = Error_monad.error list
+
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t =
-  ('meth, 'prefix, 'params, 'query, 'input, 'output, unit) raw
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
   constraint 'meth = [< meth ]
 
 type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
-  ('meth, 'prefix, 'params, 'query, 'input, 'output, unit) raw
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
   constraint 'meth = [< meth ]
 
 include (module type of struct include Resto.MakeService(RPC_encoding) end
@@ -68,3 +70,15 @@ val put_service:
   output: 'output Data_encoding.t ->
   ('prefix, 'params) RPC_path.t ->
   ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output) service
+
+
+(**/**)
+
+val description_service:
+  ([ `GET ], unit, unit * string list, Resto.Description.request,
+   unit, Json_schema.schema Resto.Description.directory) service
+
+val error_service:
+  ([ `POST ], unit, unit, unit, unit, Json_schema.schema) service
+
+val error_encoding: error Data_encoding.t

src/lib_rpc_http/RPC_client.ml

@@ -331,8 +331,10 @@ let handle accept (meth, uri, ans) =
   | `Ok (Some v) -> return v
   | `Ok None -> request_failed meth uri Empty_answer
   | `Not_found None -> fail (RPC_context.Not_found { meth ; uri })
-  | `Conflict _ | `Error _ | `Forbidden _ | `Unauthorized _
+  | `Conflict (Some err) | `Error (Some err)
-  | `Not_found (Some _) ->
+  | `Forbidden (Some err) | `Unauthorized (Some err)
+  | `Not_found (Some err) -> Lwt.return_error err
+  | `Conflict None | `Error None | `Forbidden None | `Unauthorized None ->
       fail (RPC_context.Generic_error { meth ; uri })
   | `Unexpected_status_code (code, (content, _, media_type)) ->
       let media_type = Option.map media_type ~f:Media_type.name in

src/lib_shell/node_rpc.ml

@@ -40,63 +40,63 @@ let register_bi_dir node dir =
   let dir =
     let implementation b () include_ops =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return (filter_bi include_ops bi) in
+      return (filter_bi include_ops bi) in
     RPC_directory.register1 dir
       Block_services.S.info implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.hash in
+      return bi.hash in
     RPC_directory.register1 dir
       Block_services.S.hash
       implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.net_id in
+      return bi.net_id in
     RPC_directory.register1 dir
       Block_services.S.net_id implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.level in
+      return bi.level in
     RPC_directory.register1 dir
       Block_services.S.level implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.predecessor in
+      return bi.predecessor in
     RPC_directory.register1 dir
       Block_services.S.predecessor implementation in
   let dir =
     let implementation b () len =
       Node.RPC.block_info node b >>= fun bi ->
       Node.RPC.predecessors node len bi.hash >>= fun hashes ->
-      RPC_answer.return hashes in
+      return hashes in
     RPC_directory.register1 dir
       Block_services.S.predecessors implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.fitness in
+      return bi.fitness in
     RPC_directory.register1 dir
       Block_services.S.fitness implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.timestamp in
+      return bi.timestamp in
     RPC_directory.register1 dir
       Block_services.S.timestamp implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.protocol in
+      return bi.protocol in
     RPC_directory.register1 dir
       Block_services.S.protocol implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
-      RPC_answer.return bi.test_network in
+      return bi.test_network in
     RPC_directory.register1 dir
       Block_services.S.test_network implementation in
   let dir =
@@ -114,12 +114,12 @@ let register_bi_dir node dir =
             RPC_answer.return @@
             List.map (List.map (fun h -> h, None)) hashes
     in
-    RPC_directory.register1 dir
+    RPC_directory.gen_register1 dir
       Block_services.S.operations implementation in
   let dir =
     let implementation b () () =
       Node.RPC.pending_operations node b >>= fun res ->
-      RPC_answer.return res in
+      return res in
     RPC_directory.register1 dir
       Block_services.S.pending_operations
       implementation in
@@ -129,11 +129,9 @@ let register_bi_dir node dir =
         { Block_services.S.operations ; sort_operations ;
           timestamp ; proto_header} =
       Node.RPC.preapply node b
-        ~timestamp ~proto_header ~sort_operations operations >>= function
+        ~timestamp ~proto_header ~sort_operations operations
-      | Ok (shell_header, operations) ->
+      >>=? fun (shell_header, operations) ->
-          RPC_answer.return
+      return { Block_services.shell_header ; operations } in
-            (Ok { Block_services.shell_header ; operations })
-      | Error _ as err -> RPC_answer.return err in
     RPC_directory.register1 dir
       Block_services.S.preapply implementation in
   dir
@@ -324,12 +322,10 @@ let list_blocks
   end
 
 let list_invalid node () () =
-  Node.RPC.list_invalid node >>= fun l ->
+  Node.RPC.list_invalid node >>= return
-  RPC_answer.return l
 
 let unmark_invalid node block () () =
-  Node.RPC.unmark_invalid node block >>= fun x ->
+  Node.RPC.unmark_invalid node block
-  RPC_answer.return x
 
 let list_protocols node () { Protocol_services.S.monitor ; contents } =
   let monitor = match monitor with None -> false | Some x -> x in
@@ -363,14 +359,12 @@ let list_protocols node () { Protocol_services.S.monitor ; contents } =
     RPC_answer.return_stream { next ; shutdown }
 
 let get_protocols node hash () () =
-  Node.RPC.protocol_content node hash >>= function
+  Node.RPC.protocol_content node hash
-  | Ok bytes -> RPC_answer.return bytes
-  | Error _ -> raise Not_found
 
 let build_rpc_directory node =
   let dir = RPC_directory.empty in
   let dir =
-    RPC_directory.register0 dir Block_services.S.list
+    RPC_directory.gen_register0 dir Block_services.S.list
       (list_blocks node) in
   let dir =
     RPC_directory.register0 dir Block_services.S.list_invalid
@@ -391,7 +385,7 @@ let build_rpc_directory node =
         "All the RPCs which are specific to the protocol version."
       dir Block_services.S.proto_path implementation in
   let dir =
-    RPC_directory.register0 dir Protocol_services.S.list
+    RPC_directory.gen_register0 dir Protocol_services.S.list
       (list_protocols node) in
   let dir =
     RPC_directory.register1 dir Protocol_services.S.contents
@@ -401,7 +395,7 @@ let build_rpc_directory node =
       let res =
         Data_encoding.Binary.to_bytes Block_header.encoding header in
       RPC_answer.return res in
-    RPC_directory.register0 dir Shell_services.S.forge_block_header
+    RPC_directory.gen_register0 dir Shell_services.S.forge_block_header
       implementation in
   let dir =
     let implementation ()
@@ -411,7 +405,7 @@ let build_rpc_directory node =
           node ~force
           raw operations >>=? fun (hash, wait) ->
         (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC_answer.return in
+      end in
     RPC_directory.register0 dir Shell_services.S.inject_block implementation in
   let dir =
     let implementation () (contents, blocking, net_id) =
@@ -419,39 +413,36 @@ let build_rpc_directory node =
         node ?net_id contents >>= fun (hash, wait) ->
       begin
         (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC_answer.return in
+      end in
     RPC_directory.register0 dir Shell_services.S.inject_operation implementation in
   let dir =
     let implementation () (proto, blocking, force) =
       Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) ->
       begin
         (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC_answer.return in
+      end in
     RPC_directory.register0 dir Shell_services.S.inject_protocol implementation in
   let dir =
     let implementation () () =
       RPC_answer.return_stream (Node.RPC.bootstrapped node) in
-    RPC_directory.register0 dir Shell_services.S.bootstrapped implementation in
+    RPC_directory.gen_register0 dir Shell_services.S.bootstrapped implementation in
   let dir =
     let implementation () () =
-      RPC_answer.return
+      return Data_encoding.Json.(schema Error_monad.error_encoding) in
-        Data_encoding.Json.(schema Error_monad.error_encoding) in
+    RPC_directory.register0 dir RPC_service.error_service implementation in
-    RPC_directory.register0 dir RPC_error.service implementation in
   let dir =
     RPC_directory.register1 dir Shell_services.S.complete
-      (fun s () () ->
+      (fun s () () -> Node.RPC.complete node s >>= return) in
-         Node.RPC.complete node s >>= RPC_answer.return) in
   let dir =
     RPC_directory.register2 dir Block_services.S.complete
-      (fun block s () () ->
+      (fun block s () () -> Node.RPC.complete node ~block s >>= return) in
-         Node.RPC.complete node ~block s >>= RPC_answer.return) in
 
   (* Workers : Prevalidators *)
 
   let dir  =
     RPC_directory.register0 dir Worker_services.Prevalidators.S.list
       (fun () () ->
-         RPC_answer.return
+         return
            (List.map
               (fun (id, w) -> (id, Prevalidator.status w))
               (Prevalidator.running_workers ()))) in
@@ -459,7 +450,7 @@ let build_rpc_directory node =
     RPC_directory.register1 dir Worker_services.Prevalidators.S.state
       (fun net_id () () ->
          let w = List.assoc net_id (Prevalidator.running_workers ()) in
-         RPC_answer.return
+         return
            { Worker_types.status = Prevalidator.status w ;
              pending_requests = Prevalidator.pending_requests w ;
              backlog = Prevalidator.last_events w ;
@@ -471,7 +462,7 @@ let build_rpc_directory node =
     RPC_directory.register0 dir Worker_services.Block_validator.S.state
       (fun () () ->
          let w = Block_validator.running_worker () in
-         RPC_answer.return
+         return
            { Worker_types.status = Block_validator.status w ;
              pending_requests = Block_validator.pending_requests w ;
              backlog = Block_validator.last_events w ;
@@ -482,7 +473,7 @@ let build_rpc_directory node =
   let dir  =
     RPC_directory.register1 dir Worker_services.Peer_validators.S.list
       (fun net_id () () ->
-         RPC_answer.return
+         return
            (List.filter_map
               (fun ((id, peer_id), w) ->
                  if Net_id.equal id net_id then
@@ -493,7 +484,7 @@ let build_rpc_directory node =
     RPC_directory.register2 dir Worker_services.Peer_validators.S.state
       (fun net_id peer_id () () ->
          let w = List.assoc (net_id, peer_id) (Peer_validator.running_workers ()) in
-         RPC_answer.return
+         return
            { Worker_types.status = Peer_validator.status w ;
              pending_requests = [] ;
              backlog = Peer_validator.last_events w ;
@@ -504,7 +495,7 @@ let build_rpc_directory node =
   let dir  =
     RPC_directory.register0 dir Worker_services.Net_validators.S.list
       (fun () () ->
-         RPC_answer.return
+         return
            (List.map
               (fun (id, w) -> (id, Net_validator.status w))
               (Net_validator.running_workers ()))) in
@@ -512,7 +503,7 @@ let build_rpc_directory node =
     RPC_directory.register1 dir Worker_services.Net_validators.S.state
       (fun net_id () () ->
          let w = List.assoc net_id (Net_validator.running_workers ()) in
-         RPC_answer.return
+         return
            { Worker_types.status = Net_validator.status w ;
              pending_requests = Net_validator.pending_requests w ;
              backlog = Net_validator.last_events w ;
@@ -521,11 +512,11 @@ let build_rpc_directory node =
   (* Network : Global *)
 
   let dir =
-    let implementation () () = Node.RPC.Network.stat node |> RPC_answer.return in
+    let implementation () () = Node.RPC.Network.stat node |> return in
     RPC_directory.register0 dir P2p_services.S.stat implementation in
   let dir =
     let implementation () () =
-      RPC_answer.return Distributed_db.Raw.supported_versions in
+      return Distributed_db.Raw.supported_versions in
     RPC_directory.register0 dir P2p_services.S.versions implementation in
   let dir =
     let implementation () () =
@@ -533,10 +524,10 @@ let build_rpc_directory node =
       let shutdown () = Lwt_watcher.shutdown stopper in
       let next () = Lwt_stream.get stream in
       RPC_answer.return_stream { next ; shutdown } in
-    RPC_directory.register0 dir P2p_services.S.events implementation in
+    RPC_directory.gen_register0 dir P2p_services.S.events implementation in
   let dir =
     let implementation point () timeout =
-      Node.RPC.Network.connect node point timeout >>= RPC_answer.return in
+      Node.RPC.Network.connect node point timeout in
     RPC_directory.register1 dir P2p_services.S.connect implementation in
 
   (* Network : Connection *)
@@ -545,28 +536,28 @@ let build_rpc_directory node =
     let implementation peer_id () () =
       match Node.RPC.Network.Connection.info node peer_id with
       | None -> raise Not_found
-      | Some v -> RPC_answer.return v in
+      | Some v -> return v in
     RPC_directory.register1 dir P2p_services.Connections.S.info implementation in
   let dir =
     let implementation peer_id () wait =
-      Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_answer.return in
+      Node.RPC.Network.Connection.kick node peer_id wait >>= return in
     RPC_directory.register1 dir P2p_services.Connections.S.kick implementation in
   let dir =
     let implementation () () =
-      Node.RPC.Network.Connection.list node |> RPC_answer.return in
+      Node.RPC.Network.Connection.list node |> return in
     RPC_directory.register0 dir P2p_services.Connections.S.list implementation in
 
   (* Network : Peer_id *)
 
   let dir =
     let implementation () state =
-      Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_answer.return in
+      Node.RPC.Network.Peer_id.list node ~restrict:state |> return in
     RPC_directory.register0 dir P2p_services.Peers.S.list implementation in
   let dir =
     let implementation peer_id () () =
       match Node.RPC.Network.Peer_id.info node peer_id with
       | None -> raise Not_found
-      | Some v -> RPC_answer.return v in
+      | Some v -> return v in
     RPC_directory.register1 dir P2p_services.Peers.S.info implementation in
   let dir =
     let implementation peer_id () monitor =
@@ -584,19 +575,19 @@ let build_rpc_directory node =
         RPC_answer.return_stream { next ; shutdown }
       else
         Node.RPC.Network.Peer_id.events node peer_id |> RPC_answer.return in
-    RPC_directory.register1 dir P2p_services.Peers.S.events implementation in
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.events implementation in
 
   (* Network : Point *)
 
   let dir =
     let implementation () state =
-      Node.RPC.Network.Point.list node ~restrict:state |> RPC_answer.return in
+      Node.RPC.Network.Point.list node ~restrict:state |> return in
     RPC_directory.register0 dir P2p_services.Points.S.list implementation in
   let dir =
     let implementation point () () =
       match Node.RPC.Network.Point.info node point with
       | None -> raise Not_found
-      | Some v -> RPC_answer.return v in
+      | Some v -> return v in
     RPC_directory.register1 dir P2p_services.Points.S.info implementation in
   let dir =
     let implementation point () monitor =
@@ -614,7 +605,7 @@ let build_rpc_directory node =
         RPC_answer.return_stream { next ; shutdown }
       else
         Node.RPC.Network.Point.events node point |> RPC_answer.return in
-    RPC_directory.register1 dir P2p_services.Points.S.events implementation in
+    RPC_directory.gen_register1 dir P2p_services.Points.S.events implementation in
   let dir =
-    RPC_directory.register_describe_directory_service dir Shell_services.S.describe in
+    RPC_directory.register_describe_directory_service dir RPC_service.description_service in
   dir

src/lib_shell_services/block_services.ml

@@ -303,7 +303,7 @@ module S = struct
          the given operations and return the resulting fitness."
       ~query: RPC_query.empty
       ~input: preapply_param_encoding
-      ~output: (RPC_error.wrap preapply_result_encoding)
+      ~output: preapply_result_encoding
       RPC_path.(block_path / "preapply")
 
   let complete =
@@ -416,7 +416,7 @@ module S = struct
         "Unmark an invalid block"
       ~query: RPC_query.empty
       ~input: Data_encoding.empty
-      ~output:(RPC_error.wrap Data_encoding.empty)
+      ~output: Data_encoding.empty
       RPC_path.(root / "invalid_blocks" /: Block_hash.rpc_arg / "unmark" )
 
 end
@@ -458,11 +458,11 @@ let complete ctxt b s =
   make_call2 S.complete ctxt b s () ()
 let preapply ctxt h
     ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
-  make_err_call1 S.preapply ctxt h ()
+  make_call1 S.preapply ctxt h ()
     { timestamp ; proto_header ; sort_operations = sort ; operations }
 
 let unmark_invalid ctxt h =
-  make_err_call1 S.unmark_invalid ctxt h () ()
+  make_call1 S.unmark_invalid ctxt h () ()
 
 let list_invalid ctxt =
   make_call S.list_invalid ctxt () () ()

src/lib_shell_services/block_services.mli

@@ -189,7 +189,7 @@ module S : sig
   val unmark_invalid:
     ([ `POST ], unit,
      unit * Block_hash.t, unit, unit,
-     unit tzresult) RPC_service.t
+     unit) RPC_service.t
 
   type preapply_param = {
     timestamp: Time.t ;
@@ -201,7 +201,7 @@ module S : sig
   val preapply:
     ([ `POST ], unit,
      unit * block, unit, preapply_param,
-     preapply_result tzresult) RPC_service.t
+     preapply_result) RPC_service.t
 
   val complete:
     ([ `POST ], unit,

src/lib_shell_services/p2p_services.ml

@@ -38,7 +38,7 @@ module S = struct
       ~description:"Connect to a peer"
       ~query: RPC_query.empty
       ~input: Data_encoding.(obj1 (dft "timeout" float 5.))
-      ~output: (RPC_error.wrap Data_encoding.empty)
+      ~output: Data_encoding.empty
       RPC_path.(root / "network" / "connect" /: P2p_point.Id.rpc_arg)
 
 end
@@ -48,7 +48,7 @@ let stat ctxt = make_call S.stat ctxt () () ()
 let versions ctxt = make_call S.versions ctxt () () ()
 let events ctxt = make_streamed_call S.events ctxt () () ()
 let connect ctxt ~timeout peer_id =
-  make_err_call1 S.connect ctxt peer_id () timeout
+  make_call1 S.connect ctxt peer_id () timeout
 
 let monitor_encoding = Data_encoding.(obj1 (dft "monitor" bool false))
 

src/lib_shell_services/p2p_services.mli

@@ -38,7 +38,7 @@ module S : sig
   val connect :
     ([ `POST ], unit,
      unit * P2p_point.Id.t, unit, float,
-     unit tzresult) RPC_service.t
+     unit) RPC_service.t
 
 end
 

src/lib_shell_services/shell_services.ml

@@ -66,9 +66,7 @@ module S = struct
          validated before answering."
       ~query: RPC_query.empty
       ~input: inject_block_param
-      ~output:
+      ~output: (obj1 (req "block_hash" Block_hash.encoding))
-        (RPC_error.wrap @@
-         (obj1 (req "block_hash" Block_hash.encoding)))
       RPC_path.(root / "inject_block")
 
   let inject_operation =
@@ -96,8 +94,7 @@ module S = struct
               true)
            (opt "net_id" Net_id.encoding))
       ~output:
-        (RPC_error.wrap @@
+        (describe
-         describe
            ~title: "Hash of the injected operation" @@
          (obj1 (req "injectedOperation" Operation_hash.encoding)))
       RPC_path.(root / "inject_operation")
@@ -124,8 +121,7 @@ module S = struct
                    "Should we inject protocol that is invalid. (default: false)"
                  bool)))
       ~output:
-        (RPC_error.wrap @@
+        (describe
-         describe
            ~title: "Hash of the injected protocol" @@
          (obj1 (req "injectedProtocol" Protocol_hash.encoding)))
       RPC_path.(root / "inject_protocol")
@@ -154,11 +150,6 @@ module S = struct
       ~output: (list string)
       RPC_path.(root / "complete" /: prefix_arg )
 
-  let describe =
-    RPC_service.description_service
-      ~description: "RPCs documentation and input/output schema"
-      RPC_path.(root / "describe")
-
 end
 
 open RPC_context
@@ -169,15 +160,15 @@ let forge_block_header ctxt header =
 let inject_block ctxt
     ?(async = false) ?(force = false) ?net_id
     raw operations =
-  make_err_call S.inject_block ctxt () ()
+  make_call S.inject_block ctxt () ()
     { raw ; blocking = not async ; force ; net_id ; operations }
 
 let inject_operation ctxt ?(async = false) ?net_id operation =
-  make_err_call S.inject_operation ctxt () ()
+  make_call S.inject_operation ctxt () ()
     (operation, not async, net_id)
 
 let inject_protocol ctxt ?(async = false) ?force protocol =
-  make_err_call S.inject_protocol ctxt () ()
+  make_call S.inject_protocol ctxt () ()
     (protocol, not async, force)
 
 let bootstrapped ctxt =
@@ -189,6 +180,3 @@ let complete ctxt ?block prefix =
       make_call1 S.complete ctxt prefix () ()
   | Some block ->
       Block_services.complete ctxt block prefix
-
-let describe ctxt ?(recurse = true) path =
-  make_call1 S.describe ctxt path { recurse } ()

src/lib_shell_services/shell_services.mli

@@ -45,11 +45,6 @@ val complete:
   #simple ->
   ?block:Block_services.block -> string -> string list tzresult Lwt.t
 
-val describe:
-  #simple ->
-  ?recurse:bool -> string list ->
-  Data_encoding.json_schema RPC_description.directory tzresult Lwt.t
-
 module S : sig
 
   val forge_block_header:
@@ -68,17 +63,17 @@ module S : sig
   val inject_block:
     ([ `POST ], unit,
      unit, unit, inject_block_param,
-     Block_hash.t tzresult) RPC_service.t
+     Block_hash.t) RPC_service.t
 
   val inject_operation:
     ([ `POST ], unit,
      unit, unit, (MBytes.t * bool * Net_id.t option),
-     Operation_hash.t tzresult) RPC_service.t
+     Operation_hash.t) RPC_service.t
 
   val inject_protocol:
     ([ `POST ], unit,
      unit, unit, (Protocol.t * bool * bool option),
-     Protocol_hash.t tzresult) RPC_service.t
+     Protocol_hash.t) RPC_service.t
 
   val bootstrapped:
     ([ `POST ], unit,
@@ -90,6 +85,4 @@ module S : sig
      unit * string, unit, unit,
      string list) RPC_service.t
 
-  val describe: (unit, unit) RPC_service.description_service
-
 end

vendors/ocplib-resto/lib_ezresto/ezResto.ml

@@ -49,4 +49,5 @@ module Description = Resto.Description
 type description_service =
   ([`GET], unit * string list, Description.request,
    unit, Json_schema.schema Description.directory, unit) service
-let description_service = description_service
+let description_service ?description path =
+  description_service ?description Json_encoding.empty path

vendors/ocplib-resto/lib_resto-cohttp/server.ml

@@ -327,7 +327,12 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
       and callback (io, con) req body =
         Lwt.catch
           begin fun () -> callback server (io, con) req body end
-          begin fun exn ->
+          begin function
+            | Not_found ->
+                let status = `Not_found in
+                let body = Cohttp_lwt.Body.empty in
+                Lwt.return (Response.make ~status (), body)
+            | exn ->
                 let headers = Header.init () in
                 let headers =
                   Header.add headers "content-type" "text/ocaml.exception" in

vendors/ocplib-resto/lib_resto-directory/resto_directory.ml

@@ -684,7 +684,7 @@ module Make (Encoding : ENCODING) = struct
   let register_describe_directory_service
     : type pr.
       pr directory ->
-      (pr, pr) Service.description_service ->
+      (pr, pr, _) Service.description_service ->
       pr directory
     = fun root service ->
       let dir = ref root in

vendors/ocplib-resto/lib_resto-directory/resto_directory.mli

@@ -174,7 +174,7 @@ module Make (Encoding : ENCODING) : sig
   (** Registring a description service. *)
   val register_describe_directory_service:
     'prefix directory ->
-    ('prefix, 'prefix) Service.description_service ->
+    ('prefix, 'prefix, 'error) Service.description_service ->
     'prefix directory
 
   (**/**)

vendors/ocplib-resto/lib_resto-directory/test/services.ml

@@ -54,7 +54,7 @@ let minus_service =
     Path.(open_root /: Arg.int / "minus")
 
 let describe_service =
-  description_service Path.(root / "describe")
+  description_service Json_encoding.empty Path.(root / "describe")
 
 let dummy_service =
   post_service

vendors/ocplib-resto/lib_resto/resto.ml

@@ -635,11 +635,11 @@ module MakeService(Encoding : ENCODING) = struct
       (_, pr, p, q, i, o, e) service -> e Encoding.t
     = fun { types } -> types.error
 
-  type ('prefix, 'params) description_service =
+  type ('prefix, 'params, 'error) description_service =
     ([ `GET ], 'prefix, 'params * string list, Description.request,
-     unit, Encoding.schema Description.directory, unit) service
+     unit, Encoding.schema Description.directory, 'error) service
 
-  let description_service ?description path =
+  let description_service ?description error path =
     let description =
       match description with
       | Some descr -> descr
@@ -649,7 +649,7 @@ module MakeService(Encoding : ENCODING) = struct
       ~description
       ~query:Description.request_query
       ~output:Encoding.description_answer_encoding
-      ~error:Encoding.unit
+      ~error
       Path.(path /:* Arg.string)
 
   type 'input request = {

vendors/ocplib-resto/lib_resto/resto.mli

@@ -345,14 +345,15 @@ module MakeService(Encoding : ENCODING) : sig
     ([< meth ] as 'm, 'p, (('p * 'a) * 'b) * 'c, 'q, 'i, 'o, 'e) service ->
     ('m, 'p2, (('p2 * 'a) * 'b) * 'c, 'q, 'i, 'o, 'e) service
 
-  type ('prefix, 'params) description_service =
+  type ('prefix, 'params, 'error) description_service =
     ([ `GET ], 'prefix, 'params * string list, Description.request,
-     unit, Encoding.schema Description.directory, unit) service
+     unit, Encoding.schema Description.directory, 'error) service
 
   val description_service:
     ?description:string ->
+    'error Encoding.t ->
     ('prefix, 'params) Path.t ->
-    ('prefix, 'params) description_service
+    ('prefix, 'params, 'error) description_service
 
   type 'input request = {
     meth: meth ;