Node: add an explicit type for Block_locator.t

src/node/shell/block_locator.ml

@@ -0,0 +1,109 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open State
+
+type t = Block_hash.t list
+
+type error += Invalid_locator of P2p.Peer_id.t * t
+
+let encoding =
+  let open Data_encoding in
+  (* TODO add a [description] *)
+  list Block_hash.encoding
+
+let compute (b: Block.t) sz =
+  let rec loop acc sz step cpt b =
+    if sz = 0 then
+      Lwt.return (List.rev acc)
+    else
+      Block.predecessor b >>= function
+      | None ->
+          Lwt.return (List.rev (Block.hash b :: acc))
+      | Some predecessor ->
+          if cpt = 0 then
+            loop (Block.hash b :: acc) (sz - 1)
+                 (step * 2) (step * 20 - 1) predecessor
+          else if cpt mod step = 0 then
+            loop (Block.hash b :: acc) (sz - 1)
+                 step (cpt - 1) predecessor
+          else
+            loop acc sz step (cpt - 1) predecessor in
+  loop [] sz 1 9 b
+
+let estimated_length hist =
+  let rec loop acc step cpt = function
+    | [] -> acc
+    | _ :: hist ->
+        if cpt = 0 then
+          loop (acc+step) (step*2) 9 hist
+        else
+          loop (acc+step) step (cpt-1) hist
+  in
+  loop 0 1 9 hist
+
+let fold ~f acc hist =
+  let rec loop step cpt acc = function
+    | [] | [_] -> acc
+    | block :: (pred :: rem as hist) ->
+        let step, cpt =
+          if cpt = 0 then
+            2 * step, 9
+          else
+            step, cpt - 1 in
+        let acc = f acc ~block ~pred ~step ~strict_step:(rem <> []) in
+        loop step cpt acc hist
+  in
+  loop 1 9 acc hist
+
+type step = {
+  block: Block_hash.t ;
+  predecessor: Block_hash.t ;
+  step: int ;
+  strict_step: bool ;
+}
+
+let to_steps hist =
+  fold
+    ~f:begin fun acc ~block ~pred ~step ~strict_step -> {
+          block ; predecessor = pred ; step ; strict_step ;
+        } :: acc
+    end
+    [] hist
+
+let rec known_ancestor net_state acc hist =
+  match hist with
+  | [] -> Lwt.return_none
+  | h :: hist ->
+      Block.read_opt net_state h >>= function
+      | Some block -> Lwt.return (Some (block, List.rev (h :: acc)))
+      | None ->
+          Block.known_invalid net_state h >>= function
+          | true -> Lwt.return_none
+          | false -> known_ancestor net_state (h :: acc) hist
+
+let known_ancestor net_state hist =
+  known_ancestor net_state [] hist
+
+let find_new net_state hist sz =
+  let rec path sz acc h =
+    if sz <= 0 then Lwt.return (List.rev acc)
+    else
+      read_chain_store net_state begin fun chain_store _data ->
+        Store.Chain.In_chain.read_opt (chain_store, h)
+      end >>= function
+      | None -> Lwt.return (List.rev acc)
+      | Some s -> path (sz-1) (s :: acc) s in
+  known_ancestor net_state hist >>= function
+  | None -> Lwt.return_nil
+  | Some (known, _) ->
+      Chain.head net_state >>= fun head ->
+      Chain_traversal.common_ancestor known head >>= fun ancestor ->
+      path sz [] (Block.hash ancestor)
+

src/node/shell/block_locator.mli

@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open State
+
+type t = private Block_hash.t list
+(** A type for sparse block locator (/à la/ Bitcoin) *)
+
+val encoding: t Data_encoding.t
+
+type error += Invalid_locator of P2p.Peer_id.t * t
+
+val compute: Block.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 fold:
+  f:('a -> block:Block_hash.t -> pred:Block_hash.t -> step:int -> strict_step:bool -> 'a) ->
+  'a -> t -> 'a
+(** [map f l] applies [f] to each block of the locator, the last one
+    excepted. The function also receives the expected predecessor
+    [pred] of the [block] after [step] steps, i.e. the next block in
+    the locator. When [strict_step] is [true], then [step] is the
+    exact number of predecessor to be followed before to found
+    [pred]. Otherwise, it is only an upper bound. *)
+
+type step = {
+  block: Block_hash.t ;
+  predecessor: Block_hash.t ;
+  step: int ;
+  strict_step: bool ;
+}
+val to_steps: t -> step list
+
+val estimated_length: t -> int
+(** [estimated_length locator] estimate the length of the chain
+    represented by [locator]. *)
+
+val known_ancestor: State.Net.t -> t -> (Block.t * t) option Lwt.t
+(** [known_ancestor net_state locator] computes the first block of
+    [locator] that is known to be a valid block. It also computes the
+    'prefix' of [locator] with end at the first valid block.  The
+    function returns [None] when no block in the locator are known or
+    if the first known block is invalid. *)
+
+val find_new:
+  State.Net.t -> t -> int -> Block_hash.t list Lwt.t
+(** [find_new net locator max_length] returns the blocks from our
+    current branch that would be unknown to a peer that sends us the
+    [locator]. *)
+

