balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor: merge lib_p2p_services into lib_shell_services

Browse Source 
Also split the module `Shell_services` in smaller modules.
This commit is contained in:
Grégoire Henry 2018-01-26 13:07:49 +01:00
parent 7277c9889b
commit 1d5b4c1e3b
37 changed files with 996 additions and 1014 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/bin_node/jbuild
View File

@ -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))))

2
src/lib_client_base/client_admin.ml
View File

@ -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) ;
]

2
src/lib_client_base/client_commands.ml
View File

@ -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

6
src/lib_client_base/client_commands.mli
View File

@ -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

6
src/lib_client_base/client_config.ml
View File

@ -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

6
src/lib_client_base/client_debug.ml
View File

@ -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) ->

61
src/lib_client_base/client_node_rpcs.ml
View File

@ -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

2
src/lib_client_base/client_node_rpcs.mli
View File

@ -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 ->

2
src/lib_client_base/client_rpcs.ml
View File

@ -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

2
src/lib_client_base/client_rpcs.mli
View File

@ -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 -> [>

4
src/lib_client_base/jbuild
View File

@ -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))))

3
src/lib_client_base/tezos-client-base.opam
View File

@ -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"

6
src/lib_p2p/jbuild
View File

@ -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)

1
src/lib_p2p/tezos-p2p.opam
View File

@ -10,7 +10,6 @@ depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta15" }
"tezos-base"
"tezos-p2p-services"
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

12
src/lib_p2p_services/jbuild
View File

@ -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} ${^}))))

19
src/lib_p2p_services/tezos-p2p-services.opam
View File

@ -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 ]
]

2
src/lib_shell/jbuild
View File

@ -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))))

4
src/lib_shell/node.ml
View File

@ -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 ;

4
src/lib_shell/node.mli
View File

@ -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 ->

94
src/lib_shell/node_rpc.ml
View File

@ -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

1
src/lib_shell/tezos-shell.opam
View File

@ -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"

436
src/lib_shell_services/block_services.ml Normal file
View File

@ -0,0 +1,436 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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")

140
src/lib_shell_services/block_services.mli Normal file
View File

@ -0,0 +1,140 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

6
src/lib_shell_services/jbuild
View File

@ -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)

0
src/lib_p2p_services/p2p_services.ml → src/lib_shell_services/p2p_services.ml
View File

0
src/lib_p2p_services/p2p_services.mli → src/lib_shell_services/p2p_services.mli
View File

52
src/lib_shell_services/protocol_services.ml Normal file
View File

@ -0,0 +1,52 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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")

23
src/lib_shell_services/protocol_services.mli Normal file
View File

@ -0,0 +1,23 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

631
src/lib_shell_services/shell_services.ml
View File

@ -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"

223
src/lib_shell_services/shell_services.mli
View File

@ -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,

163
src/lib_shell_services/worker_services.ml Normal file
View File

@ -0,0 +1,163 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

71
src/lib_shell_services/worker_services.mli Normal file
View File

@ -0,0 +1,71 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

8
src/proto_alpha/lib_client_alpha/client_proto_rpcs.ml
View File

@ -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 ()

2
src/proto_alpha/lib_client_alpha/client_proto_rpcs.mli
View File

@ -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

2
src/proto_demo/lib_client_demo/client_proto_rpcs.ml
View File

@ -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)

2
src/proto_genesis/lib_client_genesis/client_proto_main.ml
View File

@ -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

2
test/p2p/jbuild
View File

@ -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