Adding Block.Header module to State, letting Chain_traversal.live_blocks use that module

src/lib_shell/chain_traversal.ml

@@ -131,17 +131,20 @@ let new_blocks ~from_block ~to_block =
   | Some path -> Lwt.return (ancestor, path)
 
 let live_blocks block n =
-  let rec loop bacc oacc block n =
-    Block.all_operation_hashes block >>= fun hashes ->
+  let rec loop bacc oacc chain_state block_head n =
+    Block.Header.all_operation_hashes chain_state block_head >>= fun hashes ->
     let oacc =
       List.fold_left
         (List.fold_left
            (fun oacc op -> Operation_hash.Set.add op oacc))
         oacc hashes  in
-    let bacc = Block_hash.Set.add (Block.hash block) bacc in
+    let bacc = Block_hash.Set.add (Block.Header.hash block_head) bacc in
     if n = 0 then Lwt.return (bacc, oacc)
     else
-      Block.predecessor block >>= function
+      Block.Header.predecessor chain_state block_head >>= function
       | None -> Lwt.return (bacc, oacc)
-      | Some predecessor -> loop bacc oacc predecessor (pred n) in
-  loop Block_hash.Set.empty Operation_hash.Set.empty block n
+      | Some predecessor -> loop bacc oacc chain_state predecessor (pred n) in
+  loop
+    Block_hash.Set.empty Operation_hash.Set.empty
+    (Block.chain_state block) (Block.Header.of_block block)
+    n

src/lib_shell/state.ml

@@ -94,6 +94,11 @@ and block = {
   header: Block_header.t ;
 }
 
+and hashed_header = {
+  header: Block_header.t ;
+  hash: Block_hash.t ;
+}
+
 let read_chain_data { chain_data } f =
   Shared.use chain_data begin fun state ->
     f state.chain_data_store state.data
@@ -620,6 +625,89 @@ module Block = struct
   }
   type block = t
 
+  module Header = struct
+
+    type t = hashed_header = {
+      header: Block_header.t ;
+      hash: Block_hash.t ;
+    }
+    type block_header = t
+
+    let compare b1 b2 = Block_hash.compare b1.hash b2.hash
+    let equal b1 b2 = Block_hash.equal b1.hash b2.hash
+
+    let hash { hash } = hash
+    let header { header } = header
+    let shell_header { header = { Block_header.shell } } = shell
+    let timestamp b = (shell_header b).timestamp
+    let fitness b = (shell_header b).fitness
+    let level b = (shell_header b).level
+    let validation_passes b = (shell_header b).validation_passes
+
+    let known chain_state hash =
+      Shared.use chain_state.block_store begin fun store ->
+        Store.Block.Header.known (store, hash)
+      end
+
+    let read chain_state ?(pred = 0) hash =
+      Shared.use chain_state.block_store begin fun store ->
+        begin
+          if pred = 0 then
+            return hash
+          else
+            predecessor_n store hash pred >>= function
+            | None -> return chain_state.genesis.block
+            | Some hash -> return hash
+        end >>=? fun hash ->
+        Store.Block.Header.read (store, hash) >>=? fun header ->
+        return { header ; hash }
+      end
+    let read_opt chain_state ?pred hash =
+      read chain_state ?pred hash >>= function
+      | Error _ -> Lwt.return_none
+      | Ok v -> Lwt.return_some v
+    let read_exn chain_state ?(pred = 0) hash =
+      Shared.use chain_state.block_store begin fun store ->
+        begin
+          if pred = 0 then
+            Lwt.return hash
+          else
+            predecessor_n store hash pred >>= function
+            | None -> Lwt.return chain_state.genesis.block
+            | Some hash -> Lwt.return hash
+        end >>= fun hash ->
+        Store.Block.Header.read_exn (store, hash) >>= fun header ->
+        Lwt.return { header ; hash }
+      end
+
+    let of_block ( { hash ; header } : block ) : t = { hash ; header }
+    let to_block chain_state ( { hash ; header } : t ) : block option Lwt.t =
+      Shared.use chain_state.block_store begin fun store ->
+        Store.Block.Contents.read_opt (store, hash) >>= function
+        | Some contents -> Lwt.return_some { chain_state ; hash ; contents ; header }
+        | None -> Lwt.return_none
+      end
+
+    let all_operation_hashes chain_state { hash ; header } =
+      Shared.use chain_state.block_store begin fun store ->
+        Lwt_list.map_p
+          (Store.Block.Operation_hashes.read_exn (store, hash))
+          (0 -- (header.Block_header.shell.validation_passes - 1))
+      end
+
+    let predecessor chain_state { hash ; header } =
+      if Block_hash.equal hash header.Block_header.shell.predecessor then
+        Lwt.return_none           (* we are at genesis *)
+      else
+        read_exn chain_state header.Block_header.shell.predecessor >>= fun block ->
+        Lwt.return_some block
+
+    let predecessor_n chain_state hash n =
+      Shared.use chain_state.block_store begin fun block_store ->
+        predecessor_n block_store hash n
+      end
+  end
+
   let compare b1 b2 = Block_hash.compare b1.hash b2.hash
   let equal b1 b2 = Block_hash.equal b1.hash b2.hash
 
@@ -719,14 +807,14 @@ module Block = struct
 
   (* Quick accessor to be optimized ?? *)
   let read_predecessor chain_state hash =
-    read chain_state hash >>=? fun { header } ->
+    Header.read chain_state hash >>=? fun { Header.header } ->
     return header.shell.predecessor
   let read_predecessor_opt chain_state hash =
     read_predecessor chain_state hash >>= function
     | Error _ -> Lwt.return_none
     | Ok v -> Lwt.return_some v
   let read_predecessor_exn chain_state hash =
-    read_exn chain_state hash >>= fun { header } ->
+    Header.read_exn chain_state hash >>= fun { Header.header } ->
     Lwt.return header.shell.predecessor
 
   let predecessor { chain_state ; header ; hash } =

src/lib_shell/state.mli

@@ -109,6 +109,9 @@ module Chain : sig
 
 end
 
+(** {2 Block header manipulation} ******************************************)
+
+
 (** {2 Block database} *****************************************************)
 
 module Block : sig
@@ -141,6 +144,37 @@ module Block : sig
     error list ->
     bool tzresult Lwt.t
 
+  module Header : sig
+    type t
+    type block_header = t
+
+    val known: Chain.t -> Block_hash.t -> bool Lwt.t
+
+    val read: Chain.t -> ?pred:int -> Block_hash.t -> block_header tzresult Lwt.t
+    val read_opt: Chain.t -> ?pred:int -> Block_hash.t -> block_header option Lwt.t
+    val read_exn: Chain.t -> ?pred:int -> Block_hash.t -> block_header Lwt.t
+    val of_block: block -> block_header
+    val to_block: Chain.t -> block_header -> block option Lwt.t
+
+    val compare: t -> t -> int
+    val equal: t -> t -> bool
+
+    val hash: t -> Block_hash.t
+    val header: t -> Block_header.t
+    val shell_header: t -> Block_header.shell_header
+    val timestamp: t -> Time.t
+    val fitness: t -> Fitness.t
+    val validation_passes: t -> int
+    val level: t -> Int32.t
+
+    val all_operation_hashes: Chain.t -> block_header -> Operation_hash.t list list Lwt.t
+
+    val predecessor : Chain.t -> block_header -> block_header option Lwt.t
+    val predecessor_n : Chain.t -> Block_hash.t -> int -> Block_hash.t option Lwt.t
+
+  end
+
+
   val compare: t -> t -> int
   val equal: t -> t -> bool