src/node/shell/chain.ml

@@ -34,25 +34,6 @@ let mem net_state hash =
       Store.Chain.In_chain.known (chain_store, hash)
   end
 
-let find_new net_state hist sz =
-  let rec common_ancestor hist =
-    match hist with
-    | [] -> Lwt.return (Net.genesis net_state).block
-    | h :: hist ->
-        mem net_state h >>= function
-        | false -> common_ancestor hist
-        | true -> Lwt.return h in
-  let rec path sz acc h =
-    if sz <= 0 then Lwt.return (List.rev acc)
-    else
-      read_chain_store net_state begin fun chain_store _data ->
-        Store.Chain.In_chain.read_opt (chain_store, h)
-      end >>= function
-      | None -> Lwt.return (List.rev acc)
-      | Some s -> path (sz-1) (s :: acc) s in
-  common_ancestor hist >>= fun ancestor ->
-  path sz [] ancestor
-
 let locked_set_head chain_store data block =
   let rec pop_blocks ancestor block =
     let hash = Block.hash block in

src/node/shell/chain.mli

@@ -35,9 +35,3 @@ val test_and_set_head:
 (** Atomically change the current head of the network's blockchain.
     This returns [true] whenever the change succeeded, or [false]
     when the current head os not equal to the [old] argument. *)
-
-val find_new:
-  Net.t -> Block_hash.t list -> int -> Block_hash.t list Lwt.t
-  (** [find_new net locator max_length], where [locator] is a sparse block
-      locator (/à la/ Bitcoin), returns the missing block when compared
-      with the current branch of [net]. *)

src/node/shell/chain_traversal.ml

@@ -37,25 +37,6 @@ let common_ancestor (b1: Block.t) (b2: Block.t) =
       | Some b1 -> loop b1 b2 in
   loop b1 b2
 
-let block_locator (b: Block.t) sz =
-  let rec loop acc sz step cpt b =
-    if sz = 0 then
-      Lwt.return (List.rev acc)
-    else
-      Block.predecessor b >>= function
-      | None ->
-          Lwt.return (List.rev (Block.hash b :: acc))
-      | Some predecessor ->
-          if cpt = 0 then
-            loop (Block.hash b :: acc) (sz - 1)
-                 (step * 2) (step * 20 - 1) predecessor
-          else if cpt mod step = 0 then
-            loop (Block.hash b :: acc) (sz - 1)
-                 step (cpt - 1) predecessor
-          else
-            loop acc sz step (cpt - 1) predecessor in
-  loop [] sz 1 9 b
-
 let iter_predecessors ?max ?min_fitness ?min_date heads ~f =
   let module Local = struct exception Exit end in
   let compare b1 b2 =

src/node/shell/chain_traversal.mli

@@ -18,10 +18,6 @@ val common_ancestor: Block.t -> Block.t -> Block.t Lwt.t
 (** [common_ancestor state h1 h2] returns the first common ancestors
     in the history of blocks [h1] and [h2]. *)
 
-val block_locator: Block.t -> int -> Block_hash.t list Lwt.t
-(** [block_locator state max_length h] compute the sparse block locator
-    (/à la/ Bitcoin) for the block [h]. *)
-
 val iter_predecessors:
   ?max:int ->
   ?min_fitness:Fitness.t ->

src/node/shell/distributed_db.ml

@@ -300,7 +300,7 @@ module Raw_protocol =
     end)
 
 type callback = {
-  notify_branch: P2p.Peer_id.t -> Block_hash.t list -> unit ;
+  notify_branch: P2p.Peer_id.t -> Block_locator.t -> unit ;
   notify_head: P2p.Peer_id.t -> Block_hash.t -> Operation_hash.t list -> unit ;
   disconnection: P2p.Peer_id.t -> unit ;
 }
@@ -404,7 +404,7 @@ module P2p_reader = struct
           @@ P2p.try_send global_db.p2p state.conn
           @@ Get_current_branch net_id ;
         Chain.head net_db.net_state >>= fun head ->
-        Chain_traversal.block_locator head 200 >>= fun locator ->
+        Block_locator.compute head 200 >>= fun locator ->
         ignore
         @@ P2p.try_send global_db.p2p state.conn
         @@ Current_branch (net_id, locator) ;
