Skip to content

Commit

Permalink
genesis/origin no slot number, ouroboros-consensus
Browse files Browse the repository at this point in the history
Follow-up to pointSlot type change in ouroboros-network, to make
ouroboros-consensus build and tests pass.

Must be reviewed by someone more familiar with ouroboros-consensus. I've
probably made some changes that aren't right.
  • Loading branch information
Alexander Vieth committed Jul 15, 2019
1 parent dd15753 commit 4b5edf7
Show file tree
Hide file tree
Showing 13 changed files with 61 additions and 37 deletions.
13 changes: 9 additions & 4 deletions ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,8 @@ import Control.Monad.Class.MonadThrow
import Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block
import Ouroboros.Network.Chain (genesisPoint, genesisSlotNo)
import Ouroboros.Network.Chain (genesisPoint)
import Ouroboros.Network.Point (WithOrigin (..))
import Ouroboros.Network.Protocol.ChainSync.Client

import Ouroboros.Consensus.Block
Expand Down Expand Up @@ -302,7 +303,7 @@ chainSyncClient tracer cfg btime (ClockSkew maxSkew)

-- Get the 'ChainState' at genesis.
let candidateChain' = Empty genesisPoint
candidateChainState' <- case rewindChainState cfg curChainState genesisSlotNo of
candidateChainState' <- case rewindChainState cfg curChainState Origin of
Nothing -> disconnect $ ForkTooDeep genesisPoint theirHead
Just c -> pure c

Expand Down Expand Up @@ -391,13 +392,17 @@ chainSyncClient tracer cfg btime (ClockSkew maxSkew)
-- TODO: Chain sync Client: Reuse anachronistic ledger view? #581
case anachronisticProtocolLedgerView cfg curLedger (pointSlot hdrPoint) of
Nothing -> retry
Just view -> case view `SB.at` pointSlot hdrPoint of
Just view -> case view `SB.at` hdrSlot of
Nothing -> error "anachronisticProtocolLedgerView invariant violated"
Just lv -> return lv
where
hdrSlot = case pointSlot hdrPoint of
Origin -> SlotNo 0
At thisSlot -> thisSlot

-- Check for clock skew
wallclock <- getCurrentSlot btime
when (unSlotNo (pointSlot hdrPoint) > unSlotNo wallclock + maxSkew) $
when (fmap unSlotNo (pointSlot hdrPoint) > At (unSlotNo wallclock + maxSkew)) $
disconnect $ HeaderExceedsClockSkew hdrPoint wallclock

