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

Shell: Rename net_id into chain_id

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-16 01:26:24 +01:00
parent e2be3360a9
commit 6fa1283240
110 changed files with 1448 additions and 1419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
docs/whitedoc/validation.rst
View File

@ -26,20 +26,18 @@ considers to be the current head of the blockchain.
The validator is written as a collection of workers: local event loops
communicating with each other via message passing. Workers are spawned
and killed dynamically, according to connected peers, incoming blocks
to validate, and active (test)nets.
to validate, and active (test)chains.
A *net validator* worker is launched by the validator for each *net*
that it considers alive. A *net* is how we call subset of block chains
that go through a given root block. This should not be mixed up with
the *net* in *peer-to-peer network*. Each net validator is responsible
for handling blocks that belong to this net, and select the best head
for this net. A main net validator is spawned for the main chain that
A *chain validator* worker is launched by the validator for each
*chain* that it considers alive. Each chain validator is responsible for
handling blocks that belong to this chain, and select the best head for
this chain. A main chain validator is spawned for the main chain that
starts at the genesis, a second one when there is an active test
chain. Forking a net is decided from within the economic protocol.
In version Alpha, this is only used to try new protocols before self
amending the main net.
chain. Forking a chain is decided from within the economic protocol. In
version Alpha, this is only used to try new protocols before self
amending the main chain.
The net validator spawns one *peer validator* worker per connected
The chain validator spawns one *peer validator* worker per connected
peer. This set updated, grown or shrinked on the fly, according to the
connections and deconnection signals from the peer-to-peer component.
Each peer validator will treat new head proposals from the associated
@ -78,8 +76,8 @@ everything needed for a block, they will call the *block validator*.
The *block validator* validates blocks (currently in sequence),
assuming that all the necessary data have already been retrieved from
the peer-to-peer network. When a block is valid, it will notify the
correspondig net validator, that may update its head. In this case,
the net validator will propagate this information to its associated
correspondig chain validator, that may update its head. In this case,
the chain validator will propagate this information to its associated
*prevalidator*, and may decide to kill or spawn the test network
according to the protocol's decision.
@ -87,10 +85,10 @@ Prevalidator
------------
.. _prevalidator_component:
To each net validator is associated a *prevalidator* (this may become
To each chain validator is associated a *prevalidator* (this may become
an option in the future, to allow running nodes on machines with less
RAM), that is responsible for the transmission of operations for this
net over the peer-to-peer network.
chain over the peer-to-peer network.
To prevent spam, this prevalidator must select the set of operations
that it considers valid, and the ones that it chooses to broadcast.

10
src/bin_attacker/attacker_minimal.ml
View File

@ -16,7 +16,7 @@ module Proto = Client_embedded_proto_alpha
let genesis_block_hashed = Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let network = Store.Net genesis_block_hashed
let network = Store.Net_id.Id genesis_block_hashed
let network = Store.Chain_id.Id genesis_block_hashed
(* the bootstrap accounts and actions like signing to do with them *)
let source_account = List.nth Proto.Bootstrap_storage.accounts 4
@ -32,7 +32,7 @@ let block_forged ?prev ops =
[ MBytes.of_string Proto.Constants_repr.version_number ;
Proto.Fitness_repr.int64_to_bytes x ] in
let pred = match prev with None -> genesis_block_hashed | Some x -> x in
let block ops = Store.Block_header.{ net_id = network ;
let block ops = Store.Block_header.{ chain_id = network ;
predecessor = pred ;
timestamp = Time.now () ;
fitness = from_int64 1L;
@ -75,7 +75,7 @@ let tx_forged ?dest amount fee =
fee = of_cents_exn fee ;
counter = 1l ;
operations = [tx] ; }) in
forge { net_id = network } op
forge { chain_id = network } op
(* forge a list of proposals, california eat your heart out *)
let props_forged period props =
@ -87,7 +87,7 @@ let props_forged period props =
let op = Sourced_operations (Delegate_operations {
source = src.public_key ;
operations = [props] }) in
forge { net_id = network } op
forge { chain_id = network } op
(* "forge" a ballot *)
let ballot_forged period prop vote =
@ -101,7 +101,7 @@ let ballot_forged period prop vote =
let op = Sourced_operations (Delegate_operations {
source = src.public_key ;
operations = [ballot] }) in
forge { net_id = network } op
forge { chain_id = network } op
let identity = P2p_identity.generate Crypto_box.default_target

2
src/bin_client/main_admin.ml
View File

@ -12,7 +12,7 @@ let select_commands _ _ =
(List.flatten
[ Client_report_commands.commands () ;
Client_admin_commands.commands () ;
Client_network_commands.commands () ;
Client_p2p_commands.commands () ;
Client_protocols_commands.commands () ;
Client_rpc_commands.commands ])

2
src/bin_client/main_client.ml
View File

@ -42,7 +42,7 @@ let get_commands_for_version ctxt block protocol =
let select_commands ctxt { block ; protocol } =
get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) ->
Client_rpc_commands.commands @
Client_network_commands.commands () @
Client_p2p_commands.commands () @
Client_keys_commands.commands () @
Client_helpers_commands.commands () @
commands_for_version

4
src/bin_client/test/test_multinode.sh
View File

@ -19,10 +19,10 @@ done
for client in "${client_instances[@]}"; do
echo
echo "### $client network stat"
echo "### $client p2p stat"
echo
$client bootstrapped
$client network stat
$client p2p stat
echo
done

122
src/bin_node/node_config_file.ml
View File

