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

Shell/RPC: some module renaming/aliasing

Browse Source
This commit is contained in:
Grégoire Henry 2018-04-22 14:40:44 +02:00 committed by Benjamin Canou
parent 2a93a336aa
commit 64c464a73f
36 changed files with 254 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/bin_client/client_protocols_commands.ml
View File

@ -25,7 +25,7 @@ let commands () =
no_options
(prefixes [ "list" ; "protocols" ] stop)
(fun () (cctxt : #Client_context.full) ->
Protocol_services.list cctxt >>=? fun protos ->
Shell_services.Protocol.list cctxt >>=? fun protos ->
Lwt_list.iter_s (fun ph -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
return ()
);
@ -39,7 +39,7 @@ let commands () =
Lwt.catch
(fun () ->
Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
Injection_services.protocol cctxt proto >>= function
Shell_services.Injection.protocol cctxt proto >>= function
| Ok hash ->
cctxt#message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () ->
return ()
@ -59,7 +59,7 @@ let commands () =
@@ Protocol_hash.param ~name:"protocol hash" ~desc:""
@@ stop)
(fun () ph (cctxt : #Client_context.full) ->
Protocol_services.contents cctxt ph >>=? fun proto ->
Shell_services.Protocol.contents cctxt ph >>=? fun proto ->
Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () ->
cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->
return ()

2
src/bin_client/main_client.ml
View File

@ -10,7 +10,7 @@
open Client_config
let get_commands_for_version ctxt block protocol =
Block_services.Empty.Metadata.next_protocol_hash ctxt ~block () >>= function
Shell_services.Blocks.Metadata.next_protocol_hash ctxt ~block () >>= function
| Ok version -> begin
match protocol with
| None ->

8
src/lib_client_base/client_confirmations.ml
View File

@ -45,8 +45,8 @@ let wait_for_operation_inclusion
assumes that the block predecessor has been processed already. *)
let process block =
Block_services.Empty.hash ctxt ~chain ~block () >>=? fun hash ->
Block_services.Empty.Header.Shell.predecessor
Shell_services.Blocks.hash ctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.Header.Shell.predecessor
ctxt ~chain ~block () >>=? fun predecessor ->
match Block_hash.Table.find blocks predecessor with
| Some n ->
@ -59,7 +59,7 @@ let wait_for_operation_inclusion
end else
return true
| None ->
Block_services.Empty.Operation_hash.operation_hashes
Shell_services.Blocks.Operation_hash.operation_hashes
ctxt ~chain ~block () >>=? fun operations ->
let in_block =
List.exists
@ -81,7 +81,7 @@ let wait_for_operation_inclusion
end
end in
Monitor_services.heads ctxt chain >>=? fun (stream, stop) ->
Shell_services.Monitor.heads ctxt chain >>=? fun (stream, stop) ->
Lwt_stream.get stream >>= function
| None -> assert false
| Some head ->

2
src/lib_client_base/client_context.ml
View File

@ -54,7 +54,7 @@ class type wallet = object
end
class type block = object
method block : Block_services.block
method block : Shell_services.block
method confirmations : int option
end

2
src/lib_client_base/client_context.mli
View File

@ -34,7 +34,7 @@ class type wallet = object
end
class type block = object
method block : Block_services.block
method block : Shell_services.block
method confirmations : int option
end

2
src/lib_client_base_unix/client_config.ml
View File

@ -141,7 +141,7 @@ module Cfg_file = struct
end
type cli_args = {
block: Block_services.block ;
block: Shell_services.block ;
confirmations: int option ;
protocol: Protocol_hash.t option ;
print_timings: bool ;

2
src/lib_client_base_unix/client_context_unix.mli
View File

@ -17,7 +17,7 @@ class unix_logger :
Client_context.printer
class unix_full :
base_dir:string ->
block:Block_services.block ->
block:Shell_services.block ->
confirmations:int option ->
rpc_config:RPC_client.config ->
Client_context.full

2
src/lib_client_commands/client_admin_commands.ml
View File

@ -20,7 +20,7 @@ let commands () =
(fun () blocks (cctxt : #Client_context.full) ->
iter_s
(fun block ->
Chain_services.Invalid_blocks.delete cctxt block >>=? fun () ->
Shell_services.Invalid_blocks.delete cctxt block >>=? fun () ->
cctxt#message
"Block %a no longer marked invalid."
Block_hash.pp block >>= fun () ->

2
src/lib_client_commands/client_helpers_commands.ml
View File

@ -26,7 +26,7 @@ let commands () = Clic.[
~desc: "the prefix of the hash to complete" @@
stop)
(fun unique prefix (cctxt : #Client_context.full) ->
Block_services.Empty.Helpers.complete
Shell_services.Blocks.Helpers.complete
cctxt ~block:cctxt#block prefix >>=? fun completions ->
match completions with
| [] -> Pervasives.exit 3

8
src/lib_client_commands/client_p2p_commands.ml
View File

@ -36,10 +36,10 @@ let commands () =
command ~group ~desc: "show global network status"
no_options
(prefixes ["p2p" ; "stat"] stop) begin fun () (cctxt : #Client_context.full) ->
P2p_services.stat cctxt >>=? fun stat ->
P2p_services.Connections.list cctxt >>=? fun conns ->
P2p_services.Peers.list cctxt >>=? fun peers ->
P2p_services.Points.list cctxt >>=? fun points ->
Shell_services.P2p.stat cctxt >>=? fun stat ->
Shell_services.P2p.Connections.list cctxt >>=? fun conns ->
Shell_services.P2p.Peers.list cctxt >>=? fun peers ->
Shell_services.P2p.Points.list cctxt >>=? fun points ->
cctxt#message "GLOBAL STATS" >>= fun () ->
cctxt#message " %a" P2p_stat.pp stat >>= fun () ->
cctxt#message "CONNECTIONS" >>= fun () ->

6
src/lib_client_commands/client_report_commands.ml
View File

@ -13,7 +13,7 @@ let skip_line ppf =
Format.pp_print_newline ppf ();
return @@ Format.pp_print_newline ppf ()
let print_invalid_blocks ppf (b: Chain_services.invalid_block) =
let print_invalid_blocks ppf (b: Shell_services.Chain.invalid_block) =
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Level: %ld\
@ -45,7 +45,7 @@ let commands () =
(args1 output_arg)
(fixed [ "list" ; "heads" ])
(fun ppf cctxt ->
Chain_services.Blocks.list cctxt () >>=? fun heads ->
Shell_services.Blocks.list cctxt () >>=? fun heads ->
Format.fprintf ppf "@[<v>%a@]@."
(Format.pp_print_list Block_hash.pp)
(List.concat heads) ;
@ -54,7 +54,7 @@ let commands () =
(args1 output_arg)
(fixed [ "list" ; "rejected" ; "blocks" ])
(fun ppf cctxt ->
Chain_services.Invalid_blocks.list cctxt () >>=? function
Shell_services.Invalid_blocks.list cctxt () >>=? function
| [] ->
Format.fprintf ppf "No invalid blocks." ;
return ()

4
src/lib_shell/block_directory.ml
View File

@ -252,6 +252,10 @@ let rpc_directory
(* helpers *)
register0 Shell_services.Blocks.S.Helpers.Forge.block_header begin fun _block () header ->
return (Data_encoding.Binary.to_bytes_exn Block_header.encoding header)
end ;
register0 S.Helpers.Preapply.block begin fun block q p ->
let timestamp =
match q#timestamp with

1
src/lib_shell/node.ml
View File

@ -141,7 +141,6 @@ let build_rpc_directory node =
merge (Protocol_directory.build_rpc_directory node.state) ;
merge (Monitor_directory.build_rpc_directory
node.validator node.mainchain_validator) ;
merge Shell_directory.rpc_directory ;
merge (Injection_directory.build_rpc_directory node.validator) ;
merge (Chain_directory.build_rpc_directory node.validator) ;
merge (P2p.build_rpc_directory node.p2p) ;

20
src/lib_shell/shell_directory.ml
View File

@ -1,20 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let rpc_directory =
let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
let register0 s f =
dir := RPC_directory.register !dir s (fun () p q -> f p q) in
register0 Shell_services.S.forge_block_header begin fun () header ->
return (Data_encoding.Binary.to_bytes_exn Block_header.encoding header)
end ;
!dir

10
src/lib_shell/shell_directory.mli
View File

@ -1,10 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val rpc_directory: unit RPC_directory.t

63
src/lib_shell_services/block_services.ml
View File

@ -9,6 +9,34 @@
open Data_encoding
type chain = [
| `Main
| `Test
| `Hash of Chain_id.t
]
let parse_chain s =
try
match s with
| "main" -> Ok `Main
| "test" -> Ok `Test
| h -> Ok (`Hash (Chain_id.of_b58check_exn h))
with _ -> Error "Cannot parse block identifier."
let chain_to_string = function
| `Main -> "main"
| `Test -> "test"
| `Hash h -> Chain_id.to_b58check h
let chain_arg =
let name = "chain_id" in
let descr =
"A chain identifier. This is either a chain hash in Base58Check notation \
or a one the predefined aliases: 'main', 'test'." in
let construct = chain_to_string in
let destruct = parse_chain in
RPC_arg.make ~name ~descr ~construct ~destruct ()
type block = [
| `Genesis
| `Head of int
@ -44,8 +72,12 @@ let blocks_arg =
let destruct = parse_block in
RPC_arg.make ~name ~descr ~construct ~destruct ()
type prefix = (unit * Chain_services.chain) * block
let path = RPC_path.(Chain_services.S.Blocks.path /: blocks_arg)
type chain_prefix = unit * chain
type prefix = chain_prefix * block
let chain_path = RPC_path.(root / "chains" /: chain_arg)
let dir_path : (chain_prefix, chain_prefix) RPC_path.t =
RPC_path.(open_root / "blocks")
let path = RPC_path.(dir_path /: blocks_arg)
type operation_list_quota = {
max_size: int ;
@ -524,6 +556,18 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
let path = RPC_path.(path / "context" / "helpers")
module Forge = struct
let block_header =
RPC_service.post_service
~description: "Forge a block header"
~query: RPC_query.empty
~input: Block_header.encoding
~output: (obj1 (req "block" bytes))
RPC_path.(path / "forge_block_header")
end
module Preapply = struct
let path = RPC_path.(path / "preapply")
@ -645,7 +689,7 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
end
let path = RPC_path.prefix Chain_services.path path
let path = RPC_path.prefix chain_path path
let make_call0 s ctxt a b q p =
let s = RPC_service.prefix path s in
@ -846,6 +890,19 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct
module S = S.Helpers
module Forge = struct
module S = S.Forge
let block_header ctxt =
let f = make_call0 S.block_header ctxt in
fun
?(chain = `Main) ?(block = `Head 0)
header ->
f chain block () header
end
module Preapply = struct
module S = S.Preapply

40
src/lib_shell_services/block_services.mli
View File

@ -7,7 +7,19 @@
(* *)
(**************************************************************************)
open Chain_services
type chain = [
| `Main
| `Test
| `Hash of Chain_id.t
]
type chain_prefix = unit * chain
val chain_path: (unit, chain_prefix) RPC_path.t
val parse_chain: string -> (chain, string) result
val chain_to_string: chain -> string
val chain_arg: chain RPC_arg.t
type block = [
| `Genesis
@ -17,8 +29,9 @@ type block = [
val parse_block: string -> (block, string) result
val to_string: block -> string
type prefix = (unit * Chain_services.chain) * block
val path: (Chain_services.prefix, Chain_services.prefix * block) RPC_path.t
type prefix = (unit * chain) * block
val dir_path: (chain_prefix, chain_prefix) RPC_path.t
val path: (chain_prefix, chain_prefix * block) RPC_path.t
type operation_list_quota = {
max_size: int ;
@ -55,7 +68,7 @@ end
module Make(Proto : PROTO)(Next_proto : PROTO) : sig
val path: (unit, Chain_services.prefix * block) RPC_path.t
val path: (unit, chain_prefix * block) RPC_path.t
type raw_block_header = {
shell: Block_header.shell_header ;
@ -222,6 +235,17 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig
module Helpers : sig
module Forge : sig
val block_header:
#RPC_context.simple ->
?chain:chain ->
?block:block ->
Block_header.t ->
MBytes.t tzresult Lwt.t
end
module Preapply : sig
val block:
@ -422,6 +446,14 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig
module Helpers : sig
module Forge : sig
val block_header:
([ `POST ], prefix,
prefix, unit, Block_header.t, MBytes.t) RPC_service.service
end
module Preapply : sig
type block_param = {

32
src/lib_shell_services/chain_services.ml
View File

@ -15,30 +15,9 @@ type chain = [
| `Hash of Chain_id.t
]
let parse_chain s =
try
match s with
| "main" -> Ok `Main
| "test" -> Ok `Test
| h -> Ok (`Hash (Chain_id.of_b58check_exn h))
with _ -> Error "Cannot parse block identifier."
let to_string = function
| `Main -> "main"
| `Test -> "test"
| `Hash h -> Chain_id.to_b58check h
let chain_arg =
let name = "chain_id" in
let descr =
"A chain identifier. This is either a chain hash in Base58Check notation \
or a one the predefined aliases: 'main', 'test'." in
let construct = to_string in
let destruct = parse_chain in
RPC_arg.make ~name ~descr ~construct ~destruct ()
type prefix = unit * chain
let path = RPC_path.(root / "chains" /: chain_arg)
let chain_arg = Block_services.chain_arg
let to_string = Block_services.chain_to_string
let parse_chain = Block_services.parse_chain
type invalid_block = {
hash: Block_hash.t ;
@ -46,6 +25,9 @@ type invalid_block = {
errors: error list ;
}
type prefix = Block_services.chain_prefix
let path = Block_services.chain_path
let invalid_block_encoding =
conv
(fun { hash ; level ; errors } -> (hash, level, errors))
@ -206,6 +188,8 @@ module Blocks = struct
end)
()
include Block_services.Empty
end
module Invalid_blocks = struct

2
src/lib_shell_services/chain_services.mli
View File

@ -54,6 +54,8 @@ module Blocks : sig
?min_date:Time.t ->
unit -> Block_hash.t list list tzresult Lwt.t
include (module type of Block_services.Empty)
end
module Invalid_blocks : sig

25
src/lib_shell_services/shell_services.ml
View File

@ -7,21 +7,18 @@
(* *)
(**************************************************************************)
module S = struct
type chain = Chain_services.chain
type block = Block_services.block
open Data_encoding
module Chain = Chain_services
module Blocks = Chain.Blocks
module Invalid_blocks = Chain.Invalid_blocks
module Mempool = Chain.Mempool
let forge_block_header =
RPC_service.post_service
~description: "Forge a block header"
~query: RPC_query.empty
~input: Block_header.encoding
~output: (obj1 (req "block" bytes))
RPC_path.(root / "forge_block_header")
module Protocol = Protocol_services
end
module Monitor = Monitor_services
module Injection = Injection_services
open RPC_context
let forge_block_header ctxt header =
make_call S.forge_block_header ctxt () () header
module P2p = P2p_services
module Worker = Worker_services

22
src/lib_shell_services/shell_services.mli
View File

@ -7,18 +7,18 @@
(* *)
(**************************************************************************)
open RPC_context
type chain = Chain_services.chain
type block = Block_services.block
val forge_block_header:
#simple ->
Block_header.t ->
MBytes.t tzresult Lwt.t
module Chain = Chain_services
module Blocks = Chain.Blocks
module Invalid_blocks = Chain.Invalid_blocks
module Mempool = Chain.Mempool
module S : sig
module Protocol = Protocol_services
val forge_block_header:
([ `POST ], unit,
unit, unit, Block_header.t,
MBytes.t) RPC_service.t
module Monitor = Monitor_services
module Injection = Injection_services
end
module P2p = P2p_services
module Worker = Worker_services

20
src/proto_alpha/lib_baking/client_baking_blocks.ml
View File

@ -22,20 +22,20 @@ type block_info = {
}
let info cctxt ?(chain = `Main) block =
Chain_services.chain_id cctxt ~chain () >>=? fun chain_id ->
Block_services.hash cctxt ~chain ~block () >>=? fun hash ->
Block_services.Header.shell_header cctxt ~chain ~block () >>=? fun header ->
Block_services.Metadata.next_protocol_hash
Shell_services.Chain.chain_id cctxt ~chain () >>=? fun chain_id ->
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.Header.shell_header cctxt ~chain ~block () >>=? fun header ->
Shell_services.Blocks.Metadata.next_protocol_hash
cctxt ~chain ~block () >>=? fun next_protocol ->
Block_services.Metadata.protocol_hash
Shell_services.Blocks.Metadata.protocol_hash
cctxt ~chain ~block () >>=? fun protocol ->
Block_services.Metadata.protocol_data cctxt ~chain ~block () >>=? fun { level } ->
Alpha_block_services.Metadata.protocol_data cctxt ~chain ~block () >>=? fun { level } ->
let { Tezos_base.Block_header.predecessor ; fitness ; timestamp ; _ } = header in
return { hash ; chain_id ; predecessor ; fitness ;
timestamp ; protocol ; next_protocol ; level }
let monitor_valid_blocks cctxt ?chains ?protocols ?next_protocols () =
Monitor_services.valid_blocks cctxt
Shell_services.Monitor.valid_blocks cctxt
?chains ?protocols ?next_protocols () >>=? fun (block_stream, _stop) ->
return (Lwt_stream.map_s
(fun (chain, block) ->
@ -49,11 +49,11 @@ let monitor_heads cctxt ?next_protocols chain =
block_stream)
let blocks_from_cycle cctxt ?(chain = `Main) block cycle =
Block_services.hash cctxt ~chain ~block () >>=? fun hash ->
Block_services.Metadata.protocol_data cctxt ~chain ~block () >>=? fun { level } ->
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
Alpha_block_services.Metadata.protocol_data cctxt ~chain ~block () >>=? fun { level } ->
Alpha_services.Helpers.levels cctxt (chain, block) cycle >>=? fun (first, last) ->
let length = Int32.to_int (Raw_level.diff level.level first) in
Chain_services.Blocks.list cctxt ~heads:[hash] ~length () >>=? fun blocks ->
Shell_services.Blocks.list cctxt ~heads:[hash] ~length () >>=? fun blocks ->
let blocks =
List.remove
(length - (Int32.to_int (Raw_level.diff last first)))

6
src/proto_alpha/lib_baking/client_baking_endorsement.ml
View File

@ -95,7 +95,7 @@ let inject_endorsement
(cctxt : #Proto_alpha.full)
?(chain = `Main) block level ?async
src_sk slots =
Block_services.hash cctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
Alpha_services.Forge.Consensus.endorsement cctxt
(chain, block)
~branch:hash
@ -105,7 +105,7 @@ let inject_endorsement
() >>=? fun bytes ->
Client_keys.append
src_sk ~watermark:Endorsement bytes >>=? fun signed_bytes ->
Injection_services.operation cctxt ?async ~chain signed_bytes >>=? fun oph ->
Shell_services.Injection.operation cctxt ?async ~chain signed_bytes >>=? fun oph ->
iter_s
(fun slot ->
State.record_endorsement cctxt level hash slot oph)
@ -130,7 +130,7 @@ let forge_endorsement (cctxt : #Proto_alpha.full)
?(chain = `Main) block
~src_sk ?slots src_pk =
let src_pkh = Signature.Public_key.hash src_pk in
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
cctxt ~chain ~block () >>=? fun { level = { level } } ->
begin
match slots with

14
src/proto_alpha/lib_baking/client_baking_forge.ml
View File

@ -71,7 +71,7 @@ let inject_block cctxt
let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in
forge_block_header cctxt ~chain block
src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
Injection_services.block cctxt
Shell_services.Injection.block cctxt
?force ~chain signed_header operations >>=? fun block_hash ->
return block_hash
@ -133,7 +133,7 @@ let forge_block cctxt ?(chain = `Main) block
begin
match operations with
| None ->
Chain_services.Mempool.pending_operations
Shell_services.Mempool.pending_operations
cctxt ~chain () >>=? fun (ops, pendings) ->
let ops =
List.map parse @@
@ -198,7 +198,7 @@ let forge_block cctxt ?(chain = `Main) block
let request = List.length operations in
let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in
let operations = classify_operations operations in
Block_services.Helpers.Preapply.block
Alpha_block_services.Helpers.Preapply.block
cctxt ~block ~timestamp ~sort ~protocol_data operations >>=?
fun (shell_header, result) ->
let valid =
@ -403,7 +403,7 @@ let get_unrevealed_nonces
Client_baking_nonces.find cctxt hash >>=? function
| None -> return None
| Some nonce ->
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
cctxt ~chain ~block:(`Hash (hash, 0)) () >>=? fun { level } ->
if force then
return (Some (hash, (level.level, nonce)))
@ -501,7 +501,7 @@ let bake (cctxt : #Proto_alpha.full) state =
lwt_debug "Try baking after %a (slot %d) for %s (%a)"
Block_hash.pp_short bi.hash
priority name Time.pp_hum timestamp >>= fun () ->
Chain_services.Mempool.pending_operations
Shell_services.Mempool.pending_operations
cctxt ~chain () >>=? fun (res, ops) ->
let operations =
List.map parse @@
@ -518,7 +518,7 @@ let bake (cctxt : #Proto_alpha.full) state =
let protocol_data =
forge_faked_protocol_data ~priority ~seed_nonce_hash in
let operations = classify_operations operations in
Block_services.Helpers.Preapply.block
Alpha_block_services.Helpers.Preapply.block
cctxt ~chain ~block
~timestamp ~sort:true ~protocol_data operations >>= function
| Error errs ->
@ -602,7 +602,7 @@ let create
| None | Some (Error _) ->
cctxt#error "Can't fetch the current block head."
| Some (Ok bi) ->
Block_services.hash cctxt ~block:`Genesis () >>=? fun genesis_hash ->
Shell_services.Blocks.hash cctxt ~block:`Genesis () >>=? fun genesis_hash ->
let last_get_block = ref None in
let get_block () =
match !last_get_block with

6
src/proto_alpha/lib_baking/client_baking_revelation.ml
View File

@ -15,17 +15,17 @@ let inject_seed_nonce_revelation rpc_config ?(chain = `Main) block ?async nonces
List.map
(fun (level, nonce) ->
Seed_nonce_revelation { level ; nonce }) nonces in
Block_services.hash rpc_config ~chain ~block () >>=? fun branch ->
Alpha_block_services.hash rpc_config ~chain ~block () >>=? fun branch ->
Alpha_services.Forge.Anonymous.operations rpc_config
(chain, block) ~branch operations >>=? fun bytes ->
Injection_services.operation rpc_config ?async ~chain bytes >>=? fun oph ->
Shell_services.Injection.operation rpc_config ?async ~chain bytes >>=? fun oph ->
return oph
let forge_seed_nonce_revelation
(cctxt: #Proto_alpha.full)
?(chain = `Main)
block nonces =
Block_services.hash cctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
match nonces with
| [] ->
cctxt#message "No nonce to reveal for block %a"

30
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -147,11 +147,12 @@ let init ?exe ?vote ?rpc_port () =
return (pid, hash)
let level (chain, block) =
Block_services.Metadata.protocol_data !rpc_ctxt ~chain ~block () >>=? fun { level } ->
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain ~block () >>=? fun { level } ->
return level
let rpc_raw_context block path depth =
Block_services.Context.Raw.read !rpc_ctxt ~block ~depth path
Shell_services.Blocks.Context.Raw.read !rpc_ctxt ~block ~depth path
module Account = struct
@ -336,12 +337,12 @@ module Protocol = struct
open Account
let voting_period_kind ?(block = `Head 0) () =
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { voting_period_kind } ->
return voting_period_kind
let proposals ?(block = `Head 0) ~src:({ pkh; sk } : Account.t) proposals =
Block_services.hash !rpc_ctxt ~block () >>=? fun hash ->
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
Alpha_services.Helpers.level
!rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
let shell = { Tezos_base.Operation.branch = hash } in
@ -353,7 +354,7 @@ module Protocol = struct
sign ~watermark:Generic_operation sk shell contents
let ballot ?(block = `Head 0) ~src:({ pkh; sk } : Account.t) ~proposal ballot =
Block_services.hash !rpc_ctxt ~block () >>=? fun hash ->
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
Alpha_services.Helpers.level
!rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
let shell = { Tezos_base.Operation.branch = hash } in
@ -489,7 +490,7 @@ module Assert = struct
end
let check_protocol ?msg ~block h =
Block_services.Metadata.next_protocol_hash
Alpha_block_services.Metadata.next_protocol_hash
!rpc_ctxt ~block () >>=? fun block_proto ->
return @@ equal
?msg
@ -498,7 +499,7 @@ module Assert = struct
block_proto h
let check_voting_period_kind ?msg ~block kind =
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { voting_period_kind } ->
return @@ equal
?msg
@ -516,7 +517,8 @@ module Baking = struct
let bake block (contract: Account.t) operations =
let ctxt = (new wrap_full (no_write_context ~block !rpc_config)) in
Alpha_services.Helpers.level ctxt ~offset:1l (`Main, block) >>=? fun level ->
Alpha_services.Helpers.level
ctxt ~offset:1l (`Main, block) >>=? fun level ->
let seed_nonce_hash =
if level.Level.expected_commitment then
let seed_nonce =
@ -549,8 +551,8 @@ module Endorse = struct
block
src_sk
slot =
Block_services.hash !rpc_ctxt ~block () >>=? fun hash ->
Block_services.Metadata.protocol_data
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { level } ->
let level = level.level in
let shell = { Tezos_base.Operation.branch = hash } in
@ -573,7 +575,7 @@ module Endorse = struct
?slot
(contract : Account.t)
block =
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { level } ->
let level = level.level in
begin
@ -602,7 +604,7 @@ module Endorse = struct
| _ -> () in
let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in
let result = Array.make 32 b1 in
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { level } ->
let level = level.level in
get_endorser_list result b1 level block >>=? fun () ->
@ -614,7 +616,7 @@ module Endorse = struct
let endorsement_rights
(contract : Account.t) block =
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { level } ->
let level = level.level in
let delegate = contract.pkh in
@ -629,7 +631,7 @@ module Endorse = struct
end
let display_level block =
Block_services.Metadata.protocol_data
Alpha_block_services.Metadata.protocol_data
!rpc_ctxt ~chain:`Main ~block () >>=? fun { level } ->
Format.eprintf "Level: %a@." Level.pp_full level ;
return ()

52
src/proto_alpha/lib_client/client_proto_context.mli
View File

@ -12,36 +12,36 @@ open Alpha_context
val list_contract_labels:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
(string * string * string) list tzresult Lwt.t
val get_storage:
#Proto_alpha.rpc_context ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
Script.expr option tzresult Lwt.t
val get_manager:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
(string * public_key_hash *
public_key * Client_keys.sk_uri) tzresult Lwt.t
val get_balance:
#Proto_alpha.rpc_context ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
Tez.t tzresult Lwt.t
val set_delegate:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
fee:Tez.tez ->
Contract.t ->
@ -52,8 +52,8 @@ val set_delegate:
val register_as_delegate:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
fee:Tez.tez ->
manager_sk:Client_keys.sk_uri ->
@ -62,15 +62,15 @@ val register_as_delegate:
val source_to_keys:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
(public_key * Client_keys.sk_uri) tzresult Lwt.t
val originate_account :
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?branch:int ->
source:Contract.t ->
@ -92,8 +92,8 @@ val save_contract :
val originate_contract:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?branch:int ->
fee:Tez.t ->
@ -113,8 +113,8 @@ val originate_contract:
val transfer :
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?branch:int ->
source:Contract.t ->
@ -131,8 +131,8 @@ val transfer :
val reveal :
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?branch:int ->
source:Contract.t ->
@ -143,8 +143,8 @@ val reveal :
val dictate :
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
dictator_operation ->
Client_keys.sk_uri ->
@ -163,8 +163,8 @@ val activation_key_encoding: activation_key Data_encoding.t
val claim_commitment:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?encrypted:bool ->
?force:bool ->

8
src/proto_alpha/lib_client/client_proto_contracts.mli
View File

@ -43,15 +43,15 @@ val list_contracts:
val get_manager:
#Proto_alpha.rpc_context ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
public_key_hash tzresult Lwt.t
val get_delegate:
#Proto_alpha.rpc_context ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
Contract.t ->
public_key_hash option tzresult Lwt.t

20
src/proto_alpha/lib_client/client_proto_programs.mli
View File

@ -16,8 +16,8 @@ module Program : Client_aliases.Alias
val run :
#Proto_alpha.rpc_context ->
?chain:Chain_services.chain ->
Block_services.block ->
?chain:Shell_services.chain ->
Shell_services.block ->
?contract:Contract.t ->
?amount:Tez.t ->
program:Michelson_v1_parser.parsed ->
@ -30,8 +30,8 @@ val run :
val trace :
#Proto_alpha.rpc_context ->
?chain:Chain_services.chain ->
Block_services.block ->
?chain:Shell_services.chain ->
Shell_services.block ->
?contract:Contract.t ->
?amount:Tez.t ->
program:Michelson_v1_parser.parsed ->
@ -63,8 +63,8 @@ val print_trace_result :
val hash_and_sign :
#Proto_alpha.full ->
?chain:Chain_services.chain ->
Block_services.block ->
?chain:Shell_services.chain ->
Shell_services.block ->
?gas:Z.t ->
Michelson_v1_parser.parsed ->
Michelson_v1_parser.parsed ->
@ -73,8 +73,8 @@ val hash_and_sign :
val typecheck_data :
#Proto_alpha.rpc_context ->
?chain:Chain_services.chain ->
Block_services.block ->
?chain:Shell_services.chain ->
Shell_services.block ->
?gas:Z.t ->
data:Michelson_v1_parser.parsed ->
ty:Michelson_v1_parser.parsed ->
@ -83,8 +83,8 @@ val typecheck_data :
val typecheck_program :
#Proto_alpha.rpc_context ->
?chain:Chain_services.chain ->
Block_services.block ->
?chain:Shell_services.chain ->
Shell_services.block ->
?gas:Z.t ->
Michelson_v1_parser.parsed ->
(Script_tc_errors.type_map * Gas.t) tzresult Lwt.t

10
src/proto_alpha/lib_client/injection.ml
View File

@ -20,7 +20,7 @@ let get_branch (rpc_config: #Proto_alpha.full)
| `Hash (h,n) -> return (`Hash (h,n+branch))
| `Genesis -> return `Genesis
end >>=? fun block ->
Block_services.hash rpc_config ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.hash rpc_config ~chain ~block () >>=? fun hash ->
return hash
type result = Operation_hash.t * operation * operation_result
@ -51,8 +51,8 @@ let preapply
{ shell = { branch } ;
protocol_data = { contents ; signature } } in
let oph = Operation.hash op in
Block_services.Helpers.Preapply.operations cctxt ~chain ~block
[op] >>=? function
Alpha_block_services.Helpers.Preapply.operations
cctxt ~chain ~block [op] >>=? function
| [result] -> return (oph, op, result)
| _ -> failwith "Unexpected result"
@ -176,7 +176,7 @@ let inject_operation
Lwt.return res
end >>=? fun () ->
let bytes = Data_encoding.Binary.to_bytes_exn Operation.encoding op in
Injection_services.operation cctxt ~chain bytes >>=? fun oph ->
Shell_services.Injection.operation cctxt ~chain bytes >>=? fun oph ->
cctxt#message "Operation successfully injected in the node." >>= fun () ->
cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
begin
@ -185,7 +185,7 @@ let inject_operation
| Some confirmations ->
cctxt#message "Waiting for the operation to be included..." >>= fun () ->
Client_confirmations.wait_for_operation_inclusion
~confirmations cctxt ~chain oph >>=? fun () ->
~confirmations cctxt ~chain oph >>=? fun _ ->
return ()
end >>=? fun () ->
cctxt#message

8
src/proto_alpha/lib_client/injection.mli
View File

@ -15,8 +15,8 @@ type result = Operation_hash.t * operation * operation_result
val preapply:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?branch:int ->
?src_sk:Client_keys.sk_uri ->
Operation.contents ->
@ -24,8 +24,8 @@ val preapply:
val inject_operation:
#Proto_alpha.full ->
chain:Chain_services.chain ->
block:Block_services.block ->
chain:Shell_services.chain ->
block:Shell_services.block ->
?confirmations:int ->
?branch:int ->
?src_sk:Client_keys.sk_uri ->

19
src/proto_alpha/lib_client/proto_alpha.ml
View File

@ -10,15 +10,12 @@
module Name = struct let name = "alpha" end
module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)()
module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
module Block_services = struct
include Block_services
include Block_services.Make(Proto)(Proto)
end
module Alpha_block_services = Block_services.Make(Proto)(Proto)
include Proto
class type rpc_context = object
inherit RPC_context.json
inherit [Chain_services.chain * Block_services.block] Alpha_environment.RPC_context.simple
inherit [Shell_services.chain * Shell_services.block] Alpha_environment.RPC_context.simple
end
class wrap_proto_context (t : RPC_context.json) : rpc_context = object
@ -32,20 +29,20 @@ class wrap_proto_context (t : RPC_context.json) : rpc_context = object
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = t#call_streamed_service
inherit [Chain_services.chain,
Block_services.block] Alpha_environment.proto_rpc_context
inherit [Shell_services.chain,
Shell_services.block] Alpha_environment.proto_rpc_context
(t :> RPC_context.t)
Block_services.path
Shell_services.Blocks.path
end
class type full = object
inherit Client_context.full
inherit [Chain_services.chain * Block_services.block] Alpha_environment.RPC_context.simple
inherit [Shell_services.chain * Shell_services.block] Alpha_environment.RPC_context.simple
end
class wrap_full (t : Client_context.full) : full = object
inherit Client_context.proxy_context t
inherit [Chain_services.chain, Block_services.block] Alpha_environment.proto_rpc_context
inherit [Shell_services.chain, Shell_services.block] Alpha_environment.proto_rpc_context
(t :> RPC_context.t)
Block_services.path
Shell_services.Blocks.path
end

2
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -56,7 +56,7 @@ let commands () =
(switch ~doc:"output time in seconds" ~short:'s' ~long:"seconds" ()))
(fixed [ "get" ; "timestamp" ])
begin fun seconds (cctxt : Proto_alpha.full) ->
Block_services.Header.Shell.timestamp
Shell_services.Blocks.Header.Shell.timestamp
cctxt ~block:cctxt#block () >>=? fun v ->
begin
if seconds

4
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -15,12 +15,12 @@ let protocol =
let bake cctxt ?(timestamp = Time.now ()) block command sk =
let protocol_data = { command ; signature = Signature.zero } in
Block_services.Helpers.Preapply.block
Genesis_block_services.Helpers.Preapply.block
cctxt ~block ~timestamp ~protocol_data
[] >>=? fun (shell_header, _) ->
let blk = Data.Command.forge shell_header command in
Client_keys.append sk blk >>=? fun signed_blk ->
Injection_services.block cctxt signed_blk []
Shell_services.Injection.block cctxt signed_blk []
let int64_parameter =
(Clic.parameter (fun _ p ->

2
src/proto_genesis/lib_client/client_proto_main.mli
View File

@ -12,7 +12,7 @@ open Proto_genesis
val bake:
#Client_context.full ->
?timestamp: Time.t ->
Block_services.block ->
Shell_services.block ->
Data.Command.t ->
Client_keys.sk_uri ->
Block_hash.t tzresult Lwt.t

5
src/proto_genesis/lib_client/proto_genesis.ml
View File

@ -10,8 +10,5 @@
module Name = struct let name = "genesis" end
module Genesis_environment = Tezos_protocol_environment_faked.MakeV1(Name)()
module Proto = Tezos_protocol_genesis.Functor.Make(Genesis_environment)
module Block_services = struct
include Block_services
include Block_services.Make(Proto)(Proto)
end
module Genesis_block_services = Block_services.Make(Proto)(Proto)
include Proto