From 4b5edf714109f3046efa40dcbe450e6bf992daf7 Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Mon, 15 Jul 2019 16:23:32 -0400 Subject: [PATCH] genesis/origin no slot number, ouroboros-consensus 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. --- .../Ouroboros/Consensus/ChainSyncClient.hs | 13 ++++++++---- .../Ouroboros/Consensus/Ledger/Abstract.hs | 3 ++- .../src/Ouroboros/Consensus/Ledger/Byron.hs | 10 ++++----- .../src/Ouroboros/Consensus/Node.hs | 7 ++++++- .../Ouroboros/Consensus/Protocol/Abstract.hs | 5 +++-- .../src/Ouroboros/Consensus/Protocol/PBFT.hs | 6 ++++-- .../src/Ouroboros/Consensus/Protocol/Praos.hs | 3 ++- .../Storage/ChainDB/Impl/Background.hs | 11 ++++++---- .../Ouroboros/Storage/ChainDB/Impl/ImmDB.hs | 21 ++++++++++--------- .../Ouroboros/Storage/ChainDB/Impl/LgrDB.hs | 3 ++- .../Ouroboros/Storage/ChainDB/Impl/Reader.hs | 3 ++- .../Ouroboros/Storage/ChainDB/Impl/Types.hs | 7 ++++--- .../Ouroboros/Storage/ChainDB/StateMachine.hs | 6 ++++-- 13 files changed, 61 insertions(+), 37 deletions(-) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs b/ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs index bf356292e19..d89906f071e 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs @@ -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 @@ -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 @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs index 07ca9baae1c..e80ef13ff4c 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs @@ -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 @@ -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))) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs index decf0392b5a..0c013cd5541 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs @@ -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 @@ -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 @@ -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) @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs index f748cf7d725..754f11c87bd 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs @@ -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 @@ -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, diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs index 0bad76a13eb..2060d12bf83 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs @@ -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 @@ -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 @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs index b3db1f5875f..a0298887e52 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs @@ -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 (..)) @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Praos.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Praos.hs index c10edfcc5eb..69b7158cbaa 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Praos.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Praos.hs @@ -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 @@ -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. diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Background.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Background.hs index 1c729eff991..80b53a46e47 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Background.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Background.hs @@ -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) @@ -118,7 +119,7 @@ copyToImmDB , HasCallStack ) => ChainDbEnv m blk - -> m SlotNo + -> m (WithOrigin SlotNo) copyToImmDB CDB{..} = withCopyLock $ do toCopy <- atomically $ do curChain <- readTVar cdbChain @@ -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 @@ -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 {------------------------------------------------------------------------------- diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs index 6359dc9d637..61407d0ec5e 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs @@ -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 @@ -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 @@ -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 -- diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs index f7c4ccb2393..d9bd2040dad 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs @@ -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 @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reader.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reader.hs index aee813ee893..2e4b29ce0f5 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reader.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reader.hs @@ -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) @@ -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 diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs index c12d6405e17..a6d3f5c233b 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs @@ -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) @@ -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. -- @@ -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 diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs index c3187842cb9..6540b9f8f36 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs @@ -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