RPC: remove the deprecated type RPC.service

2017-12-07 17:43:21 +01:00 · 2017-12-07 17:43:21 +01:00 · 7ac969beb1
commit 7ac969beb1
parent af8dd63e41
7 changed files with 183 additions and 97 deletions
--- a/lib_client_base/client_rpcs.ml
+++ b/lib_client_base/client_rpcs.ml
@ -202,16 +202,18 @@ class type rpc_sig = object
    Data_encoding.json ->
    ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
  method parse_answer :
-    (unit, 'b, 'c, 'd) RPC.service ->
+    'meth 'params 'input 'output.
+    ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC.Service.t ->
    string list ->
-    Data_encoding.json -> 'd tzresult Lwt.t
+    Data_encoding.json -> 'output tzresult Lwt.t
  method parse_err_answer :
-    (unit, 'e, 'f, 'g tzresult) RPC.service ->
+    'meth 'params 'input 'output.
+    ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC.Service.t ->
    string list ->
-    Data_encoding.json -> 'g tzresult Lwt.t
+    Data_encoding.json -> 'output tzresult Lwt.t
 end

-class rpc config = object (self)
+class rpc config : rpc_sig = object (self)
  val config = config
  method make_request :
    type a. (Uri.t -> Data_encoding.json -> a Lwt.t) ->
@ -272,9 +274,11 @@ class rpc config = object (self)
        logger.log_error reqid code ansbody >>= fun () ->
        fail config (Request_failed (service, err))

-  method parse_answer : type b c d. (unit, b, c, d) RPC.service ->
-    string list ->
-    Data_encoding.json -> d tzresult Lwt.t =
+  method parse_answer
+    : 'm 'p 'i 'o.
+      ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o, unit) RPC.Service.t ->
+      string list ->
+      Data_encoding.json -> 'o tzresult Lwt.t =
    fun service path json ->
      match Data_encoding.Json.destruct (RPC.Service.output_encoding service) json with
      | exception msg ->
@ -308,10 +312,11 @@ class rpc config = object (self)
          logger.log_error reqid code ansbody >>= fun () ->
          fail config (Request_failed (service, err))

-  method parse_err_answer : type e f g.
-    (unit, e, f, g tzresult) RPC.service ->
-    string list ->
-    Data_encoding.json -> g tzresult Lwt.t =
+  method parse_err_answer
+    : 'm 'p 'i 'o.
+      ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o tzresult, unit) RPC.Service.t ->
+      string list ->
+      Data_encoding.json -> 'o tzresult Lwt.t =
    fun service path json ->
      match Data_encoding.Json.destruct (RPC.Service.output_encoding service) json with
      | exception msg -> (* TODO print_error *)
--- a/lib_client_base/client_rpcs.mli
+++ b/lib_client_base/client_rpcs.mli
@ -40,13 +40,15 @@ class type rpc_sig = object
    Data_encoding.json ->
    ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
  method parse_answer :
