From 21789be756068e65c876fc90a66e0d45c0d91c4f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 8 Feb 2018 10:51:02 +0100 Subject: [PATCH] Client refactor: Move `Client_node_rpcs.Protocols` into `Protocols_services` --- src/lib_client_base/client_node_rpcs.ml | 10 --- src/lib_client_base/client_node_rpcs.mli | 10 --- src/lib_client_base/client_protocols.ml | 4 +- src/lib_shell/node_rpc.ml | 6 +- src/lib_shell_services/protocol_services.ml | 86 ++++++++++++-------- src/lib_shell_services/protocol_services.mli | 41 +++++++--- 6 files changed, 86 insertions(+), 71 deletions(-) diff --git a/src/lib_client_base/client_node_rpcs.ml b/src/lib_client_base/client_node_rpcs.ml index f702a4467..ed1a5de89 100644 --- a/src/lib_client_base/client_node_rpcs.ml +++ b/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 diff --git a/src/lib_client_base/client_node_rpcs.mli b/src/lib_client_base/client_node_rpcs.mli index c60a5d109..75633350b 100644 --- a/src/lib_client_base/client_node_rpcs.mli +++ b/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 diff --git a/src/lib_client_base/client_protocols.ml b/src/lib_client_base/client_protocols.ml index 2dd13142e..d3cc21844 100644 --- a/src/lib_client_base/client_protocols.ml +++ b/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 () diff --git a/src/lib_shell/node_rpc.ml b/src/lib_shell/node_rpc.ml index 63dee2d4c..c71e05b85 100644 --- a/src/lib_shell/node_rpc.ml +++ b/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 = diff --git a/src/lib_shell_services/protocol_services.ml b/src/lib_shell_services/protocol_services.ml index 28b9799ab..0cb60b0e9 100644 --- a/src/lib_shell_services/protocol_services.ml +++ b/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") diff --git a/src/lib_shell_services/protocol_services.mli b/src/lib_shell_services/protocol_services.mli index 7682b24f4..016d80d17 100644 --- a/src/lib_shell_services/protocol_services.mli +++ b/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