@ -14,18 +14,18 @@ let home =
with Not_found -> "/root"
let default_data_dir = home // ".tezos-node"
let default_net_port = 9732
let default_p2p_port = 9732
let default_rpc_port = 8732
type t = {
data_dir : string ;
net : net ;
p2p : p2p ;
rpc : rpc ;
log : log ;
shell : shell ;
}
and net = {
and p2p = {
expected_pow : float ;
bootstrap_peers : string list ;
listen_addr : string option ;
@ -56,10 +56,10 @@ and shell = {
block_validator_limits : Node.block_validator_limits ;
prevalidator_limits : Node.prevalidator_limits ;
peer_validator_limits : Node.peer_validator_limits ;
net_validator_limits : Node.net_validator_limits ;
chain_validator_limits : Node.chain_validator_limits ;
}
let default_net_limits : P2p.limits = {
let default_p2p_limits : P2p.limits = {
authentification_timeout = 5. ;
min_connections = 10 ;
expected_connections = 50 ;
@ -82,12 +82,12 @@ let default_net_limits : P2p.limits = {
binary_chunks_size = None ;
}
let default_net = {
let default_p2p = {
expected_pow = 24. ;
bootstrap_peers = ["bootstrap.tezos.com"] ;
listen_addr = Some ("[::]:" ^ string_of_int default_net_port) ;
listen_addr = Some ("[::]:" ^ string_of_int default_p2p_port) ;
closed = false ;
limits = default_net_limits ;
limits = default_p2p_limits ;
}
let default_rpc = {
@ -136,7 +136,7 @@ let default_shell = {
zombie_memory = 120. ;
}
} ;
net_validator_limits = {
chain_validator_limits = {
bootstrap_threshold = 4 ;
worker_limits = {
backlog_size = 1000 ;
@ -149,7 +149,7 @@ let default_shell = {
let default_config = {
data_dir = default_data_dir ;
net = default_net ;
p2p = default_p2p ;
rpc = default_rpc ;
log = default_log ;
shell = default_shell ;
@ -202,38 +202,38 @@ let limit : P2p.limits Data_encoding.t =
(merge_objs
(obj10
(dft "authentification-timeout"
float default_net_limits.authentification_timeout)
float default_p2p_limits.authentification_timeout)
(dft "min-connections" uint16
default_net_limits.min_connections)
default_p2p_limits.min_connections)
(dft "expected-connections" uint16
default_net_limits.expected_connections)
default_p2p_limits.expected_connections)
(dft "max-connections" uint16
default_net_limits.max_connections)
default_p2p_limits.max_connections)
(dft "backlog" uint8
default_net_limits.backlog)
default_p2p_limits.backlog)
(dft "max-incoming-connections" uint8
default_net_limits.max_incoming_connections)
default_p2p_limits.max_incoming_connections)
(opt "max-download-speed" int31)
(opt "max-upload-speed" int31)
(dft "swap-linger" float default_net_limits.swap_linger)
(dft "swap-linger" float default_p2p_limits.swap_linger)
(opt "binary-chunks-size" uint8))
(obj10
(dft "read-buffer-size" int31
default_net_limits.read_buffer_size)
default_p2p_limits.read_buffer_size)
(opt "read-queue-size" int31)
(opt "write-queue-size" int31)
(opt "incoming-app-message-queue-size" int31)
(opt "incoming-message-queue-size" int31)
(opt "outgoing-message-queue-size" int31)
(dft "known_points_history_size" uint16
default_net_limits.known_points_history_size)
default_p2p_limits.known_points_history_size)
(dft "known_peer_ids_history_size" uint16
default_net_limits.known_points_history_size)
default_p2p_limits.known_points_history_size)
(opt "max_known_points" (tup2 uint16 uint16))
(opt "max_known_peer_ids" (tup2 uint16 uint16))
))
let net =
let p2p =
let open Data_encoding in
conv
(fun { expected_pow ; bootstrap_peers ;
@ -245,12 +245,12 @@ let net =
{ expected_pow ; bootstrap_peers ;
listen_addr ; closed ; limits })
(obj5
(dft "expected-proof-of-work" float default_net.expected_pow)
(dft "expected-proof-of-work" float default_p2p.expected_pow)
(dft "bootstrap-peers"
(list string) default_net.bootstrap_peers)
(list string) default_p2p.bootstrap_peers)
(opt "listen-addr" string)
(dft "closed" bool false)
(dft "limits" limit default_net_limits))
(dft "limits" limit default_p2p_limits))
let rpc : rpc Data_encoding.t =
let open Data_encoding in
@ -389,7 +389,7 @@ let peer_validator_limits_encoding =
default_limits.worker_limits.zombie_lifetime
default_limits.worker_limits.zombie_memory))
let net_validator_limits_encoding =
let chain_validator_limits_encoding =
let open Data_encoding in
conv
(fun { Node.bootstrap_threshold ; worker_limits } ->
@ -399,42 +399,42 @@ let net_validator_limits_encoding =
(merge_objs
(obj1
(dft "bootstrap_threshold" uint8
default_shell.net_validator_limits.bootstrap_threshold))
default_shell.chain_validator_limits.bootstrap_threshold))
(worker_limits_encoding
default_shell.net_validator_limits.worker_limits.backlog_size
default_shell.net_validator_limits.worker_limits.backlog_level
default_shell.net_validator_limits.worker_limits.zombie_lifetime
default_shell.net_validator_limits.worker_limits.zombie_memory))
default_shell.chain_validator_limits.worker_limits.backlog_size
default_shell.chain_validator_limits.worker_limits.backlog_level
default_shell.chain_validator_limits.worker_limits.zombie_lifetime
default_shell.chain_validator_limits.worker_limits.zombie_memory))
let shell =
let open Data_encoding in
conv
(fun { peer_validator_limits ; block_validator_limits ;
prevalidator_limits ; net_validator_limits } ->
prevalidator_limits ; chain_validator_limits } ->
(peer_validator_limits, block_validator_limits,
prevalidator_limits, net_validator_limits))
prevalidator_limits, chain_validator_limits))
(fun (peer_validator_limits, block_validator_limits,
prevalidator_limits, net_validator_limits) ->
prevalidator_limits, chain_validator_limits) ->
{ peer_validator_limits ; block_validator_limits ;
prevalidator_limits ; net_validator_limits })
prevalidator_limits ; chain_validator_limits })
(obj4
(dft "peer_validator" peer_validator_limits_encoding default_shell.peer_validator_limits)
(dft "block_validator" block_validator_limits_encoding default_shell.block_validator_limits)
(dft "prevalidator" prevalidator_limits_encoding default_shell.prevalidator_limits)
(dft "net_validator" net_validator_limits_encoding default_shell.net_validator_limits)
(dft "chain_validator" chain_validator_limits_encoding default_shell.chain_validator_limits)
)
let encoding =
let open Data_encoding in
conv
(fun { data_dir ; rpc ; net ; log ; shell } ->
(data_dir, rpc, net, log, shell))
(fun (data_dir, rpc, net, log, shell) ->
{ data_dir ; rpc ; net ; log ; shell })
(fun { data_dir ; rpc ; p2p ; log ; shell } ->
(data_dir, rpc, p2p, log, shell))
(fun (data_dir, rpc, p2p, log, shell) ->
{ data_dir ; rpc ; p2p ; log ; shell })
(obj5
(dft "data-dir" string default_data_dir)
(dft "rpc" rpc default_rpc)
(req "net" net)
(req "p2p" p2p)
(dft "log" log default_log)
(dft "shell" shell default_shell))
@ -482,42 +482,42 @@ let update
| [] -> default
| l -> l in
let limits : P2p.limits = {
cfg.net.limits with
cfg.p2p.limits with
min_connections =
Option.unopt
~default:cfg.net.limits.min_connections
~default:cfg.p2p.limits.min_connections
min_connections ;
expected_connections =
Option.unopt
~default:cfg.net.limits.expected_connections
~default:cfg.p2p.limits.expected_connections
expected_connections ;
max_connections =
Option.unopt
~default:cfg.net.limits.max_connections
~default:cfg.p2p.limits.max_connections
max_connections ;
max_download_speed =
Option.first_some
max_download_speed cfg.net.limits.max_download_speed ;
max_download_speed cfg.p2p.limits.max_download_speed ;
max_upload_speed =
Option.first_some
max_upload_speed cfg.net.limits.max_upload_speed ;
max_upload_speed cfg.p2p.limits.max_upload_speed ;
max_known_points =
Option.first_some
peer_table_size cfg.net.limits.max_known_points ;
peer_table_size cfg.p2p.limits.max_known_points ;
max_known_peer_ids =
Option.first_some
peer_table_size cfg.net.limits.max_known_peer_ids ;
peer_table_size cfg.p2p.limits.max_known_peer_ids ;
binary_chunks_size =
Option.map ~f:(fun x -> x lsl 10) binary_chunks_size ;
} in
let net : net = {
let p2p : p2p = {
expected_pow =
Option.unopt ~default:cfg.net.expected_pow expected_pow ;
Option.unopt ~default:cfg.p2p.expected_pow expected_pow ;
bootstrap_peers =
Option.unopt ~default:cfg.net.bootstrap_peers bootstrap_peers ;
Option.unopt ~default:cfg.p2p.bootstrap_peers bootstrap_peers ;
listen_addr =
Option.first_some listen_addr cfg.net.listen_addr ;
closed = cfg.net.closed || closed ;
Option.first_some listen_addr cfg.p2p.listen_addr ;
closed = cfg.p2p.closed || closed ;
limits ;
}
and rpc : rpc = {
@ -538,16 +538,16 @@ let update
peer_validator_limits = cfg.shell.peer_validator_limits ;
block_validator_limits = cfg.shell.block_validator_limits ;
prevalidator_limits = cfg.shell.prevalidator_limits ;
net_validator_limits =
chain_validator_limits =
Option.unopt_map
~default:cfg.shell.net_validator_limits
~default:cfg.shell.chain_validator_limits
~f:(fun bootstrap_threshold ->
{ cfg.shell.net_validator_limits
{ cfg.shell.chain_validator_limits
with bootstrap_threshold })
bootstrap_threshold
}
in
return { data_dir ; net ; rpc ; log ; shell }
return { data_dir ; p2p ; rpc ; log ; shell }
let resolve_addr ?default_port ?(passive = false) peer =
let addr, port = P2p_point.Id.parse_addr_port peer in
@ -568,7 +568,7 @@ let resolve_addrs ?default_port ?passive peers =
let resolve_listening_addrs listen_addr =
resolve_addr
~default_port:default_net_port
~default_port:default_p2p_port
~passive:true
listen_addr
@ -580,10 +580,10 @@ let resolve_rpc_listening_addrs listen_addr =
let resolve_bootstrap_addrs peers =
resolve_addrs
~default_port:default_net_port
~default_port:default_p2p_port
peers
let check_listening_addr config =
match config.net.listen_addr with
match config.p2p.listen_addr with
| None -> Lwt.return_unit
| Some addr ->
Lwt.catch begin fun () ->
@ -635,7 +635,7 @@ let check_bootstrap_peer addr =
let check_bootstrap_peers config =
Lwt_list.iter_p check_bootstrap_peer config.net.bootstrap_peers
Lwt_list.iter_p check_bootstrap_peer config.p2p.bootstrap_peers
let check config =
check_listening_addr config >>= fun () ->

10
src/bin_node/node_config_file.mli
View File

@ -9,13 +9,13 @@
type t = {
data_dir : string ;
net : net ;
p2p : p2p ;
rpc : rpc ;
log : log ;
shell : shell ;
}
and net = {
and p2p = {
expected_pow : float ;
bootstrap_peers : string list ;
listen_addr : string option ;
@ -46,13 +46,13 @@ and shell = {
block_validator_limits : Node.block_validator_limits ;
prevalidator_limits : Node.prevalidator_limits ;
peer_validator_limits : Node.peer_validator_limits ;
net_validator_limits : Node.net_validator_limits ;
chain_validator_limits : Node.chain_validator_limits ;
}
val default_data_dir: string
val default_net_port: int
val default_p2p_port: int
val default_rpc_port: int
val default_net: net
val default_p2p: p2p
val default_config: t
val update:

8
src/bin_node/node_identity_command.ml
View File

@ -18,13 +18,13 @@ let show { Node_config_file.data_dir } =
Format.printf "Peer_id: %a.@." P2p_peer.Id.pp id.peer_id ;
return ()
let generate { Node_config_file.data_dir ; net } =
let generate { Node_config_file.data_dir ; p2p } =
let identity_file = identity_file data_dir in
if Sys.file_exists identity_file then
fail (Node_identity_file.Existent_identity_file identity_file)
else
let target = Crypto_box.make_target net.expected_pow in
Format.eprintf "Generating a new identity... (level: %.2f) " net.expected_pow ;
let target = Crypto_box.make_target p2p.expected_pow in
Format.eprintf "Generating a new identity... (level: %.2f) " p2p.expected_pow ;
let id =
P2p_identity.generate_with_animation Format.err_formatter target in
Node_identity_file.write identity_file id >>=? fun () ->
@ -33,7 +33,7 @@ let generate { Node_config_file.data_dir ; net } =
P2p_peer.Id.pp id.peer_id identity_file ;
return ()
let check { Node_config_file.data_dir ; net = { expected_pow } } =
let check { Node_config_file.data_dir ; p2p = { expected_pow } } =
Node_identity_file.read
~expected_pow (identity_file data_dir) >>=? fun id ->
Format.printf

16
src/bin_node/node_run_command.ml
View File

@ -9,7 +9,7 @@
open Logging.Node.Main
let genesis : State.Net.genesis = {
let genesis : State.Chain.genesis = {
time =
Time.of_notation_exn "2017-10-19T00:00:00Z" ;
block =
@ -120,7 +120,7 @@ let init_node ?sandbox (config : Node_config_file.t) =
end >>= fun patch_context ->
(* TODO "WARN" when pow is below our expectation. *)
begin
match config.net.listen_addr with
match config.p2p.listen_addr with
| None ->
lwt_log_notice "Not listening to P2P calls." >>= fun () ->
return (None, None)
@ -140,7 +140,7 @@ let init_node ?sandbox (config : Node_config_file.t) =
| None, Some _ -> return None
| _ ->
(Node_config_file.resolve_bootstrap_addrs
config.net.bootstrap_peers) >>= fun trusted_points ->
config.p2p.bootstrap_peers) >>= fun trusted_points ->
Node_identity_file.read
(config.data_dir //
Node_data_version.default_identity_file_name) >>=? fun identity ->
@ -153,13 +153,13 @@ let init_node ?sandbox (config : Node_config_file.t) =
trusted_points ;
peers_file =
(config.data_dir // "peers.json") ;
closed_network = config.net.closed ;
closed_network = config.p2p.closed ;
identity ;
proof_of_work_target =
Crypto_box.make_target config.net.expected_pow ;
Crypto_box.make_target config.p2p.expected_pow ;
}
in
return (Some (p2p_config, config.net.limits))
return (Some (p2p_config, config.p2p.limits))
end >>=? fun p2p_config ->
let node_config : Node.config = {
genesis ;
@ -167,14 +167,14 @@ let init_node ?sandbox (config : Node_config_file.t) =
store_root = store_dir config.data_dir ;
context_root = context_dir config.data_dir ;
p2p = p2p_config ;
test_network_max_tll = Some (48 * 3600) ; (* 2 days *)
test_chain_max_tll = Some (48 * 3600) ; (* 2 days *)
} in
Node.create
node_config
config.shell.peer_validator_limits
config.shell.block_validator_limits
config.shell.prevalidator_limits
config.shell.net_validator_limits
config.shell.chain_validator_limits
let () =
let old_hook = !Lwt.async_exception_hook in

10
src/bin_node/node_shared_arg.ml
View File

@ -87,11 +87,11 @@ let wrap
module Manpage = struct
let misc_section = "MISC OPTIONS"
let network_section = "NETWORK OPTIONS"
let p2p_section = "P2P OPTIONS"
let rpc_section = "RPC OPTIONS"
let args = [
`S network_section ;
`S p2p_section ;
`S rpc_section ;
`S misc_section ;
]
@ -133,9 +133,9 @@ module Term = struct
Arg.(value & opt (some string) None &
info ~docs ~doc ~docv:"FILE" ["config-file"])
(* net args *)
(* P2p args *)
let docs = Manpage.network_section
let docs = Manpage.p2p_section
let connections =
let doc =
@ -270,7 +270,7 @@ let read_and_patch_config_file ?(ignore_bootstrap_peers=false) args =
log_info "Ignoring bootstrap peers" ;
peers
end else
cfg.net.bootstrap_peers @ peers in
cfg.p2p.bootstrap_peers @ peers in
Node_config_file.update
?data_dir ?min_connections ?expected_connections ?max_connections
?max_download_speed ?max_upload_speed ?binary_chunks_size

4
src/lib_base/net_id.ml → src/lib_base/chain_id.ml
View File

@ -11,7 +11,7 @@ module Raw = struct
type t = string
let name = "Net_id"
let name = "Chain_id"
let title = "Network identifier"
let extract bh =
@ -83,7 +83,7 @@ module Raw = struct
let b58check_encoding =
Tezos_crypto.Base58.register_encoding
~prefix: Tezos_crypto.Base58.Prefix.net_id
~prefix: Tezos_crypto.Base58.Prefix.chain_id
~length: size
~wrap: (fun s -> Hash s)
~of_raw:of_string ~to_raw: (fun h -> h)

0
src/lib_base/net_id.mli → src/lib_base/chain_id.mli
View File

2
src/lib_base/protocol_environment.ml
View File

@ -52,7 +52,7 @@ module type UPDATER = sig
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network:
val fork_test_chain:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
end

2
src/lib_base/protocol_environment.mli
View File

@ -45,7 +45,7 @@ module type UPDATER = sig
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network:
val fork_test_chain:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
end

16
src/lib_base/test_network_status.ml → src/lib_base/test_chain_status.ml
View File

@ -14,7 +14,7 @@ type t =
expiration: Time.t ;
}
| Running of {
net_id: Net_id.t ;
chain_id: Chain_id.t ;
genesis: Block_hash.t ;
protocol: Protocol_hash.t ;
expiration: Time.t ;
@ -41,16 +41,16 @@ let encoding =
case (Tag 2)
(obj5
(req "status" (constant "running"))
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(req "genesis" Block_hash.encoding)
(req "protocol" Protocol_hash.encoding)
(req "expiration" Time.encoding))
(function
| Running { net_id ; genesis ; protocol ; expiration } ->
Some ((), net_id, genesis, protocol, expiration)
| Running { chain_id ; genesis ; protocol ; expiration } ->
Some ((), chain_id, genesis, protocol, expiration)
| _ -> None)
(fun ((), net_id, genesis, protocol, expiration) ->
Running { net_id ; genesis ; protocol ; expiration }) ;
(fun ((), chain_id, genesis, protocol, expiration) ->
Running { chain_id ; genesis ; protocol ; expiration }) ;
]
let pp ppf = function
@ -62,7 +62,7 @@ let pp ppf = function
protocol
Time.pp_hum
expiration
| Running { net_id ; genesis ; protocol ; expiration } ->
| Running { chain_id ; genesis ; protocol ; expiration } ->
Format.fprintf ppf
"@[<v 2>Running %a\
@ Genesis: %a\
@ -70,5 +70,5 @@ let pp ppf = function
@ Expiration: %a@]"
Protocol_hash.pp protocol
Block_hash.pp genesis
Net_id.pp net_id
Chain_id.pp chain_id
Time.pp_hum expiration

2
src/lib_base/test_network_status.mli → src/lib_base/test_chain_status.mli
View File

@ -14,7 +14,7 @@ type t =
expiration: Time.t ;
}
| Running of {
net_id: Net_id.t ;
chain_id: Chain_id.t ;
genesis: Block_hash.t ;
protocol: Protocol_hash.t ;
expiration: Time.t ;

4
src/lib_base/tzPervasives.ml
View File

@ -33,7 +33,7 @@ module Block_header = Block_header
module Operation = Operation
module Protocol = Protocol
module Net_id = Net_id
module Chain_id = Chain_id
module Block_hash = Block_hash
module Operation_hash = Operation_hash
module Operation_list_hash = Operation_list_hash
@ -41,7 +41,7 @@ module Operation_list_list_hash = Operation_list_list_hash
module Context_hash = Context_hash
module Protocol_hash = Protocol_hash
module Test_network_status = Test_network_status
module Test_chain_status = Test_chain_status
module Preapply_result = Preapply_result
module Block_locator = Block_locator

4
src/lib_base/tzPervasives.mli
View File

@ -31,12 +31,12 @@ module Fitness = Fitness
module Block_header = Block_header
module Operation = Operation
module Protocol = Protocol
module Test_network_status = Test_network_status
module Test_chain_status = Test_chain_status
module Preapply_result = Preapply_result
module Block_locator = Block_locator
module Mempool = Mempool
module Net_id = Net_id
module Chain_id = Chain_id
module Block_hash = Block_hash
module Operation_hash = Operation_hash
module Operation_list_hash = Operation_list_hash

2
src/lib_client_base_unix/client_signer_unencrypted.ml
View File

@ -16,7 +16,7 @@ module Unencrypted_signer : SIGNER = struct
"Built-in signer using raw unencrypted keys."
let description =
"Do not use this signer except for playing on the test network.\n\
"Do not use this signer except for playing on the test chain.\n\
The format for importing secret keys is either no argument (will \
generate a key) or the raw Base58-encoded key (starting with \
'edsk').\n\

6
src/lib_client_commands/client_network_commands.ml → src/lib_client_commands/client_p2p_commands.ml
View File

@ -8,14 +8,14 @@
(**************************************************************************)
let group =
{ Cli_entries.name = "network" ;
title = "Commands for monitoring and controlling network state" }
{ Cli_entries.name = "p2p" ;
title = "Commands for monitoring and controlling p2p-layer state" }
let commands () = [
let open Cli_entries in
command ~group ~desc: "show global network status"
no_options
(prefixes ["network" ; "stat"] stop) begin fun () (cctxt : #Client_context.full_context) ->
(prefixes ["p2p" ; "stat"] stop) begin fun () (cctxt : #Client_context.full_context) ->
P2p_services.stat cctxt >>=? fun stat ->
P2p_services.Connections.list cctxt >>=? fun conns ->
P2p_services.Peers.list cctxt >>=? fun peers ->

0
src/lib_client_commands/client_network_commands.mli → src/lib_client_commands/client_p2p_commands.mli
View File

10
src/lib_client_commands/client_report_commands.ml
View File

@ -10,13 +10,13 @@
(* Commands used to introspect the node's state *)
let pp_block ppf
{ Block_services.hash ; net_id ; level ;
{ Block_services.hash ; chain_id ; level ;
proto_level ; predecessor ; timestamp ;
operations_hash ; fitness ; data ;
operations ; protocol ; test_network } =
operations ; protocol ; test_chain } =
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Test network: %a\
@ Test chain: %a\
@ Level: %ld\
@ Proto_level: %d\
@ Predecessor: %a\
@ -28,12 +28,12 @@ let pp_block ppf
@ Operations: @[<v>%a@]\
@ Data (hex encoded): \"%a\"@]"
Block_hash.pp hash
Test_network_status.pp test_network
Test_chain_status.pp test_chain
level
proto_level
Block_hash.pp predecessor
Protocol_hash.pp protocol
Net_id.pp net_id
Chain_id.pp chain_id
Time.pp_hum timestamp
Fitness.pp fitness
Operation_list_list_hash.pp operations_hash

2
src/lib_crypto/base58.ml
View File

@ -319,6 +319,6 @@ module Prefix = struct
let ed25519_signature = "\009\245\205\134\018" (* edsig(99) *)
(* 4 *)
let net_id = "\087\082\000" (* Net(15) *)
let chain_id = "\087\082\000" (* Net(15) *)
end

2
src/lib_crypto/base58.mli
View File

@ -23,7 +23,7 @@ module Prefix : sig
val ed25519_public_key: string
val ed25519_secret_key: string
val ed25519_signature: string
val net_id: string
val chain_id: string
end

2
src/lib_protocol_environment_client/fake_updater.ml
View File

@ -73,6 +73,6 @@ module Make(Context : Protocol_environment.CONTEXT) = struct
let compile _ _ = assert false
let activate _ _ = assert false
let fork_test_network _ ~protocol:_ ~expiration:_ = assert false
let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false
end

2
src/lib_protocol_environment_sigs/v1/lwt_sequence.mli
View File

@ -58,7 +58,7 @@ val is_empty : 'a t -> bool
(** Returns [true] iff the given sequence is empty *)
val length : 'a t -> int
(** Returns the number of elemenets in the given sequence. This is a
(** Returns the number of elements in the given sequence. This is a
O(n) operation where [n] is the number of elements in the
sequence. *)

8
src/lib_protocol_environment_sigs/v1/updater.mli
View File

@ -95,7 +95,7 @@ module type PROTOCOL = sig
(** Checks that a block is well formed in a given context. This
function should run quickly, as its main use is to reject bad
blocks from the network as early as possible. The input context
blocks from the chain as early as possible. The input context
is the one resulting of an ancestor block of same protocol
version, not necessarily the one of its predecessor. *)
val precheck_block:
@ -169,10 +169,10 @@ val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
been previously compiled successfully. *)
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
(** Fork a test network. The forkerd network will use the current block
as genesis, and [protocol] as economic protocol. The network will
(** Fork a test chain. The forkerd chain will use the current block
as genesis, and [protocol] as economic protocol. The chain will
be destroyed when a (successor) block will have a timestamp greater
than [expiration]. The protocol must have been previously compiled
successfully. *)
val fork_test_network:
val fork_test_chain:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t

2
src/lib_protocol_updater/updater.ml
View File

@ -35,7 +35,7 @@ module Raw = struct
}
let activate = Context.set_protocol
let fork_test_network = Context.fork_test_network
let fork_test_chain = Context.fork_test_chain
(** Compiler *)

2
src/lib_protocol_updater/updater.mli
View File

@ -11,7 +11,7 @@
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network:
val fork_test_chain:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
val init: string -> unit

28
src/lib_shell/block_locator_iterator.ml
View File

@ -49,45 +49,45 @@ let to_steps locator =
end
[] locator
let block_validity net_state block : Block_locator.validity Lwt.t =
State.Block.known net_state block >>= function
let block_validity chain_state block : Block_locator.validity Lwt.t =
State.Block.known chain_state block >>= function
| false ->
if Block_hash.equal block (State.Net.faked_genesis_hash net_state) then
if Block_hash.equal block (State.Chain.faked_genesis_hash chain_state) then
Lwt.return Block_locator.Known_valid
else
Lwt.return Block_locator.Unknown
| true ->
State.Block.known_invalid net_state block >>= function
State.Block.known_invalid chain_state block >>= function
| true ->
Lwt.return Block_locator.Known_invalid
| false ->
Lwt.return Block_locator.Known_valid
let known_ancestor net_state locator =
Block_locator.unknown_prefix (block_validity net_state) locator >>= function
let known_ancestor chain_state locator =
Block_locator.unknown_prefix (block_validity chain_state) locator >>= function
| None -> Lwt.return_none
| Some (tail, locator) ->
if Block_hash.equal tail (State.Net.faked_genesis_hash net_state) then
if Block_hash.equal tail (State.Chain.faked_genesis_hash chain_state) then
State.Block.read_exn
net_state (State.Net.genesis net_state).block >>= fun genesis ->
chain_state (State.Chain.genesis chain_state).block >>= fun genesis ->
Lwt.return_some (genesis, locator)
else
State.Block.read_exn net_state tail >>= fun block ->
State.Block.read_exn chain_state tail >>= fun block ->
Lwt.return_some (block, locator)
let find_new net_state locator sz =
let find_new chain_state locator sz =
let rec path sz acc h =
if sz <= 0 then Lwt.return (List.rev acc)
else
State.read_chain_store net_state begin fun chain_store _data ->
Store.Chain.In_chain.read_opt (chain_store, h)
State.read_chain_data chain_state begin fun chain_store _data ->
Store.Chain_data.In_main_branch.read_opt (chain_store, h)
end >>= function
| None -> Lwt.return (List.rev acc)
| Some s -> path (sz-1) (s :: acc) s in
known_ancestor net_state locator >>= function
known_ancestor chain_state locator >>= function
| None -> Lwt.return_nil
| Some (known, _) ->
Chain.head net_state >>= fun head ->
Chain.head chain_state >>= fun head ->
Chain_traversal.common_ancestor known head >>= fun ancestor ->
path sz [] (State.Block.hash ancestor)

8
src/lib_shell/block_locator_iterator.mli
View File

@ -40,16 +40,16 @@ val estimated_length: Block_locator.t -> int
represented by [locator]. *)
val known_ancestor:
State.Net.t -> Block_locator.t -> (State.Block.t * Block_locator.t) option Lwt.t
(** [known_ancestor net_state locator] computes the first block of
State.Chain.t -> Block_locator.t -> (State.Block.t * Block_locator.t) option Lwt.t
(** [known_ancestor chain_state locator] computes the first block of
[locator] that is known to be a valid block. It also computes the
'prefix' of [locator] with end at the first valid block. The
function returns [None] when no block in the locator are known or
if the first known block is invalid. *)
val find_new:
State.Net.t -> Block_locator.t -> int -> Block_hash.t list Lwt.t
(** [find_new net locator max_length] returns the blocks from our
State.Chain.t -> Block_locator.t -> int -> Block_hash.t list Lwt.t
(** [find_new chain locator max_length] returns the blocks from our
current branch that would be unknown to a peer that sends us the
[locator]. *)

52
src/lib_shell/block_validator.ml
View File

@ -37,7 +37,7 @@ module Request = struct
include Request
type 'a t =
| Request_validation : {
net_db: Distributed_db.net_db ;
chain_db: Distributed_db.chain_db ;
notify_new_block: State.Block.t -> unit ;
canceler: Lwt_canceler.t option ;
peer: P2p_peer.Id.t option ;
@ -47,9 +47,9 @@ module Request = struct
} -> State.Block.t tzresult t
let view
: type a. a t -> view
= fun (Request_validation { net_db ; peer ; hash }) ->
let net_id = net_db |> Distributed_db.net_state |> State.Net.id in
{ net_id ; block = hash ; peer = peer }
= fun (Request_validation { chain_db ; peer ; hash }) ->
let chain_id = chain_db |> Distributed_db.chain_state |> State.Chain.id in
{ chain_id ; block = hash ; peer = peer }
end
module Worker = Worker.Make (Name) (Event) (Request) (Types)
@ -98,9 +98,9 @@ let assert_operation_liveness block live_blocks operations =
originating_block = op.shell.branch })))
operations
let check_liveness net_state pred hash operations_hashes operations =
let check_liveness chain_state pred hash operations_hashes operations =
begin
Chain.data net_state >>= fun chain_data ->
Chain.data chain_state >>= fun chain_data ->
if State.Block.equal chain_data.current_head pred then
Lwt.return (chain_data.live_blocks, chain_data.live_operations)
else
@ -113,7 +113,7 @@ let check_liveness net_state pred hash operations_hashes operations =
return ()
let apply_block
net_state
chain_state
pred (module Proto : Registred_protocol.T)
hash (header: Block_header.t)
operations =
@ -141,7 +141,7 @@ let apply_block
return ())
operations Proto.validation_passes >>=? fun () ->
let operation_hashes = List.map (List.map Operation.hash) operations in
check_liveness net_state pred hash operation_hashes operations >>=? fun () ->
check_liveness chain_state pred hash operation_hashes operations >>=? fun () ->
mapi2_s (fun pass -> map2_s begin fun op_hash raw ->
Lwt.return (Proto.parse_operation op_hash raw)
|> trace (invalid_block hash (Cannot_parse_operation op_hash)) >>=? fun op ->
@ -155,7 +155,7 @@ let apply_block
operation_hashes
operations >>=? fun parsed_operations ->
State.Block.context pred >>= fun pred_context ->
Context.reset_test_network
Context.reset_test_chain
pred_context pred_hash header.shell.timestamp >>= fun context ->
(* TODO wrap 'proto_error' into 'block_error' *)
Proto.begin_application
@ -194,12 +194,12 @@ let apply_block
{ new_context with max_operations_ttl } in
return new_context
let check_net_liveness net_db hash (header: Block_header.t) =
let net_state = Distributed_db.net_state net_db in
match State.Net.expiration net_state with
let check_chain_liveness chain_db hash (header: Block_header.t) =
let chain_state = Distributed_db.chain_state chain_db in
match State.Chain.expiration chain_state with
| Some eol when Time.(eol <= header.shell.timestamp) ->
fail @@ invalid_block hash @@
Expired_network { net_id = State.Net.id net_state ;
Expired_chain { chain_id = State.Chain.id chain_state ;
expiration = eol ;
timestamp = header.shell.timestamp }
| None | Some _ -> return ()
@ -217,11 +217,11 @@ let on_request
: type r. t -> r Request.t -> r tzresult Lwt.t
= fun w
(Request.Request_validation
{ net_db ; notify_new_block ; canceler ;
{ chain_db ; notify_new_block ; canceler ;
peer ; hash ; header ; operations }) ->
let bv = Worker.state w in
let net_state = Distributed_db.net_state net_db in
State.Block.read_opt net_state hash >>= function
let chain_state = Distributed_db.chain_state chain_db in
State.Block.read_opt chain_state hash >>= function
| Some block ->
debug w "previously validated block %a (after pipe)"
Block_hash.pp_short hash ;
@ -231,26 +231,26 @@ let on_request
block ;
return (Ok block)
| None ->
State.Block.read_invalid net_state hash >>= function
State.Block.read_invalid chain_state hash >>= function
| Some { errors } ->
return (Error errors)
| None ->
begin
debug w "validating block %a" Block_hash.pp_short hash ;
State.Block.read
net_state header.shell.predecessor >>=? fun pred ->
chain_state header.shell.predecessor >>=? fun pred ->
get_proto pred hash >>=? fun proto ->
(* TODO also protect with [Worker.canceler w]. *)
protect ?canceler begin fun () ->
apply_block
(Distributed_db.net_state net_db)
(Distributed_db.chain_state chain_db)
pred proto hash header operations
end
end >>= function
| Ok result -> begin
Worker.protect w begin fun () ->
Distributed_db.commit_block
net_db hash header operations result
chain_db hash header operations result
end >>=? function
| None ->
assert false (* should not happen *)
@ -269,7 +269,7 @@ let on_request
| Error errors ->
Worker.protect w begin fun () ->
Distributed_db.commit_invalid_block
net_db hash header errors
chain_db hash header errors
end >>=? fun commited ->
assert commited ;
return (Error errors)
@ -318,10 +318,10 @@ let shutdown = Worker.shutdown
let validate w
?canceler ?peer ?(notify_new_block = fun _ -> ())
net_db hash (header : Block_header.t) operations =
chain_db hash (header : Block_header.t) operations =
let bv = Worker.state w in
let net_state = Distributed_db.net_state net_db in
State.Block.read_opt net_state hash >>= function
let chain_state = Distributed_db.chain_state chain_db in
State.Block.read_opt chain_state hash >>= function
| Some block ->
debug w "previously validated block %a (before pipe)"
Block_hash.pp_short hash ;
@ -346,10 +346,10 @@ let validate w
expected = header.shell.operations_hash ;
found = computed_hash ;
}) >>=? fun () ->
check_net_liveness net_db hash header >>=? fun () ->
check_chain_liveness chain_db hash header >>=? fun () ->
Worker.push_request_and_wait w
(Request_validation
{ net_db ; notify_new_block ; canceler ;
{ chain_db ; notify_new_block ; canceler ;
peer ; hash ; header ; operations }) >>=? fun result ->
Lwt.return result

2
src/lib_shell/block_validator.mli
View File

@ -24,7 +24,7 @@ val validate:
?canceler:Lwt_canceler.t ->
?peer:P2p_peer.Id.t ->
?notify_new_block:(State.Block.t -> unit) ->
Distributed_db.net_db ->
Distributed_db.chain_db ->
Block_hash.t -> Block_header.t -> Operation.t list list ->
State.Block.t tzresult Lwt.t

12
src/lib_shell/bootstrap_pipeline.ml
View File

@ -19,7 +19,7 @@ type t = {
mutable operations_fetch_worker: unit Lwt.t ;
mutable validation_worker: unit Lwt.t ;
peer_id: P2p_peer.Id.t ;
net_db: Distributed_db.net_db ;
chain_db: Distributed_db.chain_db ;
locator: Block_locator.t ;
block_validator: Block_validator.t ;
notify_new_block: State.Block.t -> unit ;
@ -58,7 +58,7 @@ let fetch_step pipeline (step : Block_locator_iterator.step) =
protect ~canceler:pipeline.canceler begin fun () ->
Distributed_db.Block_header.fetch
~timeout:pipeline.block_header_timeout
pipeline.net_db ~peer:pipeline.peer_id
pipeline.chain_db ~peer:pipeline.peer_id
hash ()
end >>=? fun header ->
lwt_debug "fetched block header %a from peer %a."
@ -116,7 +116,7 @@ let rec operations_fetch_worker_loop pipeline =
protect ~canceler:pipeline.canceler begin fun () ->
Distributed_db.Operations.fetch
~timeout:pipeline.block_operations_timeout
pipeline.net_db ~peer:pipeline.peer_id
pipeline.chain_db ~peer:pipeline.peer_id
(hash, i) header.shell.operations_hash
end)
(0 -- (header.shell.validation_passes - 1)) >>=? fun operations ->
@ -160,7 +160,7 @@ let rec validation_worker_loop pipeline =
~canceler:pipeline.canceler
~notify_new_block:pipeline.notify_new_block
pipeline.block_validator
pipeline.net_db hash header operations
pipeline.chain_db hash header operations
end >>=? fun _block ->
lwt_log_info "validated block %a from peer %a."
Block_hash.pp_short hash
@ -186,7 +186,7 @@ let rec validation_worker_loop pipeline =
let create
?(notify_new_block = fun _ -> ())
~block_header_timeout ~block_operations_timeout
block_validator peer_id net_db locator =
block_validator peer_id chain_db locator =
let canceler = Lwt_canceler.create () in
let fetched_headers =
Lwt_pipe.create ~size:(50, fun _ -> 1) () in
@ -199,7 +199,7 @@ let create
operations_fetch_worker = Lwt.return_unit ;
validation_worker = Lwt.return_unit ;
notify_new_block ;
peer_id ; net_db ; locator ;
peer_id ; chain_db ; locator ;
block_validator ;
fetched_headers ; fetched_blocks ;
errors = [] ;

2
src/lib_shell/bootstrap_pipeline.mli
View File

@ -16,7 +16,7 @@ val create:
block_header_timeout:float ->
block_operations_timeout: float ->
Block_validator.t ->
P2p_peer.Id.t -> Distributed_db.net_db ->
P2p_peer.Id.t -> Distributed_db.chain_db ->
Block_locator.t -> t
val wait: t -> unit tzresult Lwt.t

76
src/lib_shell/chain.ml
View File

@ -8,76 +8,76 @@
(**************************************************************************)
open Logging.Node.State
open State
let mempool_encoding = Mempool.encoding
let genesis net_state =
let genesis = Net.genesis net_state in
Block.read_exn net_state genesis.block
let genesis chain_state =
let genesis = State.Chain.genesis chain_state in
State.Block.read_exn chain_state genesis.block
let known_heads net_state =
read_chain_store net_state begin fun chain_store _data ->
Store.Chain.Known_heads.elements chain_store
let known_heads chain_state =
State.read_chain_data chain_state begin fun chain_store _data ->
Store.Chain_data.Known_heads.elements chain_store
end >>= fun hashes ->
Lwt_list.map_p (Block.read_exn net_state) hashes
Lwt_list.map_p (State.Block.read_exn chain_state) hashes
let head net_state =
read_chain_store net_state begin fun _chain_store data ->
let head chain_state =
State.read_chain_data chain_state begin fun _chain_store data ->
Lwt.return data.current_head
end
let mem net_state hash =
read_chain_store net_state begin fun chain_store data ->
if Block_hash.equal (Block.hash data.current_head) hash then
let mem chain_state hash =
State.read_chain_data chain_state begin fun chain_store data ->
if Block_hash.equal (State.Block.hash data.current_head) hash then
Lwt.return true
else
Store.Chain.In_chain.known (chain_store, hash)
Store.Chain_data.In_main_branch.known (chain_store, hash)
end
type data = State.chain_data = {
current_head: Block.t ;
current_head: State.Block.t ;
current_mempool: Mempool.t ;
live_blocks: Block_hash.Set.t ;
live_operations: Operation_hash.Set.t ;
locator: Block_locator.t Lwt.t lazy_t ;
}
let data net_state =
read_chain_store net_state begin fun _chain_store data ->
let data chain_state =
State.read_chain_data chain_state begin fun _chain_store data ->
Lwt.return data
end
let locator net_state =
data net_state >>= begin fun data ->
let locator chain_state =
data chain_state >>= begin fun data ->
Lazy.force data.locator
end
let locked_set_head net_state chain_store data block =
let locked_set_head chain_state chain_store data block =
let rec pop_blocks ancestor block =
let hash = Block.hash block in
let hash = State.Block.hash block in
if Block_hash.equal hash ancestor then
Lwt.return_unit
else
lwt_debug "pop_block %a" Block_hash.pp_short hash >>= fun () ->
Store.Chain.In_chain.remove (chain_store, hash) >>= fun () ->
Block.predecessor block >>= function
Store.Chain_data.In_main_branch.remove (chain_store, hash) >>= fun () ->
State.Block.predecessor block >>= function
| Some predecessor ->
pop_blocks ancestor predecessor
| None -> assert false (* Cannot pop the genesis... *)
in
let push_block pred_hash block =
let hash = Block.hash block in
let hash = State.Block.hash block in
lwt_debug "push_block %a" Block_hash.pp_short hash >>= fun () ->
Store.Chain.In_chain.store (chain_store, pred_hash) hash >>= fun () ->
Store.Chain_data.In_main_branch.store
(chain_store, pred_hash) hash >>= fun () ->
Lwt.return hash
in
Chain_traversal.new_blocks
~from_block:data.current_head ~to_block:block >>= fun (ancestor, path) ->
let ancestor = Block.hash ancestor in
let ancestor = State.Block.hash ancestor in
pop_blocks ancestor data.current_head >>= fun () ->
Lwt_list.fold_left_s push_block ancestor path >>= fun _ ->
Store.Chain.Current_head.store chain_store (Block.hash block) >>= fun () ->
Store.Chain_data.Current_head.store chain_store (State.Block.hash block) >>= fun () ->
(* TODO more optimized updated of live_{blocks/operations} when the
new head is a direct successor of the current head...
Make sure to do the live blocks computation in `init_head`
@ -89,27 +89,27 @@ let locked_set_head net_state chain_store data block =
current_mempool = Mempool.empty ;
live_blocks ;
live_operations ;
locator = lazy (State.compute_locator net_state block) ;
locator = lazy (State.compute_locator chain_state block) ;
}
let set_head net_state block =
update_chain_store net_state begin fun chain_store data ->
locked_set_head net_state chain_store data block >>= fun new_chain_data ->
let set_head chain_state block =
State.update_chain_data chain_state begin fun chain_store data ->
locked_set_head chain_state chain_store data block >>= fun new_chain_data ->
Lwt.return (Some new_chain_data,
data.current_head)
end
let test_and_set_head net_state ~old block =
update_chain_store net_state begin fun chain_store data ->
if not (Block.equal data.current_head old) then
let test_and_set_head chain_state ~old block =
State.update_chain_data chain_state begin fun chain_store data ->
if not (State.Block.equal data.current_head old) then
Lwt.return (None, false)
else
locked_set_head net_state chain_store data block >>= fun new_chain_data ->
locked_set_head chain_state chain_store data block >>= fun new_chain_data ->
Lwt.return (Some new_chain_data, true)
end
let init_head net_state =
head net_state >>= fun block ->
set_head net_state block >>= fun _ ->
let init_head chain_state =
head chain_state >>= fun block ->
set_head chain_state block >>= fun _ ->
Lwt.return_unit

32
src/lib_shell/chain.mli
View File

@ -9,19 +9,17 @@
(** Tezos Shell Module - Manging the current head. *)
open State
(** The genesis block of the network's blockchain. On a test network,
(** The genesis block of the chain. On a test chain,
the test protocol has been promoted as "main" protocol. *)
val genesis: Net.t -> Block.t Lwt.t
val genesis: State.Chain.t -> State.Block.t Lwt.t
(** The current head of the network's blockchain. *)
val head: Net.t -> Block.t Lwt.t
val locator: Net.t -> Block_locator.t Lwt.t
(** The current head of the chain. *)
val head: State.Chain.t -> State.Block.t Lwt.t
val locator: State.Chain.t -> Block_locator.t Lwt.t
(** All the available chain data. *)
type data = {
current_head: Block.t ;
current_head: State.Block.t ;
current_mempool: Mempool.t ;
live_blocks: Block_hash.Set.t ;
live_operations: Operation_hash.Set.t ;
@ -29,25 +27,25 @@ type data = {
}
(** Reading atomically all the chain data. *)
val data: Net.t -> data Lwt.t
val data: State.Chain.t -> data Lwt.t
(** The current head and all the known (valid) alternate heads. *)
val known_heads: Net.t -> Block.t list Lwt.t
val known_heads: State.Chain.t -> State.Block.t list Lwt.t
(** Test whether a block belongs to the current mainnet. *)
val mem: Net.t -> Block_hash.t -> bool Lwt.t
(** Test whether a block belongs to the current mainchain. *)
val mem: State.Chain.t -> Block_hash.t -> bool Lwt.t
(** Record a block as the current head of the network's blockchain.
(** Record a block as the current head of the chain.
It returns the previous head. *)
val set_head: Net.t -> Block.t -> Block.t Lwt.t
val set_head: State.Chain.t -> State.Block.t -> State.Block.t Lwt.t
(** Atomically change the current head of the network's blockchain.
(** Atomically change the current head of the chain.
This returns [true] whenever the change succeeded, or [false]
when the current head os not equal to the [old] argument. *)
val test_and_set_head:
Net.t -> old:Block.t -> Block.t -> bool Lwt.t
State.Chain.t -> old:State.Block.t -> State.Block.t -> bool Lwt.t
(** Restores the data about the current head at startup
(recomputes the sets of live blocks and operations). *)
val init_head: Net.t -> unit Lwt.t
val init_head: State.Chain.t -> unit Lwt.t

8
src/lib_shell/chain_traversal.ml
View File

@ -10,7 +10,7 @@
open State
let path (b1: Block.t) (b2: Block.t) =
if not (Net_id.equal (Block.net_id b1) (Block.net_id b2)) then
if not (Chain_id.equal (Block.chain_id b1) (Block.chain_id b2)) then
invalid_arg "Chain_traversal.path" ;
let rec loop acc current =
if Block.equal b1 current then
@ -22,7 +22,7 @@ let path (b1: Block.t) (b2: Block.t) =
loop [] b2
let common_ancestor (b1: Block.t) (b2: Block.t) =
if not ( Net_id.equal (Block.net_id b1) (Block.net_id b2)) then
if not ( Chain_id.equal (Block.chain_id b1) (Block.chain_id b2)) then
invalid_arg "Chain_traversal.path" ;
let rec loop (b1: Block.t) (b2: Block.t) =
if Block.equal b1 b2 then
@ -103,8 +103,8 @@ let iter_predecessors ?max ?min_fitness ?min_date heads ~f =
match heads with
| [] -> Lwt.return_unit
| b :: _ ->
let net_id = Block.net_id b in
if not (List.for_all (fun b -> Net_id.equal net_id (Block.net_id b)) heads) then
let chain_id = Block.chain_id b in
if not (List.for_all (fun b -> Chain_id.equal chain_id (Block.chain_id b)) heads) then
invalid_arg "State.Helpers.iter_predecessors" ;
iter_predecessors ?max ?min_fitness ?min_date heads ~f

2
src/lib_shell/chain_traversal.mli
View File

@ -43,7 +43,7 @@ val new_blocks:
and [to_block] and where [path] is the chain from [ancestor]
(excluded) to [to_block] (included). The function raises an
exception when the two provided blocks do not belong the the same
[net]. *)
[chain]. *)
val live_blocks:
Block.t -> int -> (Block_hash.Set.t * Operation_hash.Set.t) Lwt.t

110
src/lib_shell/net_validator.ml → src/lib_shell/chain_validator.ml
View File

@ -7,13 +7,13 @@
(* *)
(**************************************************************************)
open Net_validator_worker_state
open Chain_validator_worker_state
module Name = struct
type t = Net_id.t
let encoding = Net_id.encoding
let base = [ "net_validator" ]
let pp = Net_id.pp_short
type t = Chain_id.t
let encoding = Chain_id.encoding
let base = [ "chain_validator" ]
let pp = Chain_id.pp_short
end
module Request = struct
@ -34,8 +34,8 @@ module Types = struct
type parameters = {
parent: Name.t option ;
db: Distributed_db.t ;
net_state: State.Net.t ;
net_db: Distributed_db.net_db ;
chain_state: State.Chain.t ;
chain_db: Distributed_db.chain_db ;
block_validator: Block_validator.t ;
global_valid_block_input: State.Block.t Lwt_watcher.input ;
@ -96,7 +96,7 @@ let notify_new_block w block =
Lwt_watcher.notify nv.parameters.global_valid_block_input block ;
Worker.push_request_now w (Validated block)
let may_toggle_bootstrapped_network w =
let may_toggle_bootstrapped_chain w =
let nv = Worker.state w in
if not nv.bootstrapped &&
P2p_peer.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold
@ -114,7 +114,7 @@ let may_activate_peer_validator w peer_id =
~notify_new_block:(notify_new_block w)
~notify_bootstrapped: begin fun () ->
P2p_peer.Table.add nv.bootstrapped_peers peer_id () ;
may_toggle_bootstrapped_network w
may_toggle_bootstrapped_chain w
end
~notify_termination: begin fun _pv ->
P2p_peer.Table.remove nv.active_peers peer_id ;
@ -122,36 +122,36 @@ let may_activate_peer_validator w peer_id =
end
nv.parameters.peer_validator_limits
nv.parameters.block_validator
nv.parameters.net_db
nv.parameters.chain_db
peer_id in
P2p_peer.Table.add nv.active_peers peer_id pv ;
pv
let may_switch_test_network w spawn_child block =
let may_switch_test_chain w spawn_child block =
let nv = Worker.state w in
let create_child genesis protocol expiration =
if State.Net.allow_forked_network nv.parameters.net_state then begin
if State.Chain.allow_forked_chain nv.parameters.chain_state then begin
shutdown_child nv >>= fun () ->
begin
let net_id = Net_id.of_block_hash (State.Block.hash genesis) in
State.Net.get
(State.Net.global_state nv.parameters.net_state) net_id >>= function
| Ok net_state -> return net_state
let chain_id = Chain_id.of_block_hash (State.Block.hash genesis) in
State.Chain.get
(State.Chain.global_state nv.parameters.chain_state) chain_id >>= function
| Ok chain_state -> return chain_state
| Error _ ->
State.fork_testnet
genesis protocol expiration >>=? fun net_state ->
Chain.head net_state >>= fun new_genesis_block ->
State.fork_testchain
genesis protocol expiration >>=? fun chain_state ->
Chain.head chain_state >>= fun new_genesis_block ->
Lwt_watcher.notify nv.parameters.global_valid_block_input new_genesis_block ;
Lwt_watcher.notify nv.valid_block_input new_genesis_block ;
return net_state
end >>=? fun net_state ->
return chain_state
end >>=? fun chain_state ->
spawn_child
~parent:(State.Net.id net_state)
~parent:(State.Chain.id chain_state)
nv.parameters.peer_validator_limits
nv.parameters.prevalidator_limits
nv.parameters.block_validator
nv.parameters.global_valid_block_input
nv.parameters.db net_state
nv.parameters.db chain_state
nv.parameters.limits (* TODO: different limits main/test ? *) >>= fun child ->
nv.child <- Some child ;
return ()
@ -166,9 +166,9 @@ let may_switch_test_network w spawn_child block =
| None -> false
| Some (child , _) ->
Block_hash.equal
(State.Net.genesis child.parameters.net_state).block
(State.Chain.genesis child.parameters.chain_state).block
genesis in
State.Block.read nv.parameters.net_state genesis >>=? fun genesis ->
State.Block.read nv.parameters.chain_state genesis >>=? fun genesis ->
begin
match nv.parameters.max_child_ttl with
| None -> Lwt.return expiration
@ -187,7 +187,7 @@ let may_switch_test_network w spawn_child block =
begin
let block_header = State.Block.header block in
State.Block.test_network block >>= function
State.Block.test_chain block >>= function
| Not_running -> shutdown_child nv >>= return
| Running { genesis ; protocol ; expiration } ->
check_child genesis protocol expiration
@ -197,7 +197,7 @@ let may_switch_test_network w spawn_child block =
end >>= function
| Ok () -> Lwt.return_unit
| Error err ->
Worker.record_event w (Could_not_switch_testnet err) ;
Worker.record_event w (Could_not_switch_testchain err) ;
Lwt.return_unit
let broadcast_head w ~previous block =
@ -213,20 +213,20 @@ let broadcast_head w ~previous block =
end >>= fun successor ->
if successor then begin
Distributed_db.Advertise.current_head
nv.parameters.net_db block ;
nv.parameters.chain_db block ;
Lwt.return_unit
end else begin
let net_state = Distributed_db.net_state nv.parameters.net_db in
Chain.locator net_state >>= fun locator ->
let chain_state = Distributed_db.chain_state nv.parameters.chain_db in
Chain.locator chain_state >>= fun locator ->
Distributed_db.Advertise.current_branch
nv.parameters.net_db locator
nv.parameters.chain_db locator
end
end
let on_request (type a) w spawn_child (req : a Request.t) : a tzresult Lwt.t =
let Request.Validated block = req in
let nv = Worker.state w in
Chain.head nv.parameters.net_state >>= fun head ->
Chain.head nv.parameters.chain_state >>= fun head ->
let head_header = State.Block.header head
and head_hash = State.Block.hash head
and block_header = State.Block.header block
@ -236,10 +236,10 @@ let on_request (type a) w spawn_child (req : a Request.t) : a tzresult Lwt.t =
then
return Event.Ignored_head
else begin
Chain.set_head nv.parameters.net_state block >>= fun previous ->
Chain.set_head nv.parameters.chain_state block >>= fun previous ->
broadcast_head w ~previous block >>= fun () ->
Prevalidator.flush nv.prevalidator block_hash >>=? fun () ->
may_switch_test_network w spawn_child block >>= fun () ->
may_switch_test_chain w spawn_child block >>= fun () ->
Lwt_watcher.notify nv.new_head_input block ;
if Block_hash.equal head_hash block_header.shell.predecessor then
return Event.Head_incrememt
@ -256,7 +256,7 @@ let on_completion (type a) w (req : a Request.t) (update : a) request_status =
let on_close w =
let nv = Worker.state w in
Distributed_db.deactivate nv.parameters.net_db >>= fun () ->
Distributed_db.deactivate nv.parameters.chain_db >>= fun () ->
Lwt.join
(Prevalidator.shutdown nv.prevalidator ::
Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child ::
@ -266,9 +266,9 @@ let on_close w =
Lwt.return_unit
let on_launch w _ parameters =
Chain.init_head parameters.net_state >>= fun () ->
Chain.init_head parameters.chain_state >>= fun () ->
Prevalidator.create
parameters.prevalidator_limits parameters.net_db >>= fun prevalidator ->
parameters.prevalidator_limits parameters.chain_db >>= fun prevalidator ->
let valid_block_input = Lwt_watcher.create_input () in
let new_head_input = Lwt_watcher.create_input () in
let bootstrapped_waiter, bootstrapped_wakener = Lwt.wait () in
@ -286,7 +286,7 @@ let on_launch w _ parameters =
child = None ;
prevalidator } in
if nv.bootstrapped then Lwt.wakeup_later bootstrapped_wakener () ;
Distributed_db.set_callback parameters.net_db {
Distributed_db.set_callback parameters.chain_db {
notify_branch = begin fun peer_id locator ->
Lwt.async begin fun () ->
may_activate_peer_validator w peer_id >>= fun pv ->
@ -316,7 +316,7 @@ let on_launch w _ parameters =
let rec create
?max_child_ttl ?parent
peer_validator_limits prevalidator_limits block_validator
global_valid_block_input db net_state limits =
global_valid_block_input db chain_state limits =
let spawn_child ~parent pvl pl bl gvbi db n l =
create ~parent pvl pl bl gvbi db n l >>= fun w ->
Lwt.return (Worker.state w, (fun () -> Worker.shutdown w)) in
@ -337,12 +337,12 @@ let rec create
block_validator ;
global_valid_block_input ;
db ;
net_db = Distributed_db.activate db net_state ;
net_state ;
chain_db = Distributed_db.activate db chain_state ;
chain_state ;
limits } in
Worker.launch table
prevalidator_limits.worker_limits
(State.Net.id net_state)
(State.Chain.id chain_state)
parameters
(module Handlers)
@ -358,33 +358,33 @@ let create
peer_validator_limits prevalidator_limits
block_validator global_valid_block_input global_db state limits
let net_id w =
let { parameters = { net_state } } = Worker.state w in
State.Net.id net_state
let chain_id w =
let { parameters = { chain_state } } = Worker.state w in
State.Chain.id chain_state
let net_state w =
let { parameters = { net_state } } = Worker.state w in
net_state
let chain_state w =
let { parameters = { chain_state } } = Worker.state w in
chain_state
let prevalidator w =
let { prevalidator } = Worker.state w in
prevalidator
let net_db w =
let { parameters = { net_db } } = Worker.state w in
net_db
let chain_db w =
let { parameters = { chain_db } } = Worker.state w in
chain_db
let child w =
match (Worker.state w).child with
| None -> None
| Some ({ parameters = { net_state } }, _) ->
try Some (List.assoc (State.Net.id net_state) (Worker.list table))
| Some ({ parameters = { chain_state } }, _) ->
try Some (List.assoc (State.Chain.id chain_state) (Worker.list table))
with Not_found -> None
let validate_block w ?(force = false) hash block operations =
let nv = Worker.state w in
assert (Block_hash.equal hash (Block_header.hash block)) ;
Chain.head nv.parameters.net_state >>= fun head ->
Chain.head nv.parameters.chain_state >>= fun head ->
let head = State.Block.header head in
if
force || Fitness.(head.shell.fitness <= block.shell.fitness)
@ -393,7 +393,7 @@ let validate_block w ?(force = false) hash block operations =
~canceler:(Worker.canceler w)
~notify_new_block:(notify_new_block w)
nv.parameters.block_validator
nv.parameters.net_db
nv.parameters.chain_db
hash block operations
else
failwith "Fitness too low"

16
src/lib_shell/net_validator.mli → src/lib_shell/chain_validator.mli
View File

@ -21,16 +21,16 @@ val create:
Block_validator.t ->
State.Block.t Lwt_watcher.input ->
Distributed_db.t ->
State.Net.t ->
State.Chain.t ->
limits ->
t Lwt.t
val bootstrapped: t -> unit Lwt.t
val net_id: t -> Net_id.t
val net_state: t -> State.Net.t
val chain_id: t -> Chain_id.t
val chain_state: t -> State.Chain.t
val prevalidator: t -> Prevalidator.t
val net_db: t -> Distributed_db.net_db
val chain_db: t -> Distributed_db.chain_db
val child: t -> t option
val validate_block:
@ -44,9 +44,9 @@ val shutdown: t -> unit Lwt.t
val valid_block_watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
val new_head_watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
val running_workers: unit -> (Net_id.t * t) list
val running_workers: unit -> (Chain_id.t * t) list
val status: t -> Worker_types.worker_status
val pending_requests : t -> (Time.t * Net_validator_worker_state.Request.view) list
val current_request : t -> (Time.t * Time.t * Net_validator_worker_state.Request.view) option
val last_events : t -> (Lwt_log_core.level * Net_validator_worker_state.Event.t list) list
val pending_requests : t -> (Time.t * Chain_validator_worker_state.Request.view) list
val current_request : t -> (Time.t * Time.t * Chain_validator_worker_state.Request.view) option
val last_events : t -> (Lwt_log_core.level * Chain_validator_worker_state.Event.t list) list

404
src/lib_shell/distributed_db.ml
View File

@ -68,7 +68,7 @@ module Make_raw
end
module Fake_operation_storage = struct
type store = State.Net.t
type store = State.Chain.t
type value = Operation.t
let known _ _ = Lwt.return_false
let read _ _ = Lwt.return (Error_monad.error_exn Not_found)
@ -92,17 +92,17 @@ module Raw_operation =
end)
module Block_header_storage = struct
type store = State.Net.t
type store = State.Chain.t
type value = Block_header.t
let known = State.Block.known_valid
let read net_state h =
State.Block.read net_state h >>=? fun b ->
let read chain_state h =
State.Block.read chain_state h >>=? fun b ->
return (State.Block.header b)
let read_opt net_state h =
State.Block.read_opt net_state h >>= fun b ->
let read_opt chain_state h =
State.Block.read_opt chain_state h >>= fun b ->
Lwt.return (Option.map ~f:State.Block.header b)
let read_exn net_state h =
State.Block.read_exn net_state h >>= fun b ->
let read_exn chain_state h =
State.Block.read_exn chain_state h >>= fun b ->
Lwt.return (State.Block.header b)
end
@ -122,21 +122,21 @@ module Raw_block_header =
end)
module Operation_hashes_storage = struct
type store = State.Net.t
type store = State.Chain.t
type value = Operation_hash.t list
let known net_state (h, _) = State.Block.known_valid net_state h
let read net_state (h, i) =
State.Block.read net_state h >>=? fun b ->
let known chain_state (h, _) = State.Block.known_valid chain_state h
let read chain_state (h, i) =
State.Block.read chain_state h >>=? fun b ->
State.Block.operation_hashes b i >>= fun (ops, _) ->
return ops
let read_opt net_state (h, i) =
State.Block.read_opt net_state h >>= function
let read_opt chain_state (h, i) =
State.Block.read_opt chain_state h >>= function
| None -> Lwt.return_none
| Some b ->
State.Block.operation_hashes b i >>= fun (ops, _) ->
Lwt.return (Some ops)
let read_exn net_state (h, i) =
State.Block.read_exn net_state h >>= fun b ->
let read_exn chain_state (h, i) =
State.Block.read_exn chain_state h >>= fun b ->
State.Block.operation_hashes b i >>= fun (ops, _) ->
Lwt.return ops
end
@ -199,21 +199,21 @@ module Raw_operation_hashes = struct
end
module Operations_storage = struct
type store = State.Net.t
type store = State.Chain.t
type value = Operation.t list
let known net_state (h, _) = State.Block.known_valid net_state h
let read net_state (h, i) =
State.Block.read net_state h >>=? fun b ->
let known chain_state (h, _) = State.Block.known_valid chain_state h
let read chain_state (h, i) =
State.Block.read chain_state h >>=? fun b ->
State.Block.operations b i >>= fun (ops, _) ->
return ops
let read_opt net_state (h, i) =
State.Block.read_opt net_state h >>= function
let read_opt chain_state (h, i) =
State.Block.read_opt chain_state h >>= function
| None -> Lwt.return_none
| Some b ->
State.Block.operations b i >>= fun (ops, _) ->
Lwt.return (Some ops)
let read_exn net_state (h, i) =
State.Block.read_exn net_state h >>= fun b ->
let read_exn chain_state (h, i) =
State.Block.read_exn chain_state h >>= fun b ->
State.Block.operations b i >>= fun (ops, _) ->
Lwt.return ops
end
@ -302,14 +302,14 @@ type db = {
p2p: p2p ;
p2p_readers: p2p_reader P2p_peer.Table.t ;
disk: State.t ;
active_nets: net_db Net_id.Table.t ;
active_chains: chain_db Chain_id.Table.t ;
protocol_db: Raw_protocol.t ;
block_input: (Block_hash.t * Block_header.t) Lwt_watcher.input ;
operation_input: (Operation_hash.t * Operation.t) Lwt_watcher.input ;
}
and net_db = {
net_state: State.Net.t ;
and chain_db = {
chain_state: State.Chain.t ;
global_db: db ;
operation_db: Raw_operation.t ;
block_header_db: Raw_block_header.t ;
@ -323,7 +323,7 @@ and net_db = {
and p2p_reader = {
gid: P2p_peer.Id.t ;
conn: connection ;
peer_active_nets: net_db Net_id.Table.t ;
peer_active_chains: chain_db Chain_id.Table.t ;
canceler: Lwt_canceler.t ;
mutable worker: unit Lwt.t ;
}
@ -337,116 +337,116 @@ let noop_callback = {
type t = db
let state { disk } = disk
let net_state { net_state } = net_state
let chain_state { chain_state } = chain_state
let db { global_db } = global_db
let read_block_header { disk } h =
State.read_block disk h >>= function
| Some b ->
Lwt.return_some (State.Block.net_id b, State.Block.header b)
Lwt.return_some (State.Block.chain_id b, State.Block.header b)
| None ->
Lwt.return_none
let find_pending_block_header { peer_active_nets } h =
Net_id.Table.fold
(fun _net_id net_db acc ->
let find_pending_block_header { peer_active_chains } h =
Chain_id.Table.fold
(fun _chain_id chain_db acc ->
match acc with
| Some _ -> acc
| None when Raw_block_header.Table.pending
net_db.block_header_db.table h ->
Some net_db
chain_db.block_header_db.table h ->
Some chain_db
| None -> None)
peer_active_nets
peer_active_chains
None
let find_pending_operations { peer_active_nets } h i =
Net_id.Table.fold
(fun _net_id net_db acc ->
let find_pending_operations { peer_active_chains } h i =
Chain_id.Table.fold
(fun _chain_id chain_db acc ->
match acc with
| Some _ -> acc
| None when Raw_operations.Table.pending
net_db.operations_db.table (h, i) ->
Some net_db
chain_db.operations_db.table (h, i) ->
Some chain_db
| None -> None)
peer_active_nets
peer_active_chains
None
let find_pending_operation_hashes { peer_active_nets } h i =
Net_id.Table.fold
(fun _net_id net_db acc ->
let find_pending_operation_hashes { peer_active_chains } h i =
Chain_id.Table.fold
(fun _chain_id chain_db acc ->
match acc with
| Some _ -> acc
| None when Raw_operation_hashes.Table.pending
net_db.operation_hashes_db.table (h, i) ->
Some net_db
chain_db.operation_hashes_db.table (h, i) ->
Some chain_db
| None -> None)
peer_active_nets
peer_active_chains
None
let find_pending_operation { peer_active_nets } h =
Net_id.Table.fold
(fun _net_id net_db acc ->
let find_pending_operation { peer_active_chains } h =
Chain_id.Table.fold
(fun _chain_id chain_db acc ->
match acc with
| Some _ -> acc
| None when Raw_operation.Table.pending
net_db.operation_db.table h ->
Some net_db
chain_db.operation_db.table h ->
Some chain_db
| None -> None)
peer_active_nets
peer_active_chains
None
let read_operation { active_nets } h =
Net_id.Table.fold
(fun net_id net_db acc ->
let read_operation { active_chains } h =
Chain_id.Table.fold
(fun chain_id chain_db acc ->
acc >>= function
| Some _ -> acc
| None ->
Raw_operation.Table.read_opt
net_db.operation_db.table h >>= function
chain_db.operation_db.table h >>= function
| None -> Lwt.return_none
| Some bh -> Lwt.return_some (net_id, bh))
active_nets
| Some bh -> Lwt.return_some (chain_id, bh))
active_chains
Lwt.return_none
module P2p_reader = struct
let may_activate global_db state net_id f =
match Net_id.Table.find state.peer_active_nets net_id with
| net_db ->
f net_db
let may_activate global_db state chain_id f =
match Chain_id.Table.find state.peer_active_chains chain_id with
| chain_db ->
f chain_db
| exception Not_found ->
match Net_id.Table.find global_db.active_nets net_id with
| net_db ->
net_db.active_peers :=
P2p_peer.Set.add state.gid !(net_db.active_peers) ;
P2p_peer.Table.add net_db.active_connections
match Chain_id.Table.find global_db.active_chains chain_id with
| chain_db ->
chain_db.active_peers :=
P2p_peer.Set.add state.gid !(chain_db.active_peers) ;
P2p_peer.Table.add chain_db.active_connections
state.gid state ;
Net_id.Table.add state.peer_active_nets net_id net_db ;
f net_db
Chain_id.Table.add state.peer_active_chains chain_id chain_db ;
f chain_db
| exception Not_found ->
(* TODO decrease peer score. *)
Lwt.return_unit
let deactivate state net_db =
net_db.callback.disconnection state.gid ;
net_db.active_peers :=
P2p_peer.Set.remove state.gid !(net_db.active_peers) ;
P2p_peer.Table.remove net_db.active_connections state.gid
let deactivate state chain_db =
chain_db.callback.disconnection state.gid ;
chain_db.active_peers :=
P2p_peer.Set.remove state.gid !(chain_db.active_peers) ;
P2p_peer.Table.remove chain_db.active_connections state.gid
let may_handle state net_id f =
match Net_id.Table.find state.peer_active_nets net_id with
let may_handle state chain_id f =
match Chain_id.Table.find state.peer_active_chains chain_id with
| exception Not_found ->
(* TODO decrease peer score *)
Lwt.return_unit
| net_db ->
f net_db
| chain_db ->
f chain_db
let may_handle_global global_db net_id f =
match Net_id.Table.find global_db.active_nets net_id with
let may_handle_global global_db chain_id f =
match Chain_id.Table.find global_db.active_chains chain_id with
| exception Not_found ->
Lwt.return_unit
| net_db ->
f net_db
| chain_db ->
f chain_db
let handle_msg global_db state msg =
@ -460,50 +460,50 @@ module P2p_reader = struct
match msg with
| Get_current_branch net_id ->
may_handle_global global_db net_id @@ fun net_db ->
if not (Net_id.Table.mem state.peer_active_nets net_id) then
| Get_current_branch chain_id ->
may_handle_global global_db chain_id @@ fun chain_db ->
if not (Chain_id.Table.mem state.peer_active_chains chain_id) then
ignore
@@ P2p.try_send global_db.p2p state.conn
@@ Get_current_branch net_id ;
Chain.locator net_db.net_state >>= fun locator ->
@@ Get_current_branch chain_id ;
Chain.locator chain_db.chain_state >>= fun locator ->
ignore
@@ P2p.try_send global_db.p2p state.conn
@@ Current_branch (net_id, locator) ;
@@ Current_branch (chain_id, locator) ;
Lwt.return_unit
| Current_branch (net_id, locator) ->
may_activate global_db state net_id @@ fun net_db ->
| Current_branch (chain_id, locator) ->
may_activate global_db state chain_id @@ fun chain_db ->
let head, hist = (locator :> Block_header.t * Block_hash.t list) in
Lwt_list.exists_p
(State.Block.known_invalid net_db.net_state)
(State.Block.known_invalid chain_db.chain_state)
(Block_header.hash head :: hist) >>= fun known_invalid ->
if not known_invalid then
net_db.callback.notify_branch state.gid locator ;
chain_db.callback.notify_branch state.gid locator ;
(* TODO Kickban *)
Lwt.return_unit
| Deactivate net_id ->
may_handle state net_id @@ fun net_db ->
deactivate state net_db ;
Net_id.Table.remove state.peer_active_nets net_id ;
| Deactivate chain_id ->
may_handle state chain_id @@ fun chain_db ->
deactivate state chain_db ;
Chain_id.Table.remove state.peer_active_chains chain_id ;
Lwt.return_unit
| Get_current_head net_id ->
may_handle state net_id @@ fun net_db ->
State.Current_mempool.get net_db.net_state >>= fun (head, mempool) ->
| Get_current_head chain_id ->
may_handle state chain_id @@ fun chain_db ->
State.Current_mempool.get chain_db.chain_state >>= fun (head, mempool) ->
(* TODO bound the sent mempool size *)
ignore
@@ P2p.try_send global_db.p2p state.conn
@@ Current_head (net_id, head, mempool) ;
@@ Current_head (chain_id, head, mempool) ;
Lwt.return_unit
| Current_head (net_id, header, mempool) ->
may_handle state net_id @@ fun net_db ->
| Current_head (chain_id, header, mempool) ->
may_handle state chain_id @@ fun chain_db ->
let head = Block_header.hash header in
State.Block.known_invalid net_db.net_state head >>= fun known_invalid ->
State.Block.known_invalid chain_db.chain_state head >>= fun known_invalid ->
if not known_invalid then
net_db.callback.notify_head state.gid header mempool ;
chain_db.callback.notify_head state.gid header mempool ;
(* TODO Kickban *)
Lwt.return_unit
@ -514,7 +514,7 @@ module P2p_reader = struct
| None ->
(* TODO: Blame request of unadvertised blocks ? *)
Lwt.return_unit
| Some (_net_id, header) ->
| Some (_chain_id, header) ->
ignore @@
P2p.try_send global_db.p2p state.conn (Block_header header) ;
Lwt.return_unit)
@ -526,9 +526,9 @@ module P2p_reader = struct
| None ->
(* TODO some penalty. *)
Lwt.return_unit
| Some net_db ->
| Some chain_db ->
Raw_block_header.Table.notify
net_db.block_header_db.table state.gid hash block >>= fun () ->
chain_db.block_header_db.table state.gid hash block >>= fun () ->
Lwt.return_unit
end
@ -539,7 +539,7 @@ module P2p_reader = struct
| None ->
(* TODO: Blame request of unadvertised operations ? *)
Lwt.return_unit
| Some (_net_id, op) ->
| Some (_chain_id, op) ->
ignore @@
P2p.try_send global_db.p2p state.conn (Operation op) ;
Lwt.return_unit)
@ -551,9 +551,9 @@ module P2p_reader = struct
| None ->
(* TODO some penalty. *)
Lwt.return_unit
| Some net_db ->
| Some chain_db ->
Raw_operation.Table.notify
net_db.operation_db.table state.gid hash operation >>= fun () ->
chain_db.operation_db.table state.gid hash operation >>= fun () ->
Lwt.return_unit
end
@ -595,9 +595,9 @@ module P2p_reader = struct
| None ->
(* TODO some penalty. *)
Lwt.return_unit
| Some net_db ->
| Some chain_db ->
Raw_operation_hashes.Table.notify
net_db.operation_hashes_db.table state.gid
chain_db.operation_hashes_db.table state.gid
(block, ofs) (ops, path) >>= fun () ->
Lwt.return_unit
end
@ -621,9 +621,9 @@ module P2p_reader = struct
| None ->
(* TODO some penalty. *)
Lwt.return_unit
| Some net_db ->
| Some chain_db ->
Raw_operations.Table.notify
net_db.operations_db.table state.gid
chain_db.operations_db.table state.gid
(block, ofs) (ops, path) >>= fun () ->
Lwt.return_unit
end
@ -636,9 +636,9 @@ module P2p_reader = struct
handle_msg global_db state msg >>= fun () ->
worker_loop global_db state
| Error _ ->
Net_id.Table.iter
Chain_id.Table.iter
(fun _ -> deactivate state)
state.peer_active_nets ;
state.peer_active_chains ;
P2p_peer.Table.remove global_db.p2p_readers state.gid ;
Lwt.return_unit
@ -646,14 +646,14 @@ module P2p_reader = struct
let canceler = Lwt_canceler.create () in
let state = {
conn ; gid ; canceler ;
peer_active_nets = Net_id.Table.create 17 ;
peer_active_chains = Chain_id.Table.create 17 ;
worker = Lwt.return_unit ;
} in
Net_id.Table.iter (fun net_id _net_db ->
Chain_id.Table.iter (fun chain_id _chain_db ->
Lwt.async begin fun () ->
P2p.send db.p2p conn (Get_current_branch net_id)
P2p.send db.p2p conn (Get_current_branch chain_id)
end)
db.active_nets ;
db.active_chains ;
state.worker <-
Lwt_utils.worker
(Format.asprintf "db_network_reader.%a"
@ -688,21 +688,21 @@ let create disk p2p =
send = raw_try_send p2p ;
} in
let protocol_db = Raw_protocol.create global_request disk in
let active_nets = Net_id.Table.create 17 in
let active_chains = Chain_id.Table.create 17 in
let p2p_readers = P2p_peer.Table.create 17 in
let block_input = Lwt_watcher.create_input () in
let operation_input = Lwt_watcher.create_input () in
let db =
{ p2p ; p2p_readers ; disk ;
active_nets ; protocol_db ;
active_chains ; protocol_db ;
block_input ; operation_input } in
P2p.on_new_connection p2p (P2p_reader.run db) ;
P2p.iter_connections p2p (P2p_reader.run db) ;
db
let activate ({ p2p ; active_nets } as global_db) net_state =
let net_id = State.Net.id net_state in
match Net_id.Table.find active_nets net_id with
let activate ({ p2p ; active_chains } as global_db) chain_state =
let chain_id = State.Chain.id chain_state in
match Chain_id.Table.find active_chains chain_id with
| exception Not_found ->
let active_peers = ref P2p_peer.Set.empty in
let p2p_request =
@ -712,50 +712,50 @@ let activate ({ p2p ; active_nets } as global_db) net_state =
} in
let operation_db =
Raw_operation.create
~global_input:global_db.operation_input p2p_request net_state in
~global_input:global_db.operation_input p2p_request chain_state in
let block_header_db =
Raw_block_header.create
~global_input:global_db.block_input p2p_request net_state in
~global_input:global_db.block_input p2p_request chain_state in
let operation_hashes_db =
Raw_operation_hashes.create p2p_request net_state in
Raw_operation_hashes.create p2p_request chain_state in
let operations_db =
Raw_operations.create p2p_request net_state in
let net = {
Raw_operations.create p2p_request chain_state in
let chain = {
global_db ; operation_db ; block_header_db ;
operation_hashes_db ; operations_db ;
net_state ; callback = noop_callback ; active_peers ;
chain_state ; callback = noop_callback ; active_peers ;
active_connections = P2p_peer.Table.create 53 ;
} in
P2p.iter_connections p2p (fun _peer_id conn ->
Lwt.async begin fun () ->
P2p.send p2p conn (Get_current_branch net_id)
P2p.send p2p conn (Get_current_branch chain_id)
end) ;
Net_id.Table.add active_nets net_id net ;
net
| net ->
net
Chain_id.Table.add active_chains chain_id chain ;
chain
| chain ->
chain
let set_callback net_db callback =
net_db.callback <- callback
let set_callback chain_db callback =
chain_db.callback <- callback
let deactivate net_db =
let { active_nets ; p2p } = net_db.global_db in
let net_id = State.Net.id net_db.net_state in
Net_id.Table.remove active_nets net_id ;
let deactivate chain_db =
let { active_chains ; p2p } = chain_db.global_db in
let chain_id = State.Chain.id chain_db.chain_state in
Chain_id.Table.remove active_chains chain_id ;
P2p_peer.Table.iter
(fun _peer_id reader ->
P2p_reader.deactivate reader net_db ;
P2p_reader.deactivate reader chain_db ;
Lwt.async begin fun () ->
P2p.send p2p reader.conn (Deactivate net_id)
P2p.send p2p reader.conn (Deactivate chain_id)
end)
net_db.active_connections ;
Raw_operation.shutdown net_db.operation_db >>= fun () ->
Raw_block_header.shutdown net_db.block_header_db >>= fun () ->
chain_db.active_connections ;
Raw_operation.shutdown chain_db.operation_db >>= fun () ->
Raw_block_header.shutdown chain_db.block_header_db >>= fun () ->
Lwt.return_unit >>= fun () ->
Lwt.return_unit
let get_net { active_nets } net_id =
try Some (Net_id.Table.find active_nets net_id)
let get_chain { active_chains } chain_id =
try Some (Chain_id.Table.find active_chains chain_id)
with Not_found -> None
let disconnect { global_db = { p2p } } peer_id =
@ -763,43 +763,43 @@ let disconnect { global_db = { p2p } } peer_id =
| None -> Lwt.return_unit
| Some conn -> P2p.disconnect p2p conn
let shutdown { p2p ; p2p_readers ; active_nets } =
let shutdown { p2p ; p2p_readers ; active_chains } =
P2p_peer.Table.fold
(fun _peer_id reader acc ->
P2p_reader.shutdown reader >>= fun () -> acc)
p2p_readers
Lwt.return_unit >>= fun () ->
Net_id.Table.fold
(fun _ net_db acc ->
Raw_operation.shutdown net_db.operation_db >>= fun () ->
Raw_block_header.shutdown net_db.block_header_db >>= fun () ->
Chain_id.Table.fold
(fun _ chain_db acc ->
Raw_operation.shutdown chain_db.operation_db >>= fun () ->
Raw_block_header.shutdown chain_db.block_header_db >>= fun () ->
acc)
active_nets
active_chains
Lwt.return_unit >>= fun () ->
P2p.shutdown p2p >>= fun () ->
Lwt.return_unit
let clear_block net_db hash n =
Raw_operations.clear_all net_db.operations_db.table hash n ;
Raw_operation_hashes.clear_all net_db.operation_hashes_db.table hash n ;
Raw_block_header.Table.clear_or_cancel net_db.block_header_db.table hash
let clear_block chain_db hash n =
Raw_operations.clear_all chain_db.operations_db.table hash n ;
Raw_operation_hashes.clear_all chain_db.operation_hashes_db.table hash n ;
Raw_block_header.Table.clear_or_cancel chain_db.block_header_db.table hash
let commit_block net_db hash header operations result =
let commit_block chain_db hash header operations result =
assert (Block_hash.equal hash (Block_header.hash header)) ;
assert (List.length operations = header.shell.validation_passes) ;
State.Block.store net_db.net_state header operations result >>=? fun res ->
clear_block net_db hash header.shell.validation_passes ;
State.Block.store chain_db.chain_state header operations result >>=? fun res ->
clear_block chain_db hash header.shell.validation_passes ;
return res
let commit_invalid_block net_db hash header errors =
let commit_invalid_block chain_db hash header errors =
assert (Block_hash.equal hash (Block_header.hash header)) ;
State.Block.store_invalid net_db.net_state header errors >>=? fun res ->
clear_block net_db hash header.shell.validation_passes ;
State.Block.store_invalid chain_db.chain_state header errors >>=? fun res ->
clear_block chain_db hash header.shell.validation_passes ;
return res
let inject_operation net_db h op =
let inject_operation chain_db h op =
assert (Operation_hash.equal h (Operation.hash op)) ;
Raw_operation.Table.inject net_db.operation_db.table h op
Raw_operation.Table.inject chain_db.operation_db.table h op
let commit_protocol db h p =
State.Protocol.store db.disk p >>= fun res ->
@ -844,9 +844,9 @@ end
module Block_header = struct
type t = Block_header.t
include (Make (Raw_block_header.Table) (struct
type t = net_db
let proj net = net.block_header_db.table
end) : Distributed_db_functors.DISTRIBUTED_DB with type t := net_db
type t = chain_db
let proj chain = chain.block_header_db.table
end) : Distributed_db_functors.DISTRIBUTED_DB with type t := chain_db
and type key := Block_hash.t
and type value := Block_header.t
and type param := unit)
@ -854,22 +854,22 @@ end
module Operation_hashes =
Make (Raw_operation_hashes.Table) (struct
type t = net_db
let proj net = net.operation_hashes_db.table
type t = chain_db
let proj chain = chain.operation_hashes_db.table
end)
module Operations =
Make (Raw_operations.Table) (struct
type t = net_db
let proj net = net.operations_db.table
type t = chain_db
let proj chain = chain.operations_db.table
end)
module Operation = struct
include Operation
include (Make (Raw_operation.Table) (struct
type t = net_db
let proj net = net.operation_db.table
end) : Distributed_db_functors.DISTRIBUTED_DB with type t := net_db
type t = chain_db
let proj chain = chain.operation_db.table
end) : Distributed_db_functors.DISTRIBUTED_DB with type t := chain_db
and type key := Operation_hash.t
and type value := Operation.t
and type param := unit)
@ -887,46 +887,46 @@ module Protocol = struct
end
let broadcast net_db msg =
let broadcast chain_db msg =
P2p_peer.Table.iter
(fun _peer_id state ->
ignore (P2p.try_send net_db.global_db.p2p state.conn msg))
net_db.active_connections
ignore (P2p.try_send chain_db.global_db.p2p state.conn msg))
chain_db.active_connections
let try_send net_db peer_id msg =
let try_send chain_db peer_id msg =
try
let conn = P2p_peer.Table.find net_db.active_connections peer_id in
ignore (P2p.try_send net_db.global_db.p2p conn.conn msg : bool)
let conn = P2p_peer.Table.find chain_db.active_connections peer_id in
ignore (P2p.try_send chain_db.global_db.p2p conn.conn msg : bool)
with Not_found -> ()
let send net_db ?peer msg =
let send chain_db ?peer msg =
match peer with
| Some peer -> try_send net_db peer msg
| None -> broadcast net_db msg
| Some peer -> try_send chain_db peer msg
| None -> broadcast chain_db msg
module Request = struct
let current_head net_db ?peer () =
let net_id = State.Net.id net_db.net_state in
send net_db ?peer @@ Get_current_head net_id
let current_head chain_db ?peer () =
let chain_id = State.Chain.id chain_db.chain_state in
send chain_db ?peer @@ Get_current_head chain_id
let current_branch net_db ?peer () =
let net_id = State.Net.id net_db.net_state in
send net_db ?peer @@ Get_current_branch net_id
let current_branch chain_db ?peer () =
let chain_id = State.Chain.id chain_db.chain_state in
send chain_db ?peer @@ Get_current_branch chain_id
end
module Advertise = struct
let current_head net_db ?peer ?(mempool = Mempool.empty) head =
let net_id = State.Net.id net_db.net_state in
assert (Net_id.equal net_id (State.Block.net_id head)) ;
send net_db ?peer @@
Current_head (net_id, State.Block.header head, mempool)
let current_head chain_db ?peer ?(mempool = Mempool.empty) head =
let chain_id = State.Chain.id chain_db.chain_state in
assert (Chain_id.equal chain_id (State.Block.chain_id head)) ;
send chain_db ?peer @@
Current_head (chain_id, State.Block.header head, mempool)
let current_branch net_db ?peer locator =
let net_id = State.Net.id net_db.net_state in
send net_db ?peer @@ Current_branch (net_id, locator) ;
let current_branch chain_db ?peer locator =
let chain_id = State.Chain.id chain_db.chain_state in
send chain_db ?peer @@ Current_branch (chain_id, locator) ;
Lwt.return_unit
end

68
src/lib_shell/distributed_db.mli
View File

@ -25,21 +25,21 @@ val shutdown: t -> unit Lwt.t
(** {1 Network database} *)
(** An instance of the distributed DB for a given network (mainnet,
current testnet, ...) *)
type net_db
(** An instance of the distributed DB for a given chain (mainchain,
current testchain, ...) *)
type chain_db
(** Activate a given network. The node will notify its neighbours that
it now handles the given network and that it expects notification
(** Activate a given chain. The node will notify its neighbours that
it now handles the given chain and that it expects notification
for new head or new operations. *)
val activate: t -> State.Net.t -> net_db
val activate: t -> State.Chain.t -> chain_db
(** Look for the database of an active network. *)
val get_net: t -> Net_id.t -> net_db option
(** Look for the database of an active chain. *)
val get_chain: t -> Chain_id.t -> chain_db option
(** Deactivate a given network. The node will notify its neighbours
that it does not care anymore about this network. *)
val deactivate: net_db -> unit Lwt.t
(** Deactivate a given chain. The node will notify its neighbours
that it does not care anymore about this chain. *)
val deactivate: chain_db -> unit Lwt.t
type callback = {
notify_branch: P2p_peer.Id.t -> Block_locator.t -> unit ;
@ -49,43 +49,43 @@ type callback = {
(** Register all the possible callback from the distributed DB to the
validator. *)
val set_callback: net_db -> callback -> unit
val set_callback: chain_db -> callback -> unit
(** Kick a given peer. *)
val disconnect: net_db -> P2p_peer.Id.t -> unit Lwt.t
val disconnect: chain_db -> P2p_peer.Id.t -> unit Lwt.t
(** Various accessors. *)
val net_state: net_db -> State.Net.t
val db: net_db -> db
val chain_state: chain_db -> State.Chain.t
val db: chain_db -> db
(** {1 Sending messages} *)
module Request : sig
(** Send to a given peer, or to all known active peers for the
network, a friendly request "Hey, what's your current branch
chain, a friendly request "Hey, what's your current branch
?". The expected answer is a `Block_locator.t.`. *)
val current_branch: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit
val current_branch: chain_db -> ?peer:P2p_peer.Id.t -> unit -> unit
(** Send to a given peer, or to all known active peers for the
given network, a friendly request "Hey, what's your current
given chain, a friendly request "Hey, what's your current
branch ?". The expected answer is a `Block_locator.t.`. *)
val current_head: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit
val current_head: chain_db -> ?peer:P2p_peer.Id.t -> unit -> unit
end
module Advertise : sig
(** Notify a given peer, or all known active peers for the
network, of a new head and possibly of new operations. *)
chain, of a new head and possibly of new operations. *)
val current_head:
net_db -> ?peer:P2p_peer.Id.t ->
chain_db -> ?peer:P2p_peer.Id.t ->
?mempool:Mempool.t -> State.Block.t -> unit
(** Notify a given peer, or all known active peers for the
network, of a new head and its sparse history. *)
chain, of a new head and its sparse history. *)
val current_branch:
net_db -> ?peer:P2p_peer.Id.t ->
chain_db -> ?peer:P2p_peer.Id.t ->
Block_locator.t -> unit Lwt.t
end
@ -95,19 +95,19 @@ end
(** Index of block headers. *)
module Block_header : sig
type t = Block_header.t (* avoid shadowing. *)
include DISTRIBUTED_DB with type t := net_db
include DISTRIBUTED_DB with type t := chain_db
and type key := Block_hash.t
and type value := Block_header.t
and type param := unit
end
(** Lookup for block header in any active networks *)
(** Lookup for block header in any active chains *)
val read_block_header:
db -> Block_hash.t -> (Net_id.t * Block_header.t) option Lwt.t
db -> Block_hash.t -> (Chain_id.t * Block_header.t) option Lwt.t
(** Index of all the operations of a given block (per validation pass). *)
module Operations :
DISTRIBUTED_DB with type t := net_db
DISTRIBUTED_DB with type t := chain_db
and type key = Block_hash.t * int
and type value = Operation.t list
and type param := Operation_list_list_hash.t
@ -115,14 +115,14 @@ module Operations :
(** Index of all the hashes of operations of a given block (per
validation pass). *)
module Operation_hashes :
DISTRIBUTED_DB with type t := net_db
DISTRIBUTED_DB with type t := chain_db
and type key = Block_hash.t * int
and type value = Operation_hash.t list
and type param := Operation_list_list_hash.t
(** Store on disk all the data associated to a valid block. *)
val commit_block:
net_db ->
chain_db ->
Block_hash.t ->
Block_header.t -> Operation.t list list ->
Updater.validation_result ->
@ -130,11 +130,11 @@ val commit_block:
(** Store on disk all the data associated to an invalid block. *)
val commit_invalid_block:
net_db ->
chain_db ->
Block_hash.t -> Block_header.t -> Error_monad.error list ->
bool tzresult Lwt.t
(** Monitor all the fetched block headers (for all activate networks). *)
(** Monitor all the fetched block headers (for all activate chains). *)
val watch_block_header:
t -> (Block_hash.t * Block_header.t) Lwt_stream.t * Lwt_watcher.stopper
@ -144,7 +144,7 @@ val watch_block_header:
(** Index of operations (for the mempool). *)
module Operation : sig
type t = Operation.t (* avoid shadowing. *)
include DISTRIBUTED_DB with type t := net_db
include DISTRIBUTED_DB with type t := chain_db
and type key := Operation_hash.t
and type value := Operation.t
and type param := unit
@ -152,9 +152,9 @@ end
(** Inject a new operation in the local index (memory only). *)
val inject_operation:
net_db -> Operation_hash.t -> Operation.t -> bool Lwt.t
chain_db -> Operation_hash.t -> Operation.t -> bool Lwt.t
(** Monitor all the fetched operations (for all activate networks). *)
(** Monitor all the fetched operations (for all activate chains). *)
val watch_operation:
t -> (Operation_hash.t * Operation.t) Lwt_stream.t * Lwt_watcher.stopper

40
src/lib_shell/distributed_db_message.ml
View File

@ -9,12 +9,12 @@
type t =
| Get_current_branch of Net_id.t
| Current_branch of Net_id.t * Block_locator.t
| Deactivate of Net_id.t
| Get_current_branch of Chain_id.t
| Current_branch of Chain_id.t * Block_locator.t
| Deactivate of Chain_id.t
| Get_current_head of Net_id.t
| Current_head of Net_id.t * Block_header.t * Mempool.t
| Get_current_head of Chain_id.t
| Current_head of Chain_id.t * Block_header.t * Mempool.t
| Get_block_headers of Block_hash.t list
| Block_header of Block_header.t
@ -42,46 +42,46 @@ let encoding =
[
case ~tag:0x10
(obj1
(req "get_current_branch" Net_id.encoding))
(req "get_current_branch" Chain_id.encoding))
(function
| Get_current_branch net_id -> Some net_id
| Get_current_branch chain_id -> Some chain_id
| _ -> None)
(fun net_id -> Get_current_branch net_id) ;
(fun chain_id -> Get_current_branch chain_id) ;
case ~tag:0x11
(obj2
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(req "current_branch" Block_locator.encoding))
(function
| Current_branch (net_id, locator) -> Some (net_id, locator)
| Current_branch (chain_id, locator) -> Some (chain_id, locator)
| _ -> None)
(fun (net_id, locator) -> Current_branch (net_id, locator)) ;
(fun (chain_id, locator) -> Current_branch (chain_id, locator)) ;
case ~tag:0x12
(obj1
(req "deactivate" Net_id.encoding))
(req "deactivate" Chain_id.encoding))
(function
| Deactivate net_id -> Some net_id
| Deactivate chain_id -> Some chain_id
| _ -> None)
(fun net_id -> Deactivate net_id) ;
(fun chain_id -> Deactivate chain_id) ;
case ~tag:0x13
(obj1
(req "get_current_head" Net_id.encoding))
(req "get_current_head" Chain_id.encoding))
(function
| Get_current_head net_id -> Some net_id
| Get_current_head chain_id -> Some chain_id
| _ -> None)
(fun net_id -> Get_current_branch net_id) ;
(fun chain_id -> Get_current_branch chain_id) ;
case ~tag:0x14
(obj3
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(req "current_block_header" (dynamic_size Block_header.encoding))
(req "current_mempool" Mempool.encoding))
(function
| Current_head (net_id, bh, mempool) -> Some (net_id, bh, mempool)
| Current_head (chain_id, bh, mempool) -> Some (chain_id, bh, mempool)
| _ -> None)
(fun (net_id, bh, mempool) -> Current_head (net_id, bh, mempool)) ;
(fun (chain_id, bh, mempool) -> Current_head (chain_id, bh, mempool)) ;
case ~tag:0x20
(obj1 (req "get_block_headers" (list Block_hash.encoding)))

10
src/lib_shell/distributed_db_message.mli
View File

@ -11,12 +11,12 @@
type t =
| Get_current_branch of Net_id.t
| Current_branch of Net_id.t * Block_locator.t
| Deactivate of Net_id.t
| Get_current_branch of Chain_id.t
| Current_branch of Chain_id.t * Block_locator.t
| Deactivate of Chain_id.t
| Get_current_head of Net_id.t
| Current_head of Net_id.t * Block_header.t * Mempool.t
| Get_current_head of Chain_id.t
| Current_head of Chain_id.t * Block_header.t * Mempool.t
| Get_block_headers of Block_hash.t list
| Block_header of Block_header.t

204
src/lib_shell/node.ml
View File

@ -10,12 +10,12 @@
open Lwt.Infix
open Logging.Node.Worker
let inject_operation validator ?net_id bytes =
let inject_operation validator ?chain_id bytes =
let t =
match Data_encoding.Binary.of_bytes Operation.encoding bytes with
| None -> failwith "Can't parse the operation"
| Some op ->
Validator.inject_operation validator ?net_id op
Validator.inject_operation validator ?chain_id op
in
let hash = Operation_hash.hash_bytes [bytes] in
Lwt.return (hash, t)
@ -40,23 +40,23 @@ let inject_protocol state ?force:_ proto =
in
Lwt.return (hash, validation)
let inject_block validator ?force ?net_id bytes operations =
let inject_block validator ?force ?chain_id bytes operations =
Validator.validate_block
validator ?force ?net_id bytes operations >>=? fun (hash, block) ->
validator ?force ?chain_id bytes operations >>=? fun (hash, block) ->
return (hash, (block >>=? fun _ -> return ()))
type t = {
state: State.t ;
distributed_db: Distributed_db.t ;
validator: Validator.t ;
mainnet_validator: Net_validator.t ;
mainchain_validator: Chain_validator.t ;
inject_block:
?force:bool ->
?net_id:Net_id.t ->
?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list ->
(Block_hash.t * unit tzresult Lwt.t) tzresult Lwt.t ;
inject_operation:
?net_id:Net_id.t -> MBytes.t ->
?chain_id:Chain_id.t -> MBytes.t ->
(Operation_hash.t * unit tzresult Lwt.t) Lwt.t ;
inject_protocol:
?force:bool -> Protocol.t ->
@ -65,13 +65,13 @@ type t = {
shutdown: unit -> unit Lwt.t ;
}
let init_p2p net_params =
match net_params with
let init_p2p p2p_params =
match p2p_params with
| None ->
lwt_log_notice "P2P layer is disabled" >>= fun () ->
Error_monad.return (P2p.faked_network Distributed_db_metadata.cfg)
| Some (config, limits) ->
lwt_log_notice "bootstraping network..." >>= fun () ->
lwt_log_notice "bootstraping chain..." >>= fun () ->
P2p.create
~config ~limits
Distributed_db_metadata.cfg
@ -80,12 +80,12 @@ let init_p2p net_params =
Error_monad.return p2p
type config = {
genesis: State.Net.genesis ;
genesis: State.Chain.genesis ;
store_root: string ;
context_root: string ;
patch_context: (Context.t -> Context.t Lwt.t) option ;
p2p: (P2p.config * P2p.limits) option ;
test_network_max_tll: int option ;
test_chain_max_tll: int option ;
}
and peer_validator_limits = Peer_validator.limits = {
@ -107,25 +107,25 @@ and block_validator_limits = Block_validator.limits = {
worker_limits : Worker_types.limits ;
}
and net_validator_limits = Net_validator.limits = {
and chain_validator_limits = Chain_validator.limits = {
bootstrap_threshold: int ;
worker_limits : Worker_types.limits ;
}
let may_create_net state genesis =
State.Net.get state (Net_id.of_block_hash genesis.State.Net.block) >>= function
| Ok net -> Lwt.return net
let may_create_chain state genesis =
State.Chain.get state (Chain_id.of_block_hash genesis.State.Chain.block) >>= function
| Ok chain -> Lwt.return chain
| Error _ ->
State.Net.create state genesis
State.Chain.create state genesis
let create { genesis ; store_root ; context_root ;
patch_context ; p2p = net_params ;
test_network_max_tll = max_child_ttl }
patch_context ; p2p = p2p_params ;
test_chain_max_tll = max_child_ttl }
peer_validator_limits
block_validator_limits
prevalidator_limits
net_validator_limits =
init_p2p net_params >>=? fun p2p ->
chain_validator_limits =
init_p2p p2p_params >>=? fun p2p ->
State.read
~store_root ~context_root ?patch_context () >>=? fun state ->
let distributed_db = Distributed_db.create state p2p in
@ -133,10 +133,10 @@ let create { genesis ; store_root ; context_root ;
peer_validator_limits
block_validator_limits
prevalidator_limits
net_validator_limits >>= fun validator ->
may_create_net state genesis >>= fun mainnet_state ->
chain_validator_limits >>= fun validator ->
may_create_chain state genesis >>= fun mainchain_state ->
Validator.activate validator
?max_child_ttl mainnet_state >>= fun mainnet_validator ->
?max_child_ttl mainchain_state >>= fun mainchain_validator ->
let shutdown () =
P2p.shutdown p2p >>= fun () ->
Validator.shutdown validator >>= fun () ->
@ -147,7 +147,7 @@ let create { genesis ; store_root ; context_root ;
state ;
distributed_db ;
validator ;
mainnet_validator ;
mainchain_validator ;
inject_block = inject_block validator ;
inject_operation = inject_operation validator ;
inject_protocol = inject_protocol state ;
@ -162,7 +162,7 @@ module RPC = struct
type block = Block_services.block
type block_info = Block_services.block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
@ -174,7 +174,7 @@ module RPC = struct
data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_network: Test_network_status.t ;
test_chain: Test_chain_status.t ;
}
let convert (block: State.Block.t) =
@ -185,10 +185,10 @@ module RPC = struct
List.map (List.map (fun op -> (Operation.hash op, op))) operations in
State.Block.context block >>= fun context ->
Context.get_protocol context >>= fun protocol ->
Context.get_test_network context >>= fun test_network ->
Context.get_test_chain context >>= fun test_chain ->
Lwt.return {
hash ;
net_id = State.Block.net_id block ;
chain_id = State.Block.chain_id block ;
level = header.shell.level ;
proto_level = header.shell.proto_level ;
predecessor = header.shell.predecessor ;
@ -200,7 +200,7 @@ module RPC = struct
data = header.proto ;
operations = Some operations ;
protocol ;
test_network ;
test_chain ;
}
let inject_block node = node.inject_block
@ -219,21 +219,21 @@ module RPC = struct
"BLockPrevaLidationPrevaLidationPrevaLidationPrZ4mr6"
let get_validator node = function
| `Genesis | `Head _ | `Prevalidation -> node.mainnet_validator
| `Genesis | `Head _ | `Prevalidation -> node.mainchain_validator
| `Test_head _ | `Test_prevalidation ->
match Net_validator.child node.mainnet_validator with
match Chain_validator.child node.mainchain_validator with
| None -> raise Not_found
| Some v -> v
let get_validator_per_hash node hash =
State.read_block_exn node.state hash >>= fun block ->
let net_id = State.Block.net_id block in
if Net_id.equal (Net_validator.net_id node.mainnet_validator) net_id then
Lwt.return (Some node.mainnet_validator)
let chain_id = State.Block.chain_id block in
if Chain_id.equal (Chain_validator.chain_id node.mainchain_validator) chain_id then
Lwt.return (Some node.mainchain_validator)
else
match Net_validator.child node.mainnet_validator with
match Chain_validator.child node.mainchain_validator with
| Some test_validator ->
if Net_id.equal (Net_validator.net_id test_validator) net_id then
if Chain_id.equal (Chain_validator.chain_id test_validator) chain_id then
Lwt.return_some test_validator
else
Lwt.return_none
@ -245,42 +245,42 @@ module RPC = struct
let read_valid_block_exn node h =
State.read_block_exn node.state h
let rec predecessor net_db n v =
let rec predecessor chain_db n v =
if n <= 0 then
Lwt.return v
else
State.Block.predecessor v >>= function
| None -> Lwt.return v
| Some v -> predecessor net_db (n-1) v
| Some v -> predecessor chain_db (n-1) v
let block_info node (block: block) =
match block with
| `Genesis ->
let net_state = Net_validator.net_state node.mainnet_validator in
Chain.genesis net_state >>= convert
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= convert
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let net_db = Net_validator.net_db validator in
let net_state = Net_validator.net_state validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= convert
let chain_db = Chain_validator.chain_db validator in
let chain_state = Chain_validator.chain_state validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= convert
| `Hash h ->
read_valid_block_exn node h >>= convert
| ( `Prevalidation | `Test_prevalidation ) as block ->
let validator = get_validator node block in
let pv = Net_validator.prevalidator validator in
let net_state = Net_validator.net_state validator in
Chain.head net_state >>= fun head ->
let pv = Chain_validator.prevalidator validator in
let chain_state = Chain_validator.chain_state validator in
Chain.head chain_state >>= fun head ->
let head_header = State.Block.header head in
let head_hash = State.Block.hash head in
let head_net_id = State.Block.net_id head in
let head_chain_id = State.Block.chain_id head in
State.Block.context head >>= fun head_context ->
Context.get_protocol head_context >>= fun head_protocol ->
Prevalidator.context pv >>= function
| Error _ -> Lwt.fail Not_found
| Ok { context ; fitness } ->
Context.get_protocol context >>= fun protocol ->
Context.get_test_network context >>= fun test_network ->
Context.get_test_chain context >>= fun test_chain ->
let proto_level =
if Protocol_hash.equal protocol head_protocol then
head_header.shell.proto_level
@ -306,8 +306,8 @@ module RPC = struct
operations = Some operations ;
context = Context_hash.zero ;
data = MBytes.of_string "" ;
net_id = head_net_id ;
test_network ;
chain_id = head_chain_id ;
test_chain ;
}
let rpc_context block : Updater.rpc_context Lwt.t =
@ -324,16 +324,16 @@ module RPC = struct
let get_rpc_context node block =
match block with
| `Genesis ->
let net_state = Net_validator.net_state node.mainnet_validator in
Chain.genesis net_state >>= fun block ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= fun block ->
rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt)
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let net_state = Net_validator.net_state validator in
let net_db = Net_validator.net_db validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= fun block ->
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt)
| `Hash hash-> begin
@ -346,9 +346,9 @@ module RPC = struct
end
| ( `Prevalidation | `Test_prevalidation ) as block ->
let validator = get_validator node block in
let pv = Net_validator.prevalidator validator in
let net_state = Net_validator.net_state validator in
Chain.head net_state >>= fun head ->
let pv = Chain_validator.prevalidator validator in
let chain_state = Chain_validator.chain_state validator in
Chain.head chain_state >>= fun head ->
let head_header = State.Block.header head in
let head_hash = State.Block.hash head in
State.Block.context head >>= fun head_context ->
@ -394,14 +394,14 @@ module RPC = struct
| `Genesis -> Lwt.return []
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let net_state = Net_validator.net_state validator in
let net_db = Net_validator.net_db validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= fun block ->
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
State.Block.all_operation_hashes block
| (`Prevalidation | `Test_prevalidation) as block ->
let validator = get_validator node block in
let pv = Net_validator.prevalidator validator in
let pv = Chain_validator.prevalidator validator in
let { Preapply_result.applied }, _ = Prevalidator.operations pv in
Lwt.return [List.map fst applied]
| `Hash hash ->
@ -415,14 +415,14 @@ module RPC = struct
| `Genesis -> Lwt.return []
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let net_state = Net_validator.net_state validator in
let net_db = Net_validator.net_db validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= fun block ->
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
State.Block.all_operations block
| (`Prevalidation | `Test_prevalidation) as block ->
let validator = get_validator node block in
let pv = Net_validator.prevalidator validator in
let pv = Chain_validator.prevalidator validator in
let { Preapply_result.applied }, _ = Prevalidator.operations pv in
Lwt.return [List.map snd applied]
| `Hash hash ->
@ -436,22 +436,22 @@ module RPC = struct
| ( `Head 0 | `Prevalidation
| `Test_head 0 | `Test_prevalidation ) as block ->
let validator = get_validator node block in
let pv = Net_validator.prevalidator validator in
let pv = Chain_validator.prevalidator validator in
Lwt.return (Prevalidator.operations pv)
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let prevalidator = Net_validator.prevalidator validator in
let net_state = Net_validator.net_state validator in
let net_db = Net_validator.net_db validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= fun b ->
let prevalidator = Chain_validator.prevalidator validator in
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun b ->
Prevalidator.pending ~block:b prevalidator >|= fun ops ->
Preapply_result.empty, ops
| `Genesis ->
let net_state = Net_validator.net_state node.mainnet_validator in
let chain_state = Chain_validator.chain_state node.mainchain_validator in
let prevalidator =
Net_validator.prevalidator node.mainnet_validator in
Chain.genesis net_state >>= fun b ->
Chain_validator.prevalidator node.mainchain_validator in
Chain.genesis chain_state >>= fun b ->
Prevalidator.pending ~block:b prevalidator >|= fun ops ->
Preapply_result.empty, ops
| `Hash h -> begin
@ -459,9 +459,9 @@ module RPC = struct
| None ->
Lwt.return (Preapply_result.empty, Operation_hash.Map.empty)
| Some validator ->
let net_state = Net_validator.net_state validator in
let prevalidator = Net_validator.prevalidator validator in
State.Block.read_exn net_state h >>= fun block ->
let chain_state = Chain_validator.chain_state validator in
let prevalidator = Chain_validator.prevalidator validator in
State.Block.read_exn chain_state h >>= fun block ->
Prevalidator.pending ~block prevalidator >|= fun ops ->
Preapply_result.empty, ops
end
@ -479,19 +479,19 @@ module RPC = struct
begin
match block with
| `Genesis ->
let net_state = Net_validator.net_state node.mainnet_validator in
Chain.genesis net_state >>= return
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= return
| ( `Head 0 | `Prevalidation
| `Test_head 0 | `Test_prevalidation ) as block ->
let validator = get_validator node block in
let net_state = Net_validator.net_state validator in
Chain.head net_state >>= return
let chain_state = Chain_validator.chain_state validator in
Chain.head chain_state >>= return
| `Head n | `Test_head n as block -> begin
let validator = get_validator node block in
let net_state = Net_validator.net_state validator in
let net_db = Net_validator.net_db validator in
Chain.head net_state >>= fun head ->
predecessor net_db n head >>= return
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= return
end
| `Hash hash ->
read_valid_block node hash >>= function
@ -561,14 +561,14 @@ module RPC = struct
Lwt.return (Some (RPC_directory.map (fun _ -> ()) dir))
let heads node =
let net_state = Net_validator.net_state node.mainnet_validator in
Chain.known_heads net_state >>= fun heads ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.known_heads chain_state >>= fun heads ->
begin
match Net_validator.child node.mainnet_validator with
match Chain_validator.child node.mainchain_validator with
| None -> Lwt.return_nil
| Some test_validator ->
let net_state = Net_validator.net_state test_validator in
Chain.known_heads net_state
let chain_state = Chain_validator.chain_state test_validator in
Chain.known_heads chain_state
end >>= fun test_heads ->
Lwt_list.fold_left_s
(fun map block ->
@ -625,10 +625,10 @@ module RPC = struct
Lwt.return (List.rev blocks)
let list_invalid node =
State.Block.list_invalid (Net_validator.net_state node.mainnet_validator)
State.Block.list_invalid (Chain_validator.chain_state node.mainchain_validator)
let unmark_invalid node block =
State.Block.unmark_invalid (Net_validator.net_state node.mainnet_validator) block
State.Block.unmark_invalid (Chain_validator.chain_state node.mainchain_validator) block
let block_header_watcher node =
Distributed_db.watch_block_header node.distributed_db
@ -646,13 +646,13 @@ module RPC = struct
let bootstrapped node =
let block_stream, stopper =
Net_validator.new_head_watcher node.mainnet_validator in
Chain_validator.new_head_watcher node.mainchain_validator in
let first_run = ref true in
let next () =
if !first_run then begin
first_run := false ;
let net_state = Net_validator.net_state node.mainnet_validator in
Chain.head net_state >>= fun head ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.head chain_state >>= fun head ->
let head_hash = State.Block.hash head in
let head_header = State.Block.header head in
Lwt.return (Some (head_hash, head_header.shell.timestamp))
@ -661,7 +661,7 @@ module RPC = struct
( Lwt_stream.get block_stream >|=
Option.map ~f:(fun b ->
(State.Block.hash b, (State.Block.header b).shell.timestamp)) ) ;
(Net_validator.bootstrapped node.mainnet_validator >|= fun () -> None) ;
(Chain_validator.bootstrapped node.mainchain_validator >|= fun () -> None) ;
]
end in
let shutdown () = Lwt_watcher.shutdown stopper in

12
src/lib_shell/node.mli
View File

@ -10,12 +10,12 @@
type t
type config = {
genesis: State.Net.genesis ;
genesis: State.Chain.genesis ;
store_root: string ;
context_root: string ;
patch_context: (Context.t -> Context.t Lwt.t) option ;
p2p: (P2p.config * P2p.limits) option ;
test_network_max_tll: int option ;
test_chain_max_tll: int option ;
}
and peer_validator_limits = {
@ -34,7 +34,7 @@ and block_validator_limits = {
protocol_timeout: float ;
worker_limits : Worker_types.limits ;
}
and net_validator_limits = {
and chain_validator_limits = {
bootstrap_threshold: int ;
worker_limits : Worker_types.limits ;
}
@ -44,7 +44,7 @@ val create:
peer_validator_limits ->
block_validator_limits ->
prevalidator_limits ->
net_validator_limits ->
chain_validator_limits ->
t tzresult Lwt.t
module RPC : sig
@ -53,7 +53,7 @@ module RPC : sig
type block_info = Block_services.block_info
val inject_block:
t -> ?force:bool -> ?net_id:Net_id.t ->
t -> ?force:bool -> ?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list ->
(Block_hash.t * unit tzresult Lwt.t) tzresult Lwt.t
(** [inject_block node ?force bytes] tries to insert [bytes]
@ -62,7 +62,7 @@ module RPC : sig
non strictly increasing fitness. *)
val inject_operation:
t -> ?net_id:Net_id.t -> MBytes.t ->
t -> ?chain_id:Chain_id.t -> MBytes.t ->
(Operation_hash.t * unit tzresult Lwt.t) Lwt.t
val inject_protocol:
t -> ?force:bool -> Protocol.t ->

44
src/lib_shell/node_rpc.ml
View File

@ -53,9 +53,9 @@ let register_bi_dir node dir =
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
return bi.net_id in
return bi.chain_id in
RPC_directory.register1 dir
Block_services.S.net_id implementation in
Block_services.S.chain_id implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
@ -96,9 +96,9 @@ let register_bi_dir node dir =
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
return bi.test_network in
return bi.test_chain in
RPC_directory.register1 dir
Block_services.S.test_network implementation in
Block_services.S.test_chain implementation in
let dir =
let implementation b () { Block_services.S.contents ; monitor } =
match b with
@ -408,9 +408,9 @@ let build_rpc_directory node =
end in
RPC_directory.register0 dir Shell_services.S.inject_block implementation in
let dir =
let implementation () (contents, blocking, net_id) =
let implementation () (contents, blocking, chain_id) =
Node.RPC.inject_operation
node ?net_id contents >>= fun (hash, wait) ->
node ?chain_id contents >>= fun (hash, wait) ->
begin
(if blocking then wait else return ()) >>=? fun () -> return hash
end in
@ -448,8 +448,8 @@ let build_rpc_directory node =
(Prevalidator.running_workers ()))) in
let dir =
RPC_directory.register1 dir Worker_services.Prevalidators.S.state
(fun net_id () () ->
let w = List.assoc net_id (Prevalidator.running_workers ()) in
(fun chain_id () () ->
let w = List.assoc chain_id (Prevalidator.running_workers ()) in
return
{ Worker_types.status = Prevalidator.status w ;
pending_requests = Prevalidator.pending_requests w ;
@ -472,18 +472,18 @@ let build_rpc_directory node =
let dir =
RPC_directory.register1 dir Worker_services.Peer_validators.S.list
(fun net_id () () ->
(fun chain_id () () ->
return
(List.filter_map
(fun ((id, peer_id), w) ->
if Net_id.equal id net_id then
if Chain_id.equal id chain_id then
Some (peer_id, Peer_validator.status w)
else None)
(Peer_validator.running_workers ()))) in
let dir =
RPC_directory.register2 dir Worker_services.Peer_validators.S.state
(fun net_id peer_id () () ->
let w = List.assoc (net_id, peer_id) (Peer_validator.running_workers ()) in
(fun chain_id peer_id () () ->
let w = List.assoc (chain_id, peer_id) (Peer_validator.running_workers ()) in
return
{ Worker_types.status = Peer_validator.status w ;
pending_requests = [] ;
@ -493,21 +493,21 @@ let build_rpc_directory node =
(* Workers : Net validators *)
let dir =
RPC_directory.register0 dir Worker_services.Net_validators.S.list
RPC_directory.register0 dir Worker_services.Chain_validators.S.list
(fun () () ->
return
(List.map
(fun (id, w) -> (id, Net_validator.status w))
(Net_validator.running_workers ()))) in
(fun (id, w) -> (id, Chain_validator.status w))
(Chain_validator.running_workers ()))) in
let dir =
RPC_directory.register1 dir Worker_services.Net_validators.S.state
(fun net_id () () ->
let w = List.assoc net_id (Net_validator.running_workers ()) in
RPC_directory.register1 dir Worker_services.Chain_validators.S.state
(fun chain_id () () ->
let w = List.assoc chain_id (Chain_validator.running_workers ()) in
return
{ Worker_types.status = Net_validator.status w ;
pending_requests = Net_validator.pending_requests w ;
backlog = Net_validator.last_events w ;
current_request = Net_validator.current_request w }) in
{ Worker_types.status = Chain_validator.status w ;
pending_requests = Chain_validator.pending_requests w ;
backlog = Chain_validator.last_events w ;
current_request = Chain_validator.current_request w }) in
(* Network *)
let dir = RPC_directory.merge dir (Node.RPC.build_p2p_rpc_directory node) in

54
src/lib_shell/peer_validator.ml
View File

@ -12,13 +12,13 @@
open Peer_validator_worker_state
module Name = struct
type t = Net_id.t * P2p_peer.Id.t
type t = Chain_id.t * P2p_peer.Id.t
let encoding =
Data_encoding.tup2 Net_id.encoding P2p_peer.Id.encoding
Data_encoding.tup2 Chain_id.encoding P2p_peer.Id.encoding
let base = [ "peer_validator" ]
let pp ppf (net, peer) =
let pp ppf (chain, peer) =
Format.fprintf ppf "%a:%a"
Net_id.pp_short net P2p_peer.Id.pp_short peer
Chain_id.pp_short chain P2p_peer.Id.pp_short peer
end
module Request = struct
@ -47,9 +47,9 @@ module Types = struct
include Worker_state
type parameters = {
net_db: Distributed_db.net_db ;
chain_db: Distributed_db.chain_db ;
block_validator: Block_validator.t ;
(* callback to net_validator *)
(* callback to chain_validator *)
notify_new_block: State.Block.t -> unit ;
notify_bootstrapped: unit -> unit ;
notify_termination: unit -> unit ;
@ -103,7 +103,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix =
~block_header_timeout:pv.parameters.limits.block_header_timeout
~block_operations_timeout:pv.parameters.limits.block_operations_timeout
pv.parameters.block_validator
pv.peer_id pv.parameters.net_db unknown_prefix in
pv.peer_id pv.parameters.chain_db unknown_prefix in
Worker.protect w
~on_error:begin fun error ->
(* if the peer_validator is killed, let's cancel the pipeline *)
@ -121,14 +121,14 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix =
let validate_new_head w hash (header : Block_header.t) =
let pv = Worker.state w in
let net_state = Distributed_db.net_state pv.parameters.net_db in
State.Block.known net_state header.shell.predecessor >>= function
let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
State.Block.known chain_state header.shell.predecessor >>= function
| false ->
debug w
"missing predecessor for new head %a from peer %a"
Block_hash.pp_short hash
P2p_peer.Id.pp_short pv.peer_id ;
Distributed_db.Request.current_branch pv.parameters.net_db ~peer:pv.peer_id () ;
Distributed_db.Request.current_branch pv.parameters.chain_db ~peer:pv.peer_id () ;
return ()
| true ->
debug w
@ -140,7 +140,7 @@ let validate_new_head w hash (header : Block_header.t) =
Worker.protect w begin fun () ->
Distributed_db.Operations.fetch
~timeout:pv.parameters.limits.block_operations_timeout
pv.parameters.net_db ~peer:pv.peer_id
pv.parameters.chain_db ~peer:pv.peer_id
(hash, i) header.shell.operations_hash
end)
(0 -- (header.shell.validation_passes - 1)) >>=? fun operations ->
@ -150,7 +150,7 @@ let validate_new_head w hash (header : Block_header.t) =
P2p_peer.Id.pp_short pv.peer_id ;
Block_validator.validate
~notify_new_block:pv.parameters.notify_new_block
pv.parameters.block_validator pv.parameters.net_db
pv.parameters.block_validator pv.parameters.chain_db
hash header operations >>=? fun _block ->
debug w
"end of validation for new head %a from peer %a"
@ -161,8 +161,8 @@ let validate_new_head w hash (header : Block_header.t) =
let only_if_fitness_increases w distant_header cont =
let pv = Worker.state w in
let net_state = Distributed_db.net_state pv.parameters.net_db in
Chain.head net_state >>= fun local_header ->
let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
Chain.head chain_state >>= fun local_header ->
if Fitness.compare
distant_header.Block_header.shell.fitness
(State.Block.fitness local_header) <= 0 then begin
@ -177,10 +177,10 @@ let only_if_fitness_increases w distant_header cont =
let may_validate_new_head w hash header =
let pv = Worker.state w in
let net_state = Distributed_db.net_state pv.parameters.net_db in
State.Block.known net_state hash >>= function
let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
State.Block.known chain_state hash >>= function
| true -> begin
State.Block.known_valid net_state hash >>= function
State.Block.known_valid chain_state hash >>= function
| true ->
debug w
"ignoring previously validated block %a from peer %a"
@ -204,8 +204,8 @@ let may_validate_new_branch w distant_hash locator =
let pv = Worker.state w in
let distant_header, _ = (locator : Block_locator.t :> Block_header.t * _) in
only_if_fitness_increases w distant_header @@ fun () ->
let net_state = Distributed_db.net_state pv.parameters.net_db in
Block_locator_iterator.known_ancestor net_state locator >>= function
let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
Block_locator_iterator.known_ancestor chain_state locator >>= function
| None ->
debug w
"ignoring branch %a without common ancestor from peer: %a."
@ -220,7 +220,7 @@ let on_no_request w =
debug w "no new head from peer %a for %g seconds."
P2p_peer.Id.pp_short pv.peer_id
pv.parameters.limits.new_head_request_timeout ;
Distributed_db.Request.current_head pv.parameters.net_db ~peer:pv.peer_id () ;
Distributed_db.Request.current_head pv.parameters.chain_db ~peer:pv.peer_id () ;
return ()
let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t =
@ -281,13 +281,13 @@ let on_error w r st errs =
let on_close w =
let pv = Worker.state w in
pv.parameters.notify_termination () ;
Distributed_db.disconnect pv.parameters.net_db pv.peer_id >>= fun () ->
Distributed_db.disconnect pv.parameters.chain_db pv.peer_id >>= fun () ->
Lwt.return ()
let on_launch _ name parameters =
let net_state = Distributed_db.net_state parameters.net_db in
State.Block.read_exn net_state
(State.Net.genesis net_state).block >>= fun genesis ->
let chain_state = Distributed_db.chain_state parameters.chain_db in
State.Block.read_exn chain_state
(State.Chain.genesis chain_state).block >>= fun genesis ->
let rec pv = {
peer_id = snd name ;
parameters = { parameters with notify_new_block } ;
@ -324,10 +324,10 @@ let create
?(notify_new_block = fun _ -> ())
?(notify_bootstrapped = fun () -> ())
?(notify_termination = fun _ -> ())
limits block_validator net_db peer_id =
let name = (State.Net.id (Distributed_db.net_state net_db), peer_id) in
limits block_validator chain_db peer_id =
let name = (State.Chain.id (Distributed_db.chain_state chain_db), peer_id) in
let parameters = {
net_db ;
chain_db ;
notify_termination ;
block_validator ;
notify_new_block ;

4
src/lib_shell/peer_validator.mli
View File

@ -27,13 +27,13 @@ val create:
?notify_termination: (unit -> unit) ->
limits ->
Block_validator.t ->
Distributed_db.net_db -> P2p_peer.Id.t -> t Lwt.t
Distributed_db.chain_db -> P2p_peer.Id.t -> t Lwt.t
val shutdown: t -> unit Lwt.t
val notify_branch: t -> Block_locator.t -> unit
val notify_head: t -> Block_header.t -> unit
val running_workers: unit -> ((Net_id.t * P2p_peer.Id.t) * t) list
val running_workers: unit -> ((Chain_id.t * P2p_peer.Id.t) * t) list
val status: t -> Worker_types.worker_status
val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option

2
src/lib_shell/prevalidation.ml
View File

@ -78,7 +78,7 @@ let start_prevalidation
| Some protocol ->
return protocol
end >>=? fun (module Proto) ->
Context.reset_test_network
Context.reset_test_chain
predecessor_context predecessor
timestamp >>= fun predecessor_context ->
Proto.begin_construction

67
src/lib_shell/prevalidator.ml
View File

@ -16,10 +16,10 @@ type limits = {
}
module Name = struct
type t = Net_id.t
let encoding = Net_id.encoding
type t = Chain_id.t
let encoding = Chain_id.encoding
let base = [ "prevalidator" ]
let pp = Net_id.pp_short
let pp = Chain_id.pp_short
end
module Types = struct
@ -30,7 +30,7 @@ module Types = struct
- pv.prevalidation_result.refused = Ø, refused ops are in pv.refused
- the 'applied' operations in pv.validation_result are in reverse order. *)
type state = {
net_db : Distributed_db.net_db ;
chain_db : Distributed_db.chain_db ;
limits : limits ;
mutable predecessor : State.Block.t ;
mutable timestamp : Time.t ;
@ -46,7 +46,7 @@ module Types = struct
mutable validation_state : Prevalidation.prevalidation_state tzresult ;
mutable advertisement : [ `Pending of Mempool.t | `None ] ;
}
type parameters = limits * Distributed_db.net_db
type parameters = limits * Distributed_db.chain_db
include Worker_state
@ -80,7 +80,7 @@ type error += Closed = Worker.Closed
let debug w =
Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
let list_pendings ?maintain_net_db ~from_block ~to_block old_mempool =
let list_pendings ?maintain_chain_db ~from_block ~to_block old_mempool =
let rec pop_blocks ancestor block mempool =
let hash = State.Block.hash block in
if Block_hash.equal hash ancestor then
@ -90,9 +90,9 @@ let list_pendings ?maintain_net_db ~from_block ~to_block old_mempool =
Lwt_list.fold_left_s
(Lwt_list.fold_left_s (fun mempool op ->
let h = Operation.hash op in
Lwt_utils.may maintain_net_db
~f:begin fun net_db ->
Distributed_db.inject_operation net_db h op >>= fun _ ->
Lwt_utils.may maintain_chain_db
~f:begin fun chain_db ->
Distributed_db.inject_operation chain_db h op >>= fun _ ->
Lwt.return_unit
end >>= fun () ->
Lwt.return (Operation_hash.Map.add h op mempool)))
@ -103,10 +103,10 @@ let list_pendings ?maintain_net_db ~from_block ~to_block old_mempool =
in
let push_block mempool block =
State.Block.all_operation_hashes block >|= fun operations ->
Option.iter maintain_net_db
~f:(fun net_db ->
Option.iter maintain_chain_db
~f:(fun chain_db ->
List.iter
(List.iter (Distributed_db.Operation.clear_or_cancel net_db))
(List.iter (Distributed_db.Operation.clear_or_cancel chain_db))
operations) ;
List.fold_left
(List.fold_left (fun mempool h -> Operation_hash.Map.remove h mempool))
@ -209,7 +209,7 @@ let handle_unprocessed w pv =
Operation_hash.Map.add h errs pv.refusals)
pv.validation_result.refused ;
Operation_hash.Map.iter
(fun oph _ -> Distributed_db.Operation.clear_or_cancel pv.net_db oph)
(fun oph _ -> Distributed_db.Operation.clear_or_cancel pv.chain_db oph)
pv.validation_result.refused ;
pv.validation_result <-
merge_validation_results
@ -232,7 +232,7 @@ let handle_unprocessed w pv =
(fun k _ s -> Operation_hash.Set.add k s)
pv.validation_result.branch_refused @@
Operation_hash.Set.empty } ;
State.Current_mempool.set (Distributed_db.net_state pv.net_db)
State.Current_mempool.set (Distributed_db.chain_state pv.chain_db)
~head:(State.Block.hash pv.predecessor) pv.mempool >>= fun () ->
Lwt.return ()
@ -242,7 +242,7 @@ let fetch_operation w pv ?peer oph =
Operation_hash.pp_short oph ;
Distributed_db.Operation.fetch
~timeout:pv.limits.operation_timeout
pv.net_db ?peer oph () >>= function
pv.chain_db ?peer oph () >>= function
| Ok op ->
Worker.push_request_now w (Arrived (oph, op)) ;
Lwt.return_unit
@ -257,7 +257,7 @@ let fetch_operation w pv ?peer oph =
let on_operation_arrived (pv : state) oph op =
pv.fetching <- Operation_hash.Set.remove oph pv.fetching ;
if not (Block_hash.Set.mem op.Operation.shell.branch pv.live_blocks) then begin
Distributed_db.Operation.clear_or_cancel pv.net_db oph
Distributed_db.Operation.clear_or_cancel pv.chain_db oph
(* TODO: put in a specific delayed map ? *)
end else if not (already_handled pv oph) (* prevent double inclusion on flush *) then begin
pv.pending <- Operation_hash.Map.add oph op pv.pending
@ -274,7 +274,7 @@ let on_inject pv op =
validation_state ~sort:false [ (oph, op) ] >>= fun (_, result) ->
match result.applied with
| [ app_oph, _ ] when Operation_hash.equal app_oph oph ->
Distributed_db.inject_operation pv.net_db oph op >>= fun (_ : bool) ->
Distributed_db.inject_operation pv.chain_db oph op >>= fun (_ : bool) ->
pv.pending <- Operation_hash.Map.add oph op pv.pending ;
return result
| _ ->
@ -317,7 +317,7 @@ let on_notify w pv peer mempool =
let on_flush w pv predecessor =
list_pendings
~maintain_net_db:pv.net_db
~maintain_chain_db:pv.chain_db
~from_block:pv.predecessor ~to_block:predecessor
(Preapply_result.operations pv.validation_result) >>= fun pending ->
let timestamp = Time.now () in
@ -352,7 +352,7 @@ let on_advertise pv =
| `None -> () (* should not happen *)
| `Pending mempool ->
pv.advertisement <- `None ;
Distributed_db.Advertise.current_head pv.net_db ~mempool pv.predecessor
Distributed_db.Advertise.current_head pv.chain_db ~mempool pv.predecessor
let on_request
: type r. t -> r Request.t -> r tzresult Lwt.t
@ -362,8 +362,8 @@ let on_request
| Request.Flush hash ->
on_advertise pv ;
(* TODO: rebase the advertisement instead *)
let net_state = Distributed_db.net_state pv.net_db in
State.Block.read net_state hash >>=? fun block ->
let chain_state = Distributed_db.chain_state pv.chain_db in
State.Block.read chain_state hash >>=? fun block ->
on_flush w pv block >>=? fun () ->
return (() : r)
| Request.Notify (peer, mempool) ->
@ -385,16 +385,15 @@ let on_request
let on_close w =
let pv = Worker.state w in
Operation_hash.Set.iter
(Distributed_db.Operation.clear_or_cancel pv.net_db)
(Distributed_db.Operation.clear_or_cancel pv.chain_db)
pv.fetching ;
Lwt.return_unit
let on_launch w _ (limits, net_db) =
let net_state = Distributed_db.net_state net_db in
State.read_chain_store net_state
(fun _ { current_head ; current_mempool ; live_blocks ; live_operations } ->
Lwt.return (current_head, current_mempool, live_blocks, live_operations))
>>= fun (predecessor, mempool, live_blocks, live_operations) ->
let on_launch w _ (limits, chain_db) =
let chain_state = Distributed_db.chain_state chain_db in
Chain.data chain_state >>= fun
{ current_head = predecessor ; current_mempool = mempool ;
live_blocks ; live_operations } ->
let timestamp = Time.now () in
Prevalidation.start_prevalidation
~predecessor ~timestamp () >>= fun validation_state ->
@ -411,7 +410,7 @@ let on_launch w _ (limits, net_db) =
(fun s h -> Operation_hash.Set.add h s)
Operation_hash.Set.empty mempool.known_valid in
let pv =
{ limits ; net_db ;
{ limits ; chain_db ;
predecessor ; timestamp ; live_blocks ; live_operations ;
mempool = { known_valid = [] ; pending = Operation_hash.Set.empty };
refused = Ring.create limits.max_refused_operations ;
@ -436,8 +435,8 @@ let on_completion w r _ st =
let table = Worker.create_table Queue
let create limits net_db =
let net_state = Distributed_db.net_state net_db in
let create limits chain_db =
let chain_state = Distributed_db.chain_state chain_db in
let module Handlers = struct
type self = t
let on_launch = on_launch
@ -448,8 +447,8 @@ let create limits net_db =
let on_no_request _ = return ()
end in
Worker.launch table limits.worker_limits
(State.Net.id net_state)
(limits, net_db)
(State.Chain.id chain_state)
(limits, chain_db)
(module Handlers)
let shutdown = Worker.shutdown
@ -472,7 +471,7 @@ let pending ?block w =
match block with
| Some to_block ->
list_pendings
~maintain_net_db:pv.net_db
~maintain_chain_db:pv.chain_db
~from_block:pv.predecessor ~to_block ops
| None -> Lwt.return ops

6
src/lib_shell/prevalidator.mli
View File

@ -36,9 +36,9 @@ type limits = {
worker_limits : Worker_types.limits ;
}
type error += Closed of Net_id.t
type error += Closed of Chain_id.t
val create: limits -> Distributed_db.net_db -> t Lwt.t
val create: limits -> Distributed_db.chain_db -> t Lwt.t
val shutdown: t -> unit Lwt.t
val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit
val inject_operation: t -> Operation.t -> unit tzresult Lwt.t
@ -48,7 +48,7 @@ val operations: t -> error Preapply_result.t * Operation.t Operation_hash.Map.t
val context: t -> Updater.validation_result tzresult Lwt.t
val pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t Lwt.t
val running_workers: unit -> (Net_id.t * t) list
val running_workers: unit -> (Chain_id.t * t) list
val status: t -> Worker_types.worker_status
val pending_requests : t -> (Time.t * Prevalidator_worker_state.Request.view) list

2
src/lib_shell/protocol_validator.ml
View File

@ -181,7 +181,7 @@ let fetch_and_compile_protocols pv ?peer ?timeout (block: State.Block.t) =
fetch_and_compile_protocol pv ?peer ?timeout protocol_hash >>=? fun _ ->
return ()
and test_protocol =
Context.get_test_network context >>= function
Context.get_test_chain context >>= function
| Not_running -> return ()
| Forking { protocol }
| Running { protocol } ->

336
src/lib_shell/state.ml
View File

@ -10,7 +10,7 @@
open Logging.Node.State
type error +=
| Unknown_network of Net_id.t
| Unknown_chain of Chain_id.t
type error += Bad_data_dir
@ -20,14 +20,14 @@ let () =
let open Error_monad in
register_error_kind
`Temporary
~id:"state.unknown_network"
~title:"Unknown network"
~id:"state.unknown_chain"
~title:"Unknown chain"
~description:"TODO"
~pp:(fun ppf id ->
Format.fprintf ppf "Unknown network %a" Net_id.pp id)
Data_encoding.(obj1 (req "net" Net_id.encoding))
(function Unknown_network x -> Some x | _ -> None)
(fun x -> Unknown_network x) ;
Format.fprintf ppf "Unknown chain %a" Chain_id.pp id)
Data_encoding.(obj1 (req "chain" Chain_id.encoding))
(function Unknown_chain x -> Some x | _ -> None)
(fun x -> Unknown_chain x) ;
register_error_kind
`Permanent
~id:"badDataDir"
@ -70,22 +70,22 @@ type global_state = {
}
and global_data = {
nets: net_state Net_id.Table.t ;
chains: chain_state Chain_id.Table.t ;
global_store: Store.t ;
context_index: Context.index ;
}
and net_state = {
and chain_state = {
global_state: global_state ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
genesis: genesis ;
faked_genesis_hash: Block_hash.t ;
expiration: Time.t option ;
allow_forked_network: bool ;
allow_forked_chain: bool ;
block_store: Store.Block.store Shared.t ;
context_index: Context.index Shared.t ;
block_watcher: block Lwt_watcher.input ;
chain_state: chain_state Shared.t ;
chain_data: chain_data_state Shared.t ;
}
and genesis = {
@ -94,9 +94,9 @@ and genesis = {
protocol: Protocol_hash.t ;
}
and chain_state = {
and chain_data_state = {
mutable data: chain_data ;
chain_store: Store.Chain.store ;
chain_data_store: Store.Chain_data.store ;
}
and chain_data = {
@ -108,24 +108,24 @@ and chain_data = {
}
and block = {
net_state: net_state ;
chain_state: chain_state ;
hash: Block_hash.t ;
contents: Store.Block.contents ;
}
let read_chain_store { chain_state } f =
Shared.use chain_state begin fun state ->
f state.chain_store state.data
let read_chain_data { chain_data } f =
Shared.use chain_data begin fun state ->
f state.chain_data_store state.data
end
let update_chain_store { net_id ; context_index ; chain_state } f =
Shared.use chain_state begin fun state ->
f state.chain_store state.data >>= fun (data, res) ->
let update_chain_data { chain_id ; context_index ; chain_data } f =
Shared.use chain_data begin fun state ->
f state.chain_data_store state.data >>= fun (data, res) ->
Lwt_utils.may data
~f:begin fun data ->
state.data <- data ;
Shared.use context_index begin fun context_index ->
Context.set_head context_index net_id
Context.set_head context_index chain_id
data.current_head.contents.context
end >>= fun () ->
Lwt.return_unit
@ -232,15 +232,15 @@ let predecessor_n (store: Store.Block.store) (b: Block_hash.t) (distance: int)
in
loop b distance
let compute_locator_from_hash (net : net_state) ?(size = 200) head_hash =
Shared.use net.block_store begin fun block_store ->
let compute_locator_from_hash (chain : chain_state) ?(size = 200) head_hash =
Shared.use chain.block_store begin fun block_store ->
Store.Block.Contents.read_exn (block_store, head_hash) >>= fun { header } ->
Block_locator.compute ~predecessor:(predecessor_n block_store)
~genesis:net.genesis.block head_hash header size
~genesis:chain.genesis.block head_hash header size
end
let compute_locator net ?size head =
compute_locator_from_hash net ?size head.hash
let compute_locator chain ?size head =
compute_locator_from_hash chain ?size head.hash
type t = global_state
@ -267,7 +267,7 @@ module Locked_block = struct
end
module Net = struct
module Chain = struct
type nonrec genesis = genesis = {
time: Time.t ;
@ -284,61 +284,61 @@ module Net = struct
(req "block" Block_hash.encoding)
(req "protocol" Protocol_hash.encoding))
type t = net_state
type net_state = t
type t = chain_state
type chain_state = t
let allocate
~genesis ~faked_genesis_hash ~expiration ~allow_forked_network
~genesis ~faked_genesis_hash ~expiration ~allow_forked_chain
~current_head
global_state context_index chain_store block_store =
global_state context_index chain_data_store block_store =
Store.Block.Contents.read_exn
(block_store, current_head) >>= fun current_block ->
let rec chain_state = {
let rec chain_data = {
data = {
current_head = {
net_state ;
chain_state ;
hash = current_head ;
contents = current_block ;
} ;
current_mempool = Mempool.empty ;
live_blocks = Block_hash.Set.singleton genesis.block ;
live_operations = Operation_hash.Set.empty ;
locator = lazy (compute_locator_from_hash net_state current_head) ;
locator = lazy (compute_locator_from_hash chain_state current_head) ;
} ;
chain_store ;
chain_data_store ;
}
and net_state = {
and chain_state = {
global_state ;
net_id = Net_id.of_block_hash genesis.block ;
chain_state = { Shared.data = chain_state ; lock = Lwt_mutex.create () } ;
chain_id = Chain_id.of_block_hash genesis.block ;
chain_data = { Shared.data = chain_data ; lock = Lwt_mutex.create () } ;
genesis ; faked_genesis_hash ;
expiration ;
allow_forked_network ;
allow_forked_chain ;
block_store = Shared.create block_store ;
context_index = Shared.create context_index ;
block_watcher = Lwt_watcher.create_input () ;
} in
Lwt.return net_state
Lwt.return chain_state
let locked_create
global_state data ?expiration ?(allow_forked_network = false)
net_id genesis commit =
let net_store = Store.Net.get data.global_store net_id in
let block_store = Store.Block.get net_store
and chain_store = Store.Chain.get net_store in
Store.Net.Genesis_hash.store net_store genesis.block >>= fun () ->
Store.Net.Genesis_time.store net_store genesis.time >>= fun () ->
Store.Net.Genesis_protocol.store net_store genesis.protocol >>= fun () ->
Store.Chain.Current_head.store chain_store genesis.block >>= fun () ->
Store.Chain.Known_heads.store chain_store genesis.block >>= fun () ->
global_state data ?expiration ?(allow_forked_chain = false)
chain_id genesis commit =
let chain_store = Store.Chain.get data.global_store chain_id in
let block_store = Store.Block.get chain_store
and chain_data_store = Store.Chain_data.get chain_store in
Store.Chain.Genesis_hash.store chain_store genesis.block >>= fun () ->
Store.Chain.Genesis_time.store chain_store genesis.time >>= fun () ->
Store.Chain.Genesis_protocol.store chain_store genesis.protocol >>= fun () ->
Store.Chain_data.Current_head.store chain_data_store genesis.block >>= fun () ->
Store.Chain_data.Known_heads.store chain_data_store genesis.block >>= fun () ->
begin
match expiration with
| None -> Lwt.return_unit
| Some time -> Store.Net.Expiration.store net_store time
| Some time -> Store.Chain.Expiration.store chain_store time
end >>= fun () ->
begin
if allow_forked_network then
Store.Net.Allow_forked_network.store data.global_store net_id
if allow_forked_chain then
Store.Chain.Allow_forked_chain.store data.global_store chain_id
else
Lwt.return_unit
end >>= fun () ->
@ -349,62 +349,62 @@ module Net = struct
~faked_genesis_hash:(Block_header.hash genesis_header)
~current_head:genesis.block
~expiration
~allow_forked_network
~allow_forked_chain
global_state
data.context_index
chain_store
chain_data_store
block_store
let create state ?allow_forked_network genesis =
let net_id = Net_id.of_block_hash genesis.block in
let create state ?allow_forked_chain genesis =
let chain_id = Chain_id.of_block_hash genesis.block in
Shared.use state.global_data begin fun data ->
if Net_id.Table.mem data.nets net_id then
Pervasives.failwith "State.Net.create"
if Chain_id.Table.mem data.chains chain_id then
Pervasives.failwith "State.Chain.create"
else
Context.commit_genesis
data.context_index
~net_id
~chain_id
~time:genesis.time
~protocol:genesis.protocol >>= fun commit ->
locked_create
state data ?allow_forked_network net_id genesis commit >>= fun net ->
Net_id.Table.add data.nets net_id net ;
Lwt.return net
state data ?allow_forked_chain chain_id genesis commit >>= fun chain ->
Chain_id.Table.add data.chains chain_id chain ;
Lwt.return chain
end
let locked_read global_state data id =
let net_store = Store.Net.get data.global_store id in
let block_store = Store.Block.get net_store
and chain_store = Store.Chain.get net_store in
Store.Net.Genesis_hash.read net_store >>=? fun genesis_hash ->
Store.Net.Genesis_time.read net_store >>=? fun time ->
Store.Net.Genesis_protocol.read net_store >>=? fun protocol ->
Store.Net.Expiration.read_opt net_store >>= fun expiration ->
Store.Net.Allow_forked_network.known
data.global_store id >>= fun allow_forked_network ->
let chain_store = Store.Chain.get data.global_store id in
let block_store = Store.Block.get chain_store
and chain_data_store = Store.Chain_data.get chain_store in
Store.Chain.Genesis_hash.read chain_store >>=? fun genesis_hash ->
Store.Chain.Genesis_time.read chain_store >>=? fun time ->
Store.Chain.Genesis_protocol.read chain_store >>=? fun protocol ->
Store.Chain.Expiration.read_opt chain_store >>= fun expiration ->
Store.Chain.Allow_forked_chain.known
data.global_store id >>= fun allow_forked_chain ->
Store.Block.Contents.read (block_store, genesis_hash) >>=? fun genesis_header ->
let genesis = { time ; protocol ; block = genesis_hash } in
Store.Chain.Current_head.read chain_store >>=? fun current_head ->
Store.Chain_data.Current_head.read chain_data_store >>=? fun current_head ->
try
allocate
~genesis
~faked_genesis_hash:(Block_header.hash genesis_header.header)
~current_head
~expiration
~allow_forked_network
~allow_forked_chain
global_state
data.context_index
chain_store
chain_data_store
block_store >>= return
with Not_found ->
fail Bad_data_dir
let locked_read_all global_state data =
Store.Net.list data.global_store >>= fun ids ->
Store.Chain.list data.global_store >>= fun ids ->
iter_p
(fun id ->
locked_read global_state data id >>=? fun net ->
Net_id.Table.add data.nets id net ;
locked_read global_state data id >>=? fun chain ->
Chain_id.Table.add data.chains id chain ;
return ())
ids
@ -415,28 +415,28 @@ module Net = struct
let get state id =
Shared.use state.global_data begin fun data ->
try return (Net_id.Table.find data.nets id)
with Not_found -> fail (Unknown_network id)
try return (Chain_id.Table.find data.chains id)
with Not_found -> fail (Unknown_chain id)
end
let all state =
Shared.use state.global_data begin fun { nets } ->
Shared.use state.global_data begin fun { chains } ->
Lwt.return @@
Net_id.Table.fold (fun _ net acc -> net :: acc) nets []
Chain_id.Table.fold (fun _ chain acc -> chain :: acc) chains []
end
let id { net_id } = net_id
let id { chain_id } = chain_id
let genesis { genesis } = genesis
let faked_genesis_hash { faked_genesis_hash } = faked_genesis_hash
let expiration { expiration } = expiration
let allow_forked_network { allow_forked_network } = allow_forked_network
let allow_forked_chain { allow_forked_chain } = allow_forked_chain
let global_state { global_state } = global_state
let destroy state net =
lwt_debug "destroy %a" Net_id.pp (id net) >>= fun () ->
Shared.use state.global_data begin fun { global_store ; nets } ->
Net_id.Table.remove nets (id net) ;
Store.Net.destroy global_store (id net) >>= fun () ->
let destroy state chain =
lwt_debug "destroy %a" Chain_id.pp (id chain) >>= fun () ->
Shared.use state.global_data begin fun { global_store ; chains } ->
Chain_id.Table.remove chains (id chain) ;
Store.Chain.destroy global_store (id chain) >>= fun () ->
Lwt.return_unit
end
@ -445,7 +445,7 @@ end
module Block = struct
type t = block = {
net_state: Net.t ;
chain_state: Chain.t ;
hash: Block_hash.t ;
contents: Store.Block.contents ;
}
@ -456,8 +456,8 @@ module Block = struct
let hash { hash } = hash
let header { contents = { header } } = header
let net_state { net_state } = net_state
let net_id { net_state = { net_id } } = net_id
let chain_state { chain_state } = chain_state
let chain_id { chain_state = { chain_id } } = chain_id
let shell_header { contents = { header = { shell } } } = shell
let timestamp b = (shell_header b).timestamp
let fitness b = (shell_header b).fitness
@ -470,36 +470,36 @@ module Block = struct
let max_operation_data_length { contents = { max_operation_data_length } } =
max_operation_data_length
let is_genesis b = Block_hash.equal b.hash b.net_state.genesis.block
let is_genesis b = Block_hash.equal b.hash b.chain_state.genesis.block
let known_valid net_state hash =
Shared.use net_state.block_store begin fun store ->
let known_valid chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Contents.known (store, hash)
end
let known_invalid net_state hash =
Shared.use net_state.block_store begin fun store ->
let known_invalid chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Invalid_block.known store hash
end
let read_invalid net_state hash =
Shared.use net_state.block_store begin fun store ->
let read_invalid chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Invalid_block.read_opt store hash
end
let list_invalid net_state =
Shared.use net_state.block_store begin fun store ->
let list_invalid chain_state =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Invalid_block.fold store ~init:[]
~f:(fun hash { level ; errors } acc ->
Lwt.return ((hash, level, errors) :: acc))
end
let unmark_invalid net_state block =
Shared.use net_state.block_store begin fun store ->
let unmark_invalid chain_state block =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Invalid_block.known store block >>= fun mem ->
if mem
then Store.Block.Invalid_block.remove store block >>= return
else fail (Block_not_invalid block)
end
let known net_state hash =
Shared.use net_state.block_store begin fun store ->
let known chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Contents.known (store, hash) >>= fun known ->
if known then
Lwt.return_true
@ -507,42 +507,42 @@ module Block = struct
Store.Block.Invalid_block.known store hash
end
let read net_state hash =
Shared.use net_state.block_store begin fun store ->
let read chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Contents.read (store, hash) >>=? fun contents ->
return { net_state ; hash ; contents }
return { chain_state ; hash ; contents }
end
let read_opt net_state hash =
read net_state hash >>= function
let read_opt chain_state hash =
read chain_state hash >>= function
| Error _ -> Lwt.return None
| Ok v -> Lwt.return (Some v)
let read_exn net_state hash =
Shared.use net_state.block_store begin fun store ->
let read_exn chain_state hash =
Shared.use chain_state.block_store begin fun store ->
Store.Block.Contents.read_exn (store, hash) >>= fun contents ->
Lwt.return { net_state ; hash ; contents }
Lwt.return { chain_state ; hash ; contents }
end
(* Quick accessor to be optimized ?? *)
let read_predecessor net_state hash =
read net_state hash >>=? fun { contents = { header } } ->
let read_predecessor chain_state hash =
read chain_state hash >>=? fun { contents = { header } } ->
return header.shell.predecessor
let read_predecessor_opt net_state hash =
read_predecessor net_state hash >>= function
let read_predecessor_opt chain_state hash =
read_predecessor chain_state hash >>= function
| Error _ -> Lwt.return None
| Ok v -> Lwt.return (Some v)
let read_predecessor_exn net_state hash =
read_exn net_state hash >>= fun { contents = { header } } ->
let read_predecessor_exn chain_state hash =
read_exn chain_state hash >>= fun { contents = { header } } ->
Lwt.return header.shell.predecessor
let predecessor { net_state ; contents = { header } ; hash } =
let predecessor { chain_state ; contents = { header } ; hash } =
if Block_hash.equal hash header.shell.predecessor then
Lwt.return_none (* we are at genesis *)
else
read_exn net_state header.shell.predecessor >>= fun block ->
read_exn chain_state header.shell.predecessor >>= fun block ->
Lwt.return (Some block)
let predecessor_n (net: Net.t) (b: Block_hash.t) (distance: int) : Block_hash.t option Lwt.t =
Shared.use net.block_store (fun store ->
let predecessor_n (chain: Chain.t) (b: Block_hash.t) (distance: int) : Block_hash.t option Lwt.t =
Shared.use chain.block_store (fun store ->
predecessor_n store b distance)
@ -569,13 +569,13 @@ module Block = struct
let store
?(dont_enforce_context_hash = false)
net_state block_header operations
chain_state block_header operations
{ Updater.context ; message ; max_operations_ttl ;
max_operation_data_length } =
let bytes = Block_header.to_bytes block_header in
let hash = Block_header.hash_raw bytes in
(* let's the validator check the consistency... of fitness, level, ... *)
Shared.use net_state.block_store begin fun store ->
Shared.use chain_state.block_store begin fun store ->
Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
fail_when known_invalid (failure "Known invalid") >>=? fun () ->
Store.Block.Contents.known (store, hash) >>= fun known ->
@ -616,22 +616,22 @@ module Block = struct
(* Store predecessors *)
store_predecessors store hash >>= fun () ->
(* Update the chain state. *)
Shared.use net_state.chain_state begin fun chain_state ->
let store = chain_state.chain_store in
Shared.use chain_state.chain_data begin fun chain_data ->
let store = chain_data.chain_data_store in
let predecessor = block_header.shell.predecessor in
Store.Chain.Known_heads.remove store predecessor >>= fun () ->
Store.Chain.Known_heads.store store hash
Store.Chain_data.Known_heads.remove store predecessor >>= fun () ->
Store.Chain_data.Known_heads.store store hash
end >>= fun () ->
let block = { net_state ; hash ; contents } in
Lwt_watcher.notify net_state.block_watcher block ;
let block = { chain_state ; hash ; contents } in
Lwt_watcher.notify chain_state.block_watcher block ;
return (Some block)
end
end
let store_invalid net_state block_header errors =
let store_invalid chain_state block_header errors =
let bytes = Block_header.to_bytes block_header in
let hash = Block_header.hash_raw bytes in
Shared.use net_state.block_store begin fun store ->
Shared.use chain_state.block_store begin fun store ->
Store.Block.Contents.known (store, hash) >>= fun known_valid ->
fail_when known_valid (failure "Known valid") >>=? fun () ->
Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
@ -643,46 +643,46 @@ module Block = struct
return true
end
let watcher net_state =
Lwt_watcher.create_stream net_state.block_watcher
let watcher chain_state =
Lwt_watcher.create_stream chain_state.block_watcher
let operation_hashes { net_state ; hash ; contents } i =
let operation_hashes { chain_state ; hash ; contents } i =
if i < 0 || contents.header.shell.validation_passes <= i then
invalid_arg "State.Block.operations" ;
Shared.use net_state.block_store begin fun store ->
Shared.use chain_state.block_store begin fun store ->
Store.Block.Operation_hashes.read_exn (store, hash) i >>= fun hashes ->
Store.Block.Operation_path.read_exn (store, hash) i >>= fun path ->
Lwt.return (hashes, path)
end
let all_operation_hashes { net_state ; hash ; contents } =
Shared.use net_state.block_store begin fun store ->
let all_operation_hashes { chain_state ; hash ; contents } =
Shared.use chain_state.block_store begin fun store ->
Lwt_list.map_p
(Store.Block.Operation_hashes.read_exn (store, hash))
(0 -- (contents.header.shell.validation_passes - 1))
end
let operations { net_state ; hash ; contents } i =
let operations { chain_state ; hash ; contents } i =
if i < 0 || contents.header.shell.validation_passes <= i then
invalid_arg "State.Block.operations" ;
Shared.use net_state.block_store begin fun store ->
Shared.use chain_state.block_store begin fun store ->
Store.Block.Operation_path.read_exn (store, hash) i >>= fun path ->
Store.Block.Operations.read_exn (store, hash) i >>= fun ops ->
Lwt.return (ops, path)
end
let all_operations { net_state ; hash ; contents } =
Shared.use net_state.block_store begin fun store ->
let all_operations { chain_state ; hash ; contents } =
Shared.use chain_state.block_store begin fun store ->
Lwt_list.map_p
(fun i -> Store.Block.Operations.read_exn (store, hash) i)
(0 -- (contents.header.shell.validation_passes - 1))
end
let context { net_state ; hash } =
Shared.use net_state.block_store begin fun block_store ->
let context { chain_state ; hash } =
Shared.use chain_state.block_store begin fun block_store ->
Store.Block.Contents.read_exn (block_store, hash)
end >>= fun { context = commit } ->
Shared.use net_state.context_index begin fun context_index ->
Shared.use chain_state.context_index begin fun context_index ->
Context.checkout_exn context_index commit
end
@ -690,23 +690,23 @@ module Block = struct
context block >>= fun context ->
Context.get_protocol context
let test_network block =
let test_chain block =
context block >>= fun context ->
Context.get_test_network context
Context.get_test_chain context
end
let read_block { global_data } hash =
Shared.use global_data begin fun { nets } ->
Net_id.Table.fold
(fun _net_id net_state acc ->
Shared.use global_data begin fun { chains } ->
Chain_id.Table.fold
(fun _chain_id chain_state acc ->
acc >>= function
| Some _ -> acc
| None ->
Block.read_opt net_state hash >>= function
Block.read_opt chain_state hash >>= function
| None -> acc
| Some block -> Lwt.return (Some block))
nets
chains
Lwt.return_none
end
@ -715,22 +715,22 @@ let read_block_exn t hash =
| None -> Lwt.fail Not_found
| Some b -> Lwt.return b
let fork_testnet block protocol expiration =
Shared.use block.net_state.global_state.global_data begin fun data ->
let fork_testchain block protocol expiration =
Shared.use block.chain_state.global_state.global_data begin fun data ->
Block.context block >>= fun context ->
Context.set_test_network context Not_running >>= fun context ->
Context.set_test_chain context Not_running >>= fun context ->
Context.set_protocol context protocol >>= fun context ->
Context.commit_test_network_genesis
Context.commit_test_chain_genesis
data.context_index block.hash block.contents.header.shell.timestamp
context >>=? fun (net_id, genesis, commit) ->
context >>=? fun (chain_id, genesis, commit) ->
let genesis = {
block = genesis ;
time = Time.add block.contents.header.shell.timestamp 1L ;
protocol ;
} in
Net.locked_create block.net_state.global_state data
net_id ~expiration genesis commit >>= fun net ->
return net
Chain.locked_create block.chain_state.global_state data
chain_id ~expiration genesis commit >>= fun chain ->
return chain
end
module Protocol = struct
@ -801,8 +801,8 @@ end
module Current_mempool = struct
let set net_state ~head mempool =
update_chain_store net_state begin fun _chain_store data ->
let set chain_state ~head mempool =
update_chain_data chain_state begin fun _chain_data_store data ->
if Block_hash.equal head (Block.hash data.current_head) then
Lwt.return (Some { data with current_mempool = mempool },
())
@ -810,8 +810,8 @@ module Current_mempool = struct
Lwt.return (None, ())
end
let get net_state =
read_chain_store net_state begin fun _chain_store data ->
let get chain_state =
read_chain_data chain_state begin fun _chain_data_store data ->
Lwt.return (Block.header data.current_head, data.current_mempool)
end
@ -825,7 +825,7 @@ let read
Store.init store_root >>=? fun global_store ->
Context.init ?patch_context ~root:context_root >>= fun context_index ->
let global_data = {
nets = Net_id.Table.create 17 ;
chains = Chain_id.Table.create 17 ;
global_store ;
context_index ;
} in
@ -833,7 +833,7 @@ let read
global_data = Shared.create global_data ;
protocol_store = Shared.create @@ Store.Protocol.get global_store ;
} in
Net.read_all state >>=? fun () ->
Chain.read_all state >>=? fun () ->
return state
let close { global_data } =

106
src/lib_shell/state.mli
View File

@ -13,8 +13,8 @@
- the index of validation contexts; and
- the persistent state of the node:
- the blockchain and its alternate heads of a "network";
- the pool of pending operations of a "network". *)
- the blockchain and its alternate heads ;
- the pool of pending operations of a chain. *)
type t
type global_state = t
@ -34,17 +34,17 @@ val close:
(** {2 Errors} **************************************************************)
type error +=
| Unknown_network of Net_id.t
| Unknown_chain of Chain_id.t
(** {2 Network} ************************************************************)
(** Data specific to a given network (e.g the mainnet or the current
test network). *)
module Net : sig
(** Data specific to a given chain (e.g the main chain or the current
test chain). *)
module Chain : sig
type t
type net_state = t
type chain_state = t
(** The chain starts from a genesis block associated to a seed protocol *)
type genesis = {
@ -54,36 +54,36 @@ module Net : sig
}
val genesis_encoding: genesis Data_encoding.t
(** Initialize a network for a given [genesis]. By default,
the network does accept forking test network. When
[~allow_forked_network:true] is provided, test network are allowed. *)
(** Initialize a chain for a given [genesis]. By default,
the chain does accept forking test chain. When
[~allow_forked_chain:true] is provided, test chain are allowed. *)
val create:
global_state ->
?allow_forked_network:bool ->
genesis -> net_state Lwt.t
?allow_forked_chain:bool ->
genesis -> chain_state Lwt.t
(** Look up for a network by the hash of its genesis block. *)
val get: global_state -> Net_id.t -> net_state tzresult Lwt.t
(** Look up for a chain by the hash of its genesis block. *)
val get: global_state -> Chain_id.t -> chain_state tzresult Lwt.t
(** Returns all the known networks. *)
val all: global_state -> net_state list Lwt.t
(** Returns all the known chains. *)
val all: global_state -> chain_state list Lwt.t
(** Destroy a network: this completly removes from the local storage all
the data associated to the network (this includes blocks and
(** Destroy a chain: this completly removes from the local storage all
the data associated to the chain (this includes blocks and
operations). *)
val destroy: global_state -> net_state -> unit Lwt.t
val destroy: global_state -> chain_state -> unit Lwt.t
(** Various accessors. *)
val id: net_state -> Net_id.t
val genesis: net_state -> genesis
val global_state: net_state -> global_state
val id: chain_state -> Chain_id.t
val genesis: chain_state -> genesis
val global_state: chain_state -> global_state
(** Hash of the faked block header of the genesis block. *)
val faked_genesis_hash: net_state -> Block_hash.t
val faked_genesis_hash: chain_state -> Block_hash.t
(** Return the expiration timestamp of a test netwowk. *)
val expiration: net_state -> Time.t option
val allow_forked_network: net_state -> bool
(** Return the expiration timestamp of a test chain. *)
val expiration: chain_state -> Time.t option
val allow_forked_chain: chain_state -> bool
end
@ -94,29 +94,29 @@ module Block : sig
type t
type block = t
val known: Net.t -> Block_hash.t -> bool Lwt.t
val known_valid: Net.t -> Block_hash.t -> bool Lwt.t
val known_invalid: Net.t -> Block_hash.t -> bool Lwt.t
val read_invalid: Net.t -> Block_hash.t -> Store.Block.invalid_block option Lwt.t
val list_invalid: Net.t -> (Block_hash.t * int32 * error list) list Lwt.t
val unmark_invalid: Net.t -> Block_hash.t -> unit tzresult Lwt.t
val known: Chain.t -> Block_hash.t -> bool Lwt.t
val known_valid: Chain.t -> Block_hash.t -> bool Lwt.t
val known_invalid: Chain.t -> Block_hash.t -> bool Lwt.t
val read_invalid: Chain.t -> Block_hash.t -> Store.Block.invalid_block option Lwt.t
val list_invalid: Chain.t -> (Block_hash.t * int32 * error list) list Lwt.t
val unmark_invalid: Chain.t -> Block_hash.t -> unit tzresult Lwt.t
val read: Net.t -> Block_hash.t -> block tzresult Lwt.t
val read_opt: Net.t -> Block_hash.t -> block option Lwt.t
val read_exn: Net.t -> Block_hash.t -> block Lwt.t
val read: Chain.t -> Block_hash.t -> block tzresult Lwt.t
val read_opt: Chain.t -> Block_hash.t -> block option Lwt.t
val read_exn: Chain.t -> Block_hash.t -> block Lwt.t
type error += Inconsistent_hash of Context_hash.t * Context_hash.t
val store:
?dont_enforce_context_hash:bool ->
Net.t ->
Chain.t ->
Block_header.t ->
Operation.t list list ->
Updater.validation_result ->
block option tzresult Lwt.t
val store_invalid:
Net.t ->
Chain.t ->
Block_header.t ->
error list ->
bool tzresult Lwt.t
@ -130,8 +130,8 @@ module Block : sig
val timestamp: t -> Time.t
val fitness: t -> Fitness.t
val validation_passes: t -> int
val net_id: t -> Net_id.t
val net_state: t -> Net.t
val chain_id: t -> Chain_id.t
val chain_state: t -> Chain.t
val level: t -> Int32.t
val message: t -> string option
val max_operations_ttl: t -> int
@ -139,11 +139,11 @@ module Block : sig
val is_genesis: t -> bool
val predecessor: t -> block option Lwt.t
val predecessor_n: Net.t -> Block_hash.t -> int -> Block_hash.t option Lwt.t
val predecessor_n: Chain.t -> Block_hash.t -> int -> Block_hash.t option Lwt.t
val context: t -> Context.t Lwt.t
val protocol_hash: t -> Protocol_hash.t Lwt.t
val test_network: t -> Test_network_status.t Lwt.t
val test_chain: t -> Test_chain_status.t Lwt.t
val operation_hashes:
t -> int ->
@ -154,7 +154,7 @@ module Block : sig
t -> int -> (Operation.t list * Operation_list_list_hash.path) Lwt.t
val all_operations: t -> Operation.t list list Lwt.t
val watcher: Net.t -> block Lwt_stream.t * Lwt_watcher.stopper
val watcher: Chain.t -> block Lwt_stream.t * Lwt_watcher.stopper
end
@ -164,10 +164,10 @@ val read_block:
val read_block_exn:
global_state -> Block_hash.t -> Block.t Lwt.t
val compute_locator: Net.t -> ?size:int -> Block.t -> Block_locator.t Lwt.t
val compute_locator: Chain.t -> ?size:int -> Block.t -> Block_locator.t Lwt.t
val fork_testnet:
Block.t -> Protocol_hash.t -> Time.t -> Net.t tzresult Lwt.t
val fork_testchain:
Block.t -> Protocol_hash.t -> Time.t -> Chain.t tzresult Lwt.t
type chain_data = {
current_head: Block.t ;
@ -177,14 +177,14 @@ type chain_data = {
locator: Block_locator.t Lwt.t lazy_t ;
}
val read_chain_store:
Net.t ->
(Store.Chain.store -> chain_data -> 'a Lwt.t) ->
val read_chain_data:
Chain.t ->
(Store.Chain_data.store -> chain_data -> 'a Lwt.t) ->
'a Lwt.t
val update_chain_store:
Net.t ->
(Store.Chain.store -> chain_data -> (chain_data option * 'a) Lwt.t) ->
val update_chain_data:
Chain.t ->
(Store.Chain_data.store -> chain_data -> (chain_data option * 'a) Lwt.t) ->
'a Lwt.t
(** {2 Protocol database} ***************************************************)
@ -217,10 +217,10 @@ end
module Current_mempool : sig
val get: Net.t -> (Block_header.t * Mempool.t) Lwt.t
val get: Chain.t -> (Block_header.t * Mempool.t) Lwt.t
(** The current mempool. *)
val set: Net.t -> head:Block_hash.t -> Mempool.t -> unit Lwt.t
val set: Chain.t -> head:Block_hash.t -> Mempool.t -> unit Lwt.t
(** Set the current mempool. It is ignored if the current head is
not the provided one. *)

38
src/lib_storage/store.ml → src/lib_shell/store.ml
View File

@ -11,18 +11,18 @@ type t = Raw_store.t
type global_store = t
(**************************************************************************
* Net store under "net/"
* Net store under "chain/"
**************************************************************************)
module Net = struct
module Chain = struct
type store = global_store * Net_id.t
type store = global_store * Chain_id.t
let get s id = (s, id)
module Indexed_store =
Store_helpers.Make_indexed_substore
(Store_helpers.Make_substore(Raw_store)(struct let name = ["net"] end))
(Net_id)
(Store_helpers.Make_substore(Raw_store)(struct let name = ["chain"] end))
(Chain_id)
let destroy = Indexed_store.remove_all
let list t =
@ -59,24 +59,24 @@ module Net = struct
(struct let name = ["expiration"] end)
(Store_helpers.Make_value(Time))
module Allow_forked_network =
Indexed_store.Make_set (struct let name = ["allow_forked_network"] end)
module Allow_forked_chain =
Indexed_store.Make_set (struct let name = ["allow_forked_chain"] end)
end
(**************************************************************************
* Block_header store under "net/<id>/blocks/"
* Block_header store under "chain/<id>/blocks/"
**************************************************************************)
module Block = struct
type store = Net.store
type store = Chain.store
let get x = x
module Indexed_store =
Store_helpers.Make_indexed_substore
(Store_helpers.Make_substore
(Net.Indexed_store.Store)
(Chain.Indexed_store.Store)
(struct let name = ["blocks"] end))
(Block_hash)
@ -153,7 +153,7 @@ module Block = struct
module Invalid_block =
Store_helpers.Make_map
(Store_helpers.Make_substore
(Net.Indexed_store.Store)
(Chain.Indexed_store.Store)
(struct let name = ["invalid_blocks"] end))
(Block_hash)
(Store_helpers.Make_value(struct
@ -169,9 +169,9 @@ module Block = struct
let register s =
Base58.register_resolver Block_hash.b58check_encoding begin fun str ->
let pstr = Block_hash.prefix_path str in
Net.Indexed_store.fold_indexes s ~init:[]
~f:begin fun net acc ->
Indexed_store.resolve_index (s, net) pstr >>= fun l ->
Chain.Indexed_store.fold_indexes s ~init:[]
~f:begin fun chain acc ->
Indexed_store.resolve_index (s, chain) pstr >>= fun l ->
Lwt.return (List.rev_append l acc)
end
end
@ -191,26 +191,26 @@ end
* Blockchain data
**************************************************************************)
module Chain = struct
module Chain_data = struct
type store = Net.store
type store = Chain.store
let get s = s
module Known_heads =
Store_helpers.Make_buffered_set
(Store_helpers.Make_substore
(Net.Indexed_store.Store)
(Chain.Indexed_store.Store)
(struct let name = ["known_heads"] end))
(Block_hash)
(Block_hash.Set)
module Current_head =
Store_helpers.Make_single_store
(Net.Indexed_store.Store)
(Chain.Indexed_store.Store)
(struct let name = ["current_head"] end)
(Store_helpers.Make_value(Block_hash))
module In_chain =
module In_main_branch =
Store_helpers.Make_single_store
(Block.Indexed_store.Store)
(struct let name = ["in_chain"] end)

24
src/lib_storage/store.mli → src/lib_shell/store.mli
View File

@ -17,15 +17,15 @@ val init: string -> t tzresult Lwt.t
val close : t -> unit
(** {2 Net store} ************************************************************)
(** {2 Chain store} **********************************************************)
module Net : sig
module Chain : sig
val list: global_store -> Net_id.t list Lwt.t
val destroy: global_store -> Net_id.t -> unit Lwt.t
val list: global_store -> Chain_id.t list Lwt.t
val destroy: global_store -> Chain_id.t -> unit Lwt.t
type store
val get: global_store -> Net_id.t -> store
val get: global_store -> Chain_id.t -> store
module Genesis_hash : SINGLE_STORE
with type t := store
@ -47,19 +47,19 @@ module Net : sig
with type t := store
and type value := Time.t
module Allow_forked_network : SET_STORE
module Allow_forked_chain : SET_STORE
with type t := t
and type elt := Net_id.t
and type elt := Chain_id.t
end
(** {2 Chain data} ***********************************************************)
(** {2 Mutable chain data} *******************************************************)
module Chain : sig
module Chain_data : sig
type store
val get: Net.store -> store
val get: Chain.store -> store
module Current_head : SINGLE_STORE
with type t := store
@ -70,7 +70,7 @@ module Chain : sig
and type elt := Block_hash.t
and module Set := Block_hash.Set
module In_chain : SINGLE_STORE
module In_main_branch : SINGLE_STORE
with type t = store * Block_hash.t
and type value := Block_hash.t (* successor *)
@ -82,7 +82,7 @@ end
module Block : sig
type store
val get: Net.store -> store
val get: Chain.store -> store
type contents = {
header: Block_header.t ;

52
src/lib_shell/test/assert.ml
View File

@ -39,3 +39,55 @@ let equal_block ?msg st1 st2 =
| None -> "none"
| Some st -> Block_hash.to_hex (Block_header.hash st) in
equal ?msg ~prn ~eq st1 st2
let make_equal_list eq prn ?(msg="") x y =
let rec iter i x y =
match x, y with
| hd_x :: tl_x, hd_y :: tl_y ->
if eq hd_x hd_y then
iter (succ i) tl_x tl_y
else
let fm = Printf.sprintf "%s (at index %d)" msg i in
fail (prn hd_x) (prn hd_y) fm
| _ :: _, [] | [], _ :: _ ->
let fm = Printf.sprintf "%s (lists of different sizes)" msg in
fail_msg "%s" fm
| [], [] ->
() in
iter 0 x y
let equal_string_list ?msg l1 l2 =
make_equal_list ?msg (=) (fun x -> x) l1 l2
let equal_string_list_list ?msg l1 l2 =
let pr_persist l =
let res =
String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
Printf.sprintf "[%s]" res in
make_equal_list ?msg (=) pr_persist l1 l2
let equal_block_set ?msg set1 set2 =
let b1 = Block_hash.Set.elements set1
and b2 = Block_hash.Set.elements set2 in
make_equal_list ?msg
(fun h1 h2 -> Block_hash.equal h1 h2)
Block_hash.to_string
b1 b2
let equal_block_map ?msg ~eq map1 map2 =
let b1 = Block_hash.Map.bindings map1
and b2 = Block_hash.Map.bindings map2 in
make_equal_list ?msg
(fun (h1, b1) (h2, b2) -> Block_hash.equal h1 h2 && eq b1 b2)
(fun (h1, _) -> Block_hash.to_string h1)
b1 b2
let equal_block_hash_list ?msg l1 l2 =
let pr_block_hash = Block_hash.to_short_b58check in
make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2
let is_false ?(msg="") x =
if x then fail "false" "true" msg
let is_true ?(msg="") x =
if not x then fail "true" "false" msg

10
src/lib_shell/test/jbuild
View File

@ -1,7 +1,7 @@
(jbuild_version 1)
(executables
((names (test_state
((names (test
test_locator))
(libraries (tezos-base
tezos-storage
@ -20,12 +20,12 @@
(alias
((name buildtest)
(deps (test_state.exe
(deps (test.exe
test_locator.exe))))
(alias
((name runtest_state)
(action (run ${exe:test_state.exe}))))
((name runtest_shell)
(action (run ${exe:test.exe}))))
(alias
((name runtest_locator)
@ -37,7 +37,7 @@
(alias
((name runtest)
(deps ((alias runtest_state)
(deps ((alias runtest_shell)
(alias runtest_locator)))))
(alias

14
src/lib_shell/test/test.ml Normal file
View File

@ -0,0 +1,14 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () =
Alcotest.run "tezos-state" [
"store", Test_store.tests ;
"state", Test_state.tests ;
]

68
src/lib_shell/test/test_locator.ml
View File

@ -23,12 +23,12 @@ let genesis_time = Time.of_seconds 0L
let state_genesis_block =
{
State.Net.time = genesis_time;
State.Net.block= genesis_hash;
State.Net.protocol = genesis_protocol
State.Chain.time = genesis_time;
State.Chain.block= genesis_hash;
State.Chain.protocol = genesis_protocol
}
let net_id = Net_id.of_block_hash genesis_hash
let chain_id = Chain_id.of_block_hash genesis_hash
module Proto = (val Registred_protocol.get_exn genesis_protocol)
@ -51,13 +51,13 @@ let incr_fitness fitness =
(* returns a new state with a single block, genesis *)
let init_net base_dir : State.Net.t Lwt.t =
let init_chain base_dir : State.Chain.t Lwt.t =
let store_root = base_dir // "store" in
let context_root = base_dir // "context" in
State.read ~store_root ~context_root () >>= function
| Error _ -> Pervasives.failwith "read err"
| Ok (state:State.global_state) ->
State.Net.create state state_genesis_block
State.Chain.create state state_genesis_block
let block_header
@ -81,9 +81,9 @@ let block_header
Block_header.proto = MBytes.of_string "" ;
}
(* adds n blocks on top of an initialized net *)
let make_empty_chain (net:State.Net.t) n : Block_hash.t Lwt.t =
State.Block.read_exn net genesis_hash >>= fun genesis ->
(* adds n blocks on top of an initialized chain *)
let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
State.Block.read_exn chain genesis_hash >>= fun genesis ->
State.Block.context genesis >>= fun empty_context ->
let header = State.Block.header genesis in
Context.commit
@ -104,7 +104,7 @@ let make_empty_chain (net:State.Net.t) n : Block_hash.t Lwt.t =
{ header with
shell = { header.shell with predecessor = pred ;
level = Int32.of_int lvl } } in
State.Block.store net header [] empty_result >>=? fun _ ->
State.Block.store chain header [] empty_result >>=? fun _ ->
loop (lvl+1) (Block_header.hash header)
in
loop 1 genesis_hash >>= function
@ -151,22 +151,22 @@ let print_block b =
(Int32.to_int (State.Block.level b))
(Block_hash.to_b58check (State.Block.hash b))
let print_block_h net bh =
State.Block.read_exn net bh >|= fun b ->
let print_block_h chain bh =
State.Block.read_exn chain bh >|= fun b ->
print_block b
(* returns the predecessor at distance one, reading the header *)
let linear_predecessor net (bh: Block_hash.t) : Block_hash.t option Lwt.t =
State.Block.read_exn net bh >>= fun b ->
let linear_predecessor chain (bh: Block_hash.t) : Block_hash.t option Lwt.t =
State.Block.read_exn chain bh >>= fun b ->
State.Block.predecessor b >|= function
| None -> None
| Some pred -> Some (State.Block.hash pred)
let print_chain net bh =
let print_chain chain bh =
let rec loop bh cnt =
let _ = print_block_h net bh in
linear_predecessor net bh >>= function
let _ = print_block_h chain bh in
linear_predecessor chain bh >>= function
| Some pred -> loop pred (cnt+1)
| None -> Lwt.return_unit
in
@ -174,15 +174,15 @@ let print_chain net bh =
(* returns the predecessors at ditance n, traversing all n intermediate blocks *)
let linear_predecessor_n (net:State.Net.t) (bh:Block_hash.t) (distance:int)
let linear_predecessor_n (chain:State.Chain.t) (bh:Block_hash.t) (distance:int)
: Block_hash.t option Lwt.t =
(* let _ = Printf.printf "LP: %4i " distance; print_block_h net bh in *)
(* let _ = Printf.printf "LP: %4i " distance; print_block_h chain bh in *)
if distance < 1 then invalid_arg "distance<1" else
let rec loop bh distance =
if distance = 0
then Lwt.return_some bh (* reached distance *)
else
linear_predecessor net bh >>= function
linear_predecessor chain bh >>= function
| None -> Lwt.return_none
| Some pred ->
loop pred (distance-1)
@ -197,12 +197,12 @@ let linear_predecessor_n (net:State.Net.t) (bh:Block_hash.t) (distance:int)
requested *)
let test_pred (base_dir:string) : unit tzresult Lwt.t =
let size_chain = 1000 in
init_net base_dir >>= fun net ->
make_empty_chain net size_chain >>= fun head ->
init_chain base_dir >>= fun chain ->
make_empty_chain chain size_chain >>= fun head ->
let test_once distance =
linear_predecessor_n net head distance >>= fun lin_res ->
State.Block.predecessor_n net head distance >>= fun exp_res ->
linear_predecessor_n chain head distance >>= fun lin_res ->
State.Block.predecessor_n chain head distance >>= fun exp_res ->
match lin_res,exp_res with
| None, None ->
Lwt.return_unit
@ -211,9 +211,9 @@ let test_pred (base_dir:string) : unit tzresult Lwt.t =
| Some lin_res, Some exp_res ->
(* check that the two results are the same *)
(assert (lin_res = exp_res));
State.Block.read_exn net lin_res >>= fun pred ->
State.Block.read_exn chain lin_res >>= fun pred ->
let level_pred = Int32.to_int (State.Block.level pred) in
State.Block.read_exn net head >>= fun head ->
State.Block.read_exn chain head >>= fun head ->
let level_start = Int32.to_int (State.Block.level head) in
(* check distance using the level *)
assert (level_start - distance = level_pred);
@ -226,11 +226,11 @@ let test_pred (base_dir:string) : unit tzresult Lwt.t =
(* compute locator using the linear predecessor *)
let compute_linear_locator (net:State.Net.t) ~size block =
let genesis = State.Net.genesis net in
let compute_linear_locator (chain:State.Chain.t) ~size block =
let genesis = State.Chain.genesis chain in
let block_hash = State.Block.hash block in
let header = State.Block.header block in
Block_locator.compute ~predecessor:(linear_predecessor_n net)
Block_locator.compute ~predecessor:(linear_predecessor_n chain)
~genesis:genesis.block block_hash header size
@ -270,9 +270,9 @@ let test_locator base_dir =
let locator_limit = compute_size_locator size_chain in
let _ = Printf.printf "#locator_limit %i\n" locator_limit in
init_net base_dir >>= fun net ->
init_chain base_dir >>= fun chain ->
time1 (fun () ->
make_empty_chain net size_chain) |>
make_empty_chain chain size_chain) |>
fun (res, t_chain) ->
let _ = Printf.printf
"#size_chain %i built in %f sec\n# size exp lins\n"
@ -280,12 +280,12 @@ let test_locator base_dir =
res >>= fun head ->
let check_locator size : unit tzresult Lwt.t =
State.Block.read net head >>=? fun block ->
State.Block.read chain head >>=? fun block ->
time ~runs:runs (fun () ->
State.compute_locator net ~size:size block) |>
State.compute_locator chain ~size:size block) |>
fun (l_exp,t_exp) ->
time ~runs:runs (fun () ->
compute_linear_locator net ~size:size block) |>
compute_linear_locator chain ~size:size block) |>
fun (l_lin,t_lin) ->
l_exp >>= fun l_exp ->
l_lin >>= fun l_lin ->

58
src/lib_shell/test/test_state.ml
View File

@ -24,13 +24,13 @@ let genesis_time =
module Proto = (val Registred_protocol.get_exn genesis_protocol)
let genesis : State.Net.genesis = {
let genesis : State.Chain.genesis = {
time = genesis_time ;
block = genesis_block ;
protocol = genesis_protocol ;
}
let net_id = Net_id.of_block_hash genesis_block
let chain_id = Chain_id.of_block_hash genesis_block
let incr_fitness fitness =
let new_fitness =
@ -112,21 +112,21 @@ let build_valid_chain state vtbl pred names =
names >>= fun _ ->
Lwt.return ()
let build_example_tree net =
let build_example_tree chain =
let vtbl = Hashtbl.create 23 in
Chain.genesis net >>= fun genesis ->
Chain.genesis chain >>= fun genesis ->
Hashtbl.add vtbl "Genesis" genesis ;
let chain = [ "A1" ; "A2" ; "A3" ; "A4" ; "A5" ; "A6" ; "A7" ; "A8" ] in
build_valid_chain net vtbl genesis chain >>= fun () ->
let c = [ "A1" ; "A2" ; "A3" ; "A4" ; "A5" ; "A6" ; "A7" ; "A8" ] in
build_valid_chain chain vtbl genesis c >>= fun () ->
let a3 = Hashtbl.find vtbl "A3" in
let chain = [ "B1" ; "B2" ; "B3" ; "B4" ; "B5" ; "B6" ; "B7" ; "B8" ] in
build_valid_chain net vtbl a3 chain >>= fun () ->
let c = [ "B1" ; "B2" ; "B3" ; "B4" ; "B5" ; "B6" ; "B7" ; "B8" ] in
build_valid_chain chain vtbl a3 c >>= fun () ->
Lwt.return vtbl
type state = {
vblock: (string, State.Block.t) Hashtbl.t ;
state: State.t ;
net: State.Net.t ;
chain: State.Chain.t ;
init: unit -> State.t tzresult Lwt.t;
}
@ -148,9 +148,9 @@ let wrap_state_init f base_dir =
~context_root
() in
init () >>=? fun state ->
State.Net.create state genesis >>= fun net ->
build_example_tree net >>= fun vblock ->
f { state ; net ; vblock ; init } >>=? fun () ->
State.Chain.create state genesis >>= fun chain ->
build_example_tree chain >>= fun vblock ->
f { state ; chain ; vblock ; init } >>=? fun () ->
return ()
end
@ -166,7 +166,7 @@ let test_init (_ : state) =
let test_read_block (s: state) =
Lwt_list.iter_s (fun (name, vblock) ->
let hash = State.Block.hash vblock in
State.Block.read s.net hash >>= function
State.Block.read s.chain hash >>= function
| Error _ ->
Assert.fail_msg "Error while reading valid block %s" name
| Ok _vblock' ->
@ -238,7 +238,7 @@ let test_ancestor s =
let test_locator s =
let check_locator length h1 expected =
State.compute_locator s.net
State.compute_locator s.chain
~size:length (vblock s h1) >>= fun l ->
let _, l = (l : Block_locator.t :> _ * _) in
if List.length l <> List.length expected then
@ -276,7 +276,7 @@ let compare s name heads l =
l
let test_known_heads s =
Chain.known_heads s.net >>= fun heads ->
Chain.known_heads s.chain >>= fun heads ->
compare s "initial" heads ["A8";"B8"] ;
return ()
@ -286,11 +286,11 @@ let test_known_heads s =
(** Chain.head/set_head *)
let test_head s =
Chain.head s.net >>= fun head ->
Chain.head s.chain >>= fun head ->
if not (Block_hash.equal (State.Block.hash head) genesis_block) then
Assert.fail_msg "unexpected head" ;
Chain.set_head s.net (vblock s "A6") >>= fun _ ->
Chain.head s.net >>= fun head ->
Chain.set_head s.chain (vblock s "A6") >>= fun _ ->
Chain.head s.chain >>= fun head ->
if not (Block_hash.equal (State.Block.hash head) (State.Block.hash @@ vblock s "A6")) then
Assert.fail_msg "unexpected head" ;
return ()
@ -302,7 +302,7 @@ let test_head s =
let test_mem s =
let mem s x =
Chain.mem s.net (State.Block.hash @@ vblock s x) in
Chain.mem s.chain (State.Block.hash @@ vblock s x) in
let test_mem s x =
mem s x >>= function
| true -> Lwt.return_unit
@ -317,21 +317,21 @@ let test_mem s =
test_not_mem s "B1" >>= fun () ->
test_not_mem s "B6" >>= fun () ->
test_not_mem s "B8" >>= fun () ->
Chain.set_head s.net (vblock s "A8") >>= fun _ ->
Chain.set_head s.chain (vblock s "A8") >>= fun _ ->
test_mem s "A3" >>= fun () ->
test_mem s "A6" >>= fun () ->
test_mem s "A8" >>= fun () ->
test_not_mem s "B1" >>= fun () ->
test_not_mem s "B6" >>= fun () ->
test_not_mem s "B8" >>= fun () ->
Chain.set_head s.net (vblock s "A6") >>= fun _ ->
Chain.set_head s.chain (vblock s "A6") >>= fun _ ->
test_mem s "A3" >>= fun () ->
test_mem s "A6" >>= fun () ->
test_not_mem s "A8" >>= fun () ->
test_not_mem s "B1" >>= fun () ->
test_not_mem s "B6" >>= fun () ->
test_not_mem s "B8" >>= fun () ->
Chain.set_head s.net (vblock s "B6") >>= fun _ ->
Chain.set_head s.chain (vblock s "B6") >>= fun _ ->
test_mem s "A3" >>= fun () ->
test_not_mem s "A4" >>= fun () ->
test_not_mem s "A6" >>= fun () ->
@ -339,7 +339,7 @@ let test_mem s =
test_mem s "B1" >>= fun () ->
test_mem s "B6" >>= fun () ->
test_not_mem s "B8" >>= fun () ->
Chain.set_head s.net (vblock s "B8") >>= fun _ ->
Chain.set_head s.chain (vblock s "B8") >>= fun _ ->
test_mem s "A3" >>= fun () ->
test_not_mem s "A4" >>= fun () ->
test_not_mem s "A6" >>= fun () ->
@ -384,9 +384,9 @@ let test_new_blocks s =
let test_find_new s =
let test s h expected =
State.compute_locator s.net ~size:50 (vblock s h) >>= fun loc ->
State.compute_locator s.chain ~size:50 (vblock s h) >>= fun loc ->
Block_locator_iterator.find_new
s.net loc (List.length expected) >>= fun blocks ->
s.chain loc (List.length expected) >>= fun blocks ->
if List.length blocks <> List.length expected then
Assert.fail_msg
"Invalid find new length %s (found: %d, expected: %d)"
@ -398,7 +398,7 @@ let test_find_new s =
blocks expected ;
Lwt.return_unit
in
Chain.set_head s.net (vblock s "A8") >>= fun _ ->
Chain.set_head s.chain (vblock s "A8") >>= fun _ ->
test s "A6" [] >>= fun () ->
test s "A6" ["A7";"A8"] >>= fun () ->
test s "A6" ["A7"] >>= fun () ->
@ -433,7 +433,5 @@ let wrap (n, f) =
end
end
let () =
Alcotest.run ~argv:[|""|] "tezos-shell" [
"state", List.map wrap tests
]
let tests =List.map wrap tests

6
src/lib_storage/test/test_store.ml → src/lib_shell/test/test_store.ml
View File

@ -54,7 +54,7 @@ let wrap_raw_store_init f _ () =
let test_init _ = Lwt.return_unit
let net_id = Net_id.of_block_hash genesis_block
let chain_id = Chain_id.of_block_hash genesis_block
(** Operation store *)
@ -120,7 +120,7 @@ let check_block s h b =
exit 1
let test_block s =
let s = Store.Net.get s net_id in
let s = Store.Chain.get s chain_id in
let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () ->
@ -130,7 +130,7 @@ let test_block s =
check_block s bh3 b3
let test_expand s =
let s = Store.Net.get s net_id in
let s = Store.Chain.get s chain_id in
let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () ->

92
src/lib_shell/validator.ml
View File

@ -14,13 +14,13 @@ type t = {
state: State.t ;
db: Distributed_db.t ;
block_validator: Block_validator.t ;
net_validator_limits: Net_validator.limits ;
chain_validator_limits: Chain_validator.limits ;
peer_validator_limits: Peer_validator.limits ;
block_validator_limits: Block_validator.limits ;
prevalidator_limits: Prevalidator.limits ;
valid_block_input: State.Block.t Lwt_watcher.input ;
active_nets: Net_validator.t Lwt.t Net_id.Table.t ;
active_chains: Chain_validator.t Lwt.t Chain_id.Table.t ;
}
@ -28,76 +28,76 @@ let create state db
peer_validator_limits
block_validator_limits
prevalidator_limits
net_validator_limits =
chain_validator_limits =
Block_validator.create block_validator_limits db >>= fun block_validator ->
let valid_block_input = Lwt_watcher.create_input () in
Lwt.return
{ state ; db ; block_validator ;
block_validator_limits ; prevalidator_limits ;
peer_validator_limits ; net_validator_limits ;
peer_validator_limits ; chain_validator_limits ;
valid_block_input ;
active_nets = Net_id.Table.create 7 }
active_chains = Chain_id.Table.create 7 }
let activate v ?max_child_ttl net_state =
let net_id = State.Net.id net_state in
lwt_log_notice "activate network %a" Net_id.pp net_id >>= fun () ->
try Net_id.Table.find v.active_nets net_id
let activate v ?max_child_ttl chain_state =
let chain_id = State.Chain.id chain_state in
lwt_log_notice "activate chain %a" Chain_id.pp chain_id >>= fun () ->
try Chain_id.Table.find v.active_chains chain_id
with Not_found ->
let nv =
Net_validator.create
Chain_validator.create
?max_child_ttl
v.peer_validator_limits v.prevalidator_limits
v.block_validator v.valid_block_input v.db net_state
v.net_validator_limits in
Net_id.Table.add v.active_nets net_id nv ;
v.block_validator v.valid_block_input v.db chain_state
v.chain_validator_limits in
Chain_id.Table.add v.active_chains chain_id nv ;
nv
let get_exn { active_nets } net_id =
Net_id.Table.find active_nets net_id
let get_exn { active_chains } chain_id =
Chain_id.Table.find active_chains chain_id
type error +=
| Inactive_network of Net_id.t
| Inactive_chain of Chain_id.t
let () =
register_error_kind `Branch
~id: "node.validator.inactive_network"
~title: "Inactive network"
~description: "Attempted validation of a block from an inactive network."
~pp: (fun ppf net ->
~id: "node.validator.inactive_chain"
~title: "Inactive chain"
~description: "Attempted validation of a block from an inactive chain."
~pp: (fun ppf chain ->
Format.fprintf ppf
"Tried to validate a block from network %a, \
"Tried to validate a block from chain %a, \
that is not currently considered active."
Net_id.pp net)
Data_encoding.(obj1 (req "inactive_network" Net_id.encoding))
(function Inactive_network net -> Some net | _ -> None)
(fun net -> Inactive_network net)
Chain_id.pp chain)
Data_encoding.(obj1 (req "inactive_chain" Chain_id.encoding))
(function Inactive_chain chain -> Some chain | _ -> None)
(fun chain -> Inactive_chain chain)
let get v net_id =
try get_exn v net_id >>= fun nv -> return nv
with Not_found -> fail (Inactive_network net_id)
let get v chain_id =
try get_exn v chain_id >>= fun nv -> return nv
with Not_found -> fail (Inactive_chain chain_id)
let validate_block v ?(force = false) ?net_id bytes operations =
let validate_block v ?(force = false) ?chain_id bytes operations =
let hash = Block_hash.hash_bytes [bytes] in
match Block_header.of_bytes bytes with
| None -> failwith "Cannot parse block header."
| Some block ->
begin
match net_id with
match chain_id with
| None -> begin
Distributed_db.read_block_header
v.db block.shell.predecessor >>= function
| None ->
failwith "Unknown predecessor (%a), cannot inject the block."
Block_hash.pp_short block.shell.predecessor
| Some (net_id, _bh) -> get v net_id
| Some (chain_id, _bh) -> get v chain_id
end
| Some net_id ->
get v net_id >>=? fun nv ->
| Some chain_id ->
get v chain_id >>=? fun nv ->
if force then
return nv
else
Distributed_db.Block_header.known
(Net_validator.net_db nv)
(Chain_validator.chain_db nv)
block.shell.predecessor >>= function
| true ->
return nv
@ -106,36 +106,36 @@ let validate_block v ?(force = false) ?net_id bytes operations =
Block_hash.pp_short block.shell.predecessor
end >>=? fun nv ->
let validation =
Net_validator.validate_block nv ~force hash block operations in
Chain_validator.validate_block nv ~force hash block operations in
return (hash, validation)
let shutdown { active_nets ; block_validator } =
let shutdown { active_chains ; block_validator } =
let jobs =
Block_validator.shutdown block_validator ::
Net_id.Table.fold
(fun _ nv acc -> (nv >>= Net_validator.shutdown) :: acc)
active_nets [] in
Chain_id.Table.fold
(fun _ nv acc -> (nv >>= Chain_validator.shutdown) :: acc)
active_chains [] in
Lwt.join jobs >>= fun () ->
Lwt.return_unit
let watcher { valid_block_input } =
Lwt_watcher.create_stream valid_block_input
let inject_operation v ?net_id op =
let inject_operation v ?chain_id op =
begin
match net_id with
match chain_id with
| None -> begin
Distributed_db.read_block_header
v.db op.Operation.shell.branch >>= function
| None ->
failwith "Unknown branch (%a), cannot inject the operation."
Block_hash.pp_short op.shell.branch
| Some (net_id, _bh) -> get v net_id
| Some (chain_id, _bh) -> get v chain_id
end
| Some net_id ->
get v net_id >>=? fun nv ->
| Some chain_id ->
get v chain_id >>=? fun nv ->
Distributed_db.Block_header.known
(Net_validator.net_db nv)
(Chain_validator.chain_db nv)
op.shell.branch >>= function
| true ->
return nv
@ -143,5 +143,5 @@ let inject_operation v ?net_id op =
failwith "Unknown branch (%a), cannot inject the operation."
Block_hash.pp_short op.shell.branch
end >>=? fun nv ->
let pv = Net_validator.prevalidator nv in
let pv = Chain_validator.prevalidator nv in
Prevalidator.inject_operation pv op

18
src/lib_shell/validator.mli
View File

@ -17,33 +17,33 @@ val create:
Peer_validator.limits ->
Block_validator.limits ->
Prevalidator.limits ->
Net_validator.limits ->
Chain_validator.limits ->
t Lwt.t
val shutdown: t -> unit Lwt.t
(** Start the validation scheduler of a given network. *)
(** Start the validation scheduler of a given chain. *)
val activate:
t ->
?max_child_ttl:int ->
State.Net.t -> Net_validator.t Lwt.t
State.Chain.t -> Chain_validator.t Lwt.t
type error +=
| Inactive_network of Net_id.t
val get: t -> Net_id.t -> Net_validator.t tzresult Lwt.t
val get_exn: t -> Net_id.t -> Net_validator.t Lwt.t
| Inactive_chain of Chain_id.t
val get: t -> Chain_id.t -> Chain_validator.t tzresult Lwt.t
val get_exn: t -> Chain_id.t -> Chain_validator.t Lwt.t
(** Force the validation of a block. *)
val validate_block:
t ->
?force:bool ->
?net_id:Net_id.t ->
?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list ->
(Block_hash.t * State.Block.t tzresult Lwt.t) tzresult Lwt.t
(** Monitor all the valid block (for all activate networks). *)
(** Monitor all the valid block (for all activate chains). *)
val watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
val inject_operation:
t ->
?net_id:Net_id.t ->
?chain_id:Chain_id.t ->
Operation.t -> unit tzresult Lwt.t

4
src/lib_shell/worker.ml
View File

@ -109,8 +109,8 @@ module Make
"Worker %s[%a] has been shut down."
base_name Name.pp name)
Data_encoding.(obj1 (req "worker_id" Name.encoding))
(function Closed net_id -> Some net_id | _ -> None)
(fun net_id -> Closed net_id)
(function Closed chain_id -> Some chain_id | _ -> None)
(fun chain_id -> Closed chain_id)
let queue_item ?u r =
Time.now (),

42
src/lib_shell_services/block_services.ml
View File

@ -47,7 +47,7 @@ let to_string = function
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
@ -59,7 +59,7 @@ type block_info = {
data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_network: Test_network_status.t ;
test_chain: Test_chain_status.t ;
}
let block_info_encoding =
@ -68,35 +68,35 @@ let block_info_encoding =
(obj1 (req "hash" Operation_hash.encoding))
Operation.encoding in
conv
(fun { hash ; net_id ; level ; proto_level ; predecessor ;
(fun { hash ; chain_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ;
validation_passes ; operations_hash ; context ; data ;
operations ; test_network } ->
((hash, net_id, operations, protocol, test_network),
operations ; test_chain } ->
((hash, chain_id, operations, protocol, test_chain),
{ Block_header.shell =
{ level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness ;
context } ;
proto = data }))
(fun ((hash, net_id, operations, protocol, test_network),
(fun ((hash, chain_id, operations, protocol, test_chain),
{ Block_header.shell =
{ level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness ;
context } ;
proto = data }) ->
{ hash ; net_id ; level ; proto_level ; predecessor ;
{ hash ; chain_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ;
validation_passes ; operations_hash ; context ; data ;
operations ; test_network })
operations ; test_chain })
(dynamic_size
(merge_objs
(obj5
(req "hash" Block_hash.encoding)
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_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))
(dft "test_chain"
Test_chain_status.encoding Not_running))
Block_header.encoding))
type preapply_result = {
@ -143,13 +143,13 @@ module S = struct
~output: block_info_encoding
block_path
let net_id =
let chain_id =
RPC_service.post_service
~description:"Returns the net of the chain in which the block belongs."
~description:"Returns the chain in which the block belongs."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "net_id" Net_id.encoding))
RPC_path.(block_path / "net_id")
~output: (obj1 (req "chain_id" Chain_id.encoding))
RPC_path.(block_path / "chain_id")
let level =
RPC_service.post_service
@ -245,13 +245,13 @@ module S = struct
~output: (obj1 (req "protocol" Protocol_hash.encoding))
RPC_path.(block_path / "protocol")
let test_network =
let test_chain =
RPC_service.post_service
~description:"Returns the status of the associated test network."
~description:"Returns the status of the associated test chain."
~query: RPC_query.empty
~input: empty
~output: Test_network_status.encoding
RPC_path.(block_path / "test_network")
~output: Test_chain_status.encoding
RPC_path.(block_path / "test_chain")
let pending_operations =
let operation_encoding =
@ -432,7 +432,7 @@ let monitor_prevalidated_operations ?(contents = false) ctxt =
((), `Prevalidation) ()
{ contents ; monitor = true }
let net_id ctxt b = make_call1 S.net_id ctxt b () ()
let chain_id ctxt b = make_call1 S.chain_id ctxt b () ()
let level ctxt b = make_call1 S.level ctxt b () ()
let predecessor ctxt b = make_call1 S.predecessor ctxt b () ()
let predecessors ctxt b n = make_call1 S.predecessors ctxt b () n
@ -442,7 +442,7 @@ let fitness ctxt b = make_call1 S.fitness ctxt b () ()
let operations ctxt ?(contents = false) h =
make_call1 S.operations ctxt h () { contents ; monitor = false }
let protocol ctxt b = make_call1 S.protocol ctxt b () ()
let test_network ctxt b = make_call1 S.test_network ctxt b () ()
let test_chain ctxt b = make_call1 S.test_chain ctxt b () ()
let pending_operations ctxt b = make_call1 S.pending_operations ctxt b () ()
let info ctxt ?(include_ops = true) h =
make_call1 S.info ctxt h () include_ops

20
src/lib_shell_services/block_services.mli
View File

@ -26,7 +26,7 @@ val to_string: block -> string
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
@ -38,7 +38,7 @@ type block_info = {
data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_network: Test_network_status.t ;
test_chain: Test_chain_status.t ;
}
type preapply_result = {
@ -48,8 +48,8 @@ type preapply_result = {
open RPC_context
val net_id:
#simple -> block -> Net_id.t tzresult Lwt.t
val chain_id:
#simple -> block -> Chain_id.t tzresult Lwt.t
val level:
#simple -> block -> Int32.t tzresult Lwt.t
val predecessor:
@ -67,8 +67,8 @@ val operations:
block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t
val protocol:
#simple -> block -> Protocol_hash.t tzresult Lwt.t
val test_network:
#simple -> block -> Test_network_status.t tzresult Lwt.t
val test_chain:
#simple -> block -> Test_chain_status.t tzresult Lwt.t
val pending_operations:
#simple -> block ->
@ -119,10 +119,10 @@ module S : sig
([ `POST ], unit,
unit * block, unit, bool,
block_info) RPC_service.t
val net_id:
val chain_id:
([ `POST ], unit,
unit * block, unit, unit,
Net_id.t) RPC_service.t
Chain_id.t) RPC_service.t
val level:
([ `POST ], unit,
unit * block, unit, unit,
@ -165,10 +165,10 @@ module S : sig
([ `POST ], unit,
unit * block, unit, unit,
Protocol_hash.t) RPC_service.t
val test_network:
val test_chain:
([ `POST ], unit,
unit * block, unit, unit,
Test_network_status.t) RPC_service.t
Test_chain_status.t) RPC_service.t
val pending_operations:
([ `POST ], unit,
unit * block, unit, unit,

10
src/lib_shell_services/block_validator_errors.ml
View File

@ -18,8 +18,8 @@ type block_error =
| Outdated_operation of
{ operation: Operation_hash.t;
originating_block: Block_hash.t }
| Expired_network of
{ net_id: Net_id.t ;
| Expired_chain of
{ chain_id: Chain_id.t ;
expiration: Time.t ;
timestamp: Time.t ;
}
@ -188,13 +188,13 @@ let pp_block_error ppf = function
"The operation %a is outdated (originated in block: %a)"
Operation_hash.pp_short operation
Block_hash.pp_short originating_block
| Expired_network { net_id ; expiration ; timestamp } ->
| Expired_chain { chain_id ; expiration ; timestamp } ->
Format.fprintf ppf
"The block timestamp (%a) is later than \
its network expiration date: %a (net: %a)."
its chain expiration date: %a (chain: %a)."
Time.pp_hum timestamp
Time.pp_hum expiration
Net_id.pp_short net_id
Chain_id.pp_short chain_id
| Unexpected_number_of_validation_passes n ->
Format.fprintf ppf
"Invalid number of validation passes (found: %d)"

4
src/lib_shell_services/block_validator_errors.mli
View File

@ -18,8 +18,8 @@ type block_error =
| Outdated_operation of
{ operation: Operation_hash.t;
originating_block: Block_hash.t }
| Expired_network of
{ net_id: Net_id.t ;
| Expired_chain of
{ chain_id: Chain_id.t ;
expiration: Time.t ;
timestamp: Time.t ;
}

14
src/lib_shell_services/block_validator_worker_state.ml
View File

@ -9,24 +9,24 @@
module Request = struct
type view = {
net_id : Net_id.t ;
chain_id : Chain_id.t ;
block : Block_hash.t ;
peer : P2p_peer.Id.t option ;
}
let encoding =
let open Data_encoding in
conv
(fun { net_id ; block ; peer } -> (block, net_id, peer))
(fun (block, net_id, peer) -> { net_id ; block ; peer })
(fun { chain_id ; block ; peer } -> (block, chain_id, peer))
(fun (block, chain_id, peer) -> { chain_id ; block ; peer })
(obj3
(req "block" Block_hash.encoding)
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(opt "peer" P2p_peer.Id.encoding))
let pp ppf { net_id ; block ; peer } =
Format.fprintf ppf "Validation of %a (net: %a)"
let pp ppf { chain_id ; block ; peer } =
Format.fprintf ppf "Validation of %a (chain: %a)"
Block_hash.pp block
Net_id.pp_short net_id ;
Chain_id.pp_short chain_id ;
match peer with
| None -> ()
| Some peer ->

2
src/lib_shell_services/block_validator_worker_state.mli
View File

@ -9,7 +9,7 @@
module Request : sig
type view = {
net_id : Net_id.t ;
chain_id : Chain_id.t ;
block : Block_hash.t ;
peer: P2p_peer.Id.t option ;
}

12
src/lib_shell_services/net_validator_worker_state.ml → src/lib_shell_services/chain_validator_worker_state.ml
View File

@ -25,7 +25,7 @@ module Event = struct
request_status : Worker_types.request_status ;
update : update ;
fitness : Fitness.t }
| Could_not_switch_testnet of error list
| Could_not_switch_testchain of error list
let level = function
| Processed_block req ->
@ -33,7 +33,7 @@ module Event = struct
| Ignored_head -> Logging.Info
| Branch_switch | Head_incrememt -> Logging.Notice
end
| Could_not_switch_testnet _ -> Logging.Error
| Could_not_switch_testchain _ -> Logging.Error
let encoding =
let open Data_encoding in
@ -56,9 +56,9 @@ module Event = struct
case (Tag 1)
RPC_error.encoding
(function
| Could_not_switch_testnet err -> Some err
| Could_not_switch_testchain err -> Some err
| _ -> None)
(fun err -> Could_not_switch_testnet err) ]
(fun err -> Could_not_switch_testchain err) ]
let pp ppf = function
| Processed_block req ->
@ -81,8 +81,8 @@ module Event = struct
Time.pp_hum req.request_status.pushed
Time.pp_hum req.request_status.treated
Time.pp_hum req.request_status.completed
| Could_not_switch_testnet err ->
Format.fprintf ppf "@[<v 2>Error while switch test network:@ %a@]"
| Could_not_switch_testchain err ->
Format.fprintf ppf "@[<v 2>Error while switching test chain:@ %a@]"
Error_monad.pp_print_error err
end

2
src/lib_shell_services/net_validator_worker_state.mli → src/lib_shell_services/chain_validator_worker_state.mli
View File

@ -24,7 +24,7 @@ module Event : sig
request_status : Worker_types.request_status ;
update : update ;
fitness : Fitness.t }
| Could_not_switch_testnet of error list
| Could_not_switch_testchain of error list
val level : t -> Logging.level
val encoding : t Data_encoding.encoding
val pp : Format.formatter -> t -> unit

24
src/lib_shell_services/p2p_services.ml
View File

@ -15,7 +15,7 @@ module S = struct
~query: RPC_query.empty
~input: Data_encoding.empty
~output: (Data_encoding.list P2p_version.encoding)
RPC_path.(root / "network" / "versions")
RPC_path.(root / "p2p" / "versions")
let stat =
RPC_service.post_service
@ -23,7 +23,7 @@ module S = struct
~query: RPC_query.empty
~input: Data_encoding.empty
~output: P2p_stat.encoding
RPC_path.(root / "network" / "stat")
RPC_path.(root / "p2p" / "stat")
let events =
RPC_service.post_service
@ -31,7 +31,7 @@ module S = struct
~query: RPC_query.empty
~input: Data_encoding.empty
~output: P2p_connection.Pool_event.encoding
RPC_path.(root / "network" / "log")
RPC_path.(root / "p2p" / "log")
let connect =
RPC_service.post_service
@ -39,7 +39,7 @@ module S = struct
~query: RPC_query.empty
~input: Data_encoding.(obj1 (dft "timeout" float 5.))
~output: Data_encoding.empty
RPC_path.(root / "network" / "connect" /: P2p_point.Id.rpc_arg)
RPC_path.(root / "p2p" / "connect" /: P2p_point.Id.rpc_arg)
end
@ -62,7 +62,7 @@ module Connections = struct
~query: RPC_query.empty
~input: Data_encoding.empty
~output: (Data_encoding.list P2p_connection.Info.encoding)
RPC_path.(root / "network" / "connections")
RPC_path.(root / "p2p" / "connections")
let info =
RPC_service.post_service
@ -70,7 +70,7 @@ module Connections = struct
~input: Data_encoding.empty
~output: P2p_connection.Info.encoding
~description:"Details about the current P2P connection to the given peer."
RPC_path.(root / "network" / "connections" /: P2p_peer.Id.rpc_arg)
RPC_path.(root / "p2p" / "connections" /: P2p_peer.Id.rpc_arg)
let kick =
RPC_service.post_service
@ -78,7 +78,7 @@ module Connections = struct
~input: Data_encoding.(obj1 (req "wait" bool))
~output: Data_encoding.empty
~description:"Forced close of the current P2P connection to the given peer."
RPC_path.(root / "network" / "connections" /: P2p_peer.Id.rpc_arg / "kick")
RPC_path.(root / "p2p" / "connections" /: P2p_peer.Id.rpc_arg / "kick")
end
@ -98,7 +98,7 @@ module Points = struct
~input: Data_encoding.empty
~output: P2p_point.Info.encoding
~description: "Details about a given `IP:addr`."
RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg)
RPC_path.(root / "p2p" / "points" /: P2p_point.Id.rpc_arg)
let events =
RPC_service.post_service
@ -107,7 +107,7 @@ module Points = struct
~output: (Data_encoding.list
P2p_point.Pool_event.encoding)
~description: "Monitor network events related to an `IP:addr`."
RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "log")
RPC_path.(root / "p2p" / "points" /: P2p_point.Id.rpc_arg / "log")
let list =
let filter =
@ -144,7 +144,7 @@ module Peers = struct
~input: Data_encoding.empty
~output: P2p_peer.Info.encoding
~description:"Details about a given peer."
RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg)
RPC_path.(root / "p2p" / "peers" /: P2p_peer.Id.rpc_arg)
let events =
RPC_service.post_service
@ -153,7 +153,7 @@ module Peers = struct
~output: (Data_encoding.list
P2p_peer.Pool_event.encoding)
~description:"Monitor network events related to a given peer."
RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "log")
RPC_path.(root / "p2p" / "peers" /: P2p_peer.Id.rpc_arg / "log")
let list =
let filter =
@ -167,7 +167,7 @@ module Peers = struct
P2p_peer.Id.encoding
P2p_peer.Info.encoding))
~description:"List the peers the node ever met."
RPC_path.(root / "network" / "peers")
RPC_path.(root / "p2p" / "peers")
end

22
src/lib_shell_services/shell_services.ml
View File

@ -23,16 +23,16 @@ module S = struct
raw: MBytes.t ;
blocking: bool ;
force: bool ;
net_id: Net_id.t option ;
chain_id: Chain_id.t option ;
operations: Operation.t list list ;
}
let inject_block_param =
conv
(fun { raw ; blocking ; force ; net_id ; operations } ->
(raw, blocking, force, net_id, operations))
(fun (raw, blocking, force, net_id, operations) ->
{ raw ; blocking ; force ; net_id ; operations })
(fun { raw ; blocking ; force ; chain_id ; operations } ->
(raw, blocking, force, chain_id, operations))
(fun (raw, blocking, force, chain_id, operations) ->
{ raw ; blocking ; force ; chain_id ; operations })
(obj5
(req "data" bytes)
(dft "blocking"
@ -49,7 +49,7 @@ module S = struct
the current head. (default: false)"
bool)
false)
(opt "net_id" Net_id.encoding)
(opt "chain_id" Chain_id.encoding)
(req "operations"
(describe
~description:"..."
@ -92,7 +92,7 @@ module S = struct
(pre-)validated before answering. (default: true)"
bool)
true)
(opt "net_id" Net_id.encoding))
(opt "chain_id" Chain_id.encoding))
~output:
(describe
~title: "Hash of the injected operation" @@
@ -158,14 +158,14 @@ let forge_block_header ctxt header =
make_call S.forge_block_header ctxt () () header
let inject_block ctxt
?(async = false) ?(force = false) ?net_id
?(async = false) ?(force = false) ?chain_id
raw operations =
make_call S.inject_block ctxt () ()
{ raw ; blocking = not async ; force ; net_id ; operations }
{ raw ; blocking = not async ; force ; chain_id ; operations }
let inject_operation ctxt ?(async = false) ?net_id operation =
let inject_operation ctxt ?(async = false) ?chain_id operation =
make_call S.inject_operation ctxt () ()
(operation, not async, net_id)
(operation, not async, chain_id)
let inject_protocol ctxt ?(async = false) ?force protocol =
make_call S.inject_protocol ctxt () ()

8
src/lib_shell_services/shell_services.mli
View File

@ -17,7 +17,7 @@ val forge_block_header:
val inject_block:
#simple ->
?async:bool -> ?force:bool -> ?net_id:Net_id.t ->
?async:bool -> ?force:bool -> ?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list ->
Block_hash.t tzresult Lwt.t
(** [inject_block cctxt ?async ?force raw_block] tries to inject
@ -28,7 +28,7 @@ val inject_block:
val inject_operation:
#simple ->
?async:bool -> ?net_id:Net_id.t ->
?async:bool -> ?chain_id:Chain_id.t ->
MBytes.t ->
Operation_hash.t tzresult Lwt.t
@ -56,7 +56,7 @@ module S : sig
raw: MBytes.t ;
blocking: bool ;
force: bool ;
net_id: Net_id.t option ;
chain_id: Chain_id.t option ;
operations: Operation.t list list ;
}
@ -67,7 +67,7 @@ module S : sig
val inject_operation:
([ `POST ], unit,
unit, unit, (MBytes.t * bool * Net_id.t option),
unit, unit, (MBytes.t * bool * Chain_id.t option),
Operation_hash.t) RPC_service.t
val inject_protocol:

48
src/lib_shell_services/worker_services.ml
View File

@ -13,11 +13,11 @@ module Prevalidators = struct
module S = struct
let (net_id_arg : Net_id.t RPC_arg.t) =
let (chain_id_arg : Chain_id.t RPC_arg.t) =
RPC_arg.like
Net_id.rpc_arg
~descr:"The network identifier of whom the prevalidator is responsible."
"net_id"
Chain_id.rpc_arg
~descr:"The chain identifier of whom the prevalidator is responsible."
"chain_id"
let list =
RPC_service.post_service
@ -27,7 +27,7 @@ module Prevalidators = struct
~output:
(list
(obj2
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(req "status" (Worker_types.worker_status_encoding RPC_error.encoding))))
RPC_path.(root / "workers" / "prevalidators")
@ -42,7 +42,7 @@ module Prevalidators = struct
Prevalidator_worker_state.Request.encoding
Prevalidator_worker_state.Event.encoding
RPC_error.encoding)
RPC_path.(root / "workers" / "prevalidators" /: Net_id.rpc_arg )
RPC_path.(root / "workers" / "prevalidators" /: Chain_id.rpc_arg )
end
@ -80,11 +80,11 @@ module Peer_validators = struct
module S = struct
let (net_id_arg : Net_id.t RPC_arg.t) =
let (chain_id_arg : Chain_id.t RPC_arg.t) =
RPC_arg.like
Net_id.rpc_arg
~descr:"The network identifier the peer validator is associated to."
"net_id"
Chain_id.rpc_arg
~descr:"The chain identifier the peer validator is associated to."
"chain_id"
let (peer_id_arg : P2p_peer.Id.t RPC_arg.t) =
RPC_arg.make
@ -106,7 +106,7 @@ module Peer_validators = struct
(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)
RPC_path.(root / "workers" / "peer_validators" /: chain_id_arg)
let state =
let open Data_encoding in
@ -119,7 +119,7 @@ module Peer_validators = struct
Peer_validator_worker_state.Request.encoding
Peer_validator_worker_state.Event.encoding
RPC_error.encoding)
RPC_path.(root / "workers" / "peer_validators" /: net_id_arg /: peer_id_arg)
RPC_path.(root / "workers" / "peer_validators" /: chain_id_arg /: peer_id_arg)
end
@ -129,39 +129,39 @@ module Peer_validators = struct
end
module Net_validators = struct
module Chain_validators = struct
module S = struct
let (net_id_arg : Net_id.t RPC_arg.t) =
let (chain_id_arg : Chain_id.t RPC_arg.t) =
RPC_arg.like
Net_id.rpc_arg
~descr:"The network identifier of whom the net validator is responsible."
"net_id"
Chain_id.rpc_arg
~descr:"The chain identifier of whom the chain validator is responsible."
"chain_id"
let list =
RPC_service.post_service
~description:"Lists the net validator workers and their status."
~description:"Lists the chain validator workers and their status."
~query: RPC_query.empty
~input: empty
~output:
(list
(obj2
(req "net_id" Net_id.encoding)
(req "chain_id" Chain_id.encoding)
(req "status" (Worker_types.worker_status_encoding RPC_error.encoding))))
RPC_path.(root / "workers" / "net_validators")
RPC_path.(root / "workers" / "chain_validators")
let state =
let open Data_encoding in
RPC_service.post_service
~description:"Introspect the state of a net validator worker."
~description:"Introspect the state of a chain validator worker."
~query: RPC_query.empty
~input: empty
~output:
(Worker_types.full_status_encoding
Net_validator_worker_state.Request.encoding
Net_validator_worker_state.Event.encoding
Chain_validator_worker_state.Request.encoding
Chain_validator_worker_state.Event.encoding
RPC_error.encoding)
RPC_path.(root / "workers" / "net_validators" /: net_id_arg )
RPC_path.(root / "workers" / "chain_validators" /: chain_id_arg )
end

28
src/lib_shell_services/worker_services.mli
View File

@ -14,20 +14,20 @@ module Prevalidators : sig
open Prevalidator_worker_state
val list:
#simple -> (Net_id.t * Worker_types.worker_status) list tzresult Lwt.t
#simple -> (Chain_id.t * Worker_types.worker_status) list tzresult Lwt.t
val state:
#simple -> Net_id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
#simple -> Chain_id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
module S : sig
val list :
([ `POST ], unit,
unit, unit, unit,
(Net_id.t * Worker_types.worker_status) list) RPC_service.t
(Chain_id.t * Worker_types.worker_status) list) RPC_service.t
val state :
([ `POST ], unit,
unit * Net_id.t, unit, unit,
unit * Chain_id.t, unit, unit,
(Request.view, Event.t) Worker_types.full_status) RPC_service.t
end
@ -57,48 +57,48 @@ module Peer_validators : sig
open Peer_validator_worker_state
val list:
#simple -> Net_id.t ->
#simple -> Chain_id.t ->
(P2p_peer.Id.t * Worker_types.worker_status) list tzresult Lwt.t
val state:
#simple ->
Net_id.t -> P2p_peer.Id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
Chain_id.t -> P2p_peer.Id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
module S : sig
val list :
([ `POST ], unit,
unit * Net_id.t, unit, unit,
unit * Chain_id.t, unit, unit,
(P2p_peer.Id.t * Worker_types.worker_status) list) RPC_service.t
val state :
([ `POST ], unit,
(unit * Net_id.t) * P2p_peer.Id.t, unit, unit,
(unit * Chain_id.t) * P2p_peer.Id.t, unit, unit,
(Request.view, Event.t) Worker_types.full_status) RPC_service.t
end
end
module Net_validators : sig
module Chain_validators : sig
open Net_validator_worker_state
open Chain_validator_worker_state
val list:
#simple -> (Net_id.t * Worker_types.worker_status) list tzresult Lwt.t
#simple -> (Chain_id.t * Worker_types.worker_status) list tzresult Lwt.t
val state:
#simple -> Net_id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
#simple -> Chain_id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
module S : sig
val list :
([ `POST ], unit,
unit, unit, unit,
(Net_id.t * Worker_types.worker_status) list) RPC_service.t
(Chain_id.t * Worker_types.worker_status) list) RPC_service.t
val state :
([ `POST ], unit,
unit * Net_id.t, unit, unit,
unit * Chain_id.t, unit, unit,
(Request.view, Event.t) Worker_types.full_status) RPC_service.t
end

2
src/lib_stdlib/logging.ml
View File

@ -67,7 +67,7 @@ module Make(S : sig val name: string end) : LOG = struct
end
module Core = Make(struct let name = "core" end)
module Net = Make(struct let name = "net" end)
module P2p = Make(struct let name = "p2p" end)
module RPC = Make(struct let name = "rpc" end)
module Db = Make(struct let name = "db" end)
module Updater = Make(struct let name = "updater" end)

2
src/lib_stdlib/logging.mli
View File

@ -26,7 +26,7 @@ module type LOG = sig
end
module Core : LOG
module Net : LOG
module P2p : LOG
module RPC : LOG
module Db : LOG
module Updater : LOG

68
src/lib_storage/context.ml
View File

@ -89,7 +89,7 @@ type t = context
(*-- Version Access and Update -----------------------------------------------*)
let current_protocol_key = ["protocol"]
let current_test_network_key = ["test_network"]
let current_test_chain_key = ["test_chain"]
let exists index key =
GitStore.Commit.of_hash index.repo key >>= function
@ -178,21 +178,21 @@ let get_protocol v =
let set_protocol v key =
raw_set v current_protocol_key (Protocol_hash.to_bytes key)
let get_test_network v =
raw_get v current_test_network_key >>= function
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
let get_test_chain v =
raw_get v current_test_chain_key >>= function
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_chain)")
| Some data ->
match Data_encoding.Binary.of_bytes Test_network_status.encoding data with
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
match Data_encoding.Binary.of_bytes Test_chain_status.encoding data with
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_chain)")
| Some r -> Lwt.return r
let set_test_network v id =
raw_set v current_test_network_key
(Data_encoding.Binary.to_bytes Test_network_status.encoding id)
let del_test_network v = raw_del v current_test_network_key
let set_test_chain v id =
raw_set v current_test_chain_key
(Data_encoding.Binary.to_bytes Test_chain_status.encoding id)
let del_test_chain v = raw_del v current_test_chain_key
let fork_test_network v ~protocol ~expiration =
set_test_network v (Forking { protocol ; expiration })
let fork_test_chain v ~protocol ~expiration =
set_test_chain v (Forking { protocol ; expiration })
(*-- Initialisation ----------------------------------------------------------*)
@ -208,53 +208,53 @@ let init ?patch_context ~root =
| Some patch_context -> patch_context
}
let get_branch net_id = Format.asprintf "%a" Net_id.pp net_id
let get_branch chain_id = Format.asprintf "%a" Chain_id.pp chain_id
let commit_genesis index ~net_id ~time ~protocol =
let commit_genesis index ~chain_id ~time ~protocol =
let tree = GitStore.Tree.empty in
let ctxt = { index ; tree ; parents = [] } in
index.patch_context ctxt >>= fun ctxt ->
set_protocol ctxt protocol >>= fun ctxt ->
set_test_network ctxt Not_running >>= fun ctxt ->
set_test_chain ctxt Not_running >>= fun ctxt ->
raw_commit ~time ~message:"Genesis" ctxt >>= fun commit ->
GitStore.Branch.set index.repo (get_branch net_id) commit >>= fun () ->
GitStore.Branch.set index.repo (get_branch chain_id) commit >>= fun () ->
Lwt.return (GitStore.Commit.hash commit)
let compute_testnet_genesis forked_block =
let compute_testchain_genesis forked_block =
let genesis = Block_hash.hash_bytes [Block_hash.to_bytes forked_block] in
let net_id = Net_id.of_block_hash genesis in
net_id, genesis
let chain_id = Chain_id.of_block_hash genesis in
chain_id, genesis
let commit_test_network_genesis index forked_block time ctxt =
let net_id, genesis = compute_testnet_genesis forked_block in
let branch = get_branch net_id in
let message = Format.asprintf "Forking testnet: %s." branch in
let commit_test_chain_genesis index forked_block time ctxt =
let chain_id, genesis = compute_testchain_genesis forked_block in
let branch = get_branch chain_id in
let message = Format.asprintf "Forking testchain: %s." branch in
raw_commit ~time ~message ctxt >>= fun commit ->
GitStore.Branch.set index.repo branch commit >>= fun () ->
return (net_id, genesis, GitStore.Commit.hash commit)
return (chain_id, genesis, GitStore.Commit.hash commit)
let reset_test_network ctxt forked_block timestamp =
get_test_network ctxt >>= function
let reset_test_chain ctxt forked_block timestamp =
get_test_chain ctxt >>= function
| Not_running -> Lwt.return ctxt
| Running { expiration } ->
if Time.(expiration <= timestamp) then
set_test_network ctxt Not_running
set_test_chain ctxt Not_running
else
Lwt.return ctxt
| Forking { protocol ; expiration } ->
let net_id, genesis = compute_testnet_genesis forked_block in
set_test_network ctxt
(Running { net_id ; genesis ;
let chain_id, genesis = compute_testchain_genesis forked_block in
set_test_chain ctxt
(Running { chain_id ; genesis ;
protocol ; expiration })
let clear_test_network index net_id =
let clear_test_chain index chain_id =
(* TODO remove commits... ??? *)
let branch = get_branch net_id in
let branch = get_branch chain_id in
GitStore.Branch.remove index.repo branch
let set_head index net_id commit =
let branch = get_branch net_id in
let set_head index chain_id commit =
let branch = get_branch chain_id in
GitStore.Commit.of_hash index.repo commit >>= function
| None -> assert false
| Some commit ->

20
src/lib_storage/context.mli
View File

@ -24,14 +24,14 @@ val init:
val commit_genesis:
index ->
net_id:Net_id.t ->
chain_id:Chain_id.t ->
time:Time.t ->
protocol:Protocol_hash.t ->
Context_hash.t Lwt.t
val commit_test_network_genesis:
val commit_test_chain_genesis:
index -> Block_hash.t -> Time.t -> context ->
(Net_id.t * Block_hash.t * Context_hash.t) tzresult Lwt.t
(Chain_id.t * Block_hash.t * Context_hash.t) tzresult Lwt.t
(** {2 Generic interface} ****************************************************)
@ -60,7 +60,7 @@ val commit:
?message:string ->
context ->
Context_hash.t Lwt.t
val set_head: index -> Net_id.t -> Context_hash.t -> unit Lwt.t
val set_head: index -> Chain_id.t -> Context_hash.t -> unit Lwt.t
val set_master: index -> Context_hash.t -> unit Lwt.t
(** {2 Predefined Fields} ****************************************************)
@ -68,13 +68,13 @@ val set_master: index -> Context_hash.t -> unit Lwt.t
val get_protocol: context -> Protocol_hash.t Lwt.t
val set_protocol: context -> Protocol_hash.t -> context Lwt.t
val get_test_network: context -> Test_network_status.t Lwt.t
val set_test_network: context -> Test_network_status.t -> context Lwt.t
val get_test_chain: context -> Test_chain_status.t Lwt.t
val set_test_chain: context -> Test_chain_status.t -> context Lwt.t
val del_test_network: context -> context Lwt.t
val del_test_chain: context -> context Lwt.t
val reset_test_network: context -> Block_hash.t -> Time.t -> context Lwt.t
val reset_test_chain: context -> Block_hash.t -> Time.t -> context Lwt.t
val fork_test_network:
val fork_test_chain:
context -> protocol:Protocol_hash.t -> expiration:Time.t -> context Lwt.t
val clear_test_network: index -> Net_id.t -> unit Lwt.t
val clear_test_chain: index -> Chain_id.t -> unit Lwt.t

29
src/lib_storage/test/assert.ml
View File

@ -23,12 +23,6 @@ let equal_string_option ?msg o1 o2 =
| Some s -> s in
equal ?msg ~prn o1 o2
let is_false ?(msg="") x =
if x then fail "false" "true" msg
let is_true ?(msg="") x =
if not x then fail "true" "false" msg
let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg
@ -48,32 +42,9 @@ let make_equal_list eq prn ?(msg="") x y =
() in
iter 0 x y
let equal_string_list ?msg l1 l2 =
make_equal_list ?msg (=) (fun x -> x) l1 l2
let equal_string_list_list ?msg l1 l2 =
let pr_persist l =
let res =
String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
Printf.sprintf "[%s]" res in
make_equal_list ?msg (=) pr_persist l1 l2
let equal_block_set ?msg set1 set2 =
let b1 = Block_hash.Set.elements set1
and b2 = Block_hash.Set.elements set2 in
make_equal_list ?msg
(fun h1 h2 -> Block_hash.equal h1 h2)
Block_hash.to_string
b1 b2
let equal_block_map ?msg ~eq map1 map2 =
let b1 = Block_hash.Map.bindings map1
and b2 = Block_hash.Map.bindings map2 in
make_equal_list ?msg
(fun (h1, b1) (h2, b2) -> Block_hash.equal h1 h2 && eq b1 b2)
(fun (h1, _) -> Block_hash.to_string h1)
b1 b2
let equal_block_hash_list ?msg l1 l2 =
let pr_block_hash = Block_hash.to_short_b58check in
make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2

1
src/lib_storage/test/test.ml
View File

@ -9,6 +9,5 @@
let () =
Alcotest.run "tezos-storage" [
"store", Test_store.tests ;
"context", Test_context.tests ;
]

4
src/lib_storage/test/test_context.ml
View File

@ -26,7 +26,7 @@ let genesis_protocol =
let genesis_time =
Time.of_seconds 0L
let net_id = Net_id.of_block_hash genesis_block
let chain_id = Chain_id.of_block_hash genesis_block
(** Context creation *)
@ -89,7 +89,7 @@ let wrap_context_init f _ () =
let root = base_dir // "context" in
Context.init ~root ?patch_context:None >>= fun idx ->
Context.commit_genesis idx
~net_id
~chain_id
~time:genesis_time
~protocol:genesis_protocol >>= fun genesis ->
create_block2 idx genesis >>= fun block2 ->

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

@ -12,7 +12,7 @@ open Alpha_context
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
predecessor: Block_hash.t ;
fitness: MBytes.t list ;
timestamp: Time.t ;
@ -21,22 +21,22 @@ type block_info = {
}
let convert_block_info cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) =
Alpha_services.Context.level cctxt (`Hash hash) >>= function
| Ok level ->
Lwt.return
(Some { hash ; net_id ; predecessor ;
(Some { hash ; chain_id ; predecessor ;
fitness ; timestamp ; protocol ; level })
| Error _ ->
(* TODO log error *)
Lwt.return_none
let convert_block_info_err cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) =
Alpha_services.Context.level cctxt (`Hash hash) >>=? fun level ->
return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level }
return { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol ; level }
let info cctxt ?include_ops block =
Block_services.info cctxt ?include_ops block >>=? fun block ->

2
src/proto_alpha/lib_baking/client_baking_blocks.mli
View File

@ -12,7 +12,7 @@ open Alpha_context
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
chain_id: Chain_id.t ;
predecessor: Block_hash.t ;
fitness: MBytes.t list ;
timestamp: Time.t ;

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

@ -105,7 +105,7 @@ let inject_endorsement (cctxt : #Proto_alpha.full_context)
() >>=? fun bytes ->
Client_keys.append src_sk bytes >>=? fun signed_bytes ->
Shell_services.inject_operation
cctxt ?async ~net_id:bi.net_id signed_bytes >>=? fun oph ->
cctxt ?async ~chain_id:bi.chain_id signed_bytes >>=? fun oph ->
State.record_endorsement cctxt level bi.hash slot oph >>=? fun () ->
return oph

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

@ -61,14 +61,14 @@ let assert_valid_operations_hash shell_header operations =
inconsistent header.")
let inject_block cctxt
?force ?net_id
?force ?chain_id
~shell_header ~priority ~seed_nonce_hash ~src_sk operations =
assert_valid_operations_hash shell_header operations >>=? fun () ->
let block = `Hash shell_header.Tezos_base.Block_header.predecessor in
forge_block_header cctxt block
src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
Shell_services.inject_block cctxt
?force ?net_id signed_header operations >>=? fun block_hash ->
?force ?chain_id signed_header operations >>=? fun block_hash ->
return block_hash
type error +=
@ -194,9 +194,9 @@ let forge_block cctxt block
let operations =
if not best_effort then operations
else List.map (fun l -> List.map snd l.Preapply_result.applied) result in
Block_services.info cctxt block >>=? fun {net_id} ->
Block_services.info cctxt block >>=? fun {chain_id} ->
inject_block cctxt
?force ~net_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
?force ~chain_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
operations
else
let result =
@ -527,7 +527,7 @@ let bake (cctxt : #Proto_alpha.full_context) state =
Fitness.pp shell_header.fitness >>= fun () ->
Client_keys.get_key cctxt delegate >>=? fun (_,_,src_sk) ->
inject_block cctxt
~force:true ~net_id:bi.net_id
~force:true ~chain_id:bi.chain_id
~shell_header ~priority ~seed_nonce_hash ~src_sk
[List.map snd operations.applied]
|> trace_exn (Failure "Error while injecting block") >>=? fun block_hash ->

2
src/proto_alpha/lib_baking/client_baking_forge.mli
View File

@ -19,7 +19,7 @@ val generate_seed_nonce: unit -> Nonce.t
val inject_block:
#Proto_alpha.rpc_context ->
?force:bool ->
?net_id:Net_id.t ->
?chain_id:Chain_id.t ->
shell_header:Block_header.shell_header ->
priority:int ->
seed_nonce_hash:Nonce_hash.t ->

4
src/proto_alpha/lib_baking/client_baking_operations.ml
View File

@ -50,7 +50,7 @@ let filter_valid_endorsement cctxt ({ hash ; content } : operation) =
| Some { contents = Sourced_operations (Dictator_operation _ ) }
| Some { contents = Sourced_operations (Manager_operations _ ) } ->
Lwt.return_none
| Some { shell = {net_id} ;
| Some { shell = {chain_id} ;
contents =
Sourced_operations (Delegate_operations { source ; operations }) } ->
let source = Ed25519.Public_key.hash source in
@ -72,7 +72,7 @@ let filter_valid_endorsement cctxt ({ hash ; content } : operation) =
slots in
(* Ensure thath the block has been previously validated by
the node. This might took some times... *)
Client_node_rpcs.validate_block cctxt net_id block >>= function
Client_node_rpcs.validate_block cctxt chain_id block >>= function
| Error error ->
lwt_log_info
"@[<v 2>Found endorsement for an invalid block@,%a@["

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

@ -20,7 +20,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
Alpha_services.Forge.Anonymous.operations rpc_config
block ~branch:bi.hash operations >>=? fun bytes ->
Shell_services.inject_operation
rpc_config ?async ~net_id:bi.net_id
rpc_config ?async ~chain_id:bi.chain_id
bytes >>=? fun oph ->
return oph

30
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -36,8 +36,8 @@ let get_branch rpc_config block branch =
| `Hash h -> find_predecessor rpc_config h branch
| `Genesis -> return `Genesis
end >>=? fun block ->
Block_services.info rpc_config block >>=? fun { net_id ; hash } ->
return (net_id, hash)
Block_services.info rpc_config block >>=? fun { chain_id ; hash } ->
return (chain_id, hash)
let parse_expression arg =
Lwt.return
@ -47,7 +47,7 @@ let parse_expression arg =
let transfer rpc_config
block ?branch
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
get_branch rpc_config block branch >>=? fun (chain_id, branch) ->
begin match arg with
| Some arg ->
parse_expression arg >>=? fun { expanded = arg } ->
@ -69,11 +69,11 @@ let transfer rpc_config
Alpha_services.Helpers.apply_operation rpc_config block
predecessor oph bytes (Some signature) >>=? fun contracts ->
Shell_services.inject_operation
rpc_config ~net_id signed_bytes >>=? fun injected_oph ->
rpc_config ~chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return (oph, contracts)
let originate rpc_config ?net_id ~block ?signature bytes =
let originate rpc_config ?chain_id ~block ?signature bytes =
let signed_bytes =
match signature with
| None -> bytes
@ -84,7 +84,7 @@ let originate rpc_config ?net_id ~block ?signature bytes =
predecessor oph bytes signature >>=? function
| [ contract ] ->
Shell_services.inject_operation
rpc_config ?net_id signed_bytes >>=? fun injected_oph ->
rpc_config ?chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return (oph, contract)
| contracts ->
@ -105,7 +105,7 @@ let operation_submitted_message (cctxt : #Client_context.logger) ?(contracts = [
let originate_account ?branch
~source ~src_pk ~src_sk ~manager_pkh
?delegatable ?delegate ~balance ~fee block rpc_config () =
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
get_branch rpc_config block branch >>=? fun (chain_id, branch) ->
Alpha_services.Contract.counter
rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
@ -114,20 +114,20 @@ let originate_account ?branch
~counter ~balance ~spendable:true
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
Client_keys.sign src_sk bytes >>=? fun signature ->
originate rpc_config ~block ~net_id ~signature bytes
originate rpc_config ~block ~chain_id ~signature bytes
let faucet ?branch ~manager_pkh block rpc_config () =
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
get_branch rpc_config block branch >>=? fun (chain_id, branch) ->
let nonce = Rand.generate Constants_repr.nonce_length in
Alpha_services.Forge.Anonymous.faucet
rpc_config block ~branch ~id:manager_pkh ~nonce () >>=? fun bytes ->
originate rpc_config ~net_id ~block bytes
originate rpc_config ~chain_id ~block bytes
let delegate_contract rpc_config
block ?branch
~source ?src_pk ~manager_sk
~fee delegate_opt =
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
get_branch rpc_config block branch >>=? fun (chain_id, branch) ->
Alpha_services.Contract.counter
rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
@ -138,7 +138,7 @@ let delegate_contract rpc_config
let signed_bytes = Ed25519.Signature.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Shell_services.inject_operation
rpc_config ~net_id signed_bytes >>=? fun injected_oph ->
rpc_config ~chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return oph
@ -180,14 +180,14 @@ let get_manager (cctxt : #Proto_alpha.full_context) block source =
let dictate rpc_config block command seckey =
let block = Block_services.last_baked_block block in
Block_services.info
rpc_config block >>=? fun { net_id ; hash = branch } ->
rpc_config block >>=? fun { chain_id ; hash = branch } ->
Alpha_services.Forge.Dictator.operation
rpc_config block ~branch command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in
let signed_bytes = Ed25519.Signature.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Shell_services.inject_operation
rpc_config ~net_id signed_bytes >>=? fun injected_oph ->
rpc_config ~chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return oph
@ -225,7 +225,7 @@ let originate_contract
Alpha_services.Contract.counter
cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
get_branch cctxt block None >>=? fun (_net_id, branch) ->
get_branch cctxt block None >>=? fun (_chain_id, branch) ->
Alpha_services.Forge.Manager.origination cctxt block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager
~counter ~balance ~spendable:spendable

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

@ -272,7 +272,7 @@ let commands () =
@@ stop)
begin fun () hash seckey cctxt ->
dictate cctxt cctxt#block
(Activate_testnet hash) seckey >>=? fun oph ->
(Activate_testchain hash) seckey >>=? fun oph ->
operation_submitted_message cctxt oph
end ;

2
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -148,7 +148,7 @@ let finalize ?commit_message:message c =
let configure_sandbox = Raw_context.configure_sandbox
let activate = Raw_context.activate
let fork_test_network = Raw_context.fork_test_network
let fork_test_chain = Raw_context.fork_test_chain
let faucet_count = Raw_context.faucet_count
let incr_faucet_count = Raw_context.incr_faucet_count

4
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -599,7 +599,7 @@ and delegate_operation =
and dictator_operation =
| Activate of Protocol_hash.t
| Activate_testnet of Protocol_hash.t
| Activate_testchain of Protocol_hash.t
and counter = Int32.t
@ -730,7 +730,7 @@ val configure_sandbox:
Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
val activate: context -> Protocol_hash.t -> context Lwt.t
val fork_test_network: context -> Protocol_hash.t -> Time.t -> context Lwt.t
val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
val endorsement_already_recorded: context -> int -> bool
val record_endorsement: context -> int -> context

2
src/proto_alpha/lib_protocol/src/amendment.ml
View File

@ -72,7 +72,7 @@ let start_new_voting_cycle ctxt =
let expiration = (* in two days maximum... *)
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
Vote.get_current_proposal ctxt >>=? fun proposal ->
fork_test_network ctxt proposal expiration >>= fun ctxt ->
fork_test_chain ctxt proposal expiration >>= fun ctxt ->
Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
return ctxt
else

4
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -234,12 +234,12 @@ let apply_sourced_operation
Operation.check_signature dictator_pubkey operation >>=? fun () ->
activate ctxt hash >>= fun ctxt ->
return (ctxt, origination_nonce, None)
| Dictator_operation (Activate_testnet hash) ->
| Dictator_operation (Activate_testchain hash) ->
let dictator_pubkey = Constants.dictator_pubkey ctxt in
Operation.check_signature dictator_pubkey operation >>=? fun () ->
let expiration = (* in two days maximum... *)
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
fork_test_network ctxt hash expiration >>= fun ctxt ->
fork_test_chain ctxt hash expiration >>= fun ctxt ->
return (ctxt, origination_nonce, None)
let apply_anonymous_operation ctxt baker_contract origination_nonce kind =

Some files were not shown because too many files have changed in this diff Show More