Shell: keep a reference to 'State.t' in 'State.Net.t'

src/node/shell/state.ml

@@ -48,6 +48,7 @@ and global_data = {
 }
 
 and net_state = {
+  global_state: global_state ;
   net_id: Net_id.t ;
   genesis: genesis ;
   expiration: Time.t option ;
@@ -147,7 +148,7 @@ module Net = struct
   let allocate
       ~genesis ~expiration ~allow_forked_network
       ~current_head
-      context_index chain_store block_store =
+      global_state context_index chain_store block_store =
     Store.Block.Contents.read_exn
       (block_store, current_head) >>= fun current_block ->
     let rec chain_state = {
@@ -162,6 +163,7 @@ module Net = struct
       chain_store ;
     }
     and net_state = {
+      global_state ;
       net_id = Net_id.of_block_hash genesis.block ;
       chain_state = { Shared.data = chain_state ; lock = Lwt_mutex.create () } ;
       genesis ;
@@ -174,7 +176,7 @@ module Net = struct
     Lwt.return net_state
 
   let locked_create
-      data ?expiration ?(allow_forked_network = false)
+      global_state data ?expiration ?(allow_forked_network = false)
       net_id genesis commit =
     let net_store = Store.Net.get data.global_store net_id in
     let block_store = Store.Block.get net_store
@@ -202,6 +204,7 @@ module Net = struct
       ~current_head:genesis.block
       ~expiration
       ~allow_forked_network
+      global_state
       data.context_index
       chain_store
       block_store
@@ -218,12 +221,12 @@ module Net = struct
           ~time:genesis.time
           ~protocol:genesis.protocol >>= fun commit ->
         locked_create
-          data ?allow_forked_network net_id genesis commit >>= fun net ->
+          state data ?allow_forked_network net_id genesis commit >>= fun net ->
         Net_id.Table.add data.nets net_id net ;
         Lwt.return net
     end
 
-  let locked_read data id =
+  let locked_read global_state data id =
     let net_store = Store.Net.get data.global_store id in
     let block_store = Store.Block.get net_store
     and chain_store = Store.Chain.get net_store in
@@ -240,22 +243,23 @@ module Net = struct
       ~current_head
       ~expiration
       ~allow_forked_network
+      global_state
       data.context_index
       chain_store
       block_store >>= return
 
-  let locked_read_all data =
+  let locked_read_all global_state data =
     Store.Net.list data.global_store >>= fun ids ->
     iter_p
       (fun id ->
-         locked_read data id >>=? fun net ->
+         locked_read global_state data id >>=? fun net ->
          Net_id.Table.add data.nets id net ;
          return ())
       ids
 
   let read_all state =
     Shared.use state.global_data begin fun data ->
-      locked_read_all data
+      locked_read_all state data
     end
 
   let get state id =
@@ -274,6 +278,7 @@ module Net = struct
   let genesis { genesis } = genesis
   let expiration { expiration } = expiration
   let allow_forked_network { allow_forked_network } = allow_forked_network
+  let global_state { global_state } = global_state
 
   let destroy state net =
     lwt_debug "destroy %a" Net_id.pp (id net) >>= fun () ->
@@ -299,6 +304,7 @@ module Block = struct
 
   let hash { hash } = hash
   let header { contents = { header } } = header
+  let net_state { net_state } = net_state
   let shell_header { contents = { header = { shell } } } = shell
   let net_id b = (shell_header b).net_id
   let timestamp b = (shell_header b).timestamp
@@ -506,8 +512,8 @@ let read_block_exn t hash =
   | None -> Lwt.fail Not_found
   | Some b -> Lwt.return b
 
-let fork_testnet state block protocol expiration =
+let fork_testnet block protocol expiration =
-  Shared.use state.global_data begin fun data ->
+  Shared.use block.net_state.global_state.global_data begin fun data ->
     Block.context block >>= fun context ->
     Context.set_test_network context Not_running >>= fun context ->
     Context.set_protocol context protocol >>= fun context ->
@@ -519,7 +525,7 @@ let fork_testnet state block protocol expiration =
       time = Time.add block.contents.header.shell.timestamp 1L ;
       protocol ;
     } in
-    Net.locked_create data
+    Net.locked_create block.net_state.global_state data
       net_id ~expiration genesis commit >>= fun net ->
     return net
   end

src/node/shell/state.mli

@@ -79,6 +79,7 @@ module Net : sig
       - its optional expiration time
       - the associated global state. *)
 
+  val global_state: net_state -> global_state
 
 end
 
@@ -119,6 +120,7 @@ module Block : sig
   val fitness: t -> Fitness.t
   val operation_list_count: t -> int
   val net_id: t -> Net_id.t
+  val net_state: t -> Net.t
   val level: t -> Int32.t
   val message: t -> string
   val max_operations_ttl: t -> int
@@ -149,8 +151,7 @@ val read_block_exn:
   global_state -> Block_hash.t -> Block.t Lwt.t
 
 val fork_testnet:
-  global_state -> Block.t -> Protocol_hash.t -> Time.t ->
+  Block.t -> Protocol_hash.t -> Time.t -> Net.t tzresult Lwt.t
-  Net.t tzresult Lwt.t
 
 type chain_data = {
   current_head: Block.t ;

src/node/shell/validator.ml

@@ -702,8 +702,7 @@ let rec create_validator ?parent worker ?max_child_ttl state db net =
         State.Net.get state net_id >>= function
         | Ok net_store -> return net_store
         | Error _ ->
-            State.fork_testnet
+            State.fork_testnet block protocol expiration >>=? fun net_store ->
-              state block protocol expiration >>=? fun net_store ->
             Chain.head net_store >>= fun block ->
             Watcher.notify v.worker.valid_block_input block ;
             return net_store