-- Validate header
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ module Ouroboros.Consensus.Ledger.Abstract (
import Control.Monad.Except

import Ouroboros.Network.Block (Point, SlotNo)
import Ouroboros.Network.Point (WithOrigin)

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Protocol.Abstract
Expand Down Expand Up @@ -115,5 +116,5 @@ class UpdateLedger blk => ProtocolLedgerView blk where
anachronisticProtocolLedgerView
:: NodeConfig (BlockProtocol blk)
-> LedgerState blk
-> SlotNo -- ^ Slot for which you would like a ledger view
-> WithOrigin SlotNo -- ^ Slot for which you would like a ledger view
-> Maybe (SlotBounded (LedgerView (BlockProtocol blk)))
10 changes: 5 additions & 5 deletions ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,8 +78,8 @@ import Cardano.Crypto.DSIGN
import Cardano.Crypto.Hash

import Ouroboros.Network.Block
import Ouroboros.Network.Chain (genesisSlotNo)
import qualified Ouroboros.Network.Point as Point (block, origin)
import Ouroboros.Network.Point (WithOrigin (..))

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Crypto.DSIGN.Cardano
Expand Down Expand Up @@ -354,10 +354,10 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
<$> sb
-- No snapshot - we could be in the past or in the future
Nothing
| slot >= lvLB && slot <= lvUB
| slot >= At lvLB && slot <= At lvUB
-> Just $ PBftLedgerView <$>
case Seq.takeWhileL
(\sd -> convertSlot (V.Scheduling.sdSlot sd) <= slot)
(\sd -> At (convertSlot (V.Scheduling.sdSlot sd)) <= slot)
dsScheduled of
-- No updates to apply. So the current ledger state is valid
-- from the end of the last snapshot to the first scheduled
Expand Down Expand Up @@ -385,7 +385,7 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
lvUB = SlotNo $ unSlotNo currentSlot + (2 * paramK)
lvLB
| 2 * paramK > unSlotNo currentSlot
= genesisSlotNo
= SlotNo 0
| otherwise
= SlotNo $ unSlotNo currentSlot - (2 * paramK)

Expand All @@ -398,7 +398,7 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
. CC.Block.cvsDelegationState
$ ls
currentSlot = convertSlot $ CC.Block.cvsLastSlot ls
containsSlot s sb = sbLower sb <= s && sbUpper sb >= s
containsSlot s sb = At (sbLower sb) <= s && At (sbUpper sb) >= s

{-------------------------------------------------------------------------------
Mempool integration
Expand Down
7 changes: 6 additions & 1 deletion ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ import Ouroboros.Network.Block
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.State (FetchMode (..))
import qualified Ouroboros.Network.Chain as Chain
import Ouroboros.Network.Point (WithOrigin (..))

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
Expand Down Expand Up @@ -261,7 +262,11 @@ initBlockFetchConsensusInterface tracer cfg chainDB getCandidates blockFetchSize
readFetchMode = do
curSlot <- getCurrentSlot btime
curChainSlot <- headSlot <$> ChainDB.getCurrentChain chainDB
let slotsBehind = unSlotNo curSlot - unSlotNo curChainSlot
let slotsBehind = case curChainSlot of
-- There's nothing in the chain. If the current slot is 0, then
-- we're 1 slot behind.
Origin -> unSlotNo curSlot + 1
At slot -> unSlotNo curSlot - unSlotNo slot
maxBlocksBehind = 5
-- Convert from blocks to slots. This is more or less the @f@
-- parameter, the frequency of blocks. TODO should be 10 for Praos,
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ import Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
import Ouroboros.Network.Chain (Chain)
import Ouroboros.Network.Point (WithOrigin)

import qualified Ouroboros.Consensus.Util.AnchoredFragment as AF
import Ouroboros.Consensus.Util.Random
Expand Down Expand Up @@ -177,7 +178,7 @@ class ( Show (ChainState p)
-- blocks.
--
-- This function should attempt to rewind the chain state to the state at some
-- given slot.
-- given slot, or Origin to rewind to the state with no blocks.
--
-- Implementers should take care that this function accurately reflects the
-- slot number, rather than the number of blocks, since naively the
Expand All @@ -197,7 +198,7 @@ class ( Show (ChainState p)
-- and will yield 'Nothing'.
rewindChainState :: NodeConfig p
-> ChainState p
-> SlotNo -- ^ Slot to rewind to.
-> WithOrigin SlotNo -- ^ Slot to rewind to.
-> Maybe (ChainState p)

-- | Protocol security parameter
Expand Down
6 changes: 4 additions & 2 deletions ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ import Cardano.Crypto.DSIGN.Class
import Cardano.Crypto.DSIGN.Mock (MockDSIGN)

import Ouroboros.Network.Block
import Ouroboros.Network.Point (WithOrigin (..))

import Ouroboros.Consensus.Crypto.DSIGN.Cardano
import Ouroboros.Consensus.NodeId (NodeId (..))
Expand Down Expand Up @@ -213,8 +214,9 @@ instance (PBftCrypto c, Typeable c) => OuroborosTag (PBft c) where
takeR :: Integral i => i -> Seq a -> Seq a
takeR (fromIntegral -> n) s = Seq.drop (Seq.length s - n - 1) s

rewindChainState _ cs slot = if slot == SlotNo 0 then Just Seq.empty else
case Seq.takeWhileL (\(_, s) -> s <= slot) cs of
rewindChainState _ cs mSlot = case mSlot of
Origin -> Just Seq.empty
At slot -> case Seq.takeWhileL (\(_, s) -> s <= slot) cs of
_ Seq.:<| _ -> Just cs
_ -> Nothing

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ import Cardano.Crypto.VRF.Mock (MockVRF)
import Cardano.Crypto.VRF.Simple (SimpleVRF)

import Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
import Ouroboros.Network.Point (WithOrigin (At))

import Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
import Ouroboros.Consensus.Protocol.Abstract
Expand Down Expand Up @@ -293,7 +294,7 @@ instance PraosCrypto c => OuroborosTag (Praos c) where
-- filled; instead we roll back the the block just before it.
rewindChainState PraosNodeConfig{..} cs rewindTo =
-- This may drop us back to the empty list if we go back to genesis
Just $ dropWhile (\bi -> biSlot bi > rewindTo) cs
Just $ dropWhile (\bi -> At (biSlot bi) > rewindTo) cs

-- NOTE: We redefine `preferCandidate` but NOT `compareCandidates`
-- NOTE: See note regarding clock skew.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ import Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (ChainHash (..), HasHeader, Point,
SlotNo, StandardHash, pointHash, pointSlot)
import Ouroboros.Network.Point (WithOrigin (..))

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Abstract (ProtocolLedgerView)
Expand Down Expand Up @@ -118,7 +119,7 @@ copyToImmDB
, HasCallStack
)
=> ChainDbEnv m blk
-> m SlotNo
-> m (WithOrigin SlotNo)
copyToImmDB CDB{..} = withCopyLock $ do
toCopy <- atomically $ do
curChain <- readTVar cdbChain
Expand Down Expand Up @@ -206,8 +207,10 @@ copyToImmDBRunner cdb@CDB{..} gcSchedule = forever $ do
curChain <- readTVar cdbChain
check $ fromIntegral (AF.length curChain) > k

slotNo <- copyToImmDB cdb
scheduleGC (contramap TraceGCEvent cdbTracer) slotNo cdbGcDelay gcSchedule
mSlotNo <- copyToImmDB cdb
case mSlotNo of
Origin -> pure ()
At slotNo -> scheduleGC (contramap TraceGCEvent cdbTracer) slotNo cdbGcDelay gcSchedule
where
SecurityParam k = protocolSecurityParam cdbNodeConfig

Expand Down Expand Up @@ -238,7 +241,7 @@ garbageCollect CDB{..} slotNo = do
VolDB.garbageCollect cdbVolDB slotNo
atomically $ do
LgrDB.garbageCollectPrevApplied cdbLgrDB slotNo
modifyTVar' cdbInvalid $ Set.filter ((<= slotNo) . pointSlot)
modifyTVar' cdbInvalid $ Set.filter ((<= At slotNo) . pointSlot)
traceWith cdbTracer $ TraceGCEvent $ PerformedGC slotNo

{-------------------------------------------------------------------------------
Expand Down
21 changes: 11 additions & 10 deletions ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,11 +55,12 @@ import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadThrow

import Ouroboros.Network.Block (pattern BlockPoint, ChainHash (..),
import Ouroboros.Network.Block (pattern BlockPoint,
pattern GenesisPoint, HasHeader (..), HeaderHash, Point,
SlotNo, atSlot, blockPoint, pointHash, pointSlot,
SlotNo, atSlot, blockPoint, pointSlot,
withHash)
import Ouroboros.Network.Chain (genesisPoint, genesisSlotNo)
import Ouroboros.Network.Chain (genesisPoint)
import Ouroboros.Network.Point (WithOrigin (..))

import qualified Ouroboros.Consensus.Util.CBOR as Util.CBOR

Expand Down Expand Up @@ -206,13 +207,13 @@ getPointAtTip = fmap mbBlockToPoint . getBlockAtTip
mbBlockToPoint (Just blk) = blockPoint blk

getSlotNoAtTip :: (MonadCatch m, HasHeader blk)
=> ImmDB m blk -> m SlotNo
=> ImmDB m blk -> m (WithOrigin SlotNo)
getSlotNoAtTip db = do
immTip <- withDB db $ \imm -> ImmDB.getTip imm
case immTip of
TipGen -> return genesisSlotNo
Tip (Left epochNo) -> epochInfoFirst epochNo
Tip (Right slotNo) -> return slotNo
TipGen -> return Origin
Tip (Left epochNo) -> At <$> epochInfoFirst epochNo
Tip (Right slotNo) -> return (At slotNo)
where
EpochInfo{..} = immEpochInfo db

Expand Down Expand Up @@ -400,9 +401,9 @@ streamBlobsAfter db low = withDB db $ \imm -> do
return itr
where
low' :: Maybe (SlotNo, HeaderHash blk)
low' = case pointHash low of
GenesisHash -> Nothing
BlockHash h -> Just (pointSlot low, h)
low' = case low of
GenesisPoint -> Nothing
BlockPoint slot hash -> Just (slot, hash)

-- Skip the first block (if any) to provide an /exclusive/ lower bound
--
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ import Control.Tracer
import Ouroboros.Network.Block (HasHeader (..), HeaderHash, Point,
SlotNo, StandardHash, blockPoint, castPoint)
import qualified Ouroboros.Network.Block as Block
import Ouroboros.Network.Point (WithOrigin (At))

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Abstract
Expand Down Expand Up @@ -383,7 +384,7 @@ garbageCollectPrevApplied :: MonadSTM m
-> SlotNo
-> STM m ()
garbageCollectPrevApplied LgrDB{..} slotNo = modifyTVar' varPrevApplied $
Set.filter ((<= slotNo) . Block.pointSlot)
Set.filter ((<= (At slotNo)) . Block.pointSlot)

{-------------------------------------------------------------------------------
Error handling
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ import Ouroboros.Network.Block (ChainUpdate (..), HasHeader,
HeaderHash, Point, SlotNo, blockPoint, castPoint,
pointSlot)
import Ouroboros.Network.Chain (genesisPoint)
import Ouroboros.Network.Point (WithOrigin (..))

import Ouroboros.Consensus.Block (GetHeader (..), headerPoint)
import Ouroboros.Consensus.Util.STM (blockUntilJust)
Expand Down Expand Up @@ -415,7 +416,7 @@ forward CDB{..} varReader = \pts -> do
findFirstPointOnChain
:: HasCallStack
=> AnchoredFragment (Header blk)
-> SlotNo
-> WithOrigin SlotNo
-> [Point blk]
-> m (Maybe (Point blk))
findFirstPointOnChain curChain slotNoAtImmDBTip = \case
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,7 @@ import Control.Tracer
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import Ouroboros.Network.Block (BlockNo, HasHeader, HeaderHash, Point,
SlotNo, StandardHash)
import Ouroboros.Network.Point (WithOrigin)

import Ouroboros.Consensus.Block (BlockProtocol, Header)
import Ouroboros.Consensus.Ledger.Abstract (ProtocolLedgerView)
Expand Down Expand Up @@ -236,7 +237,7 @@ data Internal m blk = Internal
--
-- The 'Bool' arguments indicates whether the background tasks should be
-- relaunched after reopening the ChainDB.
, intCopyToImmDB :: m SlotNo
, intCopyToImmDB :: m (WithOrigin SlotNo)
-- ^ Copy the blocks older than @k@ from to the VolatileDB to the
-- ImmutableDB and update the in-memory chain fragment correspondingly.
--
Expand Down Expand Up @@ -441,14 +442,14 @@ data TraceReaderEvent blk

| ReaderSwitchToMem
{ _readerPoint :: Point blk
, _slotNoAtImmDBTip :: SlotNo
, _slotNoAtImmDBTip :: WithOrigin SlotNo
}
-- ^ The reader was in the 'ReaderInImmDB' state and is switched to the
-- 'ReaderInMem' state.

| ReaderNewImmIterator
{ _readerPoint :: Point blk
, _slotNoAtImmDBTip :: SlotNo
, _slotNoAtImmDBTip :: WithOrigin SlotNo
}
-- ^ The reader is in the 'ReaderInImmDB' state but the iterator is
-- exhausted while the ImmutableDB has grown, so we open a new iterator to
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -207,8 +207,10 @@ run ChainDB{..} ChainDB.Internal{..} = \case
ignore _ = Unit ()

runBgTasks = do
slotNo <- intCopyToImmDB
intGarbageCollect slotNo
mSlotNo <- intCopyToImmDB
case mSlotNo of
Point.Origin -> pure ()
Point.At slotNo -> intGarbageCollect slotNo
intUpdateLedgerSnapshots

-- | Result type for 'getBlock'. Note that the real implementation of
Expand Down

0 comments on commit 4b5edf7

Please sign in to comment.