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

Context: simplify the storage of 'test_network'.

Browse Source 
This prepares the context to the inclusion the hash of the context in
the block header. By "looking" into the resulting context of a block,
we are now know able to determine whether:

- no testnet is currently associated to the branch;
- a testnet must be forked after the block;
- a previously forked testnet is running.
This commit is contained in:
Grégoire Henry 2017-04-10 21:14:17 +02:00
parent 495e887538
commit 2b0df39115
31 changed files with 340 additions and 338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/client/client_node_rpcs.ml
View File

@ -62,8 +62,7 @@ module Blocks = struct
data: MBytes.t ;
operations: Operation_hash.t list list option ;
protocol: Protocol_hash.t ;
test_protocol: Protocol_hash.t ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network;
}
type preapply_param = Services.Blocks.preapply_param = {
operations: Operation_hash.t list ;
@ -93,8 +92,6 @@ module Blocks = struct
call_service1 cctxt Services.Blocks.operations h ()
let protocol cctxt h =
call_service1 cctxt Services.Blocks.protocol h ()
let test_protocol cctxt h =
call_service1 cctxt Services.Blocks.test_protocol h ()
let test_network cctxt h =
call_service1 cctxt Services.Blocks.test_network h ()

8
src/client/client_node_rpcs.mli
View File

@ -92,12 +92,9 @@ module Blocks : sig
val protocol:
config ->
block -> Protocol_hash.t tzresult Lwt.t
val test_protocol:
config ->
block -> Protocol_hash.t tzresult Lwt.t
val test_network:
config ->
block -> (Net_id.t * Time.t) option tzresult Lwt.t
block -> Context.test_network tzresult Lwt.t
val pending_operations:
config ->
@ -115,8 +112,7 @@ module Blocks : sig
data: MBytes.t ;
operations: Operation_hash.t list list option ;
protocol: Protocol_hash.t ;
test_protocol: Protocol_hash.t ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network;
}
val info:

3
src/client/embedded/genesis/client_proto_main.ml
View File

@ -88,7 +88,8 @@ let commands () =
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt.rpc_config ?timestamp cctxt.config.block
(Activate_testnet hash) fitness seckey >>=? fun hash ->
(Activate_testnet (hash, Int64.mul 24L 3600L))
fitness seckey >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
end ;

166
src/node/db/context.ml
View File

