Shell: early detection of branches that forks before the checkpoint.

This commit is contained in:
Grégoire Henry 2018-05-10 17:00:26 +02:00 committed by Benjamin Canou
parent 6170ae2246
commit c16129a02d

View File

@ -31,14 +31,32 @@ type t = {
mutable errors: Error_monad.error list ;
}
let fetch_step pipeline (step : Block_locator.step) =
let assert_acceptable_header pipeline
?(first = false) hash (header : Block_header.t) =
let chain_state = Distributed_db.chain_state pipeline.chain_db in
fail_unless
(Time.(now () >= header.shell.timestamp))
(Future_block_header hash) >>=? fun () ->
State.Chain.checkpoint chain_state >>= fun (level, checkpoint) ->
fail_when
(Int32.equal header.shell.level level &&
not (Block_hash.equal checkpoint hash))
(Checkpoint_error (hash, Some pipeline.peer_id)) >>=? fun () ->
(* Early detection of fork point before the current checkpoint. *)
Chain.head chain_state >>= fun head ->
let bootstraping = (State.Block.header head).shell.level < level in
fail_when (first && not bootstraping && header.shell.level < level)
(Checkpoint_error (hash, Some pipeline.peer_id)) >>=? fun () ->
return ()
let fetch_step pipeline ?first (step : Block_locator.step) =
lwt_log_info "fetching step %a -> %a (%d%s) from peer %a."
Block_hash.pp_short step.block
Block_hash.pp_short step.predecessor
step.step
(if step.strict_step then "" else " max")
P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
let rec fetch_loop acc hash cpt =
let rec fetch_loop ?first acc hash cpt =
Lwt_unix.yield () >>= fun () ->
if cpt < 0 then
lwt_log_info "invalid step from peer %a (too long)."
@ -61,15 +79,13 @@ let fetch_step pipeline (step : Block_locator.step) =
pipeline.chain_db ~peer:pipeline.peer_id
hash ()
end >>=? fun header ->
fail_unless
(Time.(now () >= header.shell.timestamp))
(Future_block_header hash) >>=? fun () ->
assert_acceptable_header ?first pipeline hash header >>=? fun () ->
lwt_debug "fetched block header %a from peer %a."
Block_hash.pp_short hash
P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
fetch_loop ((hash, header) :: acc) header.shell.predecessor (cpt - 1)
in
fetch_loop [] step.block step.step >>=? fun headers ->
fetch_loop ?first [] step.block step.step >>=? fun headers ->
iter_s
begin fun header ->
protect ~canceler:pipeline.canceler begin fun () ->
@ -86,8 +102,12 @@ let headers_fetch_worker_loop pipeline =
the point of view of the node sending the locator *)
let seed = {Block_locator.sender_id=pipeline.peer_id; receiver_id=sender_id } in
let steps = Block_locator.to_steps seed pipeline.locator in
iter_s (fetch_step pipeline) steps >>=? fun () ->
return ()
match steps with
| [] -> return ()
| step :: steps ->
fetch_step pipeline ~first:true step >>=? fun () ->
iter_s (fetch_step pipeline) steps >>=? fun () ->
return ()
end >>= function
| Ok () ->
lwt_log_info "fetched all step from peer %a."