From 1d5b4c1e3b25cbe11380a6ee6529f3bc879eaee3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Fri, 26 Jan 2018 13:07:49 +0100 Subject: [PATCH] Refactor: merge `lib_p2p_services` into `lib_shell_services` Also split the module `Shell_services` in smaller modules. --- src/bin_node/jbuild | 10 +- src/lib_client_base/client_admin.ml | 2 +- src/lib_client_base/client_commands.ml | 2 +- src/lib_client_base/client_commands.mli | 6 +- src/lib_client_base/client_config.ml | 6 +- src/lib_client_base/client_debug.ml | 6 +- src/lib_client_base/client_node_rpcs.ml | 61 +- src/lib_client_base/client_node_rpcs.mli | 2 +- src/lib_client_base/client_rpcs.ml | 2 +- src/lib_client_base/client_rpcs.mli | 2 +- src/lib_client_base/jbuild | 4 +- src/lib_client_base/tezos-client-base.opam | 3 +- src/lib_p2p/jbuild | 6 +- src/lib_p2p/tezos-p2p.opam | 1 - src/lib_p2p_services/jbuild | 12 - src/lib_p2p_services/tezos-p2p-services.opam | 19 - src/lib_shell/jbuild | 2 - src/lib_shell/node.ml | 4 +- src/lib_shell/node.mli | 4 +- src/lib_shell/node_rpc.ml | 94 ++- src/lib_shell/tezos-shell.opam | 1 - src/lib_shell_services/block_services.ml | 436 ++++++++++++ src/lib_shell_services/block_services.mli | 140 ++++ src/lib_shell_services/jbuild | 6 +- .../p2p_services.ml | 0 .../p2p_services.mli | 0 src/lib_shell_services/protocol_services.ml | 52 ++ src/lib_shell_services/protocol_services.mli | 23 + src/lib_shell_services/shell_services.ml | 631 ------------------ src/lib_shell_services/shell_services.mli | 223 ------- src/lib_shell_services/worker_services.ml | 163 +++++ src/lib_shell_services/worker_services.mli | 71 ++ .../lib_client_alpha/client_proto_rpcs.ml | 8 +- .../lib_client_alpha/client_proto_rpcs.mli | 2 +- .../lib_client_demo/client_proto_rpcs.ml | 2 +- .../lib_client_genesis/client_proto_main.ml | 2 +- test/p2p/jbuild | 2 - 37 files changed, 996 insertions(+), 1014 deletions(-) delete mode 100644 src/lib_p2p_services/jbuild delete mode 100644 src/lib_p2p_services/tezos-p2p-services.opam create mode 100644 src/lib_shell_services/block_services.ml create mode 100644 src/lib_shell_services/block_services.mli rename src/{lib_p2p_services => lib_shell_services}/p2p_services.ml (100%) rename src/{lib_p2p_services => lib_shell_services}/p2p_services.mli (100%) create mode 100644 src/lib_shell_services/protocol_services.ml create mode 100644 src/lib_shell_services/protocol_services.mli create mode 100644 src/lib_shell_services/worker_services.ml create mode 100644 src/lib_shell_services/worker_services.mli diff --git a/src/bin_node/jbuild b/src/bin_node/jbuild index d6967834b..8cafc4369 100644 --- a/src/bin_node/jbuild +++ b/src/bin_node/jbuild @@ -4,10 +4,9 @@ ((name main) (public_name tezos-node) (libraries (tezos-base - tezos-rpc-http - tezos-p2p-services - tezos-p2p tezos-shell-services + tezos-rpc-http + tezos-p2p tezos-shell tezos-protocol-updater tezos-embedded-protocol-genesis @@ -18,10 +17,9 @@ (flags (:standard -w -9+27-30-32-40@8 -safe-string -open Tezos_base__TzPervasives - -open Tezos_rpc_http - -open Tezos_p2p_services - -open Tezos_p2p -open Tezos_shell_services + -open Tezos_rpc_http + -open Tezos_p2p -open Tezos_shell -open Tezos_protocol_updater -linkall)))) diff --git a/src/lib_client_base/client_admin.ml b/src/lib_client_base/client_admin.ml index d9b905e73..0b12315a5 100644 --- a/src/lib_client_base/client_admin.ml +++ b/src/lib_client_base/client_admin.ml @@ -18,6 +18,6 @@ let commands () = @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list" @@ stop) (fun () block (cctxt : Client_commands.full_context) -> - Client_rpcs.call_err_service0 cctxt Node_rpc_services.Blocks.unmark_invalid block >>=? fun () -> + Client_rpcs.call_err_service0 cctxt Block_services.unmark_invalid block >>=? fun () -> cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ; ] diff --git a/src/lib_client_base/client_commands.ml b/src/lib_client_base/client_commands.ml index 305484caa..39d82b39a 100644 --- a/src/lib_client_base/client_commands.ml +++ b/src/lib_client_base/client_commands.ml @@ -44,7 +44,7 @@ class type wallet = object end class type block = object - method block : Shell_services.Blocks.block + method block : Block_services.block end class type logging_wallet = object diff --git a/src/lib_client_base/client_commands.mli b/src/lib_client_base/client_commands.mli index 740a8c7ef..ead142c48 100644 --- a/src/lib_client_base/client_commands.mli +++ b/src/lib_client_base/client_commands.mli @@ -28,7 +28,7 @@ class type wallet = object end class type block = object - method block : Shell_services.Blocks.block + method block : Block_services.block end class type logging_wallet = object @@ -56,7 +56,7 @@ end val make_context : ?base_dir:string -> - ?block:Shell_services.Blocks.block -> + ?block:Block_services.block -> ?rpc_config:Client_rpcs.config -> (string -> string -> unit Lwt.t) -> full_context (** [make_context ?config log_fun] builds a context whose logging @@ -81,4 +81,4 @@ val get_versions: unit -> (Protocol_hash.t * (command list)) list val force_switch : (bool, full_context) Cli_entries.arg val default_base_dir : string -val default_block : Shell_services.Blocks.block +val default_block : Block_services.block diff --git a/src/lib_client_base/client_config.ml b/src/lib_client_base/client_config.ml index f5cf391ea..168d5ddcf 100644 --- a/src/lib_client_base/client_config.ml +++ b/src/lib_client_base/client_config.ml @@ -103,7 +103,7 @@ module Cfg_file = struct end type cli_args = { - block: Shell_services.Blocks.block ; + block: Block_services.block ; protocol: Protocol_hash.t option ; print_timings: bool ; log_requests: bool ; @@ -124,7 +124,7 @@ let string_parameter : (string, Client_commands.full_context) parameter = let block_parameter = parameter - (fun _ block -> match Shell_services.Blocks.parse_block block with + (fun _ block -> match Block_services.parse_block block with | Error _ -> fail (Invalid_block_argument block) | Ok block -> return block) @@ -161,7 +161,7 @@ let block_arg = default_arg ~parameter:"-block" ~doc:"The block on which to apply contextual commands." - ~default:(Shell_services.Blocks.to_string default_cli_args.block) + ~default:(Block_services.to_string default_cli_args.block) block_parameter let protocol_arg = arg diff --git a/src/lib_client_base/client_debug.ml b/src/lib_client_base/client_debug.ml index 41c5c71b1..1f4cfc1b5 100644 --- a/src/lib_client_base/client_debug.ml +++ b/src/lib_client_base/client_debug.ml @@ -10,7 +10,7 @@ (* Commands used to debug the node/alphanet *) let pp_block ppf - { Shell_services.Blocks.hash ; net_id ; level ; + { Block_services.hash ; net_id ; level ; proto_level ; predecessor ; timestamp ; operations_hash ; fitness ; data ; operations ; protocol ; test_network } = @@ -62,7 +62,7 @@ let registered_protocols ppf = (Client_commands.get_versions ()) let print_heads ppf cctxt = - Client_rpcs.call_service0 cctxt Shell_services.Blocks.list + Client_rpcs.call_service0 cctxt Block_services.list { include_ops = true ; length = Some 1 ; heads = None ; @@ -82,7 +82,7 @@ let print_heads ppf cctxt = let print_rejected ppf cctxt = Client_rpcs.call_service0 cctxt - Shell_services.Blocks.list_invalid () >>=? fun invalid -> + Block_services.list_invalid () >>=? fun invalid -> return @@ Format.pp_print_list (fun ppf (hash, level, errors) -> diff --git a/src/lib_client_base/client_node_rpcs.ml b/src/lib_client_base/client_node_rpcs.ml index 0cf10f552..0fe2d5c8c 100644 --- a/src/lib_client_base/client_node_rpcs.ml +++ b/src/lib_client_base/client_node_rpcs.ml @@ -10,37 +10,36 @@ (* Tezos Command line interface - RPC Calls *) open Client_rpcs -module Services = Shell_services let errors (rpc : #Client_rpcs.ctxt) = call_service0 rpc RPC_error.service () let forge_block_header rpc header = - call_service0 rpc Services.forge_block_header header + call_service0 rpc Shell_services.forge_block_header header let inject_block cctxt ?(async = false) ?(force = false) ?net_id raw operations = - call_err_service0 cctxt Services.inject_block + call_err_service0 cctxt Shell_services.inject_block { raw ; blocking = not async ; force ; net_id ; operations } let inject_operation cctxt ?(async = false) ?net_id operation = - call_err_service0 cctxt Services.inject_operation + call_err_service0 cctxt Shell_services.inject_operation (operation, not async, net_id) let inject_protocol cctxt ?(async = false) ?force protocol = - call_err_service0 cctxt Services.inject_protocol + call_err_service0 cctxt Shell_services.inject_protocol (protocol, not async, force) let bootstrapped cctxt = - call_streamed_service0 cctxt Services.bootstrapped () + call_streamed_service0 cctxt Shell_services.bootstrapped () let complete cctxt ?block prefix = match block with | None -> - call_service1 cctxt Services.complete prefix () + call_service1 cctxt Shell_services.complete prefix () | Some block -> - call_service2 cctxt Services.Blocks.complete block prefix () + call_service2 cctxt Block_services.complete block prefix () let describe cctxt ?(recurse = true) path = Client_rpcs.call_service cctxt @@ -49,9 +48,9 @@ let describe cctxt ?(recurse = true) path = module Blocks = struct - type block = Services.Blocks.block + type block = Block_services.block - type block_info = Services.Blocks.block_info = { + type block_info = Block_services.block_info = { hash: Block_hash.t ; net_id: Net_id.t ; level: Int32.t ; @@ -67,57 +66,57 @@ module Blocks = struct protocol: Protocol_hash.t ; test_network: Test_network_status.t; } - type preapply_param = Services.Blocks.preapply_param = { + type preapply_param = Block_services.preapply_param = { timestamp: Time.t ; proto_header: MBytes.t ; operations: Operation.t list list ; sort_operations: bool ; } - type preapply_result = Services.Blocks.preapply_result = { + type preapply_result = Block_services.preapply_result = { shell_header: Block_header.shell_header ; operations: error Preapply_result.t list ; } let net_id cctxt h = - call_service1 cctxt Services.Blocks.net_id h () + call_service1 cctxt Block_services.net_id h () let level cctxt h = - call_service1 cctxt Services.Blocks.level h () + call_service1 cctxt Block_services.level h () let predecessor cctxt h = - call_service1 cctxt Services.Blocks.predecessor h () + call_service1 cctxt Block_services.predecessor h () let predecessors cctxt h l = - call_service1 cctxt Services.Blocks.predecessors h l + call_service1 cctxt Block_services.predecessors h l let hash cctxt h = - call_service1 cctxt Services.Blocks.hash h () + call_service1 cctxt Block_services.hash h () let timestamp cctxt h = - call_service1 cctxt Services.Blocks.timestamp h () + call_service1 cctxt Block_services.timestamp h () let fitness cctxt h = - call_service1 cctxt Services.Blocks.fitness h () + call_service1 cctxt Block_services.fitness h () let operations cctxt ?(contents = false) h = - call_service1 cctxt Services.Blocks.operations h + call_service1 cctxt Block_services.operations h { contents ; monitor = false } let protocol cctxt h = - call_service1 cctxt Services.Blocks.protocol h () + call_service1 cctxt Block_services.protocol h () let test_network cctxt h = - call_service1 cctxt Services.Blocks.test_network h () + call_service1 cctxt Block_services.test_network h () let preapply cctxt h ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations = call_err_service1 - cctxt Services.Blocks.preapply h + cctxt Block_services.preapply h { timestamp ; proto_header ; sort_operations = sort ; operations } let pending_operations cctxt block = - call_service1 cctxt Services.Blocks.pending_operations block () + call_service1 cctxt Block_services.pending_operations block () let info cctxt ?(include_ops = true) h = - call_service1 cctxt Services.Blocks.info h include_ops + call_service1 cctxt Block_services.info h include_ops let complete cctxt block prefix = - call_service2 cctxt Services.Blocks.complete block prefix () + call_service2 cctxt Block_services.complete block prefix () let list cctxt ?(include_ops = false) ?length ?heads ?delay ?min_date ?min_heads () = - call_service0 cctxt Services.Blocks.list + call_service0 cctxt Block_services.list { include_ops ; length ; heads ; monitor = Some false ; delay ; min_date ; min_heads } let monitor cctxt ?(include_ops = false) ?length ?heads ?delay ?min_date ?min_heads () = - call_streamed_service0 cctxt Services.Blocks.list + call_streamed_service0 cctxt Block_services.list { include_ops ; length ; heads ; monitor = Some true ; delay ; min_date ; min_heads } @@ -126,7 +125,7 @@ end module Operations = struct let monitor cctxt ?(contents = false) () = - call_streamed_service1 cctxt Services.Blocks.operations + call_streamed_service1 cctxt Block_services.operations `Prevalidation { contents ; monitor = true } @@ -135,11 +134,11 @@ end module Protocols = struct let contents cctxt hash = - call_service1 cctxt Services.Protocols.contents hash () + call_service1 cctxt Protocol_services.contents hash () let list cctxt ?contents () = call_service0 - cctxt Services.Protocols.list + 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 c9699fce6..5bfa56cdc 100644 --- a/src/lib_client_base/client_node_rpcs.mli +++ b/src/lib_client_base/client_node_rpcs.mli @@ -40,7 +40,7 @@ val inject_protocol: module Blocks : sig - type block = Shell_services.Blocks.block + type block = Block_services.block val net_id: #Client_rpcs.ctxt -> diff --git a/src/lib_client_base/client_rpcs.ml b/src/lib_client_base/client_rpcs.ml index 472ea84f4..963a1f0dc 100644 --- a/src/lib_client_base/client_rpcs.ml +++ b/src/lib_client_base/client_rpcs.ml @@ -130,7 +130,7 @@ let call_err_service1 ctxt service a1 body = let call_err_service2 ctxt service a1 a2 body = call_err_service ctxt service (((), a1), a2) () body -type block = Shell_services.Blocks.block +type block = Block_services.block let last_baked_block = function | `Prevalidation -> `Head 0 diff --git a/src/lib_client_base/client_rpcs.mli b/src/lib_client_base/client_rpcs.mli index b8f251b1c..705cab06e 100644 --- a/src/lib_client_base/client_rpcs.mli +++ b/src/lib_client_base/client_rpcs.mli @@ -106,7 +106,7 @@ val call_err_service2: 'o tzresult, 'e) RPC_service.t -> 'a -> 'b -> 'i -> 'o tzresult Lwt.t -type block = Shell_services.Blocks.block +type block = Block_services.block val last_baked_block: block -> [> diff --git a/src/lib_client_base/jbuild b/src/lib_client_base/jbuild index 678325b3d..066301e2d 100644 --- a/src/lib_client_base/jbuild +++ b/src/lib_client_base/jbuild @@ -4,10 +4,9 @@ ((name tezos_client_base) (public_name tezos-client-base) (libraries (tezos-base + tezos-shell-services tezos-storage tezos-rpc-http - tezos-p2p-services - tezos-shell-services tezos-protocol-updater tezos-protocol-compiler)) (flags (:standard -w -9+27-30-32-40@8 @@ -15,7 +14,6 @@ -open Tezos_base__TzPervasives -open Tezos_storage -open Tezos_rpc_http - -open Tezos_p2p_services -open Tezos_shell_services -open Tezos_protocol_updater)))) diff --git a/src/lib_client_base/tezos-client-base.opam b/src/lib_client_base/tezos-client-base.opam index 75709ea42..ead7bf3d2 100644 --- a/src/lib_client_base/tezos-client-base.opam +++ b/src/lib_client_base/tezos-client-base.opam @@ -10,10 +10,9 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta15" } "tezos-base" + "tezos-shell-services" "tezos-storage" "tezos-rpc-http" - "tezos-p2p-services" - "tezos-shell-services" "tezos-protocol-compiler" "tezos-protocol-updater" "tezos-embedded-protocol-genesis" diff --git a/src/lib_p2p/jbuild b/src/lib_p2p/jbuild index 79bbd456b..6df9db223 100644 --- a/src/lib_p2p/jbuild +++ b/src/lib_p2p/jbuild @@ -3,12 +3,10 @@ (library ((name tezos_p2p) (public_name tezos-p2p) - (libraries (tezos-base - tezos-p2p-services)) + (libraries (tezos-base)) (flags (:standard -w -9+27-30-32-40@8 -safe-string - -open Tezos_base__TzPervasives - -open Tezos_p2p_services)))) + -open Tezos_base__TzPervasives)))) (alias ((name runtest_indent) diff --git a/src/lib_p2p/tezos-p2p.opam b/src/lib_p2p/tezos-p2p.opam index 9f16483f5..428d8be2e 100644 --- a/src/lib_p2p/tezos-p2p.opam +++ b/src/lib_p2p/tezos-p2p.opam @@ -10,7 +10,6 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta15" } "tezos-base" - "tezos-p2p-services" ] build: [ [ "jbuilder" "build" "-p" name "-j" jobs ] diff --git a/src/lib_p2p_services/jbuild b/src/lib_p2p_services/jbuild deleted file mode 100644 index 087691f0e..000000000 --- a/src/lib_p2p_services/jbuild +++ /dev/null @@ -1,12 +0,0 @@ -(jbuild_version 1) - -(library - ((name tezos_p2p_services) - (public_name tezos-p2p-services) - (libraries (tezos-base)) - (flags (:standard -open Tezos_base__TzPervasives -safe-string)))) - -(alias - ((name runtest_indent) - (deps ((glob_files *.ml) (glob_files *.mli))) - (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/lib_p2p_services/tezos-p2p-services.opam b/src/lib_p2p_services/tezos-p2p-services.opam deleted file mode 100644 index 428d8be2e..000000000 --- a/src/lib_p2p_services/tezos-p2p-services.opam +++ /dev/null @@ -1,19 +0,0 @@ -opam-version: "1.2" -version: "dev" -maintainer: "contact@tezos.com" -authors: [ "Tezos devteam" ] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "https://gitlab.com/tezos/tezos.git" -license: "unreleased" -depends: [ - "ocamlfind" { build } - "jbuilder" { build & >= "1.0+beta15" } - "tezos-base" -] -build: [ - [ "jbuilder" "build" "-p" name "-j" jobs ] -] -build-test: [ - [ "jbuilder" "runtest" "-p" name "-j" jobs ] -] diff --git a/src/lib_shell/jbuild b/src/lib_shell/jbuild index 070e150aa..0bcab1dfd 100644 --- a/src/lib_shell/jbuild +++ b/src/lib_shell/jbuild @@ -6,7 +6,6 @@ (libraries (tezos-base tezos-storage tezos-rpc-http - tezos-p2p-services tezos-p2p tezos-shell-services tezos-protocol-updater)) @@ -15,7 +14,6 @@ -open Tezos_base__TzPervasives -open Tezos_storage -open Tezos_rpc_http - -open Tezos_p2p_services -open Tezos_p2p -open Tezos_shell_services -open Tezos_protocol_updater)))) diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index 7539081f2..70d687ed5 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -159,8 +159,8 @@ let shutdown node = node.shutdown () module RPC = struct - type block = Shell_services.Blocks.block - type block_info = Shell_services.Blocks.block_info = { + type block = Block_services.block + type block_info = Block_services.block_info = { hash: Block_hash.t ; net_id: Net_id.t ; level: Int32.t ; diff --git a/src/lib_shell/node.mli b/src/lib_shell/node.mli index c7f170ed0..ed8e79b10 100644 --- a/src/lib_shell/node.mli +++ b/src/lib_shell/node.mli @@ -49,8 +49,8 @@ val create: module RPC : sig - type block = Shell_services.Blocks.block - type block_info = Shell_services.Blocks.block_info + type block = Block_services.block + type block_info = Block_services.block_info val inject_block: t -> ?force:bool -> ?net_id:Net_id.t -> diff --git a/src/lib_shell/node_rpc.ml b/src/lib_shell/node_rpc.ml index 8a488df10..3249f9756 100644 --- a/src/lib_shell/node_rpc.ml +++ b/src/lib_shell/node_rpc.ml @@ -9,9 +9,7 @@ open Logging.RPC -module Services = Shell_services - -let filter_bi operations (bi: Services.Blocks.block_info) = +let filter_bi operations (bi: Block_services.block_info) = let bi = if operations then bi else { bi with operations = None } in bi @@ -44,65 +42,65 @@ let register_bi_dir node dir = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return (filter_bi include_ops bi) in RPC_directory.register1 dir - Services.Blocks.info implementation in + Block_services.info implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.hash in RPC_directory.register1 dir - Services.Blocks.hash + Block_services.hash implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.net_id in RPC_directory.register1 dir - Services.Blocks.net_id implementation in + Block_services.net_id implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.level in RPC_directory.register1 dir - Services.Blocks.level implementation in + Block_services.level implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.predecessor in RPC_directory.register1 dir - Services.Blocks.predecessor implementation in + Block_services.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 RPC_directory.register1 dir - Services.Blocks.predecessors implementation in + Block_services.predecessors implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.fitness in RPC_directory.register1 dir - Services.Blocks.fitness implementation in + Block_services.fitness implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.timestamp in RPC_directory.register1 dir - Services.Blocks.timestamp implementation in + Block_services.timestamp implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.protocol in RPC_directory.register1 dir - Services.Blocks.protocol implementation in + Block_services.protocol implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.test_network in RPC_directory.register1 dir - Services.Blocks.test_network implementation in + Block_services.test_network implementation in let dir = - let implementation b () { Shell_services.Blocks.contents ; monitor } = + let implementation b () { Block_services.contents ; monitor } = match b with | `Prevalidation when monitor -> monitor_operations node contents @@ -117,36 +115,36 @@ let register_bi_dir node dir = List.map (List.map (fun h -> h, None)) hashes in RPC_directory.register1 dir - Services.Blocks.operations implementation in + Block_services.operations implementation in let dir = let implementation b () () = Node.RPC.pending_operations node b >>= fun res -> RPC_answer.return res in RPC_directory.register1 dir - Services.Blocks.pending_operations + Block_services.pending_operations implementation in let dir = let implementation b () - { Services.Blocks.operations ; sort_operations ; + { Block_services.operations ; sort_operations ; timestamp ; proto_header} = Node.RPC.preapply node b ~timestamp ~proto_header ~sort_operations operations >>= function | Ok (shell_header, operations) -> RPC_answer.return - (Ok { Services.Blocks.shell_header ; operations }) + (Ok { Block_services.shell_header ; operations }) | Error _ as err -> RPC_answer.return err in RPC_directory.register1 dir - Services.Blocks.preapply implementation in + Block_services.preapply implementation in dir let ops_dir _node = let ops_dir = RPC_directory.empty in ops_dir -let rec insert_future_block (bi: Services.Blocks.block_info) = function +let rec insert_future_block (bi: Block_services.block_info) = function | [] -> [bi] - | ({timestamp} as head: Services.Blocks.block_info) :: tail as all -> + | ({timestamp} as head: Block_services.block_info) :: tail as all -> if Time.compare bi.timestamp timestamp < 0 then bi :: all else @@ -201,7 +199,7 @@ let create_delayed_stream | `Block None -> lwt_debug "WWW worker_loop None" >>= fun () -> Lwt.return_unit - | `Block (Some (bi : Services.Blocks.block_info)) -> + | `Block (Some (bi : Block_services.block_info)) -> lwt_debug "WWW worker_loop Some" >>= fun () -> begin if not filtering @@ -242,7 +240,7 @@ let create_delayed_stream let list_blocks node () - { Services.Blocks.include_ops ; length ; heads ; monitor ; delay ; + { Block_services.include_ops ; length ; heads ; monitor ; delay ; min_date; min_heads} = let len = match length with None -> 1 | Some x -> x in let monitor = match monitor with None -> false | Some x -> x in @@ -285,12 +283,12 @@ let list_blocks let sorted_infos = List.sort (fun - (bi1: Services.Blocks.block_info) - (bi2: Services.Blocks.block_info) -> + (bi1: Block_services.block_info) + (bi2: Block_services.block_info) -> ~- (Fitness.compare bi1.fitness bi2.fitness)) heads_info in List.map - (fun ({ hash } : Services.Blocks.block_info) -> hash) + (fun ({ hash } : Block_services.block_info) -> hash) sorted_infos | Some heads -> let known_block h = @@ -337,7 +335,7 @@ let unmark_invalid node () block = Node.RPC.unmark_invalid node block >>= fun x -> RPC_answer.return x -let list_protocols node () {Services.Protocols.monitor; contents} = +let list_protocols node () { Protocol_services.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 -> @@ -376,13 +374,13 @@ let get_protocols node hash () () = let build_rpc_directory node = let dir = RPC_directory.empty in let dir = - RPC_directory.register0 dir Services.Blocks.list + RPC_directory.register0 dir Block_services.list (list_blocks node) in let dir = - RPC_directory.register0 dir Services.Blocks.list_invalid + RPC_directory.register0 dir Block_services.list_invalid (list_invalid node) in let dir = - RPC_directory.register0 dir Services.Blocks.unmark_invalid + RPC_directory.register0 dir Block_services.unmark_invalid (unmark_invalid node) in let dir = register_bi_dir node dir in let dir = @@ -395,19 +393,19 @@ let build_rpc_directory node = RPC_directory.register_dynamic_directory1 ~descr: "All the RPCs which are specific to the protocol version." - dir Services.Blocks.proto_path implementation in + dir Block_services.proto_path implementation in let dir = - RPC_directory.register0 dir Services.Protocols.list + RPC_directory.register0 dir Protocol_services.list (list_protocols node) in let dir = - RPC_directory.register1 dir Services.Protocols.contents + RPC_directory.register1 dir Protocol_services.contents (get_protocols node) in let dir = let implementation () header = let res = Data_encoding.Binary.to_bytes Block_header.encoding header in RPC_answer.return res in - RPC_directory.register0 dir Services.forge_block_header + RPC_directory.register0 dir Shell_services.forge_block_header implementation in let dir = let implementation () @@ -418,7 +416,7 @@ let build_rpc_directory node = raw operations >>=? fun (hash, wait) -> (if blocking then wait else return ()) >>=? fun () -> return hash end >>= RPC_answer.return in - RPC_directory.register0 dir Services.inject_block implementation in + RPC_directory.register0 dir Shell_services.inject_block implementation in let dir = let implementation () (contents, blocking, net_id) = Node.RPC.inject_operation @@ -426,43 +424,43 @@ let build_rpc_directory node = begin (if blocking then wait else return ()) >>=? fun () -> return hash end >>= RPC_answer.return in - RPC_directory.register0 dir Services.inject_operation implementation in + RPC_directory.register0 dir Shell_services.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 - RPC_directory.register0 dir Services.inject_protocol implementation in + RPC_directory.register0 dir Shell_services.inject_protocol implementation in let dir = let implementation () () = RPC_answer.return_stream (Node.RPC.bootstrapped node) in - RPC_directory.register0 dir Services.bootstrapped implementation in + RPC_directory.register0 dir Shell_services.bootstrapped implementation in let dir = let implementation () () = RPC_answer.return Data_encoding.Json.(schema Error_monad.error_encoding) in RPC_directory.register0 dir RPC_error.service implementation in let dir = - RPC_directory.register1 dir Services.complete + RPC_directory.register1 dir Shell_services.complete (fun s () () -> Node.RPC.complete node s >>= RPC_answer.return) in let dir = - RPC_directory.register2 dir Services.Blocks.complete + RPC_directory.register2 dir Block_services.complete (fun block s () () -> Node.RPC.complete node ~block s >>= RPC_answer.return) in (* Workers : Prevalidators *) let dir = - RPC_directory.register0 dir Shell_services.Workers.Prevalidators.list + RPC_directory.register0 dir Worker_services.Prevalidators.list (fun () () -> RPC_answer.return (List.map (fun (id, w) -> (id, Prevalidator.status w)) (Prevalidator.running_workers ()))) in let dir = - RPC_directory.register1 dir Shell_services.Workers.Prevalidators.state + RPC_directory.register1 dir Worker_services.Prevalidators.state (fun net_id () () -> let w = List.assoc net_id (Prevalidator.running_workers ()) in RPC_answer.return @@ -474,7 +472,7 @@ let build_rpc_directory node = (* Workers : Block_validator *) let dir = - RPC_directory.register0 dir Shell_services.Workers.Block_validator.state + RPC_directory.register0 dir Worker_services.Block_validator.state (fun () () -> let w = Block_validator.running_worker () in RPC_answer.return @@ -486,7 +484,7 @@ let build_rpc_directory node = (* Workers : Peer validators *) let dir = - RPC_directory.register1 dir Shell_services.Workers.Peer_validators.list + RPC_directory.register1 dir Worker_services.Peer_validators.list (fun net_id () () -> RPC_answer.return (List.filter_map @@ -496,7 +494,7 @@ let build_rpc_directory node = else None) (Peer_validator.running_workers ()))) in let dir = - RPC_directory.register2 dir Shell_services.Workers.Peer_validators.state + RPC_directory.register2 dir Worker_services.Peer_validators.state (fun net_id peer_id () () -> let w = List.assoc (net_id, peer_id) (Peer_validator.running_workers ()) in RPC_answer.return @@ -508,14 +506,14 @@ let build_rpc_directory node = (* Workers : Net validators *) let dir = - RPC_directory.register0 dir Shell_services.Workers.Net_validators.list + RPC_directory.register0 dir Worker_services.Net_validators.list (fun () () -> RPC_answer.return (List.map (fun (id, w) -> (id, Net_validator.status w)) (Net_validator.running_workers ()))) in let dir = - RPC_directory.register1 dir Shell_services.Workers.Net_validators.state + RPC_directory.register1 dir Worker_services.Net_validators.state (fun net_id () () -> let w = List.assoc net_id (Net_validator.running_workers ()) in RPC_answer.return @@ -616,5 +614,5 @@ let build_rpc_directory node = Node.RPC.Network.Point.events node point |> RPC_answer.return in RPC_directory.register1 dir P2p_services.Point.events implementation in let dir = - RPC_directory.register_describe_directory_service dir Services.describe in + RPC_directory.register_describe_directory_service dir Shell_services.describe in dir diff --git a/src/lib_shell/tezos-shell.opam b/src/lib_shell/tezos-shell.opam index 6477573d6..4ef166cfa 100644 --- a/src/lib_shell/tezos-shell.opam +++ b/src/lib_shell/tezos-shell.opam @@ -11,7 +11,6 @@ depends: [ "jbuilder" { build & >= "1.0+beta15" } "tezos-base" "tezos-rpc-http" - "tezos-p2p-services" "tezos-p2p" "tezos-shell-services" "tezos-protocol-updater" diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml new file mode 100644 index 000000000..3131dabe4 --- /dev/null +++ b/src/lib_shell_services/block_services.ml @@ -0,0 +1,436 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Data_encoding + +type block = [ + | `Genesis + | `Head of int | `Prevalidation + | `Test_head of int | `Test_prevalidation + | `Hash of Block_hash.t +] + +type block_info = { + hash: Block_hash.t ; + net_id: Net_id.t ; + level: Int32.t ; + proto_level: int ; (* uint8 *) + predecessor: Block_hash.t ; + timestamp: Time.t ; + validation_passes: int ; (* uint8 *) + operations_hash: Operation_list_list_hash.t ; + fitness: MBytes.t list ; + context: Context_hash.t ; + data: MBytes.t ; + operations: (Operation_hash.t * Operation.t) list list option ; + protocol: Protocol_hash.t ; + test_network: Test_network_status.t ; +} + +let block_info_encoding = + let operation_encoding = + merge_objs + (obj1 (req "hash" Operation_hash.encoding)) + Operation.encoding in + conv + (fun { hash ; net_id ; level ; proto_level ; predecessor ; + fitness ; timestamp ; protocol ; + validation_passes ; operations_hash ; context ; data ; + operations ; test_network } -> + ((hash, net_id, operations, protocol, test_network), + { Block_header.shell = + { level ; proto_level ; predecessor ; + timestamp ; validation_passes ; operations_hash ; fitness ; + context } ; + proto = data })) + (fun ((hash, net_id, operations, protocol, test_network), + { Block_header.shell = + { level ; proto_level ; predecessor ; + timestamp ; validation_passes ; operations_hash ; fitness ; + context } ; + proto = data }) -> + { hash ; net_id ; level ; proto_level ; predecessor ; + fitness ; timestamp ; protocol ; + validation_passes ; operations_hash ; context ; data ; + operations ; test_network }) + (dynamic_size + (merge_objs + (obj5 + (req "hash" Block_hash.encoding) + (req "net_id" Net_id.encoding) + (opt "operations" (dynamic_size (list (dynamic_size (list (dynamic_size operation_encoding)))))) + (req "protocol" Protocol_hash.encoding) + (dft "test_network" + Test_network_status.encoding Not_running)) + Block_header.encoding)) + +let parse_block s = + try + match String.split '~' s with + | ["genesis"] -> Ok `Genesis + | ["head"] -> Ok (`Head 0) + | ["prevalidation"] -> Ok `Prevalidation + | ["test_head"] -> Ok (`Test_head 0) + | ["test_prevalidation"] -> Ok `Test_prevalidation + | ["head"; n] -> Ok (`Head (int_of_string n)) + | ["test_head"; n] -> Ok (`Test_head (int_of_string n)) + | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) + | _ -> raise Exit + with _ -> Error "Cannot parse block identifier." + +let to_string = function + | `Genesis -> "genesis" + | `Head 0 -> "head" + | `Head n -> Printf.sprintf "head~%d" n + | `Prevalidation -> "prevalidation" + | `Test_head 0 -> "test_head" + | `Test_head n -> Printf.sprintf "test_head~%d" n + | `Test_prevalidation -> "test_prevalidation" + | `Hash h -> Block_hash.to_b58check h + +let blocks_arg = + let name = "block_id" in + let descr = + "A block identifier. This is either a block hash in hexadecimal \ + notation or a one the predefined aliases: \ + 'genesis', 'head', 'prevalidation', \ + 'test_head' or 'test_prevalidation'. One might alse use 'head~N' + to 'test_head~N', where N is an integer to denotes the Nth predecessors + of 'head' or 'test_head'." in + let construct = to_string in + let destruct = parse_block in + RPC_arg.make ~name ~descr ~construct ~destruct () + +let block_path : (unit, unit * block) RPC_path.path = + RPC_path.(root / "blocks" /: blocks_arg ) + +let info = + RPC_service.post_service + ~description:"All the information about a block." + ~query: RPC_query.empty + ~input: (obj1 (dft "operations" bool true)) + ~output: block_info_encoding + ~error: Data_encoding.empty + block_path + +let net_id = + RPC_service.post_service + ~description:"Returns the net of the chain in which the block belongs." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "net_id" Net_id.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "net_id") + +let level = + RPC_service.post_service + ~description:"Returns the block's level." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "level" int32)) + ~error: Data_encoding.empty + RPC_path.(block_path / "level") + +let predecessor = + RPC_service.post_service + ~description:"Returns the previous block's id." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "predecessor" Block_hash.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "predecessor") + +let predecessors = + RPC_service.post_service + ~description: + "...." + ~query: RPC_query.empty + ~input: (obj1 (req "length" Data_encoding.uint16)) + ~output: (obj1 + (req "blocks" (Data_encoding.list Block_hash.encoding))) + ~error: Data_encoding.empty + RPC_path.(block_path / "predecessors") + +let hash = + RPC_service.post_service + ~description:"Returns the block's id." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "hash" Block_hash.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "hash") + +let fitness = + RPC_service.post_service + ~description:"Returns the block's fitness." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "fitness" Fitness.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "fitness") + +let context = + RPC_service.post_service + ~description:"Returns the hash of the resulting context." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "context" Context_hash.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "context") + +let timestamp = + RPC_service.post_service + ~description:"Returns the block's timestamp." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "timestamp" Time.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "timestamp") + +type operations_param = { + contents: bool ; + monitor: bool ; +} + +let operations_param_encoding = + let open Data_encoding in + conv + (fun { contents ; monitor } -> (contents, monitor)) + (fun (contents, monitor) -> { contents ; monitor }) + (obj2 + (dft "contents" bool false) + (dft "monitor" bool false)) + +let operations = + RPC_service.post_service + ~description:"List the block operations." + ~query: RPC_query.empty + ~input: operations_param_encoding + ~output: (obj1 + (req "operations" + (list (list + (obj2 + (req "hash" Operation_hash.encoding) + (opt "contents" + (dynamic_size Operation.encoding))))))) + ~error: Data_encoding.empty + RPC_path.(block_path / "operations") + +let protocol = + RPC_service.post_service + ~description:"List the block protocol." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "protocol" Protocol_hash.encoding)) + ~error: Data_encoding.empty + RPC_path.(block_path / "protocol") + +let test_network = + RPC_service.post_service + ~description:"Returns the status of the associated test network." + ~query: RPC_query.empty + ~input: empty + ~output: Test_network_status.encoding + ~error: Data_encoding.empty + RPC_path.(block_path / "test_network") + +let pending_operations = + let operation_encoding = + merge_objs + (obj1 (req "hash" Operation_hash.encoding)) + Operation.encoding in + (* TODO: branch_delayed/... *) + RPC_service.post_service + ~description: + "List the not-yet-prevalidated operations." + ~query: RPC_query.empty + ~input: empty + ~output: + (conv + (fun (preapplied, unprocessed) -> + ({ preapplied with + Preapply_result.refused = Operation_hash.Map.empty }, + Operation_hash.Map.bindings unprocessed)) + (fun (preapplied, unprocessed) -> + (preapplied, + List.fold_right + (fun (h, op) m -> Operation_hash.Map.add h op m) + unprocessed Operation_hash.Map.empty)) + (merge_objs + (dynamic_size + (Preapply_result.encoding RPC_error.encoding)) + (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) + ~error: Data_encoding.empty + RPC_path.(block_path / "pending_operations") + +let proto_path = + RPC_path.(block_path / "proto") + +type preapply_param = { + timestamp: Time.t ; + proto_header: MBytes.t ; + operations: Operation.t list list ; + sort_operations: bool ; +} + +let preapply_param_encoding = + (conv + (fun { timestamp ; proto_header ; operations ; sort_operations } -> + (timestamp, proto_header, operations, sort_operations)) + (fun (timestamp, proto_header, operations, sort_operations) -> + { timestamp ; proto_header ; operations ; sort_operations }) + (obj4 + (req "timestamp" Time.encoding) + (req "proto_header" bytes) + (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding))))) + (dft "sort_operations" bool false))) + +type preapply_result = { + shell_header: Block_header.shell_header ; + operations: error Preapply_result.t list ; +} + +let preapply_result_encoding = + (conv + (fun { shell_header ; operations } -> + (shell_header, operations)) + (fun (shell_header, operations) -> + { shell_header ; operations }) + (obj2 + (req "shell_header" Block_header.shell_header_encoding) + (req "operations" + (list (Preapply_result.encoding RPC_error.encoding))))) + +let preapply = + RPC_service.post_service + ~description: + "Simulate the validation of a block that would contain \ + the given operations and return the resulting fitness." + ~query: RPC_query.empty + ~input: preapply_param_encoding + ~output: (RPC_error.wrap preapply_result_encoding) + ~error: Data_encoding.empty + RPC_path.(block_path / "preapply") + +let complete = + let prefix_arg = + let destruct s = Ok s + and construct s = s in + RPC_arg.make ~name:"prefix" ~destruct ~construct () in + RPC_service.post_service + ~description: "Try to complete a prefix of a Base58Check-encoded data. \ + This RPC is actually able to complete hashes of \ + block, operations, public_keys and contracts." + ~query: RPC_query.empty + ~input: empty + ~output: (list string) + ~error: Data_encoding.empty + RPC_path.(block_path / "complete" /: prefix_arg ) + +type list_param = { + include_ops: bool ; + length: int option ; + heads: Block_hash.t list option ; + monitor: bool option ; + delay: int option ; + min_date: Time.t option; + min_heads: int option; +} +let list_param_encoding = + conv + (fun { include_ops ; length ; heads ; monitor ; + delay ; min_date ; min_heads } -> + (include_ops, length, heads, monitor, delay, min_date, min_heads)) + (fun (include_ops, length, heads, monitor, + delay, min_date, min_heads) -> + { include_ops ; length ; heads ; monitor ; + delay ; min_date ; min_heads }) + (obj7 + (dft "include_ops" + (Data_encoding.describe + ~description: + "Whether the resulting block informations should include the \ + list of operations' hashes. Default false." + bool) false) + (opt "length" + (Data_encoding.describe + ~description: + "The requested number of predecessors to returns (per \ + requested head)." + int31)) + (opt "heads" + (Data_encoding.describe + ~description: + "An empty argument requests blocks from the current heads. \ + A non empty list allow to request specific fragment \ + of the chain." + (list Block_hash.encoding))) + (opt "monitor" + (Data_encoding.describe + ~description: + "When true, the socket is \"kept alive\" after the first \ + answer and new heads are streamed when discovered." + bool)) + (opt "delay" + (Data_encoding.describe + ~description: + "By default only the blocks that were validated by the node \ + are considered. \ + When this optional argument is 0, only blocks with a \ + timestamp in the past are considered. Other values allows to \ + adjust the current time." + int31)) + (opt "min_date" + (Data_encoding.describe + ~description: "When `min_date` is provided, heads with a \ + timestamp before `min_date` are filtered ouf" + Time.encoding)) + (opt "min_heads" + (Data_encoding.describe + ~description:"When `min_date` is provided, returns at least \ + `min_heads` even when their timestamp is before \ + `min_date`." + int31))) + +let list = + RPC_service.post_service + ~description: + "Lists known heads of the blockchain sorted with decreasing fitness. \ + Optional arguments allows to returns the list of predecessors for \ + known heads or the list of predecessors for a given list of blocks." + ~query: RPC_query.empty + ~input: list_param_encoding + ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) + ~error: Data_encoding.empty + RPC_path.(root / "blocks") + +let list_invalid = + RPC_service.post_service + ~description: + "Lists blocks that have been declared invalid along with the errors\ + that led to them being declared invalid" + ~query: RPC_query.empty + ~input:empty + ~output:(Data_encoding.list + (obj3 + (req "block" Block_hash.encoding) + (req "level" int32) + (req "errors" RPC_error.encoding))) + ~error: Data_encoding.empty + RPC_path.(root / "invalid_blocks") + +let unmark_invalid = + RPC_service.post_service + ~description: + "Unmark an invalid block" + ~query: RPC_query.empty + ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding)) + ~output:(RPC_error.wrap Data_encoding.empty) + ~error: Data_encoding.empty + RPC_path.(root / "unmark_invalid") diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli new file mode 100644 index 000000000..c4957854e --- /dev/null +++ b/src/lib_shell_services/block_services.mli @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type block = [ + | `Genesis + | `Head of int | `Prevalidation + | `Test_head of int | `Test_prevalidation + | `Hash of Block_hash.t +] +val blocks_arg : block RPC_arg.arg + +val parse_block: string -> (block, string) result +val to_string: block -> string + +type block_info = { + hash: Block_hash.t ; + net_id: Net_id.t ; + level: Int32.t ; + proto_level: int ; (* uint8 *) + predecessor: Block_hash.t ; + timestamp: Time.t ; + validation_passes: int ; (* uint8 *) + operations_hash: Operation_list_list_hash.t ; + fitness: MBytes.t list ; + context: Context_hash.t ; + data: MBytes.t ; + operations: (Operation_hash.t * Operation.t) list list option ; + protocol: Protocol_hash.t ; + test_network: Test_network_status.t ; +} + +val info: + ([ `POST ], unit, + unit * block, unit, bool, + block_info, unit) RPC_service.t +val net_id: + ([ `POST ], unit, + unit * block, unit, unit, + Net_id.t, unit) RPC_service.t +val level: + ([ `POST ], unit, + unit * block, unit, unit, + Int32.t, unit) RPC_service.t +val predecessor: + ([ `POST ], unit, + unit * block, unit, unit, + Block_hash.t, unit) RPC_service.t +val predecessors: + ([ `POST ], unit, + unit * block , unit, int, + Block_hash.t list, unit) RPC_service.t +val hash: + ([ `POST ], unit, + unit * block, unit, unit, + Block_hash.t, unit) RPC_service.t +val timestamp: + ([ `POST ], unit, + unit * block, unit, unit, + Time.t, unit) RPC_service.t +val fitness: + ([ `POST ], unit, + unit * block, unit, unit, + MBytes.t list, unit) RPC_service.t +val context: + ([ `POST ], unit, + unit * block, unit, unit, + Context_hash.t, unit) RPC_service.t + +type operations_param = { + contents: bool ; + monitor: bool ; +} +val operations: + ([ `POST ], unit, + unit * block, unit, operations_param, + (Operation_hash.t * Operation.t option) list list, unit) RPC_service.t + +val protocol: + ([ `POST ], unit, + unit * block, unit, unit, + Protocol_hash.t, unit) RPC_service.t +val test_network: + ([ `POST ], unit, + unit * block, unit, unit, + Test_network_status.t, unit) RPC_service.t +val pending_operations: + ([ `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 ; + length: int option ; + heads: Block_hash.t list option ; + monitor: bool option ; + delay: int option ; + min_date: Time.t option; + min_heads: int option; +} +val list: + ([ `POST ], unit, + unit, unit, list_param, + block_info list list, unit) RPC_service.t + +val list_invalid: + ([ `POST ], unit, + unit, unit, unit, + (Block_hash.t * int32 * error list) list, unit) RPC_service.t + +val unmark_invalid: + ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult, unit) RPC_service.t + +type preapply_param = { + timestamp: Time.t ; + proto_header: MBytes.t ; + operations: Operation.t list list ; + sort_operations: bool ; +} + +type preapply_result = { + shell_header: Block_header.shell_header ; + operations: error Preapply_result.t list ; +} +val preapply: + ([ `POST ], unit, + unit * block, unit, preapply_param, + preapply_result tzresult, unit) RPC_service.t + +val complete: + ([ `POST ], unit, + (unit * block) * string, unit, unit, + string list, unit) RPC_service.t + +val proto_path: (unit, unit * block) RPC_path.path diff --git a/src/lib_shell_services/jbuild b/src/lib_shell_services/jbuild index c7abaa88b..213006f60 100644 --- a/src/lib_shell_services/jbuild +++ b/src/lib_shell_services/jbuild @@ -3,12 +3,10 @@ (library ((name tezos_shell_services) (public_name tezos-shell-services) - (libraries (tezos-base - tezos-p2p-services)) + (libraries (tezos-base)) (flags (:standard -w -9+27-30-32-40@8 -safe-string - -open Tezos_base__TzPervasives - -open Tezos_p2p_services)))) + -open Tezos_base__TzPervasives)))) (alias ((name runtest_indent) diff --git a/src/lib_p2p_services/p2p_services.ml b/src/lib_shell_services/p2p_services.ml similarity index 100% rename from src/lib_p2p_services/p2p_services.ml rename to src/lib_shell_services/p2p_services.ml diff --git a/src/lib_p2p_services/p2p_services.mli b/src/lib_shell_services/p2p_services.mli similarity index 100% rename from src/lib_p2p_services/p2p_services.mli rename to src/lib_shell_services/p2p_services.mli diff --git a/src/lib_shell_services/protocol_services.ml b/src/lib_shell_services/protocol_services.ml new file mode 100644 index 000000000..1e8392891 --- /dev/null +++ b/src/lib_shell_services/protocol_services.ml @@ -0,0 +1,52 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +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)))) + ~error: Data_encoding.empty + 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))) + ))) + ~error: Data_encoding.empty + RPC_path.(root / "protocols") diff --git a/src/lib_shell_services/protocol_services.mli b/src/lib_shell_services/protocol_services.mli new file mode 100644 index 000000000..5b2207971 --- /dev/null +++ b/src/lib_shell_services/protocol_services.mli @@ -0,0 +1,23 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val contents: + ([ `POST ], unit, + unit * Protocol_hash.t, unit, unit, + Protocol.t, unit) 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, unit) RPC_service.t diff --git a/src/lib_shell_services/shell_services.ml b/src/lib_shell_services/shell_services.ml index a613feb5c..7d8bc8686 100644 --- a/src/lib_shell_services/shell_services.ml +++ b/src/lib_shell_services/shell_services.ml @@ -9,637 +9,6 @@ open Data_encoding -module Blocks = struct - - type block = [ - | `Genesis - | `Head of int | `Prevalidation - | `Test_head of int | `Test_prevalidation - | `Hash of Block_hash.t - ] - - type block_info = { - hash: Block_hash.t ; - net_id: Net_id.t ; - level: Int32.t ; - proto_level: int ; (* uint8 *) - predecessor: Block_hash.t ; - timestamp: Time.t ; - validation_passes: int ; (* uint8 *) - operations_hash: Operation_list_list_hash.t ; - fitness: MBytes.t list ; - context: Context_hash.t ; - data: MBytes.t ; - operations: (Operation_hash.t * Operation.t) list list option ; - protocol: Protocol_hash.t ; - test_network: Test_network_status.t ; - } - - let block_info_encoding = - let operation_encoding = - merge_objs - (obj1 (req "hash" Operation_hash.encoding)) - Operation.encoding in - conv - (fun { hash ; net_id ; level ; proto_level ; predecessor ; - fitness ; timestamp ; protocol ; - validation_passes ; operations_hash ; context ; data ; - operations ; test_network } -> - ((hash, net_id, operations, protocol, test_network), - { Block_header.shell = - { level ; proto_level ; predecessor ; - timestamp ; validation_passes ; operations_hash ; fitness ; - context } ; - proto = data })) - (fun ((hash, net_id, operations, protocol, test_network), - { Block_header.shell = - { level ; proto_level ; predecessor ; - timestamp ; validation_passes ; operations_hash ; fitness ; - context } ; - proto = data }) -> - { hash ; net_id ; level ; proto_level ; predecessor ; - fitness ; timestamp ; protocol ; - validation_passes ; operations_hash ; context ; data ; - operations ; test_network }) - (dynamic_size - (merge_objs - (obj5 - (req "hash" Block_hash.encoding) - (req "net_id" Net_id.encoding) - (opt "operations" (dynamic_size (list (dynamic_size (list (dynamic_size operation_encoding)))))) - (req "protocol" Protocol_hash.encoding) - (dft "test_network" - Test_network_status.encoding Not_running)) - Block_header.encoding)) - - let parse_block s = - try - match String.split '~' s with - | ["genesis"] -> Ok `Genesis - | ["head"] -> Ok (`Head 0) - | ["prevalidation"] -> Ok `Prevalidation - | ["test_head"] -> Ok (`Test_head 0) - | ["test_prevalidation"] -> Ok `Test_prevalidation - | ["head"; n] -> Ok (`Head (int_of_string n)) - | ["test_head"; n] -> Ok (`Test_head (int_of_string n)) - | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) - | _ -> raise Exit - with _ -> Error "Cannot parse block identifier." - - let to_string = function - | `Genesis -> "genesis" - | `Head 0 -> "head" - | `Head n -> Printf.sprintf "head~%d" n - | `Prevalidation -> "prevalidation" - | `Test_head 0 -> "test_head" - | `Test_head n -> Printf.sprintf "test_head~%d" n - | `Test_prevalidation -> "test_prevalidation" - | `Hash h -> Block_hash.to_b58check h - - let blocks_arg = - let name = "block_id" in - let descr = - "A block identifier. This is either a block hash in hexadecimal \ - notation or a one the predefined aliases: \ - 'genesis', 'head', 'prevalidation', \ - 'test_head' or 'test_prevalidation'. One might alse use 'head~N' - to 'test_head~N', where N is an integer to denotes the Nth predecessors - of 'head' or 'test_head'." in - let construct = to_string in - let destruct = parse_block in - RPC_arg.make ~name ~descr ~construct ~destruct () - - let block_path : (unit, unit * block) RPC_path.path = - RPC_path.(root / "blocks" /: blocks_arg ) - - let info = - RPC_service.post_service - ~description:"All the information about a block." - ~query: RPC_query.empty - ~input: (obj1 (dft "operations" bool true)) - ~output: block_info_encoding - ~error: Data_encoding.empty - block_path - - let net_id = - RPC_service.post_service - ~description:"Returns the net of the chain in which the block belongs." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "net_id" Net_id.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "net_id") - - let level = - RPC_service.post_service - ~description:"Returns the block's level." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "level" int32)) - ~error: Data_encoding.empty - RPC_path.(block_path / "level") - - let predecessor = - RPC_service.post_service - ~description:"Returns the previous block's id." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "predecessor" Block_hash.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "predecessor") - - let predecessors = - RPC_service.post_service - ~description: - "...." - ~query: RPC_query.empty - ~input: (obj1 (req "length" Data_encoding.uint16)) - ~output: (obj1 - (req "blocks" (Data_encoding.list Block_hash.encoding))) - ~error: Data_encoding.empty - RPC_path.(block_path / "predecessors") - - let hash = - RPC_service.post_service - ~description:"Returns the block's id." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "hash" Block_hash.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "hash") - - let fitness = - RPC_service.post_service - ~description:"Returns the block's fitness." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "fitness" Fitness.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "fitness") - - let context = - RPC_service.post_service - ~description:"Returns the hash of the resulting context." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "context" Context_hash.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "context") - - let timestamp = - RPC_service.post_service - ~description:"Returns the block's timestamp." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "timestamp" Time.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "timestamp") - - type operations_param = { - contents: bool ; - monitor: bool ; - } - - let operations_param_encoding = - let open Data_encoding in - conv - (fun { contents ; monitor } -> (contents, monitor)) - (fun (contents, monitor) -> { contents ; monitor }) - (obj2 - (dft "contents" bool false) - (dft "monitor" bool false)) - - let operations = - RPC_service.post_service - ~description:"List the block operations." - ~query: RPC_query.empty - ~input: operations_param_encoding - ~output: (obj1 - (req "operations" - (list (list - (obj2 - (req "hash" Operation_hash.encoding) - (opt "contents" - (dynamic_size Operation.encoding))))))) - ~error: Data_encoding.empty - RPC_path.(block_path / "operations") - - let protocol = - RPC_service.post_service - ~description:"List the block protocol." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "protocol" Protocol_hash.encoding)) - ~error: Data_encoding.empty - RPC_path.(block_path / "protocol") - - let test_network = - RPC_service.post_service - ~description:"Returns the status of the associated test network." - ~query: RPC_query.empty - ~input: empty - ~output: Test_network_status.encoding - ~error: Data_encoding.empty - RPC_path.(block_path / "test_network") - - let pending_operations = - let operation_encoding = - merge_objs - (obj1 (req "hash" Operation_hash.encoding)) - Operation.encoding in - (* TODO: branch_delayed/... *) - RPC_service.post_service - ~description: - "List the not-yet-prevalidated operations." - ~query: RPC_query.empty - ~input: empty - ~output: - (conv - (fun (preapplied, unprocessed) -> - ({ preapplied with - Preapply_result.refused = Operation_hash.Map.empty }, - Operation_hash.Map.bindings unprocessed)) - (fun (preapplied, unprocessed) -> - (preapplied, - List.fold_right - (fun (h, op) m -> Operation_hash.Map.add h op m) - unprocessed Operation_hash.Map.empty)) - (merge_objs - (dynamic_size - (Preapply_result.encoding RPC_error.encoding)) - (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) - ~error: Data_encoding.empty - RPC_path.(block_path / "pending_operations") - - let proto_path = - RPC_path.(block_path / "proto") - - type preapply_param = { - timestamp: Time.t ; - proto_header: MBytes.t ; - operations: Operation.t list list ; - sort_operations: bool ; - } - - let preapply_param_encoding = - (conv - (fun { timestamp ; proto_header ; operations ; sort_operations } -> - (timestamp, proto_header, operations, sort_operations)) - (fun (timestamp, proto_header, operations, sort_operations) -> - { timestamp ; proto_header ; operations ; sort_operations }) - (obj4 - (req "timestamp" Time.encoding) - (req "proto_header" bytes) - (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding))))) - (dft "sort_operations" bool false))) - - type preapply_result = { - shell_header: Block_header.shell_header ; - operations: error Preapply_result.t list ; - } - - let preapply_result_encoding = - (conv - (fun { shell_header ; operations } -> - (shell_header, operations)) - (fun (shell_header, operations) -> - { shell_header ; operations }) - (obj2 - (req "shell_header" Block_header.shell_header_encoding) - (req "operations" - (list (Preapply_result.encoding RPC_error.encoding))))) - - let preapply = - RPC_service.post_service - ~description: - "Simulate the validation of a block that would contain \ - the given operations and return the resulting fitness." - ~query: RPC_query.empty - ~input: preapply_param_encoding - ~output: (RPC_error.wrap preapply_result_encoding) - ~error: Data_encoding.empty - RPC_path.(block_path / "preapply") - - let complete = - let prefix_arg = - let destruct s = Ok s - and construct s = s in - RPC_arg.make ~name:"prefix" ~destruct ~construct () in - RPC_service.post_service - ~description: "Try to complete a prefix of a Base58Check-encoded data. \ - This RPC is actually able to complete hashes of \ - block, operations, public_keys and contracts." - ~query: RPC_query.empty - ~input: empty - ~output: (list string) - ~error: Data_encoding.empty - RPC_path.(block_path / "complete" /: prefix_arg ) - - type list_param = { - include_ops: bool ; - length: int option ; - heads: Block_hash.t list option ; - monitor: bool option ; - delay: int option ; - min_date: Time.t option; - min_heads: int option; - } - let list_param_encoding = - conv - (fun { include_ops ; length ; heads ; monitor ; - delay ; min_date ; min_heads } -> - (include_ops, length, heads, monitor, delay, min_date, min_heads)) - (fun (include_ops, length, heads, monitor, - delay, min_date, min_heads) -> - { include_ops ; length ; heads ; monitor ; - delay ; min_date ; min_heads }) - (obj7 - (dft "include_ops" - (Data_encoding.describe - ~description: - "Whether the resulting block informations should include the \ - list of operations' hashes. Default false." - bool) false) - (opt "length" - (Data_encoding.describe - ~description: - "The requested number of predecessors to returns (per \ - requested head)." - int31)) - (opt "heads" - (Data_encoding.describe - ~description: - "An empty argument requests blocks from the current heads. \ - A non empty list allow to request specific fragment \ - of the chain." - (list Block_hash.encoding))) - (opt "monitor" - (Data_encoding.describe - ~description: - "When true, the socket is \"kept alive\" after the first \ - answer and new heads are streamed when discovered." - bool)) - (opt "delay" - (Data_encoding.describe - ~description: - "By default only the blocks that were validated by the node \ - are considered. \ - When this optional argument is 0, only blocks with a \ - timestamp in the past are considered. Other values allows to \ - adjust the current time." - int31)) - (opt "min_date" - (Data_encoding.describe - ~description: "When `min_date` is provided, heads with a \ - timestamp before `min_date` are filtered ouf" - Time.encoding)) - (opt "min_heads" - (Data_encoding.describe - ~description:"When `min_date` is provided, returns at least \ - `min_heads` even when their timestamp is before \ - `min_date`." - int31))) - - let list = - RPC_service.post_service - ~description: - "Lists known heads of the blockchain sorted with decreasing fitness. \ - Optional arguments allows to returns the list of predecessors for \ - known heads or the list of predecessors for a given list of blocks." - ~query: RPC_query.empty - ~input: list_param_encoding - ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) - ~error: Data_encoding.empty - RPC_path.(root / "blocks") - - let list_invalid = - RPC_service.post_service - ~description: - "Lists blocks that have been declared invalid along with the errors\ - that led to them being declared invalid" - ~query: RPC_query.empty - ~input:empty - ~output:(Data_encoding.list - (obj3 - (req "block" Block_hash.encoding) - (req "level" int32) - (req "errors" RPC_error.encoding))) - ~error: Data_encoding.empty - RPC_path.(root / "invalid_blocks") - - let unmark_invalid = - RPC_service.post_service - ~description: - "Unmark an invalid block" - ~query: RPC_query.empty - ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding)) - ~output:(Error.wrap Data_encoding.empty) - ~error: Data_encoding.empty - RPC_path.(root / "unmark_invalid") - -end - -module Protocols = struct - - 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)))) - ~error: Data_encoding.empty - 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))) - ))) - ~error: Data_encoding.empty - RPC_path.(root / "protocols") - -end - -module Workers = struct - - module Prevalidators = struct - - let (net_id_arg : Net_id.t RPC_arg.t) = - RPC_arg.make - ~name:"net_id" - ~descr:"The network identifier of whom the prevalidator is responsible." - ~destruct:(fun s -> try - Ok (Net_id.of_b58check_exn s) - with Failure msg -> Error msg) - ~construct:Net_id.to_b58check - () - - let list = - RPC_service.post_service - ~description:"Lists the Prevalidator workers and their status." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (list - (obj2 - (req "net_id" Net_id.encoding) - (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) - RPC_path.(root / "workers" / "prevalidators") - - let state = - let open Data_encoding in - RPC_service.post_service - ~description:"Introspect the state of a prevalidator worker." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (Worker_types.full_status_encoding - Prevalidator_worker_state.Request.encoding - (Prevalidator_worker_state.Event.encoding RPC_error.encoding) - RPC_error.encoding) - RPC_path.(root / "workers" / "prevalidators" /: net_id_arg ) - - end - - module Block_validator = struct - - let state = - let open Data_encoding in - RPC_service.post_service - ~description:"Introspect the state of the block_validator worker." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (Worker_types.full_status_encoding - Block_validator_worker_state.Request.encoding - (Block_validator_worker_state.Event.encoding RPC_error.encoding) - RPC_error.encoding) - RPC_path.(root / "workers" / "block_validator") - - end - - module Peer_validators = struct - - let (net_id_arg : Net_id.t RPC_arg.t) = - RPC_arg.make - ~name:"net_id" - ~descr:"The network identifier the peer validator is associated to." - ~destruct:(fun s -> try - Ok (Net_id.of_b58check_exn s) - with Failure msg -> Error msg) - ~construct:Net_id.to_b58check - () - - let (peer_id_arg : P2p_peer.Id.t RPC_arg.t) = - RPC_arg.make - ~name:"peer_id" - ~descr:"The peer identifier of whom the prevalidator is responsible." - ~destruct:(fun s -> try - Ok (P2p_peer.Id.of_b58check_exn s) - with Failure msg -> Error msg) - ~construct:P2p_peer.Id.to_b58check - () - - let list = - RPC_service.post_service - ~description:"Lists the peer validator workers and their status." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (list - (obj2 - (req "peer_id" P2p_peer.Id.encoding) - (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) - RPC_path.(root / "workers" / "peer_validators" /: net_id_arg) - - let state = - let open Data_encoding in - RPC_service.post_service - ~description:"Introspect the state of a peer validator worker." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (Worker_types.full_status_encoding - Peer_validator_worker_state.Request.encoding - (Peer_validator_worker_state.Event.encoding RPC_error.encoding) - RPC_error.encoding) - RPC_path.(root / "workers" / "peer_validators" /: net_id_arg /: peer_id_arg) - - end - - module Net_validators = struct - - let (net_id_arg : Net_id.t RPC_arg.t) = - RPC_arg.make - ~name:"net_id" - ~descr:"The network identifier of whom the net validator is responsible." - ~destruct:(fun s -> try - Ok (Net_id.of_b58check_exn s) - with Failure msg -> Error msg) - ~construct:Net_id.to_b58check - () - - let list = - RPC_service.post_service - ~description:"Lists the net validator workers and their status." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (list - (obj2 - (req "net_id" Net_id.encoding) - (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) - RPC_path.(root / "workers" / "net_validators") - - let state = - let open Data_encoding in - RPC_service.post_service - ~description:"Introspect the state of a net validator worker." - ~query: RPC_query.empty - ~error: Data_encoding.empty - ~input: empty - ~output: - (Worker_types.full_status_encoding - Net_validator_worker_state.Request.encoding - (Net_validator_worker_state.Event.encoding RPC_error.encoding) - RPC_error.encoding) - RPC_path.(root / "workers" / "net_validators" /: net_id_arg ) - - end - -end - let forge_block_header = RPC_service.post_service ~description: "Forge a block header" diff --git a/src/lib_shell_services/shell_services.mli b/src/lib_shell_services/shell_services.mli index 6c4fd6c4d..2489f6e19 100644 --- a/src/lib_shell_services/shell_services.mli +++ b/src/lib_shell_services/shell_services.mli @@ -7,229 +7,6 @@ (* *) (**************************************************************************) -module Blocks : sig - - type block = [ - | `Genesis - | `Head of int | `Prevalidation - | `Test_head of int | `Test_prevalidation - | `Hash of Block_hash.t - ] - val blocks_arg : block RPC_arg.arg - - val parse_block: string -> (block, string) result - val to_string: block -> string - - type block_info = { - hash: Block_hash.t ; - net_id: Net_id.t ; - level: Int32.t ; - proto_level: int ; (* uint8 *) - predecessor: Block_hash.t ; - timestamp: Time.t ; - validation_passes: int ; (* uint8 *) - operations_hash: Operation_list_list_hash.t ; - fitness: MBytes.t list ; - context: Context_hash.t ; - data: MBytes.t ; - operations: (Operation_hash.t * Operation.t) list list option ; - protocol: Protocol_hash.t ; - test_network: Test_network_status.t ; - } - - val info: - ([ `POST ], unit, - unit * block, unit, bool, - block_info, unit) RPC_service.t - val net_id: - ([ `POST ], unit, - unit * block, unit, unit, - Net_id.t, unit) RPC_service.t - val level: - ([ `POST ], unit, - unit * block, unit, unit, - Int32.t, unit) RPC_service.t - val predecessor: - ([ `POST ], unit, - unit * block, unit, unit, - Block_hash.t, unit) RPC_service.t - val predecessors: - ([ `POST ], unit, - unit * block , unit, int, - Block_hash.t list, unit) RPC_service.t - val hash: - ([ `POST ], unit, - unit * block, unit, unit, - Block_hash.t, unit) RPC_service.t - val timestamp: - ([ `POST ], unit, - unit * block, unit, unit, - Time.t, unit) RPC_service.t - val fitness: - ([ `POST ], unit, - unit * block, unit, unit, - MBytes.t list, unit) RPC_service.t - val context: - ([ `POST ], unit, - unit * block, unit, unit, - Context_hash.t, unit) RPC_service.t - - type operations_param = { - contents: bool ; - monitor: bool ; - } - val operations: - ([ `POST ], unit, - unit * block, unit, operations_param, - (Operation_hash.t * Operation.t option) list list, unit) RPC_service.t - - val protocol: - ([ `POST ], unit, - unit * block, unit, unit, - Protocol_hash.t, unit) RPC_service.t - val test_network: - ([ `POST ], unit, - unit * block, unit, unit, - Test_network_status.t, unit) RPC_service.t - val pending_operations: - ([ `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 ; - length: int option ; - heads: Block_hash.t list option ; - monitor: bool option ; - delay: int option ; - min_date: Time.t option; - min_heads: int option; - } - val list: - ([ `POST ], unit, - unit, unit, list_param, - block_info list list, unit) RPC_service.t - - val list_invalid: - ([ `POST ], unit, - unit, unit, unit, - (Block_hash.t * int32 * error list) list, unit) RPC_service.t - - val unmark_invalid: - ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult, unit) RPC_service.t - - type preapply_param = { - timestamp: Time.t ; - proto_header: MBytes.t ; - operations: Operation.t list list ; - sort_operations: bool ; - } - - type preapply_result = { - shell_header: Block_header.shell_header ; - operations: error Preapply_result.t list ; - } - val preapply: - ([ `POST ], unit, - unit * block, unit, preapply_param, - preapply_result tzresult, unit) RPC_service.t - - val complete: - ([ `POST ], unit, - (unit * block) * string, unit, unit, - string list, unit) RPC_service.t - - val proto_path: (unit, unit * block) RPC_path.path - - -end - -module Protocols : sig - - val contents: - ([ `POST ], unit, - unit * Protocol_hash.t, unit, unit, - Protocol.t, unit) 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, unit) RPC_service.t - -end - -module Workers : sig - - module Prevalidators : sig - - open Prevalidator_worker_state - - val list : - ([ `POST ], unit, - unit, unit, unit, - (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t - - val state : - ([ `POST ], unit, - unit * Net_id.t, unit, unit, - (Request.view, Event.t) Worker_types.full_status, unit) - RPC_service.t - - end - - module Block_validator : sig - - open Block_validator_worker_state - - val state : - ([ `POST ], unit, - unit, unit, unit, - (Request.view, Event.t) Worker_types.full_status, unit) - RPC_service.t - - end - - module Peer_validators : sig - - open Peer_validator_worker_state - - val list : - ([ `POST ], unit, - unit * Net_id.t, unit, unit, - (P2p_peer.Id.t * Worker_types.worker_status) list, unit) RPC_service.t - - val state : - ([ `POST ], unit, - (unit * Net_id.t) * P2p_peer.Id.t, unit, unit, - (Request.view, Event.t) Worker_types.full_status, unit) - RPC_service.t - - end - - module Net_validators : sig - - open Net_validator_worker_state - - val list : - ([ `POST ], unit, - unit, unit, unit, - (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t - - val state : - ([ `POST ], unit, - unit * Net_id.t, unit, unit, - (Request.view, Event.t) Worker_types.full_status, unit) - RPC_service.t - - end - -end - val forge_block_header: ([ `POST ], unit, unit, unit, Block_header.t, diff --git a/src/lib_shell_services/worker_services.ml b/src/lib_shell_services/worker_services.ml new file mode 100644 index 000000000..5302027b6 --- /dev/null +++ b/src/lib_shell_services/worker_services.ml @@ -0,0 +1,163 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Data_encoding + +module Prevalidators = struct + + let (net_id_arg : Net_id.t RPC_arg.t) = + RPC_arg.make + ~name:"net_id" + ~descr:"The network identifier of whom the prevalidator is responsible." + ~destruct:(fun s -> try + Ok (Net_id.of_b58check_exn s) + with Failure msg -> Error msg) + ~construct:Net_id.to_b58check + () + + let list = + RPC_service.post_service + ~description:"Lists the Prevalidator workers and their status." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (list + (obj2 + (req "net_id" Net_id.encoding) + (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) + RPC_path.(root / "workers" / "prevalidators") + + let state = + let open Data_encoding in + RPC_service.post_service + ~description:"Introspect the state of a prevalidator worker." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (Worker_types.full_status_encoding + Prevalidator_worker_state.Request.encoding + (Prevalidator_worker_state.Event.encoding RPC_error.encoding) + RPC_error.encoding) + RPC_path.(root / "workers" / "prevalidators" /: net_id_arg ) + +end + +module Block_validator = struct + + let state = + let open Data_encoding in + RPC_service.post_service + ~description:"Introspect the state of the block_validator worker." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (Worker_types.full_status_encoding + Block_validator_worker_state.Request.encoding + (Block_validator_worker_state.Event.encoding RPC_error.encoding) + RPC_error.encoding) + RPC_path.(root / "workers" / "block_validator") + +end + +module Peer_validators = struct + + let (net_id_arg : Net_id.t RPC_arg.t) = + RPC_arg.make + ~name:"net_id" + ~descr:"The network identifier the peer validator is associated to." + ~destruct:(fun s -> try + Ok (Net_id.of_b58check_exn s) + with Failure msg -> Error msg) + ~construct:Net_id.to_b58check + () + + let (peer_id_arg : P2p_peer.Id.t RPC_arg.t) = + RPC_arg.make + ~name:"peer_id" + ~descr:"The peer identifier of whom the prevalidator is responsible." + ~destruct:(fun s -> try + Ok (P2p_peer.Id.of_b58check_exn s) + with Failure msg -> Error msg) + ~construct:P2p_peer.Id.to_b58check + () + + let list = + RPC_service.post_service + ~description:"Lists the peer validator workers and their status." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (list + (obj2 + (req "peer_id" P2p_peer.Id.encoding) + (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) + RPC_path.(root / "workers" / "peer_validators" /: net_id_arg) + + let state = + let open Data_encoding in + RPC_service.post_service + ~description:"Introspect the state of a peer validator worker." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (Worker_types.full_status_encoding + Peer_validator_worker_state.Request.encoding + (Peer_validator_worker_state.Event.encoding RPC_error.encoding) + RPC_error.encoding) + RPC_path.(root / "workers" / "peer_validators" /: net_id_arg /: peer_id_arg) + +end + +module Net_validators = struct + + let (net_id_arg : Net_id.t RPC_arg.t) = + RPC_arg.make + ~name:"net_id" + ~descr:"The network identifier of whom the net validator is responsible." + ~destruct:(fun s -> try + Ok (Net_id.of_b58check_exn s) + with Failure msg -> Error msg) + ~construct:Net_id.to_b58check + () + + let list = + RPC_service.post_service + ~description:"Lists the net validator workers and their status." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (list + (obj2 + (req "net_id" Net_id.encoding) + (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) + RPC_path.(root / "workers" / "net_validators") + + let state = + let open Data_encoding in + RPC_service.post_service + ~description:"Introspect the state of a net validator worker." + ~query: RPC_query.empty + ~error: Data_encoding.empty + ~input: empty + ~output: + (Worker_types.full_status_encoding + Net_validator_worker_state.Request.encoding + (Net_validator_worker_state.Event.encoding RPC_error.encoding) + RPC_error.encoding) + RPC_path.(root / "workers" / "net_validators" /: net_id_arg ) + +end + +end diff --git a/src/lib_shell_services/worker_services.mli b/src/lib_shell_services/worker_services.mli new file mode 100644 index 000000000..3b4a8fc6e --- /dev/null +++ b/src/lib_shell_services/worker_services.mli @@ -0,0 +1,71 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Prevalidators : sig + + open Prevalidator_worker_state + + val list : + ([ `POST ], unit, + unit, unit, unit, + (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t + + val state : + ([ `POST ], unit, + unit * Net_id.t, unit, unit, + (Request.view, Event.t) Worker_types.full_status, unit) + RPC_service.t + +end + +module Block_validator : sig + + open Block_validator_worker_state + + val state : + ([ `POST ], unit, + unit, unit, unit, + (Request.view, Event.t) Worker_types.full_status, unit) + RPC_service.t + +end + +module Peer_validators : sig + + open Peer_validator_worker_state + + val list : + ([ `POST ], unit, + unit * Net_id.t, unit, unit, + (P2p_peer.Id.t * Worker_types.worker_status) list, unit) RPC_service.t + + val state : + ([ `POST ], unit, + (unit * Net_id.t) * P2p_peer.Id.t, unit, unit, + (Request.view, Event.t) Worker_types.full_status, unit) + RPC_service.t + +end + +module Net_validators : sig + + open Net_validator_worker_state + + val list : + ([ `POST ], unit, + unit, unit, unit, + (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t + + val state : + ([ `POST ], unit, + unit * Net_id.t, unit, unit, + (Request.view, Event.t) Worker_types.full_status, unit) + RPC_service.t + +end diff --git a/src/proto_alpha/lib_client_alpha/client_proto_rpcs.ml b/src/proto_alpha/lib_client_alpha/client_proto_rpcs.ml index ffe7c9231..e8d839589 100644 --- a/src/proto_alpha/lib_client_alpha/client_proto_rpcs.ml +++ b/src/proto_alpha/lib_client_alpha/client_proto_rpcs.ml @@ -18,10 +18,10 @@ let handle_error (cctxt : #Client_commands.logger) = function let call_service0 cctxt s block = Client_rpcs.call_service0 cctxt - (s Shell_services.Blocks.proto_path) block + (s Block_services.proto_path) block let call_service1 cctxt s block a1 = Client_rpcs.call_service1 cctxt - (s Shell_services.Blocks.proto_path) block a1 + (s Block_services.proto_path) block a1 let call_error_service1 cctxt s block a1 = call_service1 cctxt s block a1 >>= function | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) @@ -29,14 +29,14 @@ let call_error_service1 cctxt s block a1 = | Error _ as err -> Lwt.return err let call_service2 cctxt s block a1 a2 = Client_rpcs.call_service2 cctxt - (s Shell_services.Blocks.proto_path) block a1 a2 + (s Block_services.proto_path) block a1 a2 let call_error_service2 cctxt s block a1 a2 = call_service2 cctxt s block a1 a2 >>= function | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) | Ok (Ok v) -> return v | Error _ as err -> Lwt.return err -type block = Shell_services.Blocks.block +type block = Block_services.block let header cctxt block = call_error_service1 cctxt Services.header block () diff --git a/src/proto_alpha/lib_client_alpha/client_proto_rpcs.mli b/src/proto_alpha/lib_client_alpha/client_proto_rpcs.mli index bad173545..270325520 100644 --- a/src/proto_alpha/lib_client_alpha/client_proto_rpcs.mli +++ b/src/proto_alpha/lib_client_alpha/client_proto_rpcs.mli @@ -10,7 +10,7 @@ val string_of_errors: error list -> string val handle_error: Client_commands.full_context -> 'a tzresult -> 'a Lwt.t -type block = Shell_services.Blocks.block +type block = Block_services.block val header: #Client_rpcs.ctxt -> block -> Block_header.t tzresult Lwt.t diff --git a/src/proto_demo/lib_client_demo/client_proto_rpcs.ml b/src/proto_demo/lib_client_demo/client_proto_rpcs.ml index df5a6f58a..dedea2430 100644 --- a/src/proto_demo/lib_client_demo/client_proto_rpcs.ml +++ b/src/proto_demo/lib_client_demo/client_proto_rpcs.ml @@ -9,7 +9,7 @@ let call_service1 cctxt s block a1 = Client_rpcs.call_service1 cctxt - (s Shell_services.Blocks.proto_path) block a1 + (s Block_services.proto_path) block a1 let call_error_service1 cctxt s block a1 = call_service1 cctxt s block a1 >>= function | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) diff --git a/src/proto_genesis/lib_client_genesis/client_proto_main.ml b/src/proto_genesis/lib_client_genesis/client_proto_main.ml index 838dd66b3..2f06fd9de 100644 --- a/src/proto_genesis/lib_client_genesis/client_proto_main.ml +++ b/src/proto_genesis/lib_client_genesis/client_proto_main.ml @@ -15,7 +15,7 @@ let protocol = let call_service1 rpc_config s block a1 = Client_rpcs.call_service1 rpc_config - (s Shell_services.Blocks.proto_path) block a1 + (s Block_services.proto_path) block a1 let call_error_service1 rpc_config s block a1 = call_service1 rpc_config s block a1 >>= function diff --git a/test/p2p/jbuild b/test/p2p/jbuild index 4bb45b8cf..25b8bf1f7 100644 --- a/test/p2p/jbuild +++ b/test/p2p/jbuild @@ -5,7 +5,6 @@ test_p2p_pool test_p2p_io_scheduler)) (libraries (tezos-base - tezos-p2p-services tezos-p2p lwt.unix test_lib)) @@ -13,7 +12,6 @@ -linkall -safe-string -open Tezos_base__TzPervasives - -open Tezos_p2p_services -open Tezos_p2p)))) (alias