diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs index 2b3b98983ee..1a14cd14620 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs @@ -238,9 +238,8 @@ instance ( PBftCrypto c applyChainState cfg@PBftNodeConfig{..} lv@(PBftLedgerView dms) (b :: hdr) chainState = case headerPBftFields pbftExtConfig b of - Nothing -> - -- EBB. Nothing to do - return chainState + Nothing -> do + return $! appendEBB cfg params (blockSlot b) chainState Just (PBftFields{..}, signed) -> do -- Check that the issuer signature verifies, and that it's a delegate of a -- genesis key, and that genesis key hasn't voted too many times. @@ -255,7 +254,7 @@ instance ( PBftCrypto c -- FIXME confirm that non-strict inequality is ok in general. -- It's here because EBBs have the same slot as the first block of their -- epoch. - unless (At (blockSlot b) >= CS.lastSlot chainState) + unless (At (blockSlot b) >= CS.lastSignedSlot chainState) $ throwError PBftInvalidSlot case Bimap.lookupR (hashVerKey pbftIssuer) dms of @@ -334,6 +333,16 @@ append PBftNodeConfig{..} PBftWindowParams{..} = where PBftParams{..} = pbftParams +appendEBB :: PBftCrypto c + => NodeConfig (PBft cfg c) + -> PBftWindowParams + -> SlotNo + -> PBftChainState c -> PBftChainState c +appendEBB PBftNodeConfig{..} PBftWindowParams{..} = + CS.appendEBB pbftSecurityParam windowSize + where + PBftParams{..} = pbftParams + rewind :: PBftCrypto c => NodeConfig (PBft cfg c) -> PBftWindowParams diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT/ChainState.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT/ChainState.hs index eebcc3bdf30..c76ac1cae8a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT/ChainState.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT/ChainState.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -17,18 +18,19 @@ module Ouroboros.Consensus.Protocol.PBFT.ChainState ( -- * Construction , empty , append - , appendMany + , appendEBB , rewind -- * Queries , countSignatures , countInWindow , countSignedBy - , lastSlot + , lastSignedSlot -- * Support for tests + , EbbMap (..) + , PBftSigner(..) , invariant - , toList , fromList - , PBftSigner(..) + , toList -- ** Serialization , encodePBftChainState , decodePBftChainState @@ -39,6 +41,7 @@ import Codec.Serialise.Decoding (Decoder) import qualified Codec.Serialise.Decoding as Serialise import Codec.Serialise.Encoding (Encoding) import qualified Codec.Serialise.Encoding as Serialise +import qualified Control.Exception as Exn import Control.Monad.Except import qualified Data.Foldable as Foldable import Data.Map.Strict (Map) @@ -95,7 +98,7 @@ import Ouroboros.Consensus.Util (repeatedly) -- not change the maximum rollback point). -- -- This means that unless we are near genesis, we will at least have @n@ --- signatures in the history (after a maximum rollback of @k@), and under +-- signatures in the history (even after a maximum rollback of @k@), and under -- normal circumstances (i.e., when not halfway a switch to a fork), @k+n@ -- signatures. -- @@ -127,10 +130,41 @@ data PBftChainState c = PBftChainState { -- -- We should have precisely @n@ signatures in the window, unless we are -- near genesis. + -- + -- INVARIANT Empty if and only if we are exactly at genesis. , inWindow :: !(StrictSeq (PBftSigner c)) -- | Cached counts of the signatures in the window , counts :: !(Map (PBftVerKeyHash c) Word64) + + -- | Map from slots of relevant epoch boundary blocks (EBBs) to signed + -- slots + -- + -- EBBs are not signed, so the 'preAnchor', 'postAnchor', 'preWindow', + -- and 'postWindow' fields are unaffected by EBBs. However, EBBs must + -- also be valid targets for 'rewind', so this field maps each slot that + -- contains an EBB to the preceding signed slot, /if/ that signed slot is + -- still a valid target for 'rewind'. + -- + -- See INVARIANTs on 'EbbMap'. + -- + -- INVARIANT For all @(ebbSlot, mSlot)@ in @'ebbs' (cs :: 'ChainState')@, + -- + -- * @mSlot >= anchorSlot cs@; see 'pruneEBBsLT' + -- + -- * @'At' ebbSlot <= tgt@ if @cs@ is the result of a 'rewind' to @tgt@; + -- see 'pruneEBBsGT' + -- + -- * @and [ At s <= mSlot | s <- precedingSignedSlots ]@ + -- + -- * @'rewind' k n ('At' ebbSlot) cs = 'rewind' k n mSlot cs@ + -- + -- where + -- + -- * @precedingSignedSlots = filter (< ebbSlot) signedSlots@ + -- + -- * @signedSlots = 'pbftSignerSlotNo' <$> ('preAnchor' <> 'postAnchor')@ + , ebbs :: !EbbMap } deriving (Generic) @@ -175,10 +209,35 @@ invariant (SecurityParam k) unless (computeCounts inWindow == counts) $ failure "Cached counts incorrect" + + unless (allEbbs $ \_ mSlot -> mSlot >= anchorSlot st) $ + failure "EBB mapped to slot before anchor" + + unless (allEbbs $ \slot mSlot -> + let signedSlots = + fmap pbftSignerSlotNo $ + Foldable.toList $ preAnchor <> postAnchor + precedingSignedSlots = filter (< slot) signedSlots + in all (\s -> At s <= mSlot) precedingSignedSlots + ) $ + failure "EBB does not map to the preceding signature" + + -- 'EbbMap''s "Key greater" + unless (allEbbs $ \slot mSlot -> At slot > mSlot) $ + failure "EBB mapped to a simultaneous or future slot" + + -- 'EbbMap''s "Non-descending" + unless (let nonDescending es = and $ zipWith (<=) es (tail es) + in nonDescending $ map snd $ Map.toAscList $ unEbbMap ebbs) $ + failure $ "EBB mappings are not non-descending" where failure :: String -> Except String () failure err = throwError $ err ++ ": " ++ show st + allEbbs p = + Map.null $ + Map.filterWithKey (\slot mSlot -> not (p slot mSlot)) (unEbbMap ebbs) + -- | The 'PBftChainState' tests don't rely on this flag but check the -- invariant manually. This flag is here so that the invariant checks could be -- enabled while running other consensus tests, just as a sanity check. @@ -246,13 +305,27 @@ countSignedBy PBftChainState{..} gk = Map.findWithDefault 0 gk counts -- | The last (most recent) signed slot in the window -- -- Returns 'Origin' if there are no signatures in the window (this will happen --- near genesis only). -lastSlot :: PBftChainState c -> WithOrigin SlotNo -lastSlot PBftChainState{..} = +-- exactly at genesis only). +-- +-- Unaffected by EBBs, since they're not signed. +lastSignedSlot :: PBftChainState c -> WithOrigin SlotNo +lastSignedSlot PBftChainState{..} = case inWindow of _ :|> signer -> At (pbftSignerSlotNo signer) _otherwise -> Origin +-- | The anchor slot +-- +-- Returns 'Origin' if there are no signatures in the window (this will happen +-- exactly at genesis only). +-- +-- Unaffected by EBBs, since they're not signed. +anchorSlot :: PBftChainState c -> WithOrigin SlotNo +anchorSlot PBftChainState{..} = + case preAnchor of + _ :|> signer -> At (pbftSignerSlotNo signer) + _otherwise -> Origin + {------------------------------------------------------------------------------- Construction -------------------------------------------------------------------------------} @@ -267,6 +340,7 @@ empty = PBftChainState { , preWindow = Empty , inWindow = Empty , counts = Map.empty + , ebbs = ebbsEmpty } -- | Append new signature @@ -277,13 +351,16 @@ append :: forall c. PBftCrypto c -> WindowSize -> PBftSigner c -> PBftChainState c -> PBftChainState c -append k n signer@(PBftSigner _ gk) PBftChainState{..} = assertInvariant k n $ +append k n signer@(PBftSigner _ gk) PBftChainState{..} = + assertInvariant k n $ + pruneEBBsLT $ PBftChainState { preAnchor = preAnchor' , postAnchor = postAnchor' , preWindow = preWindow' , inWindow = inWindow' , counts = updateCounts counts + , ebbs = ebbs -- NB this needs to be pruned } where (preAnchor', postAnchor') = @@ -304,14 +381,6 @@ append k n signer@(PBftSigner _ gk) PBftChainState{..} = assertInvariant k n $ , incrementKey gk ) --- | Append a bunch of blocks -appendMany :: forall c. PBftCrypto c - => SecurityParam - -> WindowSize - -> [PBftSigner c] -- ^ Old to new - -> PBftChainState c -> PBftChainState c -appendMany k n = repeatedly (append k n) - -- | Rewind the state to the specified slot -- -- This matches the semantics of 'rewindChainState' in 'OuroborosTag', in that @@ -331,6 +400,19 @@ rewind :: forall c. PBftCrypto c -> WithOrigin SlotNo -> PBftChainState c -> Maybe (PBftChainState c) rewind k n mSlot cs@PBftChainState{..} = + case rewind_ k n mSlot cs of + Right mbCs' -> pruneEBBsGT mSlot <$> mbCs' + Left mSlot' -> + error $ "rewind: rollback to block not previously applied, " + ++ show (mSlot, mSlot', ebbs) + +-- | Internal worker for 'rewind' +rewind_ :: forall c. PBftCrypto c + => SecurityParam + -> WindowSize + -> WithOrigin SlotNo + -> PBftChainState c -> Either SlotNo (Maybe (PBftChainState c)) +rewind_ k n mSlot cs@PBftChainState{..} = case mSlot of At slot -> -- We scan from the right, since block to roll back to likely at end @@ -340,8 +422,8 @@ rewind k n mSlot cs@PBftChainState{..} = -- after that slot. (toDiscard, toKeep@(_ :|> x)) -> if slot == pbftSignerSlotNo x - then Just $ go toDiscard toKeep - else notPreviouslyApplied + then Right $ Just $ go toDiscard toKeep + else notFound slot -- The slot was not found post-anchor. If the slot matches the last -- slot pre-anchor, all is well, discarding everything post-anchor. @@ -349,18 +431,10 @@ rewind k n mSlot cs@PBftChainState{..} = (toDiscard, Empty) -> case preAnchor of _ :|> x - | slot == pbftSignerSlotNo x -> Just $ go toDiscard Empty + | slot == pbftSignerSlotNo x -> Right $ Just $ go toDiscard Empty | slot < pbftSignerSlotNo x -> rollbackTooFar - | otherwise -> notPreviouslyApplied - Empty - -- In the current tests, slot 0 is always an EBB, which means - -- there is no record of it in the chain state. But we need to - -- be able to rewind to it. - -- - -- TODO Eliminate this very specific adhoc case; see Issue - -- #1312. - | slot == 0 -> rewind k n Origin cs - | otherwise -> notPreviouslyApplied + | otherwise -> notFound slot + Empty -> notFound slot -- We can only roll back to origin if there are no signatures -- pre-anchor. Rolling back to origin would leave the chain empty. This @@ -368,15 +442,18 @@ rewind k n mSlot cs@PBftChainState{..} = -- have more than @k@ blocks, the pre-anchor will not be empty. Origin -> case preAnchor of - Empty -> Just $ go postAnchor Empty + Empty -> Right $ Just $ go postAnchor Empty _otherwise -> rollbackTooFar where - notPreviouslyApplied :: forall x. x - notPreviouslyApplied = - error $ "rewind: rollback to block not previously applied" + -- If we didn't find a non-EBB, check if the slot was known to have an EBB. + -- If so, recur (just once, as long as 'ebbs' is well-formed). + notFound :: SlotNo -> Either SlotNo (Maybe (PBftChainState c)) + notFound slot = case ebbsLookup slot ebbs of + Just mSlot' -> rewind_ k n mSlot' cs + Nothing -> Left slot - rollbackTooFar :: Maybe x - rollbackTooFar = Nothing + rollbackTooFar :: Either x (Maybe y) + rollbackTooFar = Right Nothing -- Construct new state, given the remaining post-anchor signatures -- @@ -391,6 +468,7 @@ rewind k n mSlot cs@PBftChainState{..} = , preWindow = preWindow' , inWindow = inWindow' , counts = computeCounts inWindow' -- for simplicity, just recount + , ebbs = ebbs -- NB this needs to be pruned } where -- Reconstruct the window @@ -436,20 +514,24 @@ prune (SecurityParam n) (WindowSize k) (xs, ys) = Conversion -------------------------------------------------------------------------------} -toList :: PBftChainState c -> (WithOrigin SlotNo, StrictSeq (PBftSigner c)) +toList :: PBftChainState c -> (WithOrigin SlotNo, StrictSeq (PBftSigner c), EbbMap) toList PBftChainState{..} = ( case preAnchor of Empty -> Origin _ :|> x -> At (pbftSignerSlotNo x) , preWindow <> inWindow + , ebbs ) fromList :: PBftCrypto c => SecurityParam -> WindowSize - -> (WithOrigin SlotNo, StrictSeq (PBftSigner c)) + -> (WithOrigin SlotNo, StrictSeq (PBftSigner c), EbbMap) -> PBftChainState c -fromList k n (anchor, signers) = assertInvariant k n $ PBftChainState {..} +fromList k n (anchor, signers, ebbs) = + assertInvariant k n $ + pruneEBBsLT $ + PBftChainState {..} where inPreAnchor :: PBftSigner c -> Bool inPreAnchor (PBftSigner slot _) = At slot <= anchor @@ -462,25 +544,45 @@ fromList k n (anchor, signers) = assertInvariant k n $ PBftChainState {..} Serialization -------------------------------------------------------------------------------} +serializationFormatVersion1 :: Word8 +serializationFormatVersion1 = 1 + -- CHANGELOG + -- + -- Version 0 is 2 fields, the anchor and the window. Note that it does not + -- have the version marker. + -- + -- Version 1 has 4 fields, the version marker, anchor, window, and EbbMap. + encodePBftChainState :: (PBftCrypto c, Serialise (PBftVerKeyHash c)) => PBftChainState c -> Encoding -encodePBftChainState st = mconcat [ - Serialise.encodeListLen 2 +encodePBftChainState st@PBftChainState{..} = mconcat [ + Serialise.encodeListLen 4 + , encode serializationFormatVersion1 , encode (withOriginToMaybe anchor) , encode signers + , encode ebbs' ] where - (anchor, signers) = toList st + (anchor, signers, ebbs') = toList st -decodePBftChainState :: (PBftCrypto c, Serialise (PBftVerKeyHash c)) +decodePBftChainState :: (PBftCrypto c, Serialise (PBftVerKeyHash c), HasCallStack) => SecurityParam -> WindowSize -> Decoder s (PBftChainState c) -decodePBftChainState k n = do - Serialise.decodeListLenOf 2 +decodePBftChainState k n = Serialise.decodeListLen >>= \case + 2 -> do -- Version is 0 anchor <- withOriginFromMaybe <$> decode signers <- decode - return $ fromList k n (anchor, signers) + return $ fromList k n (anchor, signers, ebbsEmpty) + 4 -> do -- Version is >0 + v <- decode + unless (v == serializationFormatVersion1) $ error $ + "decode list length is 4, but version is not 1: " ++ show v + anchor <- withOriginFromMaybe <$> decode + signers <- decode + ebbs' <- decode + return $ fromList k n (anchor, signers, ebbs') + o -> error $ "unexpected list length: " <> show o instance Serialise (PBftVerKeyHash c) => Serialise (PBftSigner c) where encode = encode . toPair @@ -490,3 +592,65 @@ instance Serialise (PBftVerKeyHash c) => Serialise (PBftSigner c) where decode = fromPair <$> decode where fromPair (slotNo, genesisKey) = PBftSigner slotNo genesisKey + +{------------------------------------------------------------------------------- + EBB Map +-------------------------------------------------------------------------------} + +-- | Append an EBB +-- +-- Its slot will be mapped to the 'lastSignedSlot'. +appendEBB :: forall c. (PBftCrypto c, HasCallStack) + => SecurityParam + -> WindowSize + -> SlotNo + -> PBftChainState c -> PBftChainState c +appendEBB k n newEbbSlot cs@PBftChainState{..} = + assertInvariant k n $ + Exn.assert valid $ + cs{ebbs = ebbsInsert newEbbSlot latestNonEbbSlot ebbs} + where + latestEbbSlot = ebbsMax ebbs + latestNonEbbSlot = lastSignedSlot cs + + valid = At newEbbSlot > max latestEbbSlot latestNonEbbSlot + +-- | Discard 'ebbs' mappings whose /value/ is before the anchor +-- +-- Called by 'append', since 'ebbs' do not increase how far back the chain +-- state can rewind. +pruneEBBsLT :: PBftChainState c -> PBftChainState c +pruneEBBsLT cs@PBftChainState{..} = + cs{ebbs = EbbMap $ Map.filter (>= anchorSlot cs) (unEbbMap ebbs)} + +-- | Discard 'ebbs' mappings whose /key/ is after the given slot +-- +-- Called by 'rewind', since 'rewind'ing to a slot should forget the EBBs it +-- precedes. +pruneEBBsGT :: WithOrigin SlotNo -> PBftChainState c -> PBftChainState c +pruneEBBsGT mSlot cs@PBftChainState{..} = + cs{ ebbs = + EbbMap $ Map.filterWithKey (\s _ -> At s <= mSlot) (unEbbMap ebbs) + } + +-- | A map from the slots containing an EBB to the preceding signed slot +-- +-- INVARIANT Key greater: For all @(k, v)@, @At k > v@. +-- +-- INVARIANT Non-descending: For all @(k1, v1)@ and @(k2, v2)@, @k1 < k2@ +-- implies @v1 <= v2@. +newtype EbbMap = EbbMap {unEbbMap :: Map SlotNo (WithOrigin SlotNo)} + deriving stock (Generic, Show) + deriving newtype (Eq, Ord, NoUnexpectedThunks, Serialise) + +ebbsEmpty :: EbbMap +ebbsEmpty = EbbMap Map.empty + +ebbsInsert :: SlotNo -> WithOrigin SlotNo -> EbbMap -> EbbMap +ebbsInsert k v = EbbMap . Map.insert k v . unEbbMap + +ebbsMax :: EbbMap -> WithOrigin SlotNo +ebbsMax = maybe Origin (At . fst) . Map.lookupMax . unEbbMap + +ebbsLookup :: SlotNo -> EbbMap -> Maybe (WithOrigin SlotNo) +ebbsLookup k = Map.lookup k . unEbbMap diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs index 8a5bd63124c..141164cfc97 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs @@ -1,11 +1,17 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} module Test.Consensus.Protocol.PBFT ( tests -- * Used in the roundtrip tests , TestChainState(..) ) where +import Data.Coerce (coerce) +import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe) import qualified Data.Sequence.Strict as Seq import Data.Word @@ -18,7 +24,7 @@ import Ouroboros.Network.Block (SlotNo (..)) import Ouroboros.Network.Point (WithOrigin (..)) import Ouroboros.Consensus.Protocol.Abstract -import Ouroboros.Consensus.Protocol.PBFT.ChainState (PBftChainState) +import Ouroboros.Consensus.Protocol.PBFT.ChainState (EbbMap (..), PBftChainState) import qualified Ouroboros.Consensus.Protocol.PBFT.ChainState as CS import Ouroboros.Consensus.Protocol.PBFT.Crypto import Ouroboros.Consensus.Util (dropLast, repeatedly, takeLast) @@ -54,19 +60,24 @@ data TestChainState = TestChainState { -- #1307: this state does not include the @n@ pre-anchor signatures. , testChainOldState :: PBftChainState PBftMockCrypto - -- | The slots that were dropped (rollback before this chain state) - , testChainDropped :: [CS.PBftSigner PBftMockCrypto] + -- | The slots that were kept (i.e., not rolled back to create + -- 'testChainState') + , testChainKeptInputs :: Inputs PBftMockCrypto - -- | Possible next signers that can be added + -- | The slots that were dropped (rolled back to create 'testChainState') + , testChainDroppedInputs :: Inputs PBftMockCrypto + + -- | Possible next inputs that can be added to 'testChainState' and to + -- 'testChainOldState' -- -- INVARIANT: the length of this list will be @n + k@. - , testChainNextSigners :: [CS.PBftSigner PBftMockCrypto] + , testChainNextInputs :: Inputs PBftMockCrypto - -- | Possible next rollback + -- | Possible next rollback from 'testChainState' , testChainRollback :: WithOrigin SlotNo - -- | The blocks that 'testChainRollback' would roll back - , testChainRollbackBlocks :: [CS.PBftSigner PBftMockCrypto] + -- | The inputs that 'testChainRollback' would roll back + , testChainRollbackInputs :: Inputs PBftMockCrypto } deriving (Show) @@ -87,88 +98,143 @@ instance Arbitrary TestChainState where n <- choose (1, 10) numKeys <- choose (1, 4) - -- Pick number of slots + -- Pick number of signed slots -- -- We don't try to be too clever here; we need to test the various edge -- cases near genesis more carefully, but also want to test where we are -- well past genesis - numSlots <- oneof [ + numSigners <- oneof [ choose (0, k) , choose (0, n) , choose (0, k + n) , choose (0, 5 * (k + n)) ] - -- Generate all the signatures - slots <- generateSigners (genMockKey numKeys) numSlots Origin - - -- Compute max rollback point - let anchor = case drop (fromIntegral k) (reverse slots) of - [] -> Origin - x:_ -> At (CS.pbftSignerSlotNo x) - - -- Pick a number of blocks to drop - toDrop <- choose (0, k) - let signers = Seq.fromList $ takeLast (n + k - toDrop) (dropLast toDrop slots) - state = CS.fromList - (SecurityParam k) - (CS.WindowSize n) - (anchor, signers) - - -- Compute the state that we would have deserialised before #1307: this - -- state does not include the @k@ extra signatures before the window. - let oldSigners = Seq.fromList $ takeLast (n - toDrop) (dropLast toDrop slots) - oldState = CS.fromList + let getFirstInputSlot = SlotNo <$> choose (0, 3) + + -- Generate all the inputs + inputs <- getFirstInputSlot >>= generateInputs (genMockKey numKeys) numSigners . GenerateInputsState Origin + + -- The chain state after appending all inputs to the empty chain state + let _X = appendInputs + (SecurityParam k) + (CS.WindowSize n) + inputs + CS.empty + + -- The suffix of inputs we could \"undo\" from _X without violating k + let droppableInputs = takeLastSigners k inputs + let maxDrop = lengthInputs droppableInputs + + -- The earliest slot to which we could rewind _X, as limited by k (it + -- is necessarily a signed slot) + anchor = case safeLastSigner (dropLastInputs maxDrop inputs) of + Nothing -> Origin + Just x -> At (CS.pbftSignerSlotNo x) + + -- Pick a number of inputs to drop; they'll include at most k signers + toDrop <- choose (0, maxDrop) + + let (originalKept, originalDropped) = splitAtLastInputs toDrop inputs + + -- Directly compute the state equivalent to rewinding _X enough to drop + -- @toDrop@ many inputs + let newInputs = dropLastInputs toDrop $ takeLastSigners (n + k) inputs + newState = fromInputs + (SecurityParam k) + (CS.WindowSize n) + (anchor, newInputs) + + -- Directly compute the analogous state that we would have deserialised + -- before #1307: this state does not include the @k@ extra signatures + -- before the window. + let oldInputs = dropLastInputs toDrop $ takeLastSigners n inputs + oldState = fromInputs (SecurityParam k) (CS.WindowSize n) - (anchor, oldSigners) + (anchor, oldInputs) - -- Create potential next @k@ signers to be added - let lastSlot = case signers of - -- Can only be empty if near genesis, because @toDrop@ is - -- at most @k@ and hence @signers@ must be at least @n@ - -- long, unless @slots@ is near genesis. - Seq.Empty -> Origin - _ Seq.:|> CS.PBftSigner s _ -> At s - nextSigners <- generateSigners (genMockKey numKeys) (n + k) lastSlot + -- Create potential next @n + k@ signers to be added + resumeInputGenState <- case reverse $ unInputs $ originalKept of + [] -> GenerateInputsState Origin <$> getFirstInputSlot + InputEBB prev slot:_ -> pure $ GenerateInputsState prev slot + InputSigner x:_ -> pure $ GenerateInputsState (At s) (succ s) + where + s = CS.pbftSignerSlotNo x + nextInputs <- generateInputs (genMockKey numKeys) (n + k) resumeInputGenState -- Create potential rollback - numRollback <- oneof [ - choose (0, k - toDrop) -- rollback that will succeed - , choose (0, numSlots) -- rollback that might fail (too far) + toDrop2 <- oneof [ + choose (0, maxDrop - toDrop) -- rollback that will succeed + , choose (0, lengthInputs inputs) -- rollback that might fail (too far) ] - let rollback = case drop (fromIntegral (toDrop + numRollback)) (reverse slots) of - [] -> Origin - x:_ -> At (CS.pbftSignerSlotNo x) + + let rollback = case reverse $ slotInputs $ dropLastInputs toDrop2 originalKept of + [] -> Origin + slot:_ -> At slot return TestChainState { testChainStateK = SecurityParam k , testChainStateN = CS.WindowSize n , testChainStateNumKeys = numKeys - , testChainState = state + , testChainState = newState , testChainOldState = oldState - , testChainDropped = takeLast toDrop slots - , testChainNextSigners = nextSigners + , testChainKeptInputs = originalKept + , testChainDroppedInputs = originalDropped + , testChainNextInputs = nextInputs , testChainRollback = rollback - , testChainRollbackBlocks = takeLast numRollback (dropLast toDrop slots) + , testChainRollbackInputs = + dropWhileNotAfterInputs rollback $ -- If we rolled back to a slot + -- that had both an EBB and a + -- signer, then we must ensure + -- the signer is not in + -- testChainRollbackInputs + takeLastInputs toDrop2 originalKept } -generateSigners :: Gen (PBftVerKeyHash c) - -> Word64 - -> WithOrigin SlotNo - -> Gen [CS.PBftSigner c] -generateSigners genKey = go +data GenerateInputsState = GenerateInputsState !(WithOrigin SlotNo) !SlotNo + -- ^ (slot of latest signature, slot of next input) + +-- | The output contains the specified number of 'InputSigner's and also some +-- additional 'InputEBB's +generateInputs :: + forall c. + Gen (PBftVerKeyHash c) + -> Word64 + -> GenerateInputsState + -> Gen (Inputs c) + -- ^ inputs, slot of latest signature, slot of next input +generateInputs genKey = go where - go 0 _ = return [] - go numSlots prev = do - slot :: SlotNo <- case prev of - Origin -> - SlotNo <$> choose (0, 3) - At (SlotNo s) -> do - skip <- choose (1, 3) - return $ SlotNo (s + skip) - signer <- CS.PBftSigner slot <$> genKey - (signer :) <$> go (numSlots - 1) (At slot) + plus slot w = slot + SlotNo w + advance slot = plus slot <$> choose (0, 3) + + go :: Word64 -> GenerateInputsState -> Gen (Inputs c) + go 0 _ = return (Inputs []) + go n (GenerateInputsState prev slot) = do + let genEBB = do + pure + ( n + , prev + -- an EBB's successor may have the same slot + , advance (slot + 1) + -- an EBB never has the same slot as its predecessor + , InputEBB prev (slot + 1) + ) + genSigner = do + key <- genKey + pure + ( n - 1 + , At slot + -- an non-EBB's successor cannot have the same slot + , advance (slot + 1) + -- an non-EBB may have the same slot as its predecessor + , InputSigner (CS.PBftSigner slot key) + ) + + (n', prev', genSlot', inp) <- frequency [(1, genEBB), (9, genSigner)] + slot' <- genSlot' + (\inps -> (inp:) `coerce` inps) <$> go n' (GenerateInputsState prev' slot') genMockKey :: Int -> Gen (VerKeyDSIGN MockDSIGN) genMockKey numKeys = VerKeyMockDSIGN <$> choose (1, numKeys) @@ -233,7 +299,7 @@ prop_appendPreservesInvariant TestChainState{..} = let state' = CS.append testChainStateK testChainStateN - (head testChainNextSigners) + (headSigner testChainNextInputs) testChainState in Right () === CS.invariant testChainStateK @@ -267,10 +333,11 @@ prop_rewindReappendId TestChainState{..} = in case rewound of Nothing -> label "rollback too far in the past" True Just state' -> label "rollback succeeded" $ - testChainState === CS.appendMany + counterexample ("Rewound: " <> show state') $ + testChainState === appendInputs testChainStateK testChainStateN - testChainRollbackBlocks + testChainRollbackInputs state' -- This property holds for the old chain state too @@ -279,7 +346,7 @@ prop_appendOldStatePreservesInvariant TestChainState{..} = let state' = CS.append testChainStateK testChainStateN - (head testChainNextSigners) + (headSigner testChainNextInputs) testChainOldState in Right () === CS.invariant testChainStateK @@ -287,18 +354,17 @@ prop_appendOldStatePreservesInvariant TestChainState{..} = state' -- | After appending the missing signatures, we should have a 'CS.preWindow' --- of @k again. +-- of @k@ again. prop_appendOldStateRestoresPreWindow :: TestChainState -> Property prop_appendOldStateRestoresPreWindow TestChainState{..} = let missing = fromIntegral $ maxRollbacks testChainStateK + CS.getWindowSize testChainStateN - CS.countSignatures testChainOldState - state' = repeatedly - (CS.append - testChainStateK - testChainStateN) - (take missing testChainNextSigners) + state' = appendInputs + testChainStateK + testChainStateN + (takeSigners missing testChainNextInputs) testChainOldState in Right () === CS.invariant testChainStateK @@ -307,6 +373,112 @@ prop_appendOldStateRestoresPreWindow TestChainState{..} = .&&. size (CS.preWindow state') === maxRollbacks testChainStateK +{------------------------------------------------------------------------------- + ChainState "Inputs" +-------------------------------------------------------------------------------} + +data Input c + = InputEBB !(WithOrigin SlotNo) !SlotNo + -- ^ the preceding signed slot, the EBB's slot + | InputSigner !(CS.PBftSigner c) + deriving (Eq, Show) + +newtype Inputs c = Inputs {unInputs :: [Input c]} + deriving (Eq, Show) + +signatureInputs :: Inputs c -> [CS.PBftSigner c] +signatureInputs (Inputs inps) = [ signer | InputSigner signer <- inps ] + +ebbInputs :: Inputs c -> [(WithOrigin SlotNo, SlotNo)] +ebbInputs (Inputs inps) = [ (prev, slot) | InputEBB prev slot <- inps ] + +slotInput :: Input c -> SlotNo +slotInput = \case + InputEBB _ slot -> slot + InputSigner x -> CS.pbftSignerSlotNo x + +slotInputs :: Inputs c -> [SlotNo] +slotInputs = map slotInput . unInputs + +lengthInputs :: Num a => Inputs c -> a +lengthInputs = fromIntegral . length . unInputs + +headSigner :: Inputs c -> CS.PBftSigner c +headSigner = head . signatureInputs + +safeLastSigner :: Inputs c -> Maybe (CS.PBftSigner c) +safeLastSigner = listToMaybe . reverse . signatureInputs + +appendInput :: + PBftCrypto c + => SecurityParam + -> CS.WindowSize + -> Input c + -> CS.PBftChainState c -> CS.PBftChainState c +appendInput k n = \case + InputEBB _ slot -> CS.appendEBB k n slot + InputSigner signer -> CS.append k n signer + +appendInputs :: + PBftCrypto c + => SecurityParam + -> CS.WindowSize + -> Inputs c + -> CS.PBftChainState c -> CS.PBftChainState c +appendInputs k n = repeatedly (appendInput k n) . unInputs + +-- | May include EBBs before the first signer and after the last signer +takeSigners :: Word64 -> Inputs c -> Inputs c +takeSigners = \n0 -> Inputs . go n0 . unInputs + where + go !n = \case + [] -> [] + inp:inps -> case inp of + InputEBB{} -> inp : go n inps + InputSigner{} + | n == 0 -> [] + | otherwise -> inp : go (n - 1) inps + +-- | May include EBBs after the last signer *BUT* *NOT* before the first signer +takeLastSigners :: Word64 -> Inputs c -> Inputs c +takeLastSigners = \n0 -> Inputs . reverse . go n0 . reverse . unInputs + where + go 0 = const [] + go n = \case + [] -> [] + inp:inps -> inp : go n' inps + where + n' = case inp of + InputEBB{} -> n + InputSigner{} -> n - 1 + +-- | Wrapper around 'CS.fromList' that also sets the 'ebbs' field +fromInputs :: + PBftCrypto c + => SecurityParam + -> CS.WindowSize + -> (WithOrigin SlotNo, Inputs c) + -> CS.PBftChainState c +fromInputs k n (anchor, inputs) = + CS.fromList k n (anchor, Seq.fromList $ signatureInputs inputs, EbbMap m) + where + m = Map.fromList [ (slot, mSlot) | (mSlot, slot) <- ebbInputs inputs ] + +splitAtLastInputs :: Word64 -> Inputs c -> (Inputs c, Inputs c) +splitAtLastInputs n (Inputs inps) = (Inputs l, Inputs r) + where + (l, r) = splitAt (length inps - fromIntegral n) inps + +dropLastInputs :: Word64 -> Inputs c -> Inputs c +dropLastInputs n = Inputs . dropLast (fromIntegral n) . unInputs + +dropWhileNotAfterInputs :: WithOrigin SlotNo -> Inputs c -> Inputs c +dropWhileNotAfterInputs mSlot = + Inputs . dropWhile ((<= mSlot) . At . slotInput) . unInputs + +takeLastInputs :: Word64 -> Inputs c -> Inputs c +takeLastInputs n = Inputs . takeLast (fromIntegral n) . unInputs + {------------------------------------------------------------------------------- Auxiliary -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus/test-consensus/Test/Dynamic/RealPBFT.hs b/ouroboros-consensus/test-consensus/Test/Dynamic/RealPBFT.hs index 5b6671665f6..aa17304c98a 100644 --- a/ouroboros-consensus/test-consensus/Test/Dynamic/RealPBFT.hs +++ b/ouroboros-consensus/test-consensus/Test/Dynamic/RealPBFT.hs @@ -74,18 +74,14 @@ tests = testGroup "Dynamic chain generation" ] , nodeTopology = meshNodeTopology ncn } - , testProperty "worked around in PBFT.ChainState.rewind (see Issue #1312)" $ + , testProperty "rewind to EBB supported as of Issue #1312, #1" $ once $ let ncn = NumCoreNodes 2 in -- When node 1 joins in slot 1, it leads with an empty chain and so -- forges the 0-EBB again. This causes it to report slot 0 as the found -- intersection point to node 0, which causes node 0 to \"rewind\" to - -- slot 0 (even though it's already there). That rewind fails since its - -- chain state is empty since EBBs don't affect the PBFT chain state. - -- - -- But we currently have a workaround to handle this behavior for slot 0, - -- and we currently only ever forge the 0-EBB, not later ones, so this - -- test passes. TODO Issue #1312 will actually resolve the problem. + -- slot 0 (even though it's already there). That rewind fails if EBBs + -- don't affect the PBFT chain state, since its chain state is empty. prop_simple_real_pbft_convergence TestConfig { numCoreNodes = ncn , numSlots = NumSlots 2 @@ -93,6 +89,18 @@ tests = testGroup "Dynamic chain generation" , nodeTopology = meshNodeTopology ncn } Seed {getSeed = (15069526818753326002,9758937467355895013,16548925776947010688,13173070736975126721,13719483751339084974)} + , testProperty "rewind to EBB supported as of Issue #1312, #2" $ + once $ + let ncn = NumCoreNodes 2 in + -- Same as above, except node 0 gets to forge an actual block before node + -- 1 tells it to rewind to the EBB. + prop_simple_real_pbft_convergence + TestConfig { numCoreNodes = ncn + , numSlots = NumSlots 4 + , nodeJoinPlan = NodeJoinPlan (Map.fromList [(CoreNodeId 0,SlotNo {unSlotNo = 0}),(CoreNodeId 1,SlotNo {unSlotNo = 3})]) + , nodeTopology = meshNodeTopology ncn + } + Seed {getSeed = (16817746570690588019,3284322327197424879,14951803542883145318,5227823917971823767,14093715642382269482)} , testProperty "simple Real PBFT convergence" $ forAllShrink genRealPBFTTestConfig shrinkRealPBFTTestConfig $ \testConfig -> forAll arbitrary $ \seed ->