Client refactor: Move Client_node_rpcs.Protocols into Protocols_services

src/lib_client_base/client_node_rpcs.ml

@@ -46,14 +46,4 @@ let describe cctxt ?(recurse = true) path =
     Shell_services.describe
     ((), path) { recurse } ()
 
-module Protocols = struct
-
-  let contents cctxt hash =
-    call_service1 cctxt Protocol_services.contents hash ()
-
-  let list cctxt ?contents () =
-    call_service0
-      cctxt Protocol_services.list
-      { contents; monitor = Some false }
-
 end

src/lib_client_base/client_node_rpcs.mli

@@ -38,16 +38,6 @@ val inject_protocol:
   Protocol.t ->
   Protocol_hash.t tzresult Lwt.t
 
-module Protocols : sig
-
-  val contents:
-    #Client_rpcs.ctxt ->
-    Protocol_hash.t -> Protocol.t tzresult Lwt.t
-
-  val list:
-    #Client_rpcs.ctxt ->
-    ?contents:bool -> unit ->
-    (Protocol_hash.t * Protocol.t option) list tzresult Lwt.t
 
 end
 

src/lib_client_base/client_protocols.ml

@@ -25,7 +25,7 @@ let commands () =
       no_options
       (prefixes [ "list" ; "protocols" ] stop)
       (fun () (cctxt : Client_commands.full_context) ->
-         Client_node_rpcs.Protocols.list cctxt ~contents:false () >>=? fun protos ->
+         Protocol_services.list ~contents:false cctxt >>=? fun protos ->
          Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
          return ()
       );
@@ -59,7 +59,7 @@ let commands () =
        @@ Protocol_hash.param ~name:"protocol hash" ~desc:""
        @@ stop)
       (fun () ph (cctxt : Client_commands.full_context) ->
-         Client_node_rpcs.Protocols.contents cctxt ph >>=? fun proto ->
+         Protocol_services.contents cctxt ph >>=? fun proto ->
          Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () ->
          cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->
          return ()

src/lib_shell/node_rpc.ml

@@ -331,7 +331,7 @@ let unmark_invalid node block () () =
   Node.RPC.unmark_invalid node block >>= fun x ->
   RPC_answer.return x
 
-let list_protocols node () { Protocol_services.monitor ; contents } =
+let list_protocols node () { Protocol_services.S.monitor ; contents } =
   let monitor = match monitor with None -> false | Some x -> x in
   let include_contents = match contents with None -> false | Some x -> x in
   Node.RPC.protocols node >>= fun protocols ->
@@ -391,10 +391,10 @@ 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.list
+    RPC_directory.register0 dir Protocol_services.S.list
       (list_protocols node) in
   let dir =
-    RPC_directory.register1 dir Protocol_services.contents
+    RPC_directory.register1 dir Protocol_services.S.contents
       (get_protocols node) in
   let dir =
     let implementation () header =

src/lib_shell_services/protocol_services.ml

@@ -9,42 +9,58 @@
 
 open Data_encoding
 
-let protocols_arg = Protocol_hash.rpc_arg
 
-let contents =
-  RPC_service.post_service
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output:
-      (obj1 (req "data"
-               (describe ~title: "Tezos protocol"
-                  (Protocol.encoding))))
-    RPC_path.(root / "protocols" /: protocols_arg)
+module S = struct
 
-type list_param = {
-  contents: bool option ;
-  monitor: bool option ;
-}
+  let protocols_arg = Protocol_hash.rpc_arg
 
-let list_param_encoding =
-  conv
-    (fun {contents; monitor} -> (contents, monitor))
-    (fun (contents, monitor) -> {contents; monitor})
-    (obj2
-       (opt "contents" bool)
-       (opt "monitor" bool))
+  let contents =
+    RPC_service.post_service
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output:
+        (obj1 (req "data"
+                 (describe ~title: "Tezos protocol"
+                    (Protocol.encoding))))
+      RPC_path.(root / "protocols" /: protocols_arg)
+
+  type list_param = {
+    contents: bool option ;
+    monitor: bool option ;
+  }
+
+  let list_param_encoding =
+    conv
+      (fun {contents; monitor} -> (contents, monitor))
+      (fun (contents, monitor) -> {contents; monitor})
+      (obj2
+         (opt "contents" bool)
+         (opt "monitor" bool))
+
+  let list =
+    RPC_service.post_service
+      ~query: RPC_query.empty
+      ~input: list_param_encoding
+      ~output:
+        (obj1
+           (req "protocols"
+              (list
+                 (obj2
+                    (req "hash" Protocol_hash.encoding)
+                    (opt "contents"
+                       (dynamic_size Protocol.encoding)))
+              )))
+      RPC_path.(root / "protocols")
+
+end
+
+open RPC_context
+let contents ctxt h =
+  make_call1 S.contents ctxt h () ()
+let monitor ?(contents = false) ctxt =
+  make_streamed_call S.list ctxt () ()
+    { contents = Some contents ; monitor = Some true }
+let list ?(contents = false) ctxt =
+  make_call S.list ctxt () ()
+    { contents = Some contents ; monitor = Some false }
 
-let list =
-  RPC_service.post_service
-    ~query: RPC_query.empty
-    ~input: list_param_encoding
-    ~output:
-      (obj1
-         (req "protocols"
-            (list
-               (obj2
-                  (req "hash" Protocol_hash.encoding)
-                  (opt "contents"
-                     (dynamic_size Protocol.encoding)))
-            )))
-    RPC_path.(root / "protocols")

src/lib_shell_services/protocol_services.mli

@@ -7,17 +7,36 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val contents:
-  ([ `POST ], unit,
-   unit * Protocol_hash.t, unit, unit,
-   Protocol.t) RPC_service.t
+open RPC_context
 
-type list_param = {
-  contents: bool option ;
-  monitor: bool option ;
-}
+val contents:
+  #simple -> Protocol_hash.t -> Protocol.t tzresult Lwt.t
 
 val list:
-  ([ `POST ], unit,
-   unit, unit, list_param,
-   (Protocol_hash.t * Protocol.t option) list) RPC_service.t
+  ?contents:bool ->
+  #simple ->
+  (Protocol_hash.t * Protocol.t option) list tzresult Lwt.t
+
+val monitor:
+  ?contents:bool ->
+  #streamed ->
+  ((Protocol_hash.t * Protocol.t option) list Lwt_stream.t * stopper) tzresult Lwt.t
+
+module S : sig
+
+  val contents:
+    ([ `POST ], unit,
+     unit * Protocol_hash.t, unit, unit,
+     Protocol.t) RPC_service.t
+
+  type list_param = {
+    contents: bool option ;
+    monitor: bool option ;
+  }
+
+  val list:
+    ([ `POST ], unit,
+     unit, unit, list_param,
+     (Protocol_hash.t * Protocol.t option) list) RPC_service.t
+
+end