Shell: Rename net_id into chain_id

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -9,13 +9,13 @@
type t = { type t = {
data_dir : string ; data_dir : string ;
net : net ; p2p : p2p ;
rpc : rpc ; rpc : rpc ;
log : log ; log : log ;
shell : shell ; shell : shell ;
} }
and net = { and p2p = {
expected_pow : float ; expected_pow : float ;
bootstrap_peers : string list ; bootstrap_peers : string list ;
listen_addr : string option ; listen_addr : string option ;
@ -46,13 +46,13 @@ and shell = {
block_validator_limits : Node.block_validator_limits ; block_validator_limits : Node.block_validator_limits ;
prevalidator_limits : Node.prevalidator_limits ; prevalidator_limits : Node.prevalidator_limits ;
peer_validator_limits : Node.peer_validator_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_data_dir: string
val default_net_port: int val default_p2p_port: int
val default_rpc_port: int val default_rpc_port: int
val default_net: net val default_p2p: p2p
val default_config: t val default_config: t
val update: val update:

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 ; Format.printf "Peer_id: %a.@." P2p_peer.Id.pp id.peer_id ;
return () 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 let identity_file = identity_file data_dir in
if Sys.file_exists identity_file then if Sys.file_exists identity_file then
fail (Node_identity_file.Existent_identity_file identity_file) fail (Node_identity_file.Existent_identity_file identity_file)
else else
let target = Crypto_box.make_target net.expected_pow in let target = Crypto_box.make_target p2p.expected_pow in
Format.eprintf "Generating a new identity... (level: %.2f) " net.expected_pow ; Format.eprintf "Generating a new identity... (level: %.2f) " p2p.expected_pow ;
let id = let id =
P2p_identity.generate_with_animation Format.err_formatter target in P2p_identity.generate_with_animation Format.err_formatter target in
Node_identity_file.write identity_file id >>=? fun () -> 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 ; P2p_peer.Id.pp id.peer_id identity_file ;
return () 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 Node_identity_file.read
~expected_pow (identity_file data_dir) >>=? fun id -> ~expected_pow (identity_file data_dir) >>=? fun id ->
Format.printf Format.printf

View File

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

View File

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

View File

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

View File

@ -52,7 +52,7 @@ module type UPDATER = sig
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t 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 Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
end end

View File

@ -45,7 +45,7 @@ module type UPDATER = sig
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t 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 Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
end end

View File

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

View File

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

View File

@ -33,7 +33,7 @@ module Block_header = Block_header
module Operation = Operation module Operation = Operation
module Protocol = Protocol module Protocol = Protocol
module Net_id = Net_id module Chain_id = Chain_id
module Block_hash = Block_hash module Block_hash = Block_hash
module Operation_hash = Operation_hash module Operation_hash = Operation_hash
module Operation_list_hash = Operation_list_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 Context_hash = Context_hash
module Protocol_hash = Protocol_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 Preapply_result = Preapply_result
module Block_locator = Block_locator module Block_locator = Block_locator

View File

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

View File

@ -16,7 +16,7 @@ module Unencrypted_signer : SIGNER = struct
"Built-in signer using raw unencrypted keys." "Built-in signer using raw unencrypted keys."
let description = 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 \ The format for importing secret keys is either no argument (will \
generate a key) or the raw Base58-encoded key (starting with \ generate a key) or the raw Base58-encoded key (starting with \
'edsk').\n\ 'edsk').\n\

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -11,7 +11,7 @@
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t 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 Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
val init: string -> unit val init: string -> unit

View File

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

View File

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

View File

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

View File

@ -24,7 +24,7 @@ val validate:
?canceler:Lwt_canceler.t -> ?canceler:Lwt_canceler.t ->
?peer:P2p_peer.Id.t -> ?peer:P2p_peer.Id.t ->
?notify_new_block:(State.Block.t -> unit) -> ?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 -> Block_hash.t -> Block_header.t -> Operation.t list list ->
State.Block.t tzresult Lwt.t State.Block.t tzresult Lwt.t

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -21,16 +21,16 @@ val create:
Block_validator.t -> Block_validator.t ->
State.Block.t Lwt_watcher.input -> State.Block.t Lwt_watcher.input ->
Distributed_db.t -> Distributed_db.t ->
State.Net.t -> State.Chain.t ->
limits -> limits ->
t Lwt.t t Lwt.t
val bootstrapped: t -> unit Lwt.t val bootstrapped: t -> unit Lwt.t
val net_id: t -> Net_id.t val chain_id: t -> Chain_id.t
val net_state: t -> State.Net.t val chain_state: t -> State.Chain.t
val prevalidator: t -> Prevalidator.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 child: t -> t option
val validate_block: 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 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 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 status: t -> Worker_types.worker_status
val pending_requests : t -> (Time.t * Net_validator_worker_state.Request.view) list val pending_requests : t -> (Time.t * Chain_validator_worker_state.Request.view) list
val current_request : t -> (Time.t * Time.t * Net_validator_worker_state.Request.view) option val current_request : t -> (Time.t * Time.t * Chain_validator_worker_state.Request.view) option
val last_events : t -> (Lwt_log_core.level * Net_validator_worker_state.Event.t list) list val last_events : t -> (Lwt_log_core.level * Chain_validator_worker_state.Event.t list) list

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -27,13 +27,13 @@ val create:
?notify_termination: (unit -> unit) -> ?notify_termination: (unit -> unit) ->
limits -> limits ->
Block_validator.t -> 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 shutdown: t -> unit Lwt.t
val notify_branch: t -> Block_locator.t -> unit val notify_branch: t -> Block_locator.t -> unit
val notify_head: t -> Block_header.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 status: t -> Worker_types.worker_status
val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option

View File

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

View File

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

View File

@ -36,9 +36,9 @@ type limits = {
worker_limits : Worker_types.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 shutdown: t -> unit Lwt.t
val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit
val inject_operation: t -> Operation.t -> unit tzresult Lwt.t 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 context: t -> Updater.validation_result tzresult Lwt.t
val pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t 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 status: t -> Worker_types.worker_status
val pending_requests : t -> (Time.t * Prevalidator_worker_state.Request.view) list val pending_requests : t -> (Time.t * Prevalidator_worker_state.Request.view) list

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 _ -> fetch_and_compile_protocol pv ?peer ?timeout protocol_hash >>=? fun _ ->
return () return ()
and test_protocol = and test_protocol =
Context.get_test_network context >>= function Context.get_test_chain context >>= function
| Not_running -> return () | Not_running -> return ()
| Forking { protocol } | Forking { protocol }
| Running { protocol } -> | Running { protocol } ->

View File

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

View File

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

View File

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

View File

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

View File

@ -39,3 +39,55 @@ let equal_block ?msg st1 st2 =
| None -> "none" | None -> "none"
| Some st -> Block_hash.to_hex (Block_header.hash st) in | Some st -> Block_hash.to_hex (Block_header.hash st) in
equal ?msg ~prn ~eq st1 st2 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

View File

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

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

View File

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

View File

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

View File

@ -54,7 +54,7 @@ let wrap_raw_store_init f _ () =
let test_init _ = Lwt.return_unit 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 *) (** Operation store *)
@ -120,7 +120,7 @@ let check_block s h b =
exit 1 exit 1
let test_block s = 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 let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () -> Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () -> Block.Contents.store (s, bh2) b2 >>= fun () ->
@ -130,7 +130,7 @@ let test_block s =
check_block s bh3 b3 check_block s bh3 b3
let test_expand s = 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 let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () -> Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () -> Block.Contents.store (s, bh2) b2 >>= fun () ->

View File

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

View File

@ -17,33 +17,33 @@ val create:
Peer_validator.limits -> Peer_validator.limits ->
Block_validator.limits -> Block_validator.limits ->
Prevalidator.limits -> Prevalidator.limits ->
Net_validator.limits -> Chain_validator.limits ->
t Lwt.t t Lwt.t
val shutdown: t -> unit 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: val activate:
t -> t ->
?max_child_ttl:int -> ?max_child_ttl:int ->
State.Net.t -> Net_validator.t Lwt.t State.Chain.t -> Chain_validator.t Lwt.t
type error += type error +=
| Inactive_network of Net_id.t | Inactive_chain of Chain_id.t
val get: t -> Net_id.t -> Net_validator.t tzresult Lwt.t val get: t -> Chain_id.t -> Chain_validator.t tzresult Lwt.t
val get_exn: t -> Net_id.t -> Net_validator.t Lwt.t val get_exn: t -> Chain_id.t -> Chain_validator.t Lwt.t
(** Force the validation of a block. *) (** Force the validation of a block. *)
val validate_block: val validate_block:
t -> t ->
?force:bool -> ?force:bool ->
?net_id:Net_id.t -> ?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list -> MBytes.t -> Operation.t list list ->
(Block_hash.t * State.Block.t tzresult Lwt.t) tzresult Lwt.t (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 watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
val inject_operation: val inject_operation:
t -> t ->
?net_id:Net_id.t -> ?chain_id:Chain_id.t ->
Operation.t -> unit tzresult Lwt.t Operation.t -> unit tzresult Lwt.t

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -67,7 +67,7 @@ module Make(S : sig val name: string end) : LOG = struct
end end
module Core = Make(struct let name = "core" 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 RPC = Make(struct let name = "rpc" end)
module Db = Make(struct let name = "db" end) module Db = Make(struct let name = "db" end)
module Updater = Make(struct let name = "updater" end) module Updater = Make(struct let name = "updater" end)

View File

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

View File

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

View File

@ -24,14 +24,14 @@ val init:
val commit_genesis: val commit_genesis:
index -> index ->
net_id:Net_id.t -> chain_id:Chain_id.t ->
time:Time.t -> time:Time.t ->
protocol:Protocol_hash.t -> protocol:Protocol_hash.t ->
Context_hash.t Lwt.t Context_hash.t Lwt.t
val commit_test_network_genesis: val commit_test_chain_genesis:
index -> Block_hash.t -> Time.t -> context -> 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} ****************************************************) (** {2 Generic interface} ****************************************************)
@ -60,7 +60,7 @@ val commit:
?message:string -> ?message:string ->
context -> context ->
Context_hash.t Lwt.t 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 val set_master: index -> Context_hash.t -> unit Lwt.t
(** {2 Predefined Fields} ****************************************************) (** {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 get_protocol: context -> Protocol_hash.t Lwt.t
val set_protocol: context -> Protocol_hash.t -> context Lwt.t val set_protocol: context -> Protocol_hash.t -> context Lwt.t
val get_test_network: context -> Test_network_status.t Lwt.t val get_test_chain: context -> Test_chain_status.t Lwt.t
val set_test_network: context -> Test_network_status.t -> context 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 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

View File

@ -23,12 +23,6 @@ let equal_string_option ?msg o1 o2 =
| Some s -> s in | Some s -> s in
equal ?msg ~prn o1 o2 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 = let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg if x <> None then fail "None" "Some _" msg
@ -48,32 +42,9 @@ let make_equal_list eq prn ?(msg="") x y =
() in () in
iter 0 x y 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 equal_string_list_list ?msg l1 l2 =
let pr_persist l = let pr_persist l =
let res = let res =
String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
Printf.sprintf "[%s]" res in Printf.sprintf "[%s]" res in
make_equal_list ?msg (=) pr_persist l1 l2 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

View File

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

View File

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

View File

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

View File

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

View File

@ -105,7 +105,7 @@ let inject_endorsement (cctxt : #Proto_alpha.full_context)
() >>=? fun bytes -> () >>=? fun bytes ->
Client_keys.append src_sk bytes >>=? fun signed_bytes -> Client_keys.append src_sk bytes >>=? fun signed_bytes ->
Shell_services.inject_operation 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 () -> State.record_endorsement cctxt level bi.hash slot oph >>=? fun () ->
return oph return oph

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -148,7 +148,7 @@ let finalize ?commit_message:message c =
let configure_sandbox = Raw_context.configure_sandbox let configure_sandbox = Raw_context.configure_sandbox
let activate = Raw_context.activate 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 faucet_count = Raw_context.faucet_count
let incr_faucet_count = Raw_context.incr_faucet_count let incr_faucet_count = Raw_context.incr_faucet_count

View File

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

View File

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

View File

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