Skip to content

Commit

Permalink
consensus: do not even propagate future headers
Browse files Browse the repository at this point in the history 
This an aggressively-simple interpretation of the easy part of Ouroboros
Chronos in the presence of The Header-Body Split. (The hard part is the
_synchronization beacons_---which need to be propagated promptly, and will be
implemented much later.)

Other less-aggressive interpretations would propagate future headers/blocks but
set them aside. But this seems much simpler and within an RTT or two, assuming
eg the NTP clients are well-configured.
  • Loading branch information
@nfrisby
nfrisby committed Nov 28, 2023
1 parent ce13b8b commit 916e825
Show file tree
Hide file tree
Showing 4 changed files with 248 additions and 103 deletions.
1 change: 1 addition & 0 deletions ouroboros-consensus/ouroboros-consensus.cabal
View file
Expand Up @@ -141,6 +141,7 @@ library
Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface
Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
Ouroboros.Consensus.MiniProtocol.ChainSync.Client
Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
Ouroboros.Consensus.MiniProtocol.ChainSync.Server
Ouroboros.Consensus.MiniProtocol.LocalStateQuery.Server
Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server
Expand Down
1 change: 1 addition & 0 deletions ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/InFuture.hs
View file
Expand Up @@ -18,6 +18,7 @@ module Ouroboros.Consensus.Fragment.InFuture (
, defaultClockSkew
-- ** opaque
, ClockSkew
, unClockSkew
-- * Testing
, dontCheck
, miracle
Expand Down
254 changes: 156 additions & 98 deletions ...os-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
View file
Expand Up @@ -51,19 +51,23 @@ import NoThunks.Class (unsafeNoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Forecast
import Ouroboros.Consensus.HardFork.History (PastHorizonException (PastHorizon))
import Ouroboros.Consensus.HeaderStateHistory
(HeaderStateHistory (..), validateHeader)
import qualified Ouroboros.Consensus.HeaderStateHistory as HeaderStateHistory
import Ouroboros.Consensus.HeaderValidation hiding (validateHeader)
import Ouroboros.Consensus.Ledger.Basics (LedgerState)
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.SupportsProtocol
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.ChainDB (ChainDB,
InvalidBlockReason)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import Ouroboros.Consensus.Util
import Ouroboros.Consensus.Util.Assert (assertWithMsg)
import qualified Ouroboros.Consensus.Util.EarlyExit as EarlyExit
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.STM (Fingerprint, Watcher (..),
WithFingerprint (..), withWatcher)
Expand Down Expand Up @@ -426,13 +430,20 @@ chainSyncClient
=> MkPipelineDecision
-> Tracer m (TraceChainSyncClientEvent blk)
-> TopLevelConfig blk
-> InFutureCheck.HeaderInFutureCheck m blk
-> ChainDbView m blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> Consensus ChainSyncClientPipelined blk m
chainSyncClient mkPipelineDecision0 tracer cfg
InFutureCheck.HeaderInFutureCheck
{ handleHeaderArrival
, judgeHeaderArrival
, proxyArrival = Proxy :: Proxy arrival
, recordHeaderArrival
}
ChainDbView
{ getCurrentChain
, getHeaderStateHistory
Expand Down Expand Up @@ -706,104 +717,151 @@ chainSyncClient mkPipelineDecision0 tracer cfg
(ClientPipelinedStIdle n)
rollForward mkPipelineDecision n hdr theirTip
= Stateful $ \kis -> traceException $ do
now <- getMonotonicTime
let hdrPoint = headerPoint hdr

isInvalidBlock <- atomically $ forgetFingerprint <$> getIsInvalidBlock
let disconnectWhenInvalid = \case
GenesisHash -> pure ()
BlockHash hash ->
arrival <- recordHeaderArrival hdr
now <- getMonotonicTime
let hdrPoint = headerPoint hdr
slotNo = blockSlot hdr

do
let scrutinee =
case isPipeliningEnabled version of
NotReceivingTentativeBlocks -> BlockHash (headerHash hdr)
-- Disconnect if the parent block of `hdr` is known to be invalid.
ReceivingTentativeBlocks -> headerPrevHash hdr
case scrutinee of
GenesisHash -> return ()
BlockHash hash -> do
-- If the peer is sending headers quickly, the
-- @invalidBlockWatcher@ might miss one. So this call is a
-- lightweight supplement. Note that neither check /must/ be 100%
-- reliable.
isInvalidBlock <- atomically $ forgetFingerprint <$> getIsInvalidBlock
whenJust (isInvalidBlock hash) $ \reason ->
disconnect $ InvalidBlock hdrPoint hash reason
disconnectWhenInvalid $
case isPipeliningEnabled version of
-- Disconnect if the parent block of `hdr` is known to be invalid.
ReceivingTentativeBlocks -> headerPrevHash hdr
NotReceivingTentativeBlocks -> BlockHash (headerHash hdr)

-- Get the ledger view required to validate the header
-- NOTE: This will block if we are too far behind.
intersectCheck <- atomically $ do
-- Before obtaining a 'LedgerView', we must find the most recent
-- intersection with the current chain. Note that this is cheap when
-- the chain and candidate haven't changed.

mLedgerView <- EarlyExit.withEarlyExit $ do
Intersects kis2 lst <- checkArrivalTime kis arrival
Intersects kis3 ledgerView <- case projectLedgerView slotNo lst of
Just ledgerView -> pure $ Intersects kis2 ledgerView
Nothing -> readLedgerState kis2 (projectLedgerView slotNo)
pure $ Intersects kis3 ledgerView

case mLedgerView of

Nothing -> do
-- The above computation exited early, which means our chain (tip)
-- has changed and it no longer intersects with the candidate
-- fragment, so we have to find a new intersection. But first drain
-- the pipe.
continueWithState ()
$ drainThePipe n
$ findIntersection NoMoreIntersection

Just (Intersects kis' ledgerView) -> do
-- Our chain still intersects with the candidate fragment and we
-- have obtained a 'LedgerView' that we can use to validate @hdr@.
let KnownIntersectionState {
ourFrag
, theirFrag
, theirHeaderStateHistory
, mostRecentIntersection
} = kis'

-- Validate header
theirHeaderStateHistory' <-
case runExcept $ validateHeader cfg ledgerView hdr theirHeaderStateHistory of
Right theirHeaderStateHistory' -> return theirHeaderStateHistory'
Left vErr ->
disconnect $
HeaderError hdrPoint vErr (ourTipFromChain ourFrag) theirTip

let theirFrag' = theirFrag :> hdr
-- Advance the most recent intersection if we have the same
-- header on our fragment too. This is cheaper than recomputing
-- the intersection from scratch.
mostRecentIntersection'
| Just ourSuccessor <-
AF.successorBlock (castPoint mostRecentIntersection) ourFrag
, headerHash ourSuccessor == headerHash hdr
= headerPoint hdr
| otherwise
= mostRecentIntersection
kis'' = assertKnownIntersectionInvariants (configConsensus cfg) $
KnownIntersectionState {
theirFrag = theirFrag'
, theirHeaderStateHistory = theirHeaderStateHistory'
, ourFrag = ourFrag
, mostRecentIntersection = mostRecentIntersection'
}
atomically $ writeTVar varCandidate theirFrag'
atomically $ traceWith headerMetricsTracer (slotNo, now)

continueWithState kis'' $ nextStep mkPipelineDecision n theirTip

-- Used in 'rollForward': determines whether the header is from the future,
-- and handle that fact if so. Also return the ledger state used for the
-- determination.
--
-- Relies on 'readLedgerState'.
checkArrivalTime :: KnownIntersectionState blk
-> arrival
-> EarlyExit.WithEarlyExit m (Intersects blk (LedgerState blk))
checkArrivalTime kis arrival = do
Intersects kis' (lst, judgment) <- readLedgerState kis $ \lst ->
case runExcept $ judgeHeaderArrival (configLedger cfg) lst arrival of
Left PastHorizon{} -> Nothing
Right judgment -> Just (lst, judgment)

-- For example, throw an exception if the header is from the far
-- future.
EarlyExit.lift $ handleHeaderArrival judgment >>= \case
Just exn -> disconnect (InFutureHeaderExceedsClockSkew exn)
Nothing -> return $ Intersects kis' lst

-- Used in 'rollForward': block until the the ledger state at the
-- intersection with the local selection returns 'Just'.
--
-- Exits early if the intersection no longer exists.
readLedgerState :: KnownIntersectionState blk
-> (LedgerState blk -> Maybe a)
-> EarlyExit.WithEarlyExit m (Intersects blk a)
readLedgerState kis prj = join $ EarlyExit.lift $ atomically $ do
-- We must first find the most recent intersection with the current
-- chain. Note that this is cheap when the chain and candidate haven't
-- changed.
mKis' <- intersectsWithCurrentChain kis
case mKis' of
Nothing -> return NoLongerIntersects
Nothing -> return EarlyExit.exitEarly
Just kis'@KnownIntersectionState { mostRecentIntersection } -> do
-- We're calling 'ledgerViewForecastAt' in the same STM transaction
-- as 'intersectsWithCurrentChain'. This guarantees the former's
-- precondition: the intersection is within the last @k@ blocks of
-- the current chain.
forecast <-
lst <-
maybe
(error $
"intersection not within last k blocks: " <> show mostRecentIntersection)
(ledgerViewForecastAt (configLedger cfg) . ledgerState)
ledgerState
<$> getPastLedger mostRecentIntersection

case runExcept $ forecastFor forecast (blockSlot hdr) of
-- The header is too far ahead of the intersection point with our
-- current chain. We have to wait until our chain and the
-- intersection have advanced far enough. This will wait on
-- changes to the current chain via the call to
-- 'intersectsWithCurrentChain' before it.
Left OutsideForecastRange{} ->
retry
Right ledgerView ->
return $ Intersects kis' ledgerView

case intersectCheck of
NoLongerIntersects ->
-- Our chain (tip) has changed and it no longer intersects with the
-- candidate fragment, so we have to find a new intersection, but
-- first drain the pipe.
continueWithState ()
$ drainThePipe n
$ findIntersection NoMoreIntersection

Intersects kis' ledgerView -> do
-- Our chain still intersects with the candidate fragment and we
-- have obtained a 'LedgerView' that we can use to validate @hdr@.

let KnownIntersectionState {
ourFrag
, theirFrag
, theirHeaderStateHistory
, mostRecentIntersection
} = kis'

-- Validate header
theirHeaderStateHistory' <-
case runExcept $ validateHeader cfg ledgerView hdr theirHeaderStateHistory of
Right theirHeaderStateHistory' -> return theirHeaderStateHistory'
Left vErr ->
disconnect $
HeaderError hdrPoint vErr (ourTipFromChain ourFrag) theirTip

let theirFrag' = theirFrag :> hdr
-- Advance the most recent intersection if we have the same header
-- on our fragment too. This is cheaper than recomputing the
-- intersection from scratch.
mostRecentIntersection'
| Just ourSuccessor <-
AF.successorBlock (castPoint mostRecentIntersection) ourFrag
, headerHash ourSuccessor == headerHash hdr
= headerPoint hdr
| otherwise
= mostRecentIntersection
kis'' = assertKnownIntersectionInvariants (configConsensus cfg) $
KnownIntersectionState {
theirFrag = theirFrag'
, theirHeaderStateHistory = theirHeaderStateHistory'
, ourFrag = ourFrag
, mostRecentIntersection = mostRecentIntersection'
}
atomically $ writeTVar varCandidate theirFrag'
let slotNo = blockSlot hdr
atomically $ traceWith headerMetricsTracer (slotNo, now)

continueWithState kis'' $ nextStep mkPipelineDecision n theirTip
case prj lst of
Nothing -> retry
Just ledgerView -> return $ return $ Intersects kis' ledgerView

-- Used in 'rollForward': returns 'Nothing' if the ledger state cannot
-- forecast the ledger view that far into the future.
projectLedgerView :: SlotNo
-> LedgerState blk
-> Maybe (LedgerView (BlockProtocol blk))
projectLedgerView slot lst =
let forecast = ledgerViewForecastAt (configLedger cfg) lst
-- TODO cache this in the KnownIntersectionState? Or even in the
-- LedgerDB?
in
case runExcept $ forecastFor forecast slot of
-- The header is too far ahead of the intersection point with our
-- current chain. We have to wait until our chain and the
-- intersection have advanced far enough. This will wait on
-- changes to the current chain via the call to
-- 'intersectsWithCurrentChain' before it.
Left OutsideForecastRange{} -> Nothing
Right ledgerView -> Just ledgerView

rollBackward :: MkPipelineDecision
-> Nat n
Expand Down Expand Up @@ -1024,16 +1082,10 @@ invalidBlockRejector tracer version getIsInvalidBlock getCandidate =
throwIO ex

-- | Auxiliary data type used as an intermediary result in 'rollForward'.
data IntersectCheck blk =
-- | The upstream chain no longer intersects with our current chain because
-- our current chain changed in the background.
NoLongerIntersects
-- | The upstream chain still intersects with our chain, return the
-- resulting 'KnownIntersectionState' and the 'LedgerView' corresponding to
-- the header 'rollForward' received.
| Intersects
(KnownIntersectionState blk)
(LedgerView (BlockProtocol blk))
data Intersects blk a =
Intersects
(KnownIntersectionState blk)
a

{-------------------------------------------------------------------------------
Explicit state
Expand Down Expand Up @@ -1159,6 +1211,8 @@ data ChainSyncClientException =
-- different from the previous argument.
(InvalidBlockReason blk)

| InFutureHeaderExceedsClockSkew !InFutureCheck.HeaderArrivalException

deriving instance Show ChainSyncClientException

instance Eq ChainSyncClientException where
Expand All @@ -1180,6 +1234,10 @@ instance Eq ChainSyncClientException where
Just Refl -> (a, b, c) == (a', b', c')
InvalidBlock{} == _ = False

InFutureHeaderExceedsClockSkew a == InFutureHeaderExceedsClockSkew a' =
a == a'
InFutureHeaderExceedsClockSkew{} == _ = False

instance Exception ChainSyncClientException

{-------------------------------------------------------------------------------
Expand Down

0 comments on commit 916e825

Please sign in to comment.