-    (unit, 'b, 'c, 'd) RPC.service ->
+    'meth 'params 'input 'output.
+    ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC.Service.t ->
    string list ->
-    Data_encoding.json -> 'd tzresult Lwt.t
+    Data_encoding.json -> 'output tzresult Lwt.t
  method parse_err_answer :
-    (unit, 'e, 'f, 'g tzresult) RPC.service ->
+    'meth 'params 'input 'output.
+    ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC.Service.t ->
    string list ->
-    Data_encoding.json -> 'g tzresult Lwt.t
+    Data_encoding.json -> 'output tzresult Lwt.t
 end

 class rpc : config -> rpc_sig
@ -58,42 +60,58 @@ val full_logger: Format.formatter -> logger

 val call_service0:
  #rpc_sig ->
-  (unit, unit, 'i, 'o) RPC.service ->
+  ([ `POST ], unit,
+   unit, unit, 'i,
+   'o, unit) RPC.Service.t ->
  'i -> 'o tzresult Lwt.t

 val call_service1:
  #rpc_sig ->
-  (unit, unit * 'a, 'i, 'o) RPC.service ->
+  ([ `POST ], unit,
+   unit * 'a, unit, 'i,
+   'o, unit) RPC.Service.t ->
  'a -> 'i -> 'o tzresult Lwt.t

 val call_service2:
  #rpc_sig ->
-  (unit, (unit * 'a) * 'b, 'i, 'o) RPC.service ->
+  ([ `POST ], unit,
+   (unit * 'a) * 'b, unit, 'i,
+   'o, unit) RPC.Service.t ->
  'a -> 'b -> 'i -> 'o tzresult Lwt.t

 val call_streamed_service0:
  #rpc_sig ->
-  (unit, unit, 'a, 'b) RPC.service ->
+  ([ `POST ], unit,
+   unit, unit, 'a,
+   'b, unit) RPC.Service.t ->
  'a -> 'b tzresult Lwt_stream.t tzresult Lwt.t

 val call_streamed_service1:
  #rpc_sig ->
-  (unit, unit * 'a, 'b, 'c) RPC.service ->
+  ([ `POST ], unit,
+   unit * 'a, unit, 'b,
+   'c, unit) RPC.Service.t ->
  'a -> 'b -> 'c tzresult Lwt_stream.t tzresult Lwt.t

 val call_err_service0:
  #rpc_sig ->
-  (unit, unit, 'i, 'o tzresult) RPC.service ->
+  ([ `POST ], unit,
+   unit, unit, 'i,
+   'o tzresult, unit) RPC.Service.t ->
  'i -> 'o tzresult Lwt.t

 val call_err_service1:
  #rpc_sig ->
-  (unit, unit * 'a, 'i, 'o tzresult) RPC.service ->
+  ([ `POST ], unit,
+   unit * 'a, unit, 'i,
+   'o tzresult, unit) RPC.Service.t ->
  'a -> 'i -> 'o tzresult Lwt.t

 val call_err_service2:
  #rpc_sig ->
-  (unit, (unit * 'a) * 'b, 'i, 'o tzresult) RPC.service ->
+  ([ `POST ], unit,
+   (unit * 'a) * 'b, unit, 'i,
+   'o tzresult, unit) RPC.Service.t ->
  'a -> 'b -> 'i -> 'o tzresult Lwt.t

 type block = Node_rpc_services.Blocks.block
--- a/lib_node_http/RPC_server.mli
+++ b/lib_node_http/RPC_server.mli
@ -50,25 +50,25 @@ type 'a directory = 'a Directory.t
 val empty: 'a directory
 val register:
  'prefix directory ->
-  ('prefix, 'params, 'input, 'output) RPC.service ->
+  ([`POST], 'prefix, 'params, unit, 'input, 'output, unit) RPC.Service.t ->
  ('params -> 'input -> [< ('output, unit) RestoDirectory.Answer.t ] Lwt.t) ->
  'prefix directory

 val register0:
  unit directory ->
-  (unit, unit, 'i, 'o) RPC.service ->
+  ([`POST], unit, unit, unit, 'i, 'o, unit) RPC.Service.t ->
  ('i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  unit directory

 val register1:
  'prefix directory ->
-  ('prefix, unit * 'a, 'i, 'o) RPC.service ->
+  ([`POST], 'prefix, unit * 'a, unit, 'i, 'o, unit) RPC.Service.t ->
  ('a -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  'prefix directory

 val register2:
  'prefix directory ->
-  ('prefix, (unit * 'a) * 'b, 'i, 'o) RPC.service ->
+  ([`POST], 'prefix, (unit * 'a) * 'b, unit, 'i, 'o, unit) RPC.Service.t ->
  ('a -> 'b -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  'prefix directory

--- a/lib_node_services/RPC.ml
+++ b/lib_node_services/RPC.ml
@ -139,9 +139,6 @@ module Service = Resto.MakeService(Data)

 (* Compatibility layer, to be removed ASAP. *)

-type ('prefix, 'params, 'input, 'output) service =
-  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t
-
 let service ?description ~input ~output path =
  Service.post_service
    ?description
--- a/lib_node_services/RPC.mli
+++ b/lib_node_services/RPC.mli
@ -17,19 +17,16 @@ module Service : (module type of struct include Resto.MakeService(Data) end)

 (** Compatibility layer, to be removed ASAP. *)

-type ('prefix, 'params, 'input, 'output) service =
-  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t
-
 val service:
  ?description: string ->
  input: 'input Data_encoding.t ->
  output: 'output Data_encoding.t ->
  ('prefix, 'params) Path.t ->
-  ('prefix, 'params, 'input, 'output) service
+  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t

 type directory_descr = Data_encoding.json_schema Description.directory

-val forge_request:
-  (unit, 'params, 'input, _) service ->
+val forge_request :
+  (_ , unit, 'params, unit, 'input, 'output, unit) Service.t ->
  'params -> 'input -> MethMap.key * string list * Data_encoding.json

--- a/lib_node_services/node_rpc_services.mli
+++ b/lib_node_services/node_rpc_services.mli
@ -8,7 +8,8 @@
 (**************************************************************************)

 module Error : sig
-  val service: (unit, unit, unit, Json_schema.schema) RPC.service
+  val service:
+    ([ `POST ], unit, unit, unit, unit, Json_schema.schema, unit) RPC.Service.t
  val encoding: error list Data_encoding.t
  val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
 end
@ -43,37 +44,59 @@ module Blocks : sig
  }

  val info:
-    (unit, unit * block, bool, block_info) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, bool,
+     block_info, unit) RPC.Service.t
  val net_id:
-    (unit, unit * block, unit, Net_id.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Net_id.t, unit) RPC.Service.t
  val level:
-    (unit, unit * block, unit, Int32.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Int32.t, unit) RPC.Service.t
  val predecessor:
-    (unit, unit * block, unit, Block_hash.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Block_hash.t, unit) RPC.Service.t
  val predecessors:
-    (unit, unit * block , int, Block_hash.t list) RPC.service
+    ([ `POST ], unit,
+     unit * block , unit, int,
+     Block_hash.t list, unit) RPC.Service.t
  val hash:
-    (unit, unit * block, unit, Block_hash.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Block_hash.t, unit) RPC.Service.t
  val timestamp:
-    (unit, unit * block, unit, Time.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Time.t, unit) RPC.Service.t
  val fitness:
-    (unit, unit * block, unit, MBytes.t list) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     MBytes.t list, unit) RPC.Service.t

  type operations_param = {
    contents: bool ;
    monitor: bool ;
  }
  val operations:
-    (unit, unit * block, operations_param,
-     (Operation_hash.t * Operation.t option) list list) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, operations_param,
+     (Operation_hash.t * Operation.t option) list list, unit) RPC.Service.t

  val protocol:
-    (unit, unit * block, unit, Protocol_hash.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Protocol_hash.t, unit) RPC.Service.t
  val test_network:
-    (unit, unit * block, unit, Test_network_status.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Test_network_status.t, unit) RPC.Service.t
  val pending_operations:
-    (unit, unit * block, unit,
-     error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     error Preapply_result.t * Operation.t Operation_hash.Map.t, unit) RPC.Service.t

  type list_param = {
    include_ops: bool ;
@ -85,10 +108,14 @@ module Blocks : sig
    min_heads: int option;
  }
  val list:
-    (unit, unit, list_param, block_info list list) RPC.service
+    ([ `POST ], unit,
+     unit, unit, list_param,
+     block_info list list, unit) RPC.Service.t

  val list_invalid:
-    (unit, unit, unit, (Block_hash.t * int32 * error list) list) RPC.service
+    ([ `POST ], unit,
+     unit, unit, unit,
+     (Block_hash.t * int32 * error list) list, unit) RPC.Service.t

  type preapply_param = {
    timestamp: Time.t ;
@ -102,9 +129,14 @@ module Blocks : sig
    operations: error Preapply_result.t ;
  }
  val preapply:
-    (unit, unit * block, preapply_param, preapply_result tzresult) RPC.service
+    ([ `POST ], unit,
+     unit * block, unit, preapply_param,
+     preapply_result tzresult, unit) RPC.Service.t

-  val complete: (unit, (unit * block) * string, unit, string list) RPC.service
+  val complete:
+    ([ `POST ], unit,
+     (unit * block) * string, unit, unit,
+     string list, unit) RPC.Service.t

  val proto_path: (unit, unit * block) RPC.Path.path

@ -114,7 +146,9 @@ end
 module Protocols : sig

  val contents:
-    (unit, unit * Protocol_hash.t, unit, Protocol.t) RPC.service
+    ([ `POST ], unit,
+     unit * Protocol_hash.t, unit, unit,
+     Protocol.t, unit) RPC.Service.t

  type list_param = {
    contents: bool option ;
@ -122,71 +156,93 @@ module Protocols : sig
  }

  val list:
-    (unit, unit,
-     list_param,
-     (Protocol_hash.t * Protocol.t option) list) RPC.service
+    ([ `POST ], unit,
+     unit, unit, list_param,
+     (Protocol_hash.t * Protocol.t option) list, unit) RPC.Service.t

 end

 module Network : sig

  val stat :
-    (unit, unit, unit, P2p_types.Stat.t) RPC.service
+    ([ `POST ], unit,
+     unit, unit, unit,
+     P2p_types.Stat.t, unit) RPC.Service.t

  val versions :
-    (unit, unit, unit, P2p_types.Version.t list) RPC.service
+    ([ `POST ], unit,
+     unit, unit, unit,
+     P2p_types.Version.t list, unit) RPC.Service.t

  val events :
-    (unit, unit, unit, P2p_types.Connection_pool_log_event.t) RPC.service
+    ([ `POST ], unit,
+     unit, unit, unit,
+     P2p_types.Connection_pool_log_event.t, unit) RPC.Service.t

  val connect :
-    (unit, unit * P2p_types.Point.t, float, unit tzresult) RPC.service
+    ([ `POST ], unit,
+     unit * P2p_types.Point.t, unit, float,
+     unit tzresult, unit) RPC.Service.t

  module Connection : sig

    val list :
-      (unit, unit, unit, P2p_types.Connection_info.t list) RPC.service
+      ([ `POST ], unit,
+       unit, unit, unit,
+       P2p_types.Connection_info.t list, unit) RPC.Service.t

    val info :
-      (unit, unit * P2p_types.Peer_id.t, unit,
-       P2p_types.Connection_info.t option) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Peer_id.t, unit, unit,
+       P2p_types.Connection_info.t option, unit) RPC.Service.t

    val kick :
-      (unit, unit * P2p_types.Peer_id.t, bool, unit) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Peer_id.t, unit, bool,
+       unit, unit) RPC.Service.t

  end

  module Point : sig
    val list :
-      (unit, unit, P2p_types.Point_state.t list,
-       (P2p_types.Point.t * P2p_types.Point_info.t) list) RPC.service
+      ([ `POST ], unit,
+       unit, unit, P2p_types.Point_state.t list,
+       (P2p_types.Point.t * P2p_types.Point_info.t) list, unit) RPC.Service.t
    val info :
-      (unit, unit * P2p_types.Point.t, unit, P2p_types.Point_info.t option) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Point.t, unit, unit,
+       P2p_types.Point_info.t option, unit) RPC.Service.t
    val events :
-      (unit, unit * P2p_types.Point.t, bool,
-       P2p_connection_pool_types.Point_info.Event.t list) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Point.t, unit, bool,
+       P2p_connection_pool_types.Point_info.Event.t list, unit) RPC.Service.t
  end

  module Peer_id : sig

    val list :
-      (unit, unit, P2p_types.Peer_state.t list,
-       (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list) RPC.service
+      ([ `POST ], unit,
+       unit, unit, P2p_types.Peer_state.t list,
+       (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list, unit) RPC.Service.t

    val info :
-      (unit, unit * P2p_types.Peer_id.t, unit,
-       P2p_types.Peer_info.t option) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Peer_id.t, unit, unit,
+       P2p_types.Peer_info.t option, unit) RPC.Service.t

    val events :
-      (unit, unit * P2p_types.Peer_id.t, bool,
-       P2p_connection_pool_types.Peer_info.Event.t list) RPC.service
+      ([ `POST ], unit,
+       unit * P2p_types.Peer_id.t, unit, bool,
+       P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC.Service.t

  end

 end

 val forge_block_header:
-  (unit, unit, Block_header.t, MBytes.t) RPC.service
+  ([ `POST ], unit,
+   unit, unit, Block_header.t,
+   MBytes.t, unit) RPC.Service.t

 type inject_block_param = {
  raw: MBytes.t ;
@ -197,20 +253,28 @@ type inject_block_param = {
 }

 val inject_block:
-  (unit, unit, inject_block_param, Block_hash.t tzresult) RPC.service
+  ([ `POST ], unit,
+   unit, unit, inject_block_param,
+   Block_hash.t tzresult, unit) RPC.Service.t

 val inject_operation:
-  (unit, unit,
-   (MBytes.t * bool * Net_id.t option * bool option),
-   Operation_hash.t tzresult) RPC.service
+  ([ `POST ], unit,
+   unit, unit, (MBytes.t * bool * Net_id.t option * bool option),
+   Operation_hash.t tzresult, unit) RPC.Service.t

 val inject_protocol:
-  (unit, unit,
-   (Protocol.t * bool * bool option),
-   Protocol_hash.t tzresult) RPC.service
+  ([ `POST ], unit,
+   unit, unit, (Protocol.t * bool * bool option),
+   Protocol_hash.t tzresult, unit) RPC.Service.t

-val bootstrapped: (unit, unit, unit, Block_hash.t * Time.t) RPC.service
+val bootstrapped:
+  ([ `POST ], unit,
+   unit, unit, unit,
+   Block_hash.t * Time.t, unit) RPC.Service.t

-val complete: (unit, unit * string, unit, string list) RPC.service
+val complete:
+  ([ `POST ], unit,
+   unit * string, unit, unit,
+   string list, unit) RPC.Service.t

 val describe: (unit, unit) RPC.Service.description_service
--- a/lib_protocol_environment_sigs/v1/RPC.mli
+++ b/lib_protocol_environment_sigs/v1/RPC.mli
@ -293,36 +293,41 @@ end

 type 'a directory = 'a Directory.t

-type ('prefix, 'params, 'input, 'output) service =
-  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t
-
 val service:
  ?description: string ->
  input: 'input Data_encoding.t ->
  output: 'output Data_encoding.t ->
  ('prefix, 'params) Path.t ->
-  ('prefix, 'params, 'input, 'output) service
+  ([ `POST], 'prefix, 'params, unit, 'input, 'output, unit) Service.t

 val register:
  'prefix directory ->
-  ('prefix, 'params, 'input, 'output) service ->
+  ([ `POST ], 'prefix,
+   'params, unit, 'input,
+   'output, unit) Service.t ->
  ('params -> 'input -> [< ('output, unit) Answer.t ] Lwt.t) ->
  'prefix directory

 val register0:
  unit directory ->
-  (unit, unit, 'i, 'o) service ->
+  ([ `POST ], unit,
+   unit, unit, 'i,
+   'o, unit) Service.t ->
  ('i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  unit directory

 val register1:
  'prefix directory ->
-  ('prefix, unit * 'a, 'i, 'o) service ->
+  ([ `POST ], 'prefix,
+   unit * 'a, unit, 'i,
+   'o, unit) Service.t ->
  ('a -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  'prefix directory

 val register2:
  'prefix directory ->
-  ('prefix, (unit * 'a) * 'b, 'i, 'o) service ->
+  ([ `POST ], 'prefix,
+   (unit * 'a) * 'b, unit, 'i,
+   'o, unit) Service.t ->
  ('a -> 'b -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
  'prefix directory