Shell: memorize the current list of live blocks and operations

src/node/shell/block_validator.ml

@@ -310,16 +310,22 @@ let assert_operation_liveness block live_blocks operations =
                               originating_block = op.shell.branch })))
     operations
 
-let check_liveness pred hash operations_hashes operations =
+let check_liveness net_state pred hash operations_hashes operations =
+  begin
+    Chain.data net_state >>= fun chain_data ->
+    if State.Block.equal chain_data.current_head pred then
+      Lwt.return (chain_data.live_blocks, chain_data.live_operations)
+    else
       Chain_traversal.live_blocks
-    pred (State.Block.max_operations_ttl pred) >>= fun (live_blocks,
+        pred (State.Block.max_operations_ttl pred)
-                                                        live_operations) ->
+  end >>= fun (live_blocks, live_operations) ->
   assert_no_duplicate_operations
     hash live_operations operations_hashes >>=? fun () ->
   assert_operation_liveness hash live_blocks operations >>=? fun () ->
   return ()
 
 let apply_block
+    net_state
     pred (module Proto : State.Registred_protocol.T)
     hash (header: Block_header.t)
     operations =
@@ -327,7 +333,7 @@ let apply_block
   and pred_hash = State.Block.hash pred in
   check_header pred_header hash header >>=? fun () ->
   let operation_hashes = List.map (List.map Operation.hash) operations in
-  check_liveness pred hash operation_hashes operations >>=? fun () ->
+  check_liveness net_state pred hash operation_hashes operations >>=? fun () ->
   iter_p (iter_p (fun op ->
       let op_hash = Operation.hash op in
       fail_unless
@@ -436,7 +442,9 @@ let rec worker_loop bv =
               get_proto pred hash >>=? fun proto ->
               (* TODO also protect with [bv.canceler]. *)
               Lwt_utils.protect ?canceler begin fun () ->
-                apply_block pred proto hash header operations
+                apply_block
+                  (Distributed_db.net_state net_db)
+                  pred proto hash header operations
               end
             end >>= function
             | Ok result -> begin

src/node/shell/chain.ml

@@ -35,6 +35,18 @@ let mem net_state hash =
       Store.Chain.In_chain.known (chain_store, hash)
   end
 
+type data = State.chain_data = {
+  current_head: Block.t ;
+  current_mempool: mempool ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+}
+
+let data net_state =
+  read_chain_store net_state begin fun _chain_store data ->
+    Lwt.return data
+  end
+
 let locked_set_head chain_store data block =
   let rec pop_blocks ancestor block =
     let hash = Block.hash block in
@@ -59,13 +71,22 @@ let locked_set_head chain_store data block =
   let ancestor = Block.hash ancestor in
   pop_blocks ancestor data.current_head >>= fun () ->
   Lwt_list.fold_left_s push_block ancestor path >>= fun _ ->
-  Store.Chain.Current_head.store chain_store (Block.hash block)
+  Store.Chain.Current_head.store chain_store (Block.hash block) >>= fun () ->
+  (* TODO more optimized updated of live_{blocks/operations} when the
+     new head is a direct successor of the current head... *)
+  Chain_traversal.live_blocks
+    block (State.Block.max_operations_ttl block) >>= fun (live_blocks,
+                                                          live_operations) ->
+  Lwt.return { current_head = block  ;
+               current_mempool = State.empty_mempool ;
+               live_blocks ;
+               live_operations ;
+             }
 
 let set_head net_state block =
   update_chain_store net_state begin fun chain_store data ->
-    locked_set_head chain_store data block >>= fun () ->
+    locked_set_head chain_store data block >>= fun new_chain_data ->
-    Lwt.return (Some { current_head = block  ;
+    Lwt.return (Some new_chain_data,
-                       current_mempool = State.empty_mempool },
                 data.current_head)
   end
 
@@ -74,8 +95,6 @@ let test_and_set_head net_state ~old block =
     if not (Block.equal data.current_head old) then
       Lwt.return (None, false)
     else
-      locked_set_head chain_store data block >>= fun () ->
+      locked_set_head chain_store data block >>= fun new_chain_data ->
-      Lwt.return (Some { current_head = block ;
+      Lwt.return (Some new_chain_data, true)
-                         current_mempool = State.empty_mempool },
-                  true)
   end

src/node/shell/chain.mli

@@ -18,6 +18,17 @@ val genesis: Net.t -> Block.t Lwt.t
 (** The current head of the network's blockchain. *)
 val head: Net.t -> Block.t Lwt.t
 
+(** All the available chain data. *)
+type data = {
+  current_head: Block.t ;
+  current_mempool: mempool ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+}
+
+(** Reading atomically all the chain data. *)
+val data: Net.t -> data Lwt.t
+
 (** The current head and all the known (valid) alternate heads. *)
 val known_heads: Net.t -> Block.t list Lwt.t
 

src/node/shell/state.ml

@@ -88,6 +88,8 @@ and chain_state = {
 and chain_data = {
   current_head: block ;
   current_mempool: mempool ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
 }
 
 and mempool = {
@@ -193,6 +195,8 @@ module Net = struct
           contents = current_block ;
         } ;
         current_mempool = empty_mempool ;
+        live_blocks = Block_hash.Set.singleton genesis.block ;
+        live_operations = Operation_hash.Set.empty ;
       } ;
       chain_store ;
     }

src/node/shell/state.mli

@@ -169,6 +169,8 @@ val mempool_encoding: mempool Data_encoding.t
 type chain_data = {
   current_head: Block.t ;
   current_mempool: mempool ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
 }
 
 val read_chain_store: