Refactor: Move Mempool and Block_locator into lib_base

src/lib_base/block_locator.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Lwt.Infix
+
 type t = raw
 
 (** Non private version of Block_store_locator.t for coercions *)
@@ -21,37 +23,24 @@ let encoding =
      (req "current_head" (dynamic_size Block_header.encoding))
      (req "history" (dynamic_size (list Block_hash.encoding))))
 
-let predecessor (store : Store.Block.store) (b: Block_hash.t) =
-  Store.Block.Contents.read_exn (store, b) >>= fun contents ->
-  let predecessor = contents.header.shell.predecessor in
-  if Block_hash.equal b predecessor then
-    Lwt.return_none
-  else
-    Lwt.return_some predecessor
-
-let compute (store : Store.Block.store) (b: Block_hash.t) sz =
+let compute ~pred (h: Block_hash.t) (bh: Block_header.t) sz =
   let rec loop acc ~sz step cpt b =
     if sz = 0 then
       Lwt.return (List.rev acc)
     else
-      predecessor store b >>= function
+      pred b step >>= function
       | None ->
           Lwt.return (List.rev (b :: acc))
       | Some predecessor ->
           if cpt = 0 then
-            loop (b :: acc) ~sz:(sz - 1)
-              (step * 2) (step * 20 - 1) predecessor
-          else if cpt mod step = 0 then
-            loop (b :: acc) ~sz:(sz - 1)
-              step (cpt - 1) predecessor
+            loop (b :: acc) ~sz:(sz - 1) (step * 2) 10 predecessor
           else
-            loop acc ~sz step (cpt - 1) predecessor in
-  Store.Block.Contents.read_exn (store, b) >>= fun { header } ->
-  predecessor store b >>= function
-  | None -> Lwt.return (header, [])
+            loop (b :: acc) ~sz:(sz - 1) step (cpt - 1) predecessor in
+  pred h 1 >>= function
+  | None -> Lwt.return (bh, [])
   | Some p ->
       loop [] ~sz 1 9 p >>= fun hist ->
-      Lwt.return (header, hist)
+      Lwt.return (bh, hist)
 
 type validity =
   | Unknown

src/lib_base/block_locator.mli

@@ -17,9 +17,10 @@ val raw: t -> raw
 
 val encoding: t Data_encoding.t
 
-val compute: Store.Block.store -> Block_hash.t -> int -> t Lwt.t
-(** [compute block max_length] compute the sparse block locator for
-    the [block]. The locator contains at most [max_length] elements. *)
+val compute:
+  pred:(Block_hash.t -> int -> Block_hash.t option Lwt.t) ->
+  Block_hash.t -> Block_header.t -> int ->
+  t Lwt.t
 
 type validity =
   | Unknown

src/lib_base/tzPervasives.ml

@@ -33,5 +33,8 @@ module Protocol = Protocol
 module Test_network_status = Test_network_status
 module Preapply_result = Preapply_result
 
+module Block_locator = Block_locator
+module Mempool = Mempool
+
 include Utils.Infix
 include Error_monad

src/lib_base/tzPervasives.mli

@@ -31,6 +31,8 @@ module Operation = Operation
 module Protocol = Protocol
 module Test_network_status = Test_network_status
 module Preapply_result = Preapply_result
+module Block_locator = Block_locator
+module Mempool = Mempool
 
 include (module type of (struct include Utils.Infix end))
 include (module type of (struct include Error_monad end))

src/lib_node_shell/state.ml

@@ -133,9 +133,21 @@ let update_chain_store { net_id ; context_index ; chain_state } f =
     Lwt.return res
   end
 
+let rec predecessor (store : Store.Block.store) (b: Block_hash.t) n =
+  (* TODO optimize *)
+  if n = 0 then Lwt.return_some b else begin
+    Store.Block.Contents.read_exn (store, b) >>= fun contents ->
+    let pred = contents.header.shell.predecessor in
+    if Block_hash.equal b pred then
+      Lwt.return_none
+    else
+      predecessor store pred (n-1)
+  end
+
 let compute_locator_from_hash (net : net_state) ?(size = 200) head =
   Shared.use net.block_store begin fun block_store ->
-    Block_locator.compute block_store head size
+    Store.Block.Contents.read_exn (block_store, head) >>= fun { header } ->
+    Block_locator.compute ~pred:(predecessor block_store) head header size
   end
 
 let compute_locator net ?size head =