Commit d6f79eda authored by Grégoire Henry's avatar Grégoire Henry Committed by Benjamin Canou

Shell/RPC: rework `/blocks`

- start using `GET` and query parameters instead of `POST` when meaningful - inline parsed protocol data and metadata in block headers - inline parsed protocol data and metadata in operations - split the RPC in four categories: - static data, available explicitly in block headers and operations - static "metadata", information that were computed while validating a block or an operation, but which are not explicit in the block header (e.g. the baker of a block, the list of internal transfer... (currently not implemented, but that's WIP)) - "context" all the static data we may read in the context (contracts balance, list of delegates, ...) - "helpers" are some RPC that may perform some computation.
parent f02972bb
......@@ -5,7 +5,7 @@ Usage
*****
In order to interact with a Tezos node, you may use RPC calls through the
client using this command ``tezos-admin-client rpc post <url>``.
client using this command ``tezos-admin-client rpc (get|post) <url>``.
For instance, if you wish to request the current balance of a given
block and contract, you can call the associated RPC via the command :
......
......@@ -318,7 +318,7 @@ the appropriate value:
$ ./alphanet.sh client list known identities
my_identity: tz1iFY8aDskx9QGbgBy68SNAGgkc7AE2iG9H (public key known) (secret key known)
$ ./alphanet.sh client rpc post /blocks/head/proto/helpers/rights/baking/delegate/tz1iFY8aDskx9QGbgBy68SNAGgkc7AE2iG9H with '{}'
$ ./alphanet.sh client rpc post /chains/main/blocks/head/helpers/rights/baking/delegate/tz1iFY8aDskx9QGbgBy68SNAGgkc7AE2iG9H with {}
{ "ok":
[ { "level": 1400.000000, "priority": 2.000000,
"timestamp": "2017-05-19T03:21:52Z" },
......
......@@ -277,7 +277,7 @@ preconfigured for communicating the same-numbered node. For instance:
::
$ tezos-client rpc post blocks/head/hash
$ tezos-client rpc get /chains/main/blocks/head/hash
{ "hash": "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z" }
When you bootstrap a new network, the network is initialized with a
......@@ -288,11 +288,11 @@ activating the whole network. For instance:
::
$ tezos-client rpc post blocks/head/protocol
$ tezos-client rpc get /chains/main/blocks/head/metadata/next_protocol_hash
{ "protocol": "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" }
$ tezos-activate-alpha
Injected BMBcK869jaHQDc
$ tezos-client rpc post blocks/head/protocol
$ tezos-client rpc get /chains/main/blocks/head/metadata/next_protocol_hash
{ "protocol": "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" }
Tune protocol alpha parameters
......
......@@ -381,8 +381,8 @@ run_shell() {
display_head() {
assert_node_uptodate
exec_docker tezos-client rpc post /blocks/head with '{}'
exec_docker tezos-client rpc post /blocks/head/proto/context/level with '{}'
exec_docker tezos-client rpc get /chains/main/blocks/head
exec_docker tezos-client rpc post /chains/main/blocks/head/context/level with {}
}
## Main ####################################################################
......
......@@ -19,10 +19,10 @@ configure_client() {
wait_for_the_node_to_be_ready() {
local count=0
if "$client" rpc post /blocks/head/hash >/dev/null 2>&1; then return; fi
if "$client" rpc get /chains/main/blocks/head/hash >/dev/null 2>&1; then return; fi
printf "Waiting for the node to initialize..."
sleep 1
while ! "$client" rpc post /blocks/head/hash >/dev/null 2>&1
while ! "$client" rpc get /chains/main/blocks/head/hash >/dev/null 2>&1
do
count=$((count+1))
if [ "$count" -ge 30 ]; then
......
......@@ -10,7 +10,7 @@
open Client_config
let get_commands_for_version ctxt block protocol =
Block_services.protocol ctxt block >>= function
Block_services.Empty.Metadata.next_protocol_hash ctxt ~block () >>= function
| Ok version -> begin
match protocol with
| None ->
......
......@@ -13,13 +13,13 @@ $client -w none config update
sleep 2
#tests for the rpc service raw_context
$client rpc post '/blocks/head/raw_context/version' | assert '{ "content": "616c706861" }'
$client rpc post '/blocks/head/raw_context/non-existent' | assert 'No service found at this URL'
$client rpc post '/blocks/head/raw_context/delegates/?depth=2' | assert '{ "content":
{ "ed25519":
{ "02": null, "a9": null, "c5": null, "da": null, "e7": null } } }'
$client rpc post '/blocks/head/raw_context/non-existent?depth=-1' | assert 'No service found at this URL'
$client rpc post '/blocks/head/raw_context/non-existent?depth=0' | assert 'No service found at this URL'
$client rpc get '/chains/main/blocks/head/context/raw/version' | assert '"616c706861"'
$client rpc get '/chains/main/blocks/head/context/raw/non-existent' | assert 'No service found at this URL'
$client rpc get '/chains/main/blocks/head/context/raw/delegates/?depth=3' | assert '{ "ed25519":
{ "02": { "29": null }, "a9": { "ce": null }, "c5": { "5c": null },
"da": { "c9": null }, "e7": { "67": null } } }'
$client rpc get '/chains/main/blocks/head/context/raw/non-existent?depth=-1' | assert 'Unexpected server answer'
$client rpc get '/chains/main/blocks/head/context/raw/non-existent?depth=0' | assert 'No service found at this URL'
bake
......
......@@ -22,20 +22,19 @@ run_preflight() {
-H "Access-Control-Request-Method: $cors_method" \
-H "Access-Control-Request-Headers: $header" \
-X $method \
-I -s http://localhost:18731/blocks/head/protocol > CURL.$id 2>&1
-I -s http://localhost:18731/chains/main/blocks/head/header/shell > CURL.$id 2>&1
}
run_request() {
local origin="$1"
curl -H "Origin: $origin" \
-H "Content-Type: application/json" \
--data-binary "{}" \
-D CURL.$id \
-s http://localhost:18731/blocks/head/protocol 2>&1 > /dev/null
-s http://localhost:18731/chains/main/blocks/head/header/shell 2>&1 > /dev/null
}
# Preflight
run_preflight "localhost" "OPTIONS" "POST" "Content-Type"
run_preflight "localhost" "OPTIONS" "GET" "Content-Type"
cat CURL.$id
grep -q "access-control-allow-origin" CURL.$id
grep -q "access-control-allow-methods" CURL.$id
......
......@@ -37,7 +37,7 @@ $admin_client list protocols
#these commands cannot be used in this case because the client does not
#know about the new protocol
#$client --protocol $protocol_short bake for bootstrap1 -max-priority 512
#$client --protocol $protocol_version rpc post /blocks/head with {}
#$client --protocol $protocol_version rpc get /chains/main/blocks/head
echo
echo End of test
......
......@@ -19,10 +19,10 @@ protocol_version="PtamL2BUfeNFM2A8Thq2Wde8vNaVD9DhoARDVB41QsHFj89kQpT"
$admin_client inject protocol "$test_dir/demo"
$admin_client list protocols
$client activate protocol $protocol_version with fitness 1 and key dictator and parameters $parameters_file
answ=$($client -p ProtoALphaALph rpc post /blocks/head/protocol with {} 2>/dev/null)
answ=$($client -p ProtoALphaALph rpc get /chains/main/blocks/head/metadata/next_protocol_hash 2>/dev/null)
if ! grep "$protocol_version" <<< $answ ; then
exit 1
exit 1
fi
echo
......
......@@ -37,7 +37,7 @@ $admin_client list protocols
#these commands cannot be used in this case because the client does not
#know about the new protocol
#$client --protocol $protocol_short bake for bootstrap1 -max-priority 512
#$client --protocol $protocol_version rpc post /blocks/head with {}
#$client --protocol $protocol_version rpc get /chains/main/blocks/head
echo
echo End of test
......
......@@ -40,7 +40,7 @@ assert_propagation_level() {
level=$1
printf "\n\nAsserting all nodes have reached level %s\n" "$level"
for client in "${client_instances[@]}"; do
( $client rpc post /blocks/head/proto/context/level \
( $client rpc post /chains/main/blocks/head/context/level with {} \
| assert_in_output "\"level\": $level" ) \
|| exit 2
done
......@@ -51,7 +51,7 @@ assert_protocol() {
proto=$1
printf "\n\nAsserting protocol propagation\n"
for client in "${client_instances[@]}"; do
( $client rpc post /blocks/head/protocol | assert_in_output "$proto" ) \
( $client rpc get /chains/main/blocks/head/metadata/next_protocol_hash | assert_in_output "$proto" ) \
|| exit 2
done
}
......@@ -102,7 +102,7 @@ assert_contains_operation() {
hash="$1"
printf "Asserting operations list contains '$hash'\n"
for client in "${client_instances[@]}"; do
( $client rpc post /blocks/head/operations with {} \
( $client rpc get /chains/main/blocks/head/operation_hashes \
| assert_in_output $hash ) \
|| exit 2
done
......
......@@ -57,10 +57,10 @@ cleanup_clients() {
wait_for_the_node_to_be_ready() {
local count=0
if $client rpc post blocks/head/hash >/dev/null 2>&1; then return; fi
if $client rpc get /chains/main/blocks/head/hash >/dev/null 2>&1; then return; fi
printf "Waiting for the node to initialize..."
sleep 1
while ! $client rpc post blocks/head/hash >/dev/null 2>&1
while ! $client rpc get /chains/main/blocks/head/hash >/dev/null 2>&1
do
count=$((count+1))
if [ "$count" -ge 30 ]; then
......@@ -301,7 +301,7 @@ The client is now properly initialized. In the rest of this shell
session, you might now run \`tezos-client\` to communicate with a
tezos node launched with \`launch-sandboxed-node $1\`. For instance:
tezos-client rpc post blocks/head/protocol
tezos-client rpc get /chains/main/blocks/head/metadata/protocol_hash
Note: if the current protocol version, as reported by the previous
command, is "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im", you
......
......@@ -207,7 +207,7 @@ let init_rpc (rpc_config: Node_config_file.rpc) node =
failwith "Cannot resolve listening address: %S" addr
| (addr, port) :: _ ->
let host = Ipaddr.V6.to_string addr in
let dir = Node_rpc.build_rpc_directory node in
let dir = Node.build_rpc_directory node in
let mode =
match rpc_config.tls with
| None -> `TCP (`Port port)
......
......@@ -9,59 +9,108 @@
let wait_for_operation_inclusion
(ctxt : #Client_context.full)
~chain
?(predecessors = 10)
?(confirmations = 1)
operation_hash =
let confirmed_blocks = Hashtbl.create confirmations in
(* Table of known blocks:
- None: if neither the block or its predecessors contains the operation
- (Some n): if the `n-th` predecessors of the block contains the operation *)
let blocks : int option Block_hash.Table.t =
Block_hash.Table.create confirmations in
(* Fetch _all_ the 'unknown' predecessors af a block. *)
let fetch_predecessors block =
let rec loop acc block =
Block_services.Empty.Header.Shell.predecessor
ctxt ~chain ~block:(`Hash (block, 0)) () >>=? fun predecessor ->
if Block_hash.Table.mem blocks predecessor then
return acc
else
loop (predecessor :: acc) predecessor
in
loop [block] block >>= function
| Ok blocks -> Lwt.return blocks
| Error err ->
ctxt#warning
"Error while fetching block (ignored): %a"
pp_print_error err >>= fun () ->
(* Will be retried when a new head arrives *)
Lwt.return [] in
(* Check whether a block as enough confirmations. This function
assumes that the block predecessor has been processed already. *)
let process block =
Block_services.hash ctxt block >>=? fun hash ->
Block_services.predecessor ctxt block >>=? fun predecessor ->
match Hashtbl.find_opt confirmed_blocks predecessor with
Block_services.Empty.hash ctxt ~chain ~block () >>=? fun hash ->
Block_services.Empty.Header.Shell.predecessor
ctxt ~chain ~block () >>=? fun predecessor ->
match Block_hash.Table.find blocks predecessor with
| Some n ->
ctxt#answer
"Operation received %d confirmations as of block: %a"
(n+1) Block_hash.pp hash >>= fun () ->
if n+1 < confirmations then begin
Hashtbl.add confirmed_blocks hash (n+1) ;
Block_hash.Table.add blocks hash (Some (n+1)) ;
return false
end else
return true
| None ->
Block_services.operations
ctxt ~contents:false block >>=? fun operations ->
Block_services.Empty.Operation_hash.operation_hashes
ctxt ~chain ~block () >>=? fun operations ->
let in_block =
List.exists
(List.exists
(fun (oph, _) -> Operation_hash.equal operation_hash oph))
(Operation_hash.equal operation_hash))
operations in
if not in_block then
if not in_block then begin
Block_hash.Table.add blocks hash None ;
return false
else begin
end else begin
ctxt#answer
"Operation found in block: %a"
Block_hash.pp hash >>= fun () ->
if confirmations <= 0 then
return true
else begin
Hashtbl.add confirmed_blocks hash 0 ;
Block_hash.Table.add blocks hash (Some 0) ;
return false
end
end in
Block_services.monitor
~include_ops:false
~length:predecessors ctxt >>=? fun (stream, stop) ->
let exception WrapError of error list in
let stream = Lwt_stream.map_list List.concat stream in
Lwt.catch
(fun () ->
Lwt_stream.find_s
(fun bi ->
process (`Hash (bi.Block_services.hash, 0)) >>= function
| Ok b -> Lwt.return b
| Error err ->
Lwt.fail (WrapError err)) stream >>= return)
(function
| WrapError e -> Lwt.return (Error e)
| exn -> Lwt.fail exn) >>=? fun _ ->
stop () ;
return ()
Shell_services.Monitor.heads ctxt chain >>=? fun (stream, stop) ->
Lwt_stream.get stream >>= function
| None -> assert false
| Some head ->
let rec loop n =
if n >= 0 then
process (`Hash (head, n)) >>=? function
| true ->
stop () ;
return ()
| false ->
loop (n-1)
else
let exception WrapError of error list in
Lwt.catch
(fun () ->
let stream = Lwt_stream.map_list_s fetch_predecessors stream in
Lwt_stream.find_s
(fun block ->
process (`Hash (block, 0)) >>= function
| Ok b -> Lwt.return b
| Error err ->
Lwt.fail (WrapError err)) stream >>= return)
(function
| WrapError e -> Lwt.return (Error e)
| exn -> Lwt.fail exn) >>=? fun _ ->
stop () ;
return () in
Block_services.Empty.hash
ctxt ~block:(`Hash (head, predecessors+1)) () >>=? fun oldest ->
Block_hash.Table.add blocks oldest None ;
loop predecessors
......@@ -9,6 +9,7 @@
val wait_for_operation_inclusion:
#Client_context.full ->
chain:Chain_services.chain ->
?predecessors:int ->
?confirmations:int ->
Operation_hash.t ->
......
......@@ -20,7 +20,7 @@ let commands () =
(fun () blocks (cctxt : #Client_context.full) ->
iter_s
(fun block ->
Block_services.unmark_invalid cctxt block >>=? fun () ->
Chain_services.Invalid_blocks.delete cctxt block >>=? fun () ->
cctxt#message
"Block %a no longer marked invalid."
Block_hash.pp block >>= fun () ->
......
......@@ -26,7 +26,7 @@ let commands () = Clic.[
~desc: "the prefix of the hash to complete" @@
stop)
(fun unique prefix (cctxt : #Client_context.full) ->
Shell_services.complete
Block_services.Empty.Helpers.complete
cctxt ~block:cctxt#block prefix >>=? fun completions ->
match completions with
| [] -> Pervasives.exit 3
......
......@@ -13,32 +13,14 @@ let skip_line ppf =
Format.pp_print_newline ppf ();
return @@ Format.pp_print_newline ppf ()
let print_heads ppf heads =
Format.pp_print_list ~pp_sep:Format.pp_print_newline
(fun ppf blocks ->
Format.pp_print_list
~pp_sep:Format.pp_print_newline
Block_services.pp_block_info
ppf
blocks)
ppf heads
let print_rejected ppf = function
| [] -> Format.fprintf ppf "No invalid blocks."
| invalid ->
Format.pp_print_list
(fun ppf (hash, level, errors) ->
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Level: %ld\
@ Errors: @[<v>%a@]@]"
Block_hash.pp hash
level
(Format.pp_print_list ~pp_sep:Format.pp_print_newline
Error_monad.pp)
errors)
ppf
invalid
let print_invalid_blocks ppf (b: Chain_services.invalid_block) =
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Level: %ld\
@ %a@]"
Block_hash.pp b.hash
b.level
pp_print_error b.errors
let commands () =
let open Clic in
......@@ -63,28 +45,22 @@ let commands () =
(args1 output_arg)
(fixed [ "list" ; "heads" ])
(fun ppf cctxt ->
Block_services.list ~include_ops:true ~length:1 cctxt >>=? fun heads ->
Format.fprintf ppf "%a@." print_heads heads ;
Chain_services.Blocks.list cctxt () >>=? fun heads ->
Format.fprintf ppf "@[<v>%a@]@."
(Format.pp_print_list Block_hash.pp)
(List.concat heads) ;
return ()) ;
command ~group ~desc: "The blocks that have been marked invalid by the node."
(args1 output_arg)
(fixed [ "list" ; "rejected" ; "blocks" ])
(fun ppf cctxt ->
Block_services.list_invalid cctxt >>=? fun invalid ->
Format.fprintf ppf "%a@." print_rejected invalid ;
return ()) ;
command ~group ~desc: "A full report of the node's state."
(args1 output_arg)
(fixed [ "full" ; "report" ])
(fun ppf cctxt ->
Block_services.list ~include_ops:true ~length:1 cctxt >>=? fun heads ->
Block_services.list_invalid cctxt >>=? fun invalid ->
Format.fprintf ppf
"@[<v 0>@{<title>Date@} %a@,\
@[<v 2>@{<title>Heads@}@,%a@]@,\
@[<v 2>@{<title>Rejected blocks@}@,%a@]@]"
Time.pp_hum (Time.now ())
print_heads heads
print_rejected invalid ;
return ()) ;
Chain_services.Invalid_blocks.list cctxt () >>=? function
| [] ->
Format.fprintf ppf "No invalid blocks." ;
return ()
| _ :: _ as invalid ->
Format.fprintf ppf "@[<v>%a@]@."
(Format.pp_print_list print_invalid_blocks)
invalid ;
return ()) ;
]
......@@ -50,9 +50,7 @@ type quota = {
type rpc_context = {
block_hash: Block_hash.t ;
block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> Operation.t list list Lwt.t ;
block_header: Block_header.shell_header ;
context: Context.t ;
}
......
......@@ -47,9 +47,7 @@ module Make (Context : CONTEXT) = struct
type rpc_context = {
block_hash: Block_hash.t ;
block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> Operation.t list list Lwt.t ;
block_header: Block_header.shell_header ;
context: Context.t ;
}
......@@ -171,9 +169,9 @@ module Make (Context : CONTEXT) = struct
and type operation = P.operation
and type validation_state = P.validation_state
class ['block] proto_rpc_context :
Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t ->
['block] RPC_context.simple
class ['chain, 'block] proto_rpc_context :
Tezos_rpc.RPC_context.t -> (unit, (unit * 'chain) * 'block) RPC_path.t ->
[('chain * 'block)] RPC_context.simple
class ['block] proto_rpc_context_of_directory :
('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
......@@ -589,9 +587,7 @@ module Make (Context : CONTEXT) = struct
type nonrec rpc_context = rpc_context = {
block_hash: Block_hash.t ;
block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> Operation.t list list Lwt.t ;
block_header: Block_header.shell_header ;
context: Context.t ;
}
......@@ -663,47 +659,47 @@ module Make (Context : CONTEXT) = struct
let init c bh = init c bh >|= wrap_error
end
class ['block] proto_rpc_context
class ['chain, 'block] proto_rpc_context
(t : Tezos_rpc.RPC_context.t)
(prefix : (unit, unit * 'block) RPC_path.t) =
(prefix : (unit, (unit * 'chain) * 'block) RPC_path.t) =
object
method call_proto_service0
: 'm 'q 'i 'o.
([< RPC_service.meth ] as 'm, RPC_context.t,
RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
'block -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s block q i ->
('chain * 'block) -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s (chain, block) q i ->
let s = RPC_service.subst0 s in
let s = RPC_service.prefix prefix s in
t#call_service s ((), block) q i
t#call_service s (((), chain), block) q i
method call_proto_service1
: 'm 'a 'q 'i 'o.
([< RPC_service.meth ] as 'm, RPC_context.t,
RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s block a1 q i ->
('chain * 'block) -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s (chain, block) a1 q i ->
let s = RPC_service.subst1 s in
let s = RPC_service.prefix prefix s in
t#call_service s (((), block), a1) q i
t#call_service s ((((), chain), block), a1) q i
method call_proto_service2
: 'm 'a 'b 'q 'i 'o.
([< RPC_service.meth ] as 'm, RPC_context.t,
(RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s block a1 a2 q i ->
('chain * 'block) -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s (chain, block) a1 a2 q i ->
let s = RPC_service.subst2 s in
let s = RPC_service.prefix prefix s in
t#call_service s ((((), block), a1), a2) q i
t#call_service s (((((), chain), block), a1), a2) q i
method call_proto_service3
: 'm 'a 'b 'c 'q 'i 'o.
([< RPC_service.meth ] as 'm, RPC_context.t,
((RPC_context.t * 'a) * 'b) * 'c,
'q, 'i, 'o) RPC_service.t ->
'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s block a1 a2 a3 q i ->
('chain * 'block) -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
= fun s (chain, block) a1 a2 a3 q i ->
let s = RPC_service.subst3 s in
let s = RPC_service.prefix prefix s in
t#call_service s (((((), block), a1), a2), a3) q i
t#call_service s ((((((), chain), block), a1), a2), a3) q i
end
class ['block] proto_rpc_context_of_directory conv dir : ['block] RPC_context.simple =
......
......@@ -40,9 +40,7 @@ module Make (Context : CONTEXT) : sig
type rpc_context = {
block_hash: Block_hash.t ;
block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> Operation.t list list Lwt.t ;
block_header: Block_header.shell_header ;
context: Context.t ;
}
......@@ -164,9 +162,9 @@ module Make (Context : CONTEXT) : sig
and type operation = P.operation
and type validation_state = P.validation_state
class ['block] proto_rpc_context :
Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t ->
['block] RPC_context.simple
class ['chain, 'block] proto_rpc_context :
Tezos_rpc.RPC_context.t -> (unit, (unit * 'chain) * 'block) RPC_path.t ->
[('chain * 'block)] RPC_context.simple
class ['block] proto_rpc_context_of_directory :
('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
......
......@@ -6,6 +6,7 @@
(libraries (tezos-base
tezos-stdlib-unix
tezos-micheline
tezos-shell-services
tezos-protocol-environment-shell
tezos-protocol-compiler.registerer
tezos-protocol-compiler.native
......@@ -16,6 +17,7 @@
-open Tezos_base__TzPervasives
-open Tezos_stdlib_unix
-open Tezos_micheline
-open Tezos_shell_services
-open Tezos_storage))))
(alias
......
......@@ -8,8 +8,13 @@
(**************************************************************************)
module type T = sig
val hash: Protocol_hash.t
include Tezos_protocol_environment_shell.PROTOCOL
module P : sig
val hash: Protocol_hash.t
include Tezos_protocol_environment_shell.PROTOCOL
end
include (module type of (struct include P end))
module Block_services :
(module type of (struct include Block_services.Make(P)(P) end))
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
......@@ -22,9 +27,13 @@ let build_v1 hash =
end in
let module Env = Tezos_protocol_environment_shell.MakeV1(Name)() in
(module struct
let hash = hash
module P = F(Env)
include Env.Lift(P)
module Raw = F(Env)
module P = struct
let hash = hash
include Env.Lift(Raw)
end
include P
module Block_services = Block_services.Make(P)(P)
let complete_b58prefix = Env.Context.complete
end : T)
......@@ -68,8 +77,12 @@ module Register
VersionTable.add
versions hash
(module struct
let hash = hash
include Env.Lift(Proto)