@@ -414,7 +414,7 @@ module P2p_reader = struct
         may_activate global_db state net_id @@ fun net_db ->
         Lwt_list.exists_p
           (State.Block.known_invalid net_db.net_state)
-          locator >>= fun known_invalid ->
+          (locator :> Block_hash.t list) >>= fun known_invalid ->
         if not known_invalid then
           net_db.callback.notify_branch state.gid locator ;
         (* TODO Kickban *)

src/node/shell/distributed_db.mli

@@ -23,7 +23,7 @@ type net_db
 val state: net_db -> State.Net.t
 
 type callback = {
-  notify_branch: P2p.Peer_id.t -> Block_hash.t list -> unit ;
+  notify_branch: P2p.Peer_id.t -> Block_locator.t -> unit ;
   notify_head: P2p.Peer_id.t -> Block_hash.t -> Operation_hash.t list -> unit ;
   disconnection: P2p.Peer_id.t -> unit ;
 }

src/node/shell/distributed_db_message.ml

@@ -10,7 +10,7 @@
 type t =
 
   | Get_current_branch of Net_id.t
-  | Current_branch of Net_id.t * Block_hash.t list (* Block locator *)
+  | Current_branch of Net_id.t * Block_locator.t
   | Deactivate of Net_id.t
 
   | Get_current_head of Net_id.t
@@ -51,7 +51,7 @@ let encoding =
     case ~tag:0x11
       (obj2
          (req "net_id" Net_id.encoding)
-         (req "current_branch" (list Block_hash.encoding)))
+         (req "current_branch" Block_locator.encoding))
       (function
         | Current_branch (net_id, bhs) -> Some (net_id, bhs)
         | _ -> None)

src/node/shell/distributed_db_message.mli

@@ -10,7 +10,7 @@
 type t =
 
   | Get_current_branch of Net_id.t
-  | Current_branch of Net_id.t * Block_hash.t list (* Block locator *)
+  | Current_branch of Net_id.t * Block_locator.t
   | Deactivate of Net_id.t
 
   | Get_current_head of Net_id.t

src/node/shell/state.ml

@@ -320,6 +320,15 @@ module Block = struct
       Store.Block.Invalid_block.known store hash
     end
 
+  let known net_state hash =
+    Shared.use net_state.block_store begin fun store ->
+      Store.Block.Contents.known (store, hash) >>= fun known ->
+      if known then
+        Lwt.return_true
+      else
+        Store.Block.Invalid_block.known store hash
+    end
+
   let read net_state hash =
     Shared.use net_state.block_store begin fun store ->
       Store.Block.Contents.read (store, hash) >>=? fun contents ->

src/node/shell/state.mli

@@ -89,6 +89,7 @@ module Block : sig
   type t
   type block = t
 
+  val known: Net.t -> Block_hash.t -> bool Lwt.t
   val known_valid: Net.t -> Block_hash.t -> bool Lwt.t
   val known_invalid: Net.t -> Block_hash.t -> bool Lwt.t
 

src/node/shell/validator.ml

@@ -757,7 +757,9 @@ let rec create_validator ?parent worker ?max_child_ttl state db net =
     let rec loop () =
       Lwt_pipe.pop queue >>= function
       | `Branch (_gid, locator) ->
-          List.iter (Context_db.prefetch v session) locator ;
+          List.iter
+            (Context_db.prefetch v session)
+            (locator :> Block_hash.t list) ;
           loop ()
       | `Head (gid, head, ops) ->
           Context_db.prefetch v session head ;

test/shell/test_state.ml

@@ -275,8 +275,9 @@ let test_ancestor s =
 
 let test_locator s =
   let check_locator h1 expected =
-    Chain_traversal.block_locator
+    Block_locator.compute
       (vblock s h1) (List.length expected) >>= fun l ->
+    let l = (l :> Block_hash.t list) in
     if List.length l <> List.length expected then
       Assert.fail_msg
         "Invalid locator length %s (found: %d, expected: %d)"
@@ -414,12 +415,12 @@ let test_new_blocks s =
 
 (****************************************************************************)
 
-(** Chain.find_new *)
+(** Block_locator.find_new *)
 
 let test_find_new s =
   let test s h expected =
-    Chain_traversal.block_locator (vblock s h) 50 >>= fun loc ->
-    Chain.find_new s.net loc (List.length expected) >>= fun blocks ->
+    Block_locator.compute (vblock s h) 50 >>= fun loc ->
+    Block_locator.find_new s.net loc (List.length expected) >>= fun blocks ->
     if List.length blocks <> List.length expected then
       Assert.fail_msg
         "Invalid locator length %s (found: %d, expected: %d)"