@ -84,10 +84,7 @@ type t = context
(*-- Version Access and Update -----------------------------------------------*)
let current_protocol_key = ["protocol"]
let current_test_protocol_key = ["test_protocol"]
let current_test_network_key = ["test_network"]
let current_test_network_expiration_key = ["test_network_expiration"]
let current_fork_test_network_key = ["fork_test_network"]
let exists { repo } key =
GitStore.of_branch_id
@ -204,6 +201,77 @@ let remove_rec ctxt key =
GitStore.FunView.remove_rec ctxt.view (data_key key) >>= fun view ->
Lwt.return { ctxt with view }
(*-- Predefined Fields -------------------------------------------------------*)
let get_protocol v =
raw_get v current_protocol_key >>= function
| None -> assert false
| Some data -> Lwt.return (Protocol_hash.of_bytes_exn data)
let set_protocol v key =
raw_set v current_protocol_key (Protocol_hash.to_bytes key)
type test_network =
| Not_running
| Forking of {
protocol: Protocol_hash.t ;
expiration: Time.t ;
}
| Running of {
net_id: Net_id.t ;
genesis: Block_hash.t ;
protocol: Protocol_hash.t ;
expiration: Time.t ;
}
let test_network_encoding =
let open Data_encoding in
union [
case ~tag:0
(obj1 (req "status" (constant "not_running")))
(function Not_running -> Some () | _ -> None)
(fun () -> Not_running) ;
case ~tag:1
(obj3
(req "status" (constant "forking"))
(req "protocol" Protocol_hash.encoding)
(req "expiration" Time.encoding))
(function
| Forking { protocol ; expiration } ->
Some ((), protocol, expiration)
| _ -> None)
(fun ((), protocol, expiration) ->
Forking { protocol ; expiration }) ;
case ~tag:2
(obj5
(req "status" (constant "running"))
(req "net_id" Net_id.encoding)
(req "genesis" Block_hash.encoding)
(req "protocol" Protocol_hash.encoding)
(req "expiration" Time.encoding))
(function
| Running { net_id ; genesis ; protocol ; expiration } ->
Some ((), net_id, genesis, protocol, expiration)
| _ -> None)
(fun ((), net_id, genesis, protocol, expiration) ->
Running { net_id ; genesis ;protocol ; expiration }) ;
]
let get_test_network v =
raw_get v current_test_network_key >>= function
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
| Some data ->
match Data_encoding.Binary.of_bytes test_network_encoding data with
| None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
| Some r -> Lwt.return r
let set_test_network v id =
raw_set v current_test_network_key
(Data_encoding.Binary.to_bytes test_network_encoding id)
let del_test_network v = raw_del v current_test_network_key
let fork_test_network v ~protocol ~expiration =
set_test_network v (Forking { protocol ; expiration })
(*-- Initialisation ----------------------------------------------------------*)
let init ?patch_context ~root =
@ -220,7 +288,7 @@ let init ?patch_context ~root =
| Some patch_context -> patch_context
}
let commit_genesis index ~id:block ~time ~protocol ~test_protocol =
let commit_genesis index ~id:block ~time ~protocol =
let task = Irmin.Task.create ~date:(Time.to_seconds time) ~owner:"Tezos" in
GitStore.of_branch_id
task (Block_hash.to_b58check block)
@ -228,74 +296,40 @@ let commit_genesis index ~id:block ~time ~protocol ~test_protocol =
let store = t "Genesis" in
GitStore.FunView.of_path store [] >>= fun view ->
let view = (view, index.repack_scheduler) in
GitStore.FunView.set view current_protocol_key
(Protocol_hash.to_bytes protocol) >>= fun view ->
GitStore.FunView.set view current_test_protocol_key
(Protocol_hash.to_bytes test_protocol) >>= fun view ->
let ctxt = { index ; store ; view } in
set_protocol ctxt protocol >>= fun ctxt ->
set_test_network ctxt Not_running >>= fun ctxt ->
index.patch_context ctxt >>= fun ctxt ->
GitStore.FunView.update_path ctxt.store [] ctxt.view >>= fun () ->
Lwt.return ctxt
(*-- Predefined Fields -------------------------------------------------------*)
let compute_testnet_genesis forked_block =
let genesis = Block_hash.hash_bytes [Block_hash.to_bytes forked_block] in
let net_id = Net_id.of_block_hash genesis in
net_id, genesis
let get_protocol v =
raw_get v current_protocol_key >>= function
| None -> assert false
| Some data -> Lwt.return (Protocol_hash.of_bytes_exn data)
let set_protocol v key =
raw_set v current_protocol_key (Protocol_hash.to_bytes key)
let get_test_protocol v =
raw_get v current_test_protocol_key >>= function
| None -> assert false
| Some data -> Lwt.return (Protocol_hash.of_bytes_exn data)
let set_test_protocol v data =
raw_set v current_test_protocol_key (Protocol_hash.to_bytes data)
let get_test_network v =
raw_get v current_test_network_key >>= function
| None -> Lwt.return_none
| Some data -> Lwt.return (Some (Net_id.of_bytes_exn data))
let set_test_network v id =
raw_set v current_test_network_key (Net_id.to_bytes id)
let del_test_network v = raw_del v current_test_network_key
let get_test_network_expiration v =
raw_get v current_test_network_expiration_key >>= function
| None -> Lwt.return_none
| Some data -> Lwt.return (Time.of_notation @@ MBytes.to_string data)
let set_test_network_expiration v data =
raw_set v current_test_network_expiration_key
(MBytes.of_string @@ Time.to_notation data)
let del_test_network_expiration v =
raw_del v current_test_network_expiration_key
let read_and_reset_fork_test_network v =
raw_get v current_fork_test_network_key >>= function
| None -> Lwt.return (false, v)
| Some _ ->
raw_del v current_fork_test_network_key >>= fun v ->
Lwt.return (true, v)
let fork_test_network v =
raw_set v current_fork_test_network_key (MBytes.of_string "fork")
let init_test_network v ~time ~genesis =
get_test_protocol v >>= fun test_protocol ->
del_test_network_expiration v >>= fun v ->
set_protocol v test_protocol >>= fun v ->
let task =
Irmin.Task.create
~date:(Time.to_seconds time)
~owner:"tezos" in
GitStore.clone task v.store (Block_hash.to_b58check genesis) >>= function
| `Empty_head -> Lwt.return (Error [Exn (Empty_head genesis)])
| `Duplicated_branch -> Lwt.return (Error [Exn (Preexistent_context genesis)])
let commit_test_network_genesis forked_block time ctxt =
let net_id, genesis = compute_testnet_genesis forked_block in
let task = Irmin.Task.create ~date:(Time.to_seconds time) ~owner:"Tezos" in
GitStore.clone task ctxt.store (Block_hash.to_b58check genesis) >>= function
| `Empty_head -> fail (Exn (Empty_head genesis))
| `Duplicated_branch -> fail (Exn (Preexistent_context genesis))
| `Ok store ->
let msg =
Format.asprintf "Fake block. Forking testnet: %a."
Block_hash.pp_short genesis in
GitStore.FunView.update_path (store msg) [] v.view >>= fun () ->
return v
Format.asprintf "Forking testnet: %a." Net_id.pp_short net_id in
GitStore.FunView.update_path (store msg) [] ctxt.view >>= fun () ->
return (net_id, genesis)
let reset_test_network ctxt forked_block timestamp =
get_test_network ctxt >>= function
| Not_running -> Lwt.return ctxt
| Running { expiration } ->
if Time.(expiration <= timestamp) then
set_test_network ctxt Not_running
else
Lwt.return ctxt
| Forking { protocol ; expiration } ->
let net_id, genesis = compute_testnet_genesis forked_block in
set_test_network ctxt
(Running { net_id ; genesis ;
protocol ; expiration })

37
src/node/db/context.mli
View File

@ -27,9 +27,12 @@ val commit_genesis:
id:Block_hash.t ->
time:Time.t ->
protocol:Protocol_hash.t ->
test_protocol:Protocol_hash.t ->
context Lwt.t
val commit_test_network_genesis:
Block_hash.t -> Time.t -> context ->
(Net_id.t * Block_hash.t) tzresult Lwt.t
(** {2 Generic interface} ****************************************************)
include Persist.STORE with type t := context
@ -51,20 +54,26 @@ val commit:
val get_protocol: context -> Protocol_hash.t Lwt.t
val set_protocol: context -> Protocol_hash.t -> context Lwt.t
val get_test_protocol: context -> Protocol_hash.t Lwt.t
val set_test_protocol: context -> Protocol_hash.t -> context Lwt.t
type test_network =
| Not_running
| Forking of {
protocol: Protocol_hash.t ;
expiration: Time.t ;
}
| Running of {
net_id: Net_id.t ;
genesis: Block_hash.t ;
protocol: Protocol_hash.t ;
expiration: Time.t ;
}
val get_test_network: context -> Net_id.t option Lwt.t
val set_test_network: context -> Net_id.t -> context Lwt.t
val test_network_encoding: test_network Data_encoding.t
val get_test_network: context -> test_network Lwt.t
val set_test_network: context -> test_network -> context Lwt.t
val del_test_network: context -> context Lwt.t
val get_test_network_expiration: context -> Time.t option Lwt.t
val set_test_network_expiration: context -> Time.t -> context Lwt.t
val del_test_network_expiration: context -> context Lwt.t
val reset_test_network: context -> Block_hash.t -> Time.t -> context Lwt.t
(* FIXME split in two (reset after commit *)
val read_and_reset_fork_test_network: context -> (bool * context) Lwt.t
val fork_test_network: context -> context Lwt.t
val init_test_network:
context -> time:Time.t -> genesis:Block_hash.t -> context tzresult Lwt.t
val fork_test_network:
context -> protocol:Protocol_hash.t -> expiration:Time.t -> context Lwt.t

10
src/node/db/store.ml
View File

@ -61,14 +61,8 @@ module Net = struct
(struct let name = ["expiration"] end)
(Store_helpers.Make_value(Time))
module Forked_network_ttl =
Store_helpers.Make_single_store
(Indexed_store.Store)
(struct let name = ["forked_network_ttl"] end)
(Store_helpers.Make_value(struct
type t = Int64.t
let encoding = Data_encoding.int64
end))
module Allow_forked_network =
Indexed_store.Make_set (struct let name = ["allow_forked_network"] end)
end

6
src/node/db/store.mli
View File

@ -46,9 +46,9 @@ module Net : sig
with type t := store
and type value := Time.t
module Forked_network_ttl : SINGLE_STORE
with type t := store
and type value := Int64.t
module Allow_forked_network : SET_STORE
with type t := t
and type elt := Net_id.t
end

4
src/node/main/node_run_command.ml
View File

@ -27,8 +27,6 @@ let context_dir data_dir = data_dir // "context"
let protocol_dir data_dir = data_dir // "protocol"
let lock_file data_dir = data_dir // "lock"
let test_protocol = None
let init_logger ?verbosity (log_config : Node_config_file.log) =
let open Logging in
begin
@ -116,11 +114,11 @@ let init_node ?sandbox (config : Node_config_file.t) =
end >>=? fun p2p_config ->
let node_config : Node.config = {
genesis ;
test_protocol ;
patch_context ;
store_root = store_dir config.data_dir ;
context_root = context_dir config.data_dir ;
p2p = p2p_config ;
test_network_max_tll = Some (48 * 3600) ; (* 2 days *)
} in
Node.create node_config

28
src/node/shell/node.ml
View File

@ -87,29 +87,28 @@ type config = {
genesis: State.Net.genesis ;
store_root: string ;
context_root: string ;
test_protocol: Protocol_hash.t option ;
patch_context: (Context.t -> Context.t Lwt.t) option ;
p2p: (P2p.config * P2p.limits) option ;
test_network_max_tll: int option ;
}
let may_create_net state ?test_protocol genesis =
let may_create_net state genesis =
State.Net.get state (Net_id.of_block_hash genesis.State.Net.block) >>= function
| Ok net -> Lwt.return net
| Error _ ->
State.Net.create state
?test_protocol
~forked_network_ttl:(48 * 3600) (* 2 days *)
genesis
State.Net.create state genesis
let create { genesis ; store_root ; context_root ;
test_protocol ; patch_context ; p2p = net_params } =
patch_context ; p2p = net_params ;
test_network_max_tll = max_ttl } =
init_p2p net_params >>= fun p2p ->
State.read
~store_root ~context_root ?patch_context () >>=? fun state ->
let distributed_db = Distributed_db.create state p2p in
let validator = Validator.create_worker state distributed_db in
may_create_net state ?test_protocol genesis >>= fun mainnet_net ->
let validator =
Validator.create_worker ?max_ttl state distributed_db in
may_create_net state genesis >>= fun mainnet_net ->
Validator.activate validator mainnet_net >>= fun mainnet_validator ->
let mainnet_db = Validator.net_db mainnet_validator in
let shutdown () =
@ -147,8 +146,7 @@ module RPC = struct
data: MBytes.t ;
operations: Operation_hash.t list list option ;
protocol: Protocol_hash.t ;
test_protocol: Protocol_hash.t ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network;
}
let convert (block: State.Valid_block.t) = {
@ -162,7 +160,6 @@ module RPC = struct
data = block.proto_header ;
operations = Some block.operations ;
protocol = block.protocol_hash ;
test_protocol = block.test_protocol_hash ;
test_network = block.test_network ;
}
@ -268,13 +265,7 @@ module RPC = struct
| Error _ -> Lwt.fail Not_found
| Ok { context ; fitness } ->
Context.get_protocol context >>= fun protocol ->
Context.get_test_protocol context >>= fun test_protocol ->
Context.get_test_network context >>= fun test_network ->
Context.get_test_network_expiration context >>= fun test_network_expiration ->
let test_network =
match test_network, test_network_expiration with
| Some n, Some t -> Some (n, t)
| _, None | None, _ -> None in
let operations =
let pv_result, _ = Prevalidator.operations pv in
[ pv_result.applied ] in
@ -291,7 +282,6 @@ module RPC = struct
operations = Some operations ;
data = MBytes.of_string "" ;
net_id = head.net_id ;
test_protocol ;
test_network ;
}

2
src/node/shell/node.mli
View File

@ -13,9 +13,9 @@ type config = {
genesis: State.Net.genesis ;
store_root: string ;
context_root: string ;
test_protocol: Protocol_hash.t option ;
patch_context: (Context.t -> Context.t Lwt.t) option ;
p2p: (P2p.config * P2p.limits) option ;
test_network_max_tll: int option ;
}
val create: config -> t tzresult Lwt.t

6
src/node/shell/node_rpc.ml
View File

@ -73,12 +73,6 @@ let register_bi_dir node dir =
RPC.Answer.return bi.protocol in
RPC.register1 dir
Services.Blocks.protocol implementation in
let dir =
let implementation b () =
Node.RPC.block_info node b >>= fun bi ->
RPC.Answer.return bi.test_protocol in
RPC.register1 dir
Services.Blocks.test_protocol implementation in
let dir =
let implementation b () =
Node.RPC.block_info node b >>= fun bi ->

28
src/node/shell/node_rpc_services.ml
View File

@ -66,37 +66,36 @@ module Blocks = struct
data: MBytes.t ;
operations: Operation_hash.t list list option ;
protocol: Protocol_hash.t ;
test_protocol: Protocol_hash.t ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network;
}
let block_info_encoding =
conv
(fun { hash ; net_id ; level ; predecessor ;
fitness ; timestamp ; protocol ; operations_hash ; data ;
operations ; test_protocol ; test_network } ->
operations ; test_network } ->
({ Store.Block_header.shell =
{ net_id ; level ; predecessor ;
timestamp ; operations_hash ; fitness } ;
proto = data },
(hash, operations, protocol, test_protocol, test_network)))
(hash, operations, protocol, test_network)))
(fun ({ Store.Block_header.shell =
{ net_id ; level ; predecessor ;
timestamp ; operations_hash ; fitness } ;
proto = data },
(hash, operations, protocol, test_protocol, test_network)) ->
(hash, operations, protocol, test_network)) ->
{ hash ; net_id ; level ; predecessor ;
fitness ; timestamp ; protocol ; operations_hash ; data ;
operations ; test_protocol ; test_network })
operations ; test_network })
(dynamic_size
(merge_objs
Store.Block_header.encoding
(obj5
(obj4
(req "hash" Block_hash.encoding)
(opt "operations" (list (list Operation_hash.encoding)))
(req "protocol" Protocol_hash.encoding)
(req "test_protocol" Protocol_hash.encoding)
(opt "test_network" (tup2 Net_id.encoding Time.encoding)))))
(dft "test_network"
Context.test_network_encoding Context.Not_running))))
let parse_block s =
try
@ -248,18 +247,11 @@ module Blocks = struct
~output: (obj1 (req "protocol" Protocol_hash.encoding))
RPC.Path.(block_path / "protocol")
let test_protocol =
RPC.service
~description:"List the block test protocol."
~input: empty
~output: (obj1 (req "protocol" Protocol_hash.encoding))
RPC.Path.(block_path / "test_protocol")
let test_network =
RPC.service
~description:"Returns the associated test network."
~description:"Returns the status of the associated test network."
~input: empty
~output: (obj1 (opt "net" (tup2 Net_id.encoding Time.encoding)))
~output: Context.test_network_encoding
RPC.Path.(block_path / "test_network")
let pending_operations =

7
src/node/shell/node_rpc_services.mli
View File

@ -37,8 +37,7 @@ module Blocks : sig
data: MBytes.t ;
operations: Operation_hash.t list list option ;
protocol: Protocol_hash.t ;
test_protocol: Protocol_hash.t ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network;
}
val info:
@ -61,10 +60,8 @@ module Blocks : sig
(unit, unit * block, unit, Operation_hash.t list list) RPC.service
val protocol:
(unit, unit * block, unit, Protocol_hash.t) RPC.service
val test_protocol:
(unit, unit * block, unit, Protocol_hash.t) RPC.service
val test_network:
(unit, unit * block, unit, (Net_id.t * Time.t) option) RPC.service
(unit, unit * block, unit, Context.test_network) RPC.service
val pending_operations:
(unit, unit * block, unit,
error Prevalidation.preapply_result * Hash.Operation_hash.Set.t) RPC.service

3
src/node/shell/prevalidation.ml
View File

@ -143,6 +143,9 @@ let start_prevalidation
match protocol with
| None -> assert false (* FIXME, this should not happen! *)
| Some protocol -> protocol in
Context.reset_test_network
predecessor_context predecessor
timestamp >>= fun predecessor_context ->
Proto.begin_construction
~predecessor_context
~predecessor_timestamp

116
src/node/shell/state.ml
View File

@ -89,7 +89,7 @@ and net = {
state: net_state Shared.t ;
genesis: genesis ;
expiration: Time.t option ;
forked_network_ttl: Int64.t option ;
allow_forked_network: bool ;
operation_store: Store.Operation.store Shared.t ;
block_header_store: Store.Block_header.store Shared.t ;
valid_block_watcher: valid_block Watcher.input ;
@ -119,9 +119,7 @@ and valid_block = {
discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ;
test_protocol_hash: Protocol_hash.t ;
test_protocol: (module Updater.REGISTRED_PROTOCOL) option ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network ;
context: Context.t ;
successors: Block_hash.Set.t ;
invalid_successors: Block_hash.Set.t ;
@ -132,16 +130,8 @@ let build_valid_block
hash header operations
context discovery_time successors invalid_successors =
Context.get_protocol context >>= fun protocol_hash ->
Context.get_test_protocol context >>= fun test_protocol_hash ->
Context.get_test_network context >>= fun test_network ->
Context.get_test_network_expiration
context >>= fun test_network_expiration ->
let test_network =
match test_network, test_network_expiration with
| None, _ | _, None -> None
| Some net_id, Some time -> Some (net_id, time) in
let protocol = Updater.get protocol_hash in
let test_protocol = Updater.get test_protocol_hash in
let valid_block = {
net_id = header.Store.Block_header.shell.net_id ;
hash ;
@ -154,8 +144,6 @@ let build_valid_block
fitness = header.shell.fitness ;
protocol_hash ;
protocol ;
test_protocol_hash ;
test_protocol ;
test_network ;
context ;
successors ;
@ -857,7 +845,7 @@ module Raw_net = struct
~genesis
~genesis_block
~expiration
~forked_network_ttl
~allow_forked_network
context_index
chain_store
block_header_store
@ -872,18 +860,16 @@ module Raw_net = struct
state = Shared.create net_state ;
genesis ;
expiration ;
allow_forked_network ;
operation_store = Shared.create operation_store ;
forked_network_ttl ;
block_header_store = Shared.create block_header_store ;
valid_block_watcher = Watcher.create_input ();
} in
net
let locked_create
data
?initial_context ?forked_network_ttl
?test_protocol ?expiration genesis =
let net_id = Net_id.of_block_hash genesis.block in
data ?initial_context ?expiration ?(allow_forked_network = false)
net_id genesis =
let net_store = Store.Net.get data.global_store net_id in
let operation_store = Store.Operation.get net_store
and block_header_store = Store.Block_header.get net_store
@ -891,8 +877,6 @@ module Raw_net = struct
Store.Net.Genesis_hash.store net_store genesis.block >>= fun () ->
Store.Net.Genesis_time.store net_store genesis.time >>= fun () ->
Store.Net.Genesis_protocol.store net_store genesis.protocol >>= fun () ->
let test_protocol = Utils.unopt ~default:genesis.protocol test_protocol in
Store.Net.Genesis_test_protocol.store net_store test_protocol >>= fun () ->
Store.Chain.Current_head.store chain_store genesis.block >>= fun () ->
Store.Chain.Known_heads.store chain_store genesis.block >>= fun () ->
data.init_index net_id >>= fun context_index ->
@ -901,6 +885,12 @@ module Raw_net = struct
| None -> Lwt.return_unit
| Some time -> Store.Net.Expiration.store net_store time
end >>= fun () ->
begin
if allow_forked_network then
Store.Net.Allow_forked_network.store data.global_store net_id
else
Lwt.return_unit
end >>= fun () ->
Raw_block_header.store_genesis
block_header_store genesis >>= fun header ->
begin
@ -911,7 +901,6 @@ module Raw_net = struct
~id:genesis.block
~time:genesis.time
~protocol:genesis.protocol
~test_protocol
| Some context ->
Lwt.return context
end >>= fun context ->
@ -923,7 +912,7 @@ module Raw_net = struct
~genesis
~genesis_block
~expiration
~forked_network_ttl
~allow_forked_network
context_index
chain_store
block_header_store
@ -946,9 +935,7 @@ module Valid_block = struct
discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ;
test_protocol_hash: Protocol_hash.t ;
test_protocol: (module Updater.REGISTRED_PROTOCOL) option ;
test_network: (Net_id.t * Time.t) option ;
test_network: Context.test_network ;
context: Context.t ;
successors: Block_hash.Set.t ;
invalid_successors: Block_hash.Set.t ;
@ -1002,7 +989,7 @@ module Valid_block = struct
block_header_store
(net_state: net_state)
valid_block_watcher
hash { Updater.context ; message ; fitness } ttl =
hash { Updater.context ; message ; fitness } =
(* Read the block header. *)
Raw_block_header.Locked.read
block_header_store hash >>=? fun block ->
@ -1016,30 +1003,6 @@ module Valid_block = struct
expected = block.Store.Block_header.shell.fitness ;
found = fitness ;
}) >>=? fun () ->
begin (* Patch context about the associated test network. *)
Context.read_and_reset_fork_test_network
context >>= fun (fork, context) ->
if fork then
match ttl with
| None ->
(* Ignore fork on forked networks. *)
Context.del_test_network context >>= fun context ->
Context.del_test_network_expiration context
| Some ttl ->
let eol = Time.(add block.shell.timestamp ttl) in
Context.set_test_network
context (Net_id.of_block_hash hash) >>= fun context ->
Context.set_test_network_expiration
context eol >>= fun context ->
Lwt.return context
else
Context.get_test_network_expiration context >>= function
| Some eol when Time.(eol <= now ()) ->
Context.del_test_network context >>= fun context ->
Context.del_test_network_expiration context
| None | Some _ ->
Lwt.return context
end >>= fun context ->
Raw_block_header.Locked.mark_valid
block_header_store hash >>= fun _marked ->
(* TODO fail if the block was previsouly stored ... ??? *)
@ -1101,8 +1064,7 @@ module Valid_block = struct
| None ->
Locked.store
block_header_store net_state net.valid_block_watcher
hash vcontext
net.forked_network_ttl >>=? fun valid_block ->
hash vcontext >>=? fun valid_block ->
return (Some valid_block)
end
end
@ -1110,26 +1072,22 @@ module Valid_block = struct
let watcher net =
Watcher.create_stream net.valid_block_watcher
let fork_testnet state net block expiration =
let fork_testnet state net block protocol expiration =
assert (Net_id.equal block.net_id (Net_id.of_block_hash net.genesis.block)) ;
let hash = Block_hash.hash_bytes [Block_hash.to_bytes block.hash] in
let genesis : genesis = {
block = hash ;
time = Time.add block.timestamp 1L ;
protocol = block.test_protocol_hash ;
} in
Shared.use state.global_data begin fun data ->
if Net_id.Table.mem data.nets (Net_id.of_block_hash hash) then
assert false (* This would mean a block is validated twice... *)
else
Context.init_test_network block.context
~time:genesis.time
~genesis:genesis.block >>=? fun initial_context ->
Raw_net.locked_create data
~initial_context
~expiration
genesis >>= fun net ->
return net
let context = block.context in
Context.set_test_network context Not_running >>= fun context ->
Context.set_protocol context protocol >>= fun context ->
Context.commit_test_network_genesis
block.hash block.timestamp context >>=? fun (net_id, genesis) ->
let genesis = {
block = genesis ;
time = Time.add block.timestamp 1L ;
protocol ;
} in
Raw_net.locked_create data
net_id ~initial_context:context ~expiration genesis >>= fun net ->
return net
end
module Helpers = struct
@ -1334,15 +1292,14 @@ module Net = struct
(req "block" Block_hash.encoding)
(req "protocol" Protocol_hash.encoding))
let create state ?test_protocol ?forked_network_ttl genesis =
let create state ?allow_forked_network genesis =
let net_id = Net_id.of_block_hash genesis.block in
let forked_network_ttl = map_option Int64.of_int forked_network_ttl in
Shared.use state.global_data begin fun data ->
if Net_id.Table.mem data.nets net_id then
Pervasives.failwith "State.Net.create"
else
Raw_net.locked_create data
?test_protocol ?forked_network_ttl genesis >>= fun net ->
Raw_net.locked_create
data ?allow_forked_network net_id genesis >>= fun net ->
Net_id.Table.add data.nets net_id net ;
Lwt.return net
end
@ -1356,7 +1313,8 @@ module Net = struct
Store.Net.Genesis_time.read net_store >>=? fun time ->
Store.Net.Genesis_protocol.read net_store >>=? fun protocol ->
Store.Net.Expiration.read_opt net_store >>= fun expiration ->
Store.Net.Forked_network_ttl.read_opt net_store >>= fun forked_network_ttl ->
Store.Net.Allow_forked_network.known
data.global_store id >>= fun allow_forked_network ->
let genesis = { time ; protocol ; block = genesis_hash } in
Store.Chain.Current_head.read chain_store >>=? fun genesis_hash ->
data.init_index id >>= fun context_index ->
@ -1372,7 +1330,7 @@ module Net = struct
~genesis
~genesis_block
~expiration
~forked_network_ttl
~allow_forked_network
context_index
chain_store
block_header_store
@ -1407,7 +1365,7 @@ module Net = struct
let id { id } = id
let genesis { genesis } = genesis
let expiration { expiration } = expiration
let forked_network_ttl { forked_network_ttl } = forked_network_ttl
let allow_forked_network { allow_forked_network } = allow_forked_network
let destroy state net =
lwt_debug "destroy %a" Net_id.pp (id net) >>= fun () ->

25
src/node/shell/state.mli
View File

@ -62,12 +62,12 @@ module Net : sig
}
val genesis_encoding: genesis Data_encoding.t
(** Initialize a network for a given [genesis]. By default the network
never expirate and the test_protocol is the genesis protocol. *)
(** Initialize a network for a given [genesis]. By default,
the network does accept forking test network. When
[~allow_forked_network:true] is provided, test network are allowed. *)
val create:
global_state ->
?test_protocol: Protocol_hash.t ->
?forked_network_ttl: int ->
?allow_forked_network:bool ->
genesis -> net Lwt.t
(** Look up for a network by the hash of its genesis block. *)
@ -88,7 +88,7 @@ module Net : sig
val id: net -> Net_id.t
val genesis: net -> genesis
val expiration: net -> Time.t option
val forked_network_ttl: net -> Int64.t option
val allow_forked_network: net -> bool
end
@ -264,14 +264,8 @@ module Valid_block : sig
protocol: (module Updater.REGISTRED_PROTOCOL) option ;
(** The actual implementation of the protocol to be used for
validating the following blocks. *)
test_protocol_hash: Protocol_hash.t ;
(** The protocol to be used for the next test network. *)
test_protocol: (module Updater.REGISTRED_PROTOCOL) option ;
(** The actual implementatino of the protocol to be used for the
next test network. *)
test_network: (Net_id.t * Time.t) option ;
(** The current test network associated to the block, and the date
of its expiration date. *)
test_network: Context.test_network ;
(** The current test network associated to the block. *)
context: Context.t ;
(** The validation context that was produced by the block validation. *)
successors: Block_hash.Set.t ;
@ -296,7 +290,10 @@ module Valid_block : sig
val known_heads: Net.t -> valid_block list Lwt.t
val fork_testnet:
global_state -> Net.t -> valid_block -> Time.t -> Net.t tzresult Lwt.t
global_state ->
Net.t -> valid_block ->
Protocol_hash.t -> Time.t ->
Net.t tzresult Lwt.t
module Current : sig

140
src/node/shell/validator.ml
View File

@ -33,7 +33,11 @@ and t = {
net_db: Distributed_db.net ;
notify_block: Block_hash.t -> Store.Block_header.t -> unit Lwt.t ;
fetch_block: Block_hash.t -> State.Valid_block.t tzresult Lwt.t ;
create_child: State.Valid_block.t -> unit tzresult Lwt.t ;
create_child:
State.Valid_block.t -> Protocol_hash.t -> Time.t -> unit tzresult Lwt.t ;
check_child:
Block_hash.t -> Protocol_hash.t -> Time.t -> Time.t -> unit tzresult Lwt.t ;
deactivate_child: unit -> unit Lwt.t ;
test_validator: unit -> (t * Distributed_db.net) option ;
shutdown: unit -> unit Lwt.t ;
valid_block_input: State.Valid_block.t Watcher.input ;
@ -59,29 +63,10 @@ let bootstrapped v = v.bootstrapped
(** Current block computation *)
let may_change_test_network v (block: State.Valid_block.t) =
let change =
match block.test_network, v.child with
| None, None -> false
| Some _, None
| None, Some _ -> true
| Some (net_id, _), Some { net } ->
let net_id' = State.Net.id net in
not (Net_id.equal net_id net_id') in
if change then begin
v.create_child block >>= function
| Ok () -> Lwt.return_unit
| Error err ->
lwt_log_error "@[<v 2>Error while switch test network:@ %a@]"
Error_monad.pp_print_error err
end else
Lwt.return_unit
let fetch_protocol v hash =
lwt_log_notice "Fetching protocol %a"
Protocol_hash.pp_short hash >>= fun () ->
Distributed_db.Protocol.fetch
v.worker.db hash >>= fun protocol ->
Distributed_db.Protocol.fetch v.worker.db hash >>= fun protocol ->
Updater.compile hash protocol >>= fun valid ->
if valid then begin
lwt_log_notice "Successfully compiled protocol %a"
@ -101,12 +86,16 @@ let fetch_protocols v (block: State.Valid_block.t) =
| Some _ -> return false
| None -> fetch_protocol v block.protocol_hash
and test_proto_updated =
match block.test_protocol with
| Some _ -> return false
| None -> fetch_protocol v block.test_protocol_hash in
match block.test_network with
| Not_running -> return false
| Forking { protocol }
| Running { protocol } ->
Distributed_db.Protocol.known v.worker.db protocol >>= fun known ->
if known then return false
else fetch_protocol v protocol in
proto_updated >>=? fun proto_updated ->
test_proto_updated >>=? fun test_proto_updated ->
if test_proto_updated || proto_updated then
test_proto_updated >>=? fun _test_proto_updated ->
if proto_updated then
State.Valid_block.read_exn v.net block.hash >>= return
else
return block
@ -122,7 +111,20 @@ let rec may_set_head v (block: State.Valid_block.t) =
| true ->
Distributed_db.broadcast_head v.net_db block.hash [] ;
Prevalidator.flush v.prevalidator block ;
may_change_test_network v block >>= fun () ->
begin
begin
match block.test_network with
| Not_running -> v.deactivate_child () >>= return
| Running { genesis ; protocol ; expiration } ->
v.check_child genesis protocol expiration block.timestamp
| Forking { protocol ; expiration } ->
v.create_child block protocol expiration
end >>= function
| Ok () -> Lwt.return_unit
| Error err ->
lwt_log_error "@[<v 2>Error while switch test network:@ %a@]"
Error_monad.pp_print_error err
end >>= fun () ->
Watcher.notify v.new_head_input block ;
lwt_log_notice "update current head %a %a %a(%t)"
Block_hash.pp_short block.hash
@ -217,8 +219,10 @@ let apply_block net db
operations >>=? fun parsed_operations ->
lwt_debug "validation of %a: applying block..."
Block_hash.pp_short hash >>= fun () ->
Context.reset_test_network
pred.context pred.hash block.shell.timestamp >>= fun context ->
Proto.begin_application
~predecessor_context:pred.context
~predecessor_context:context
~predecessor_timestamp:pred.timestamp
~predecessor_fitness:pred.fitness
block >>=? fun state ->
@ -484,7 +488,7 @@ module Context_db = struct
end
let rec create_validator ?parent worker state db net =
let rec create_validator ?max_ttl ?parent worker state db net =
let queue = Lwt_pipe.create () in
let current_ops = ref (fun () -> []) in
@ -568,6 +572,8 @@ let rec create_validator ?parent worker state db net =
notify_block ;
fetch_block ;
create_child ;
check_child ;
deactivate_child ;
test_validator ;
bootstrapped ;
new_head_input ;
@ -585,36 +591,62 @@ let rec create_validator ?parent worker state db net =
and fetch_block hash =
Context_db.fetch session v hash
and create_child block =
begin
and create_child block protocol expiration =
if State.Net.allow_forked_network net then begin
deactivate_child () >>= fun () ->
begin
State.Net.get state net_id >>= function
| Ok net_store -> return net_store
| Error _ ->
State.Valid_block.fork_testnet
state net block protocol expiration >>=? fun net_store ->
State.Valid_block.Current.head net_store >>= fun block ->
Watcher.notify v.worker.valid_block_input block ;
return net_store
end >>=? fun net_store ->
worker.activate ~parent:v net_store >>= fun child ->
v.child <- Some child ;
return ()
end else begin
(* Ignoring request... *)
return ()
end
and deactivate_child () =
match v.child with
| None -> Lwt.return_unit
| Some child ->
v.child <- None ;
deactivate child
and check_child genesis protocol expiration current_time =
let activated =
match v.child with
| None -> Lwt.return_unit
| None -> false
| Some child ->
v.child <- None ;
deactivate child
end >>= fun () ->
match block.test_network with
| None -> return ()
| Some (net_id, expiration) ->
begin
State.Net.get state net_id >>= function
| Ok net_store -> return net_store
| Error _ ->
State.Valid_block.fork_testnet
state net block expiration >>=? fun net_store ->
State.Valid_block.Current.head net_store >>= fun block ->
Watcher.notify v.worker.valid_block_input block ;
return net_store
end >>=? fun net_store ->
worker.activate ~parent:v net_store >>= fun child ->
v.child <- Some child ;
return ()
Block_hash.equal (State.Net.genesis child.net).block genesis in
begin
match max_ttl with
| None -> Lwt.return expiration
| Some ttl ->
Distributed_db.Block_header.fetch net_db genesis >>= fun genesis ->
Lwt.return
(Time.min expiration
(Time.add genesis.shell.timestamp (Int64.of_int ttl)))
end >>= fun local_expiration ->
let expired = Time.(local_expiration <= current_time) in
if expired && activated then
deactivate_child () >>= return
else if not activated && not expired then
fetch_block genesis >>=? fun genesis ->
create_child genesis protocol expiration
else
return ()
and test_validator () =
match v.child with
| None -> None
| Some child -> Some (child, child.net_db)
in
new_blocks := begin
@ -637,7 +669,7 @@ let rec create_validator ?parent worker state db net =
type error += Unknown_network of Net_id.t
let create_worker state db =
let create_worker ?max_ttl state db =
let validators : t Lwt.t Net_id.Table.t =
Net_id.Table.create 7 in
@ -770,7 +802,7 @@ let create_worker state db =
Net_id.pp net_id >>= fun () ->
get net_id >>= function
| Error _ ->
let v = create_validator ?parent worker state db net in
let v = create_validator ?max_ttl ?parent worker state db net in
Net_id.Table.add validators net_id v ;
v
| Ok v -> Lwt.return v

2
src/node/shell/validator.mli
View File

@ -9,7 +9,7 @@
type worker
val create_worker: State.t -> Distributed_db.t -> worker
val create_worker: ?max_ttl:int -> State.t -> Distributed_db.t -> worker
val shutdown: worker -> unit Lwt.t
val notify_block: worker -> Block_hash.t -> State.Block_header.t -> unit Lwt.t

6
src/node/updater/environment.ml
View File

@ -82,7 +82,7 @@ module Ed25519 = struct
(conv
Sodium.Sign.Bigbytes.of_public_key
Sodium.Sign.Bigbytes.to_public_key
bytes)
(Fixed.bytes Sodium.Sign.public_key_size))
let hash v =
Public_key_hash.hash_bytes
@ -144,7 +144,7 @@ module Ed25519 = struct
(conv
Sodium.Sign.Bigbytes.of_secret_key
Sodium.Sign.Bigbytes.to_secret_key
bytes)
(Fixed.bytes Sodium.Sign.secret_key_size))
end
@ -199,7 +199,7 @@ module Ed25519 = struct
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 signature: unexpected prefix.")
string)
~binary: (Fixed.bytes 64)
~binary: (Fixed.bytes Sodium.Sign.signature_size)
let check public_key signature msg =
try

1
src/node/updater/updater.ml
View File

@ -71,7 +71,6 @@ let register hash proto =
let activate = Context.set_protocol
let fork_test_network = Context.fork_test_network
let set_test_protocol = Context.set_test_protocol
let get_exn hash = VersionTable.find versions hash
let get hash =

4
src/node/updater/updater.mli
View File

@ -66,8 +66,8 @@ val extract: Lwt_io.file_name -> Protocol_hash.t -> component list -> unit Lwt.t
val compile: Protocol_hash.t -> component list -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val set_test_protocol: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network: Context.t -> Context.t Lwt.t
val fork_test_network:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
val register: Protocol_hash.t -> (module REGISTRED_PROTOCOL) -> unit

5
src/proto/alpha/amendment.ml
View File

@ -67,9 +67,10 @@ let start_new_voting_cycle ctxt =
Vote.clear_ballots ctxt >>= fun ctxt ->
Vote.clear_listings ctxt >>=? fun ctxt ->
if approved then
let expiration = (* in two days maximum... *)
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
Vote.get_current_proposal ctxt >>=? fun proposal ->
set_test_protocol ctxt proposal >>= fun ctxt ->
fork_test_network ctxt >>= fun ctxt ->
fork_test_network ctxt proposal expiration >>= fun ctxt ->
Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
return ctxt
else

5
src/proto/alpha/apply.ml
View File

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

8
src/proto/alpha/storage.ml
View File

@ -547,11 +547,9 @@ end
let activate ({ context = c } as s) h =
Updater.activate c h >>= fun c -> Lwt.return { s with context = c }
let fork_test_network ({ context = c } as s) =
Updater.fork_test_network c >>= fun c -> Lwt.return { s with context = c }
let set_test_protocol ({ context = c } as s) h =
Updater.set_test_protocol c h >>= fun c -> Lwt.return { s with context = c }
let fork_test_network ({ context = c } as s) protocol expiration =
Updater.fork_test_network c ~protocol ~expiration >>= fun c ->
Lwt.return { s with context = c }
(** Resolver *)

3
src/proto/alpha/storage.mli
View File

@ -275,5 +275,4 @@ module Rewards : sig
end
val activate: t -> Protocol_hash.t -> t Lwt.t
val set_test_protocol: t -> Protocol_hash.t -> t Lwt.t
val fork_test_network: t -> t Lwt.t
val fork_test_network: t -> Protocol_hash.t -> Time.t -> t Lwt.t

1
src/proto/alpha/tezos_context.ml
View File

@ -119,4 +119,3 @@ let configure_sandbox = Init_storage.configure_sandbox
let activate = Storage.activate
let fork_test_network = Storage.fork_test_network
let set_test_protocol = Storage.set_test_protocol

3
src/proto/alpha/tezos_context.mli
View File

@ -583,5 +583,4 @@ val configure_sandbox:
Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
val activate: context -> Protocol_hash.t -> context Lwt.t
val set_test_protocol: context -> Protocol_hash.t -> context Lwt.t
val fork_test_network: context -> context Lwt.t
val fork_test_network: context -> Protocol_hash.t -> Time.t -> context Lwt.t

9
src/proto/environment/updater.mli
View File

@ -174,5 +174,10 @@ val compile : Protocol_hash.t -> component list -> bool Lwt.t
been previously compiled successfully. *)
val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t
val set_test_protocol: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network: Context.t -> Context.t Lwt.t
(** Fork a test network. The forkerd network will use the current block
as genesis, and [protocol] as economic protocol. The network will
be destroyed when a (successor) block will have a timestamp greater
than [expiration]. The protocol must have been previously compiled
successfully. *)
val fork_test_network:
Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t

16
src/proto/genesis/data.ml
View File

@ -14,7 +14,7 @@ module Command = struct
| Activate of Protocol_hash.t
(* Activate a protocol as a testnet *)
| Activate_testnet of Protocol_hash.t
| Activate_testnet of Protocol_hash.t * Int64.t
let mk_case name args =
let open Data_encoding in
@ -22,7 +22,7 @@ module Command = struct
(fun o -> ((), o))
(fun ((), o) -> o)
(merge_objs
(obj1 (req "network" (constant name)))
(obj1 (req "command" (constant name)))
args)
let encoding =
@ -30,14 +30,18 @@ module Command = struct
union ~tag_size:`Uint8 [
case ~tag:0
(mk_case "activate"
(obj1 (req "hash" Protocol_hash.encoding)))
(obj1
(req "hash" Protocol_hash.encoding)))
(function (Activate hash) -> Some hash | _ -> None)
(fun hash -> Activate hash) ;
case ~tag:1
(mk_case "activate_testnet"
(obj1 (req "hash" Protocol_hash.encoding)))
(function (Activate_testnet hash) -> Some hash | _ -> None)
(fun hash -> Activate_testnet hash) ;
(obj2
(req "hash" Protocol_hash.encoding)
(req "validity_time" int64)))
(function (Activate_testnet (hash, delay)) -> Some (hash, delay)
| _ -> None)
(fun (hash, delay) -> Activate_testnet (hash, delay)) ;
]
let signed_encoding =

18
src/proto/genesis/main.ml
View File

@ -45,9 +45,15 @@ type block = {
}
let max_block_length =
match Data_encoding.Binary.fixed_length Data.Command.signed_encoding with
| None -> assert false
| Some len -> len
Data_encoding.Binary.length
Data.Command.encoding
(Activate_testnet (Protocol_hash.hash_bytes [], 0L))
+
begin
match Data_encoding.Binary.fixed_length Ed25519.Signature.encoding with
| None -> assert false
| Some len -> len
end
let parse_block { Updater.shell ; proto } : block tzresult =
match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with
@ -88,11 +94,11 @@ let begin_application
Some (Format.asprintf "activate %a" Protocol_hash.pp_short hash) in
Updater.activate ctxt hash >>= fun ctxt ->
return { Updater.message ; context = ctxt ; fitness }
| Activate_testnet hash ->
| Activate_testnet (hash, delay) ->
let message =
Some (Format.asprintf "activate testnet %a" Protocol_hash.pp_short hash) in
Updater.set_test_protocol ctxt hash >>= fun ctxt ->
Updater.fork_test_network ctxt >>= fun ctxt ->
let expiration = Time.add raw_block.shell.timestamp delay in
Updater.fork_test_network ctxt hash expiration >>= fun ctxt ->
return { Updater.message ; context = ctxt ; fitness }
let begin_construction

3
test/shell/test_context.ml
View File

@ -89,8 +89,7 @@ let wrap_context_init f base_dir =
Context.commit_genesis idx
~id:genesis.block
~time:genesis.time
~protocol:genesis.protocol
~test_protocol:genesis.protocol >>= fun _ ->
~protocol:genesis.protocol >>= fun _ ->
create_block2 idx >>= fun () ->
create_block3a idx >>= fun () ->
create_block3b idx >>= fun () ->