From 9ffb6f960e4e969f0e27ef42c239bb205a9ce273 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Wed, 4 Mar 2020 09:14:21 -0800 Subject: [PATCH] byron: add protocol version update smoke test The Byron to Shelley hard-fork will end the Byron era by adopting a specific protocol version. This commit adds transactions and 'Property's to the RealPBFT tests that confirm the Byron nodes are able to update their protocol version. --- .../ouroboros-consensus-byron.cabal | 2 + .../test/Test/ThreadNet/DualPBFT.hs | 1 + .../test/Test/ThreadNet/RealPBFT.hs | 105 +++-- .../Test/ThreadNet/RealPBFT/ProtocolInfo.hs | 93 ++++ .../RealPBFT/ProtocolVersionUpdate.hs | 401 ++++++++++++++++++ .../test/Test/ThreadNet/BFT.hs | 1 + .../test/Test/ThreadNet/LeaderSchedule.hs | 3 +- .../test/Test/ThreadNet/PBFT.hs | 3 +- .../test/Test/ThreadNet/Praos.hs | 3 +- .../src/Test/ThreadNet/General.hs | 12 +- .../src/Test/ThreadNet/Network.hs | 102 +++-- 11 files changed, 640 insertions(+), 86 deletions(-) create mode 100644 ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolInfo.hs create mode 100644 ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolVersionUpdate.hs diff --git a/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal b/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal index 6d87d3fc963..d8a049e865e 100644 --- a/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal +++ b/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal @@ -85,6 +85,8 @@ test-suite test Test.Consensus.Byron.Ledger Test.ThreadNet.DualPBFT Test.ThreadNet.RealPBFT + Test.ThreadNet.RealPBFT.ProtocolInfo + Test.ThreadNet.RealPBFT.ProtocolVersionUpdate Test.ThreadNet.TxGen.Byron Ouroboros.Consensus.ByronDual.Ledger diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs index 4fa4041e0cb..d63bde850a0 100644 --- a/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs +++ b/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs @@ -153,6 +153,7 @@ setupTestOutput setup@SetupDualPBft{..} = forgeEbbEnv = Nothing -- spec does not model EBBs , rekeying = Nothing -- TODO , nodeInfo = \coreNodeId -> + plainTestNodeInitialization $ protocolInfoDualByron setupGenesis setupParams diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs index 5ec93acd190..5f910735c65 100644 --- a/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs +++ b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs @@ -17,14 +17,11 @@ module Test.ThreadNet.RealPBFT ( ) where import Data.Coerce (coerce) -import Data.Foldable (find) -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (mapMaybe) import qualified Data.Set as Set import Data.Time (Day (..), UTCTime (..)) import Data.Word (Word64) -import GHC.Stack (HasCallStack) import Numeric.Search.Range (searchFromTo) import Test.QuickCheck @@ -59,7 +56,6 @@ import qualified Cardano.Chain.Delegation as Delegation import qualified Cardano.Chain.Genesis as Genesis import Cardano.Chain.ProtocolConstants (kEpochSlots) import Cardano.Chain.Slotting (EpochNumber (..), unEpochSlots) -import qualified Cardano.Chain.Update as Update import qualified Cardano.Crypto as Crypto import qualified Cardano.Crypto.DSIGN as Crypto import qualified Test.Cardano.Chain.Genesis.Dummy as Dummy @@ -68,11 +64,11 @@ import qualified Ouroboros.Consensus.Byron.Crypto.DSIGN as Crypto import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import qualified Ouroboros.Consensus.Byron.Ledger as Byron import Ouroboros.Consensus.Byron.Ledger.Conversions -import Ouroboros.Consensus.Byron.Node import Ouroboros.Consensus.Byron.Protocol import Test.ThreadNet.General -import Test.ThreadNet.Network (NodeOutput (..)) +import Test.ThreadNet.Network (NodeOutput (..), + TestNodeInitialization (..)) import qualified Test.ThreadNet.Ref.PBFT as Ref import Test.ThreadNet.TxGen.Byron () import Test.ThreadNet.Util @@ -84,6 +80,9 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Shrink (andId, dropId) import qualified Test.Util.Stream as Stream +import Test.ThreadNet.RealPBFT.ProtocolInfo +import Test.ThreadNet.RealPBFT.ProtocolVersionUpdate + -- | Generate k values as small as this module is known to handle. -- -- TODO Issue #1566 will bring this to k>=0, at which point we may be able to @@ -551,6 +550,7 @@ prop_simple_real_pbft_convergence produceEBBs k } = tabulate "produce EBBs" [show produceEBBs] $ tabulate "Ref.PBFT result" [Ref.resultConstrName refResult] $ + tabulate "proposed protocol version was adopted" [show aPvuRequired] $ counterexample ("params: " <> show params) $ counterexample ("Ref.PBFT result: " <> show refResult) $ counterexample @@ -575,6 +575,7 @@ prop_simple_real_pbft_convergence produceEBBs k (expectedBlockRejection k numCoreNodes nodeRestarts) 1 testOutput .&&. + prop_pvu .&&. not (all (Chain.null . snd) finalChains) .&&. conjoin (map (hasAllEBBs k numSlots produceEBBs) finalChains) where @@ -584,7 +585,8 @@ prop_simple_real_pbft_convergence produceEBBs k NoEBBs -> Nothing ProduceEBBs -> Just byronForgeEbbEnv , nodeInfo = \nid -> - mkProtocolRealPBFT params nid genesisConfig genesisSecrets + mkProtocolRealPBftAndHardForkTxs + params nid genesisConfig genesisSecrets , rekeying = Just Rekeying { rekeyOracle = \cid s -> let nominalSlots = case refResult of @@ -628,6 +630,49 @@ prop_simple_real_pbft_convergence produceEBBs k finalChains :: [(NodeId, Chain ByronBlock)] finalChains = Map.toList $ nodeOutputFinalChain <$> testOutputNodes testOutput + finalLedgers :: [(NodeId, Byron.LedgerState ByronBlock)] + finalLedgers = Map.toList $ nodeOutputFinalLedger <$> testOutputNodes testOutput + + pvuLabels :: [(NodeId, ProtocolVersionUpdateLabel)] + pvuLabels = + [ (,) cid $ + mkProtocolVersionUpdateLabel + params + numSlots + genesisConfig + nodeJoinPlan + refResult + ldgr + | (cid, ldgr) <- finalLedgers + ] + + -- whether the proposed protocol version was required have been adopted in + -- one of the chains + aPvuRequired :: Bool + aPvuRequired = + or + [ Just True == pvuRequired + | (_, ProtocolVersionUpdateLabel{pvuRequired}) <- pvuLabels + ] + + -- check whether the proposed protocol version should have been and if so + -- was adopted + prop_pvu :: Property + prop_pvu = + counterexample (show pvuLabels) $ + conjoin + [ counterexample (show (cid, pvuLabel)) $ + let ProtocolVersionUpdateLabel + { pvuObserved + , pvuRequired + } = pvuLabel + in + property $ case pvuRequired of + Just b -> b == pvuObserved + Nothing -> True + | (cid, pvuLabel) <- pvuLabels + ] + params :: PBftParams params = realPBftParams k numCoreNodes @@ -682,43 +727,6 @@ hasAllEBBs k (NumSlots t) produceEBBs (nid, c) = actual = mapMaybe (nodeIsEBB . getHeader) $ Chain.toOldestFirst c -mkProtocolRealPBFT :: HasCallStack - => PBftParams - -> CoreNodeId - -> Genesis.Config - -> Genesis.GeneratedSecrets - -> ProtocolInfo ByronBlock -mkProtocolRealPBFT params (CoreNodeId i) - genesisConfig genesisSecrets = - protocolInfoByron - genesisConfig - (Just $ PBftSignatureThreshold pbftSignatureThreshold) - (Update.ProtocolVersion 1 0 0) - (Update.SoftwareVersion (Update.ApplicationName "Cardano Test") 2) - (Just leaderCredentials) - where - leaderCredentials :: PBftLeaderCredentials - leaderCredentials = either (error . show) id $ - mkPBftLeaderCredentials - genesisConfig - dlgKey - dlgCert - - PBftParams{pbftSignatureThreshold} = params - - dlgKey :: Crypto.SigningKey - dlgKey = fromMaybe (error "dlgKey") $ - find (\sec -> Delegation.delegateVK dlgCert == Crypto.toVerification sec) - $ Genesis.gsRichSecrets genesisSecrets - - dlgCert :: Delegation.Certificate - dlgCert = snd $ Map.toAscList dlgMap !! (fromIntegral i) - - dlgMap :: Map Common.KeyHash Delegation.Certificate - dlgMap = Genesis.unGenesisDelegation - $ Genesis.gdHeavyDelegation - $ Genesis.configGenesisData genesisConfig - {------------------------------------------------------------------------------- Generating the genesis configuration -------------------------------------------------------------------------------} @@ -1009,7 +1017,7 @@ mkRekeyUpd -> ProtocolInfo ByronBlock -> EpochNo -> Crypto.SignKeyDSIGN Crypto.ByronDSIGN - -> Maybe (ProtocolInfo ByronBlock, Byron.GenTx ByronBlock) + -> Maybe (TestNodeInitialization ByronBlock) mkRekeyUpd genesisConfig genesisSecrets pInfo eno newSK = case pbftIsLeader configConsensus of PBftIsNotALeader -> Nothing @@ -1028,7 +1036,10 @@ mkRekeyUpd genesisConfig genesisSecrets pInfo eno newSK = } PBftIsLeader{pbftDlgCert} = isLeader' - in Just (pInfo', dlgTx pbftDlgCert) + in Just TestNodeInitialization + { tniCrucialTxs = [dlgTx pbftDlgCert] + , tniProtocolInfo = pInfo' + } where ProtocolInfo{pInfoConfig = TopLevelConfig{ configConsensus , configLedger diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolInfo.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolInfo.hs new file mode 100644 index 00000000000..80090b06cff --- /dev/null +++ b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolInfo.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Test.ThreadNet.RealPBFT.ProtocolInfo ( + theProposedProtocolVersion, + theProposedSoftwareVersion, + mkProtocolRealPBFT, + ) where + +import Data.Foldable (find) +import Data.Map (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) +import GHC.Stack (HasCallStack) + +import qualified Cardano.Chain.Common as Common +import qualified Cardano.Chain.Delegation as Delegation +import qualified Cardano.Chain.Genesis as Genesis +import qualified Cardano.Chain.Update as Update +import qualified Cardano.Crypto as Crypto + +import Ouroboros.Consensus.Protocol.PBFT +import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo (..)) +import Ouroboros.Consensus.NodeId (CoreNodeId (..)) + +import Ouroboros.Consensus.Byron.Ledger (ByronBlock) +import Ouroboros.Consensus.Byron.Node + +mkProtocolRealPBFT :: HasCallStack + => PBftParams + -> CoreNodeId + -> Genesis.Config + -> Genesis.GeneratedSecrets + -> ProtocolInfo ByronBlock +mkProtocolRealPBFT params (CoreNodeId i) + genesisConfig genesisSecrets = + protocolInfoByron + genesisConfig + (Just $ PBftSignatureThreshold pbftSignatureThreshold) + theProposedProtocolVersion + theProposedSoftwareVersion + (Just leaderCredentials) + where + leaderCredentials :: PBftLeaderCredentials + leaderCredentials = either (error . show) id $ + mkPBftLeaderCredentials + genesisConfig + dlgKey + dlgCert + + PBftParams{pbftSignatureThreshold} = params + + dlgKey :: Crypto.SigningKey + dlgKey = fromMaybe (error "dlgKey") $ + find (\sec -> Delegation.delegateVK dlgCert == Crypto.toVerification sec) + $ Genesis.gsRichSecrets genesisSecrets + + dlgCert :: Delegation.Certificate + dlgCert = snd $ Map.toAscList dlgMap !! (fromIntegral i) + + dlgMap :: Map Common.KeyHash Delegation.Certificate + dlgMap = Genesis.unGenesisDelegation + $ Genesis.gdHeavyDelegation + $ Genesis.configGenesisData genesisConfig + +-- | The protocol version proposed as part of the hard-fork smoke test +-- +-- The initial Byron ledger state beings with protocol version @0.0.0@. In the +-- smoke test, if the proposal and votes are enabled, then we will be proposing +-- an update to @1.0.0@. +-- +-- This value occurs in two crucial places: the proposal and also the +-- 'Byron.byronProtocolVersion' field of the static node config. See the +-- Haddock comment on 'mkProtocolRealPBftAndHardForkTxs'. +-- +theProposedProtocolVersion :: Update.ProtocolVersion +theProposedProtocolVersion = Update.ProtocolVersion 1 0 0 + +-- | The software version proposed as part of the hard-fork smoke test +-- +-- We don't actually care about this for the smoke test, but we have to set it +-- both as part of the proposal and also as part of the node's static +-- configuration. Its use in the static configuration is legacy and does not +-- seem to affect anything; see Issue #1732. +-- +-- The initial Byron ledger state beings with no recorded software versions. +-- For the addition of a new software version, the Byron ledger rules require +-- that it starts at 0 or 1. +-- +theProposedSoftwareVersion :: Update.SoftwareVersion +theProposedSoftwareVersion = Update.SoftwareVersion + (Update.ApplicationName "Cardano Test") + 0 diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolVersionUpdate.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolVersionUpdate.hs new file mode 100644 index 00000000000..b6182df6158 --- /dev/null +++ b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT/ProtocolVersionUpdate.hs @@ -0,0 +1,401 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Test.ThreadNet.RealPBFT.ProtocolVersionUpdate ( + mkProtocolRealPBftAndHardForkTxs, + ProtocolVersionUpdateLabel (..), + mkProtocolVersionUpdateLabel, + ) where + +import Control.Exception (assert) +import Data.ByteString (ByteString) +import Data.Coerce (coerce) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Word (Word64) +import GHC.Stack (HasCallStack) + +import qualified Cardano.Binary +import qualified Cardano.Chain.Block as Block +import qualified Cardano.Chain.Byron.API as ByronAPI +import qualified Cardano.Chain.Genesis as Genesis +import qualified Cardano.Chain.MempoolPayload as MempoolPayload +import Cardano.Chain.Slotting (EpochSlots (..), SlotNumber (..)) +import qualified Cardano.Chain.Update as Update +import Cardano.Chain.Update.Proposal (AProposal) +import qualified Cardano.Chain.Update.Proposal as Proposal +import qualified Cardano.Chain.Update.Validation.Interface as Update +import Cardano.Chain.Update.Vote (AVote) +import qualified Cardano.Chain.Update.Vote as Vote +import qualified Cardano.Crypto as Crypto +import qualified Cardano.Crypto.DSIGN as Crypto + +import Ouroboros.Network.Block (SlotNo (..)) + +import Ouroboros.Consensus.Block (BlockProtocol) +import Ouroboros.Consensus.BlockchainTime.Mock (NumSlots (..)) +import Ouroboros.Consensus.Config (TopLevelConfig (..)) +import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..), + ProtocolInfo (..)) +import Ouroboros.Consensus.NodeId (CoreNodeId (..)) +import Ouroboros.Consensus.Protocol.Abstract (SecurityParam (..)) +import Ouroboros.Consensus.Protocol.PBFT + +import qualified Ouroboros.Consensus.Byron.Crypto.DSIGN as Crypto +import Ouroboros.Consensus.Byron.Ledger (ByronBlock) +import qualified Ouroboros.Consensus.Byron.Ledger as Byron + +import qualified Test.ThreadNet.Ref.PBFT as Ref +import Test.ThreadNet.Network (TestNodeInitialization (..)) +import Test.ThreadNet.Util.NodeJoinPlan + +import Test.ThreadNet.RealPBFT.ProtocolInfo + +data ProtocolVersionUpdateLabel = ProtocolVersionUpdateLabel + { pvuRequired :: !(Maybe Bool) + -- ^ @Just b@ indicates whether the final chains must have adopted or must + -- have not adopted the proposed protocol version. @Nothing@ means there is + -- no requirement. + , pvuObserved :: !Bool + -- ^ whether the proposed protocol version is adopted or not adopted by the + -- end of the test + } + deriving (Show) + +mkProtocolVersionUpdateLabel + :: PBftParams + -> NumSlots + -> Genesis.Config + -> NodeJoinPlan + -> Ref.Result + -> Byron.LedgerState ByronBlock + -- ^ from 'nodeOutputFinalLedger' + -> ProtocolVersionUpdateLabel +mkProtocolVersionUpdateLabel params numSlots genesisConfig nodeJoinPlan result ldgr = ProtocolVersionUpdateLabel + { pvuObserved = + (== theProposedProtocolVersion) $ + Update.adoptedProtocolVersion $ + Block.cvsUpdateState $ + -- tick the chain over into the slot after the final simulated slot + ByronAPI.applyChainTick genesisConfig sentinel $ + Byron.byronLedgerState ldgr + , pvuRequired = case result of + -- 'Ref.Forked' means there's only 1-block chains, and that's not enough + -- for a proposal to succeed + Ref.Forked{} -> Just False + -- we wouldn't necessarily be able to anticipate when the last + -- endorsement happens, so give up + Ref.Nondeterministic{} -> Nothing + Ref.Outcomes outcomes -> Just $ go Proposing (SlotNo 0) outcomes + } + where + PBftParams{pbftNumNodes, pbftSecurityParam} = params + + -- the slot immediately after the end of the simulation + sentinel :: SlotNumber + sentinel = SlotNumber t + where + NumSlots t = numSlots + + -- a block forged in slot @s@ becomes immutable/stable in slot @s + twoK@ + -- according to the Byron Chain Density invariant + twoK :: SlotNo + twoK = SlotNo $ 2 * maxRollbacks pbftSecurityParam + + -- the number of slots in an epoch + epochSlots :: SlotNo + epochSlots = coerce $ Genesis.configEpochSlots genesisConfig + + -- the protocol parameters + -- + -- ASSUMPTION: These do not change during the test. + pp0 :: Update.ProtocolParameters + pp0 = Genesis.configProtocolParameters genesisConfig + + -- how many votes/endorsements the proposal needs to gain + quorum :: Word64 + quorum = + (\x -> assert (x > 0) x) $ + fromIntegral $ Update.upAdptThd (fromIntegral n) pp0 + where + NumCoreNodes n = pbftNumNodes + + -- how many slots the proposal has to gain sufficient votes before it + -- expires + ttl :: SlotNo + ttl = coerce $ Update.ppUpdateProposalTTL pp0 + + -- the slot in which the node that casts the confirming vote joins + -- + -- By design of the test, all nodes vote for the proposal as soon as they + -- join. When a node joins, it quickly adds its vote to its mempool, but it + -- won't do so fast enough for the vote to be included in that same slot's + -- block. But TxSubmission will spread it to the other blocks. + -- + -- So the confirming vote will be submitted in first 'Nominal' slot + -- strictly after this slot. + confirmerJoinSlot :: SlotNo + confirmerJoinSlot = + coreNodeIdJoinSlot nodeJoinPlan $ CoreNodeId (pred quorum) + + -- the first slot of the epoch after the epoch containing the given slot + ebbSlotAfter :: SlotNo -> SlotNo + ebbSlotAfter (SlotNo s) = + SlotNo (denom * div s denom) + epochSlots + where + SlotNo denom = epochSlots + + -- compute the @Just@ case of 'pvuRequired' from the simulated outcomes + go + :: PvuLabelState + -- ^ the state before the next outcome + -> SlotNo + -- ^ the slot described by the next outcome + -> [Ref.Outcome] + -> Bool + go !st !s = \case + [] -> case st of + Proposing{} -> False + Voting{} -> False + Endorsing{} -> False + Adopting finalEndorsementSlot -> + assert (coerce sentinel == s) $ + ebbSlotAfter (finalEndorsementSlot + twoK) <= s + o:os -> case o of + Ref.Absent -> continueWith st + Ref.Unable -> continueWith st + Ref.Wasted -> continueWith st + Ref.Nominal -> case st of + -- the proposal is in this slot + Proposing -> + let leaderJoinSlot = + coreNodeIdJoinSlot nodeJoinPlan + (Ref.mkLeaderOf params s) + + -- if this leader just joined, it will forge before the + -- proposal is added to the mempool + lostRace = s == leaderJoinSlot + in + if lostRace then continueWith st else + -- votes can come immediately and at least one should also + -- be in this block + go (Voting s) s (o:os) + Voting proposalSlot -> + if proposalSlot + ttl < s + then False -- proposal expired + else + continueWith $ + if s <= confirmerJoinSlot + then st + else Endorsing s Set.empty -- enough votes + Endorsing finalVoteSlot ends -> + continueWith $ + if s < finalVoteSlot + twoK + then st -- ignore endorsements until final vote is stable + else + let ends' = Set.insert (Ref.mkLeaderOf params s) ends + in + if fromIntegral (Set.size ends) < quorum + then Endorsing finalVoteSlot ends' + else Adopting s -- enough endorsements + Adopting{} -> continueWith st + where + continueWith st' = go st' (succ s) os + +data PvuLabelState = + Proposing + -- ^ submitting the proposal + | Voting !SlotNo + -- ^ accumulating sufficient votes + -- + -- The slot is when the proposal was submitted; it might expire during + -- voting. + | Endorsing !SlotNo !(Set CoreNodeId) + -- ^ accumulating sufficient endorsements + -- + -- The slot is when the first sufficient vote was submitted. The set is the + -- endorsements seen so far. + | Adopting !SlotNo + -- ^ waiting for epoch transition + -- + -- The slot is when the first sufficient endorsement was submitted. + deriving (Show) + +{------------------------------------------------------------------------------- + ProtocolVersion update proposals +-------------------------------------------------------------------------------} + +-- | The protocol info for a node as well as some initial transactions +-- +-- The transactions implement a smoke test for the hard-fork from Byron to +-- Shelley. See PR #1741 for details on how that hard-fork will work. The key +-- fact is that last thing the nodes will ever do while running the Byron +-- protocol is adopt a specific (but as of yet to-be-determined) protocol +-- version. So this smoke test ensures that the nodes can in fact adopt a new +-- protocol version. +-- +-- Adopting a new protocol version requires four kinds of event in Byron. +-- Again, see PR #1741 for more details. +-- +-- * Proposal transaction. A protocol parameter update proposal transaction +-- makes it onto the chain (it doesn't have to actually change any +-- parameters, just increase the protocol version). Proposals are +-- 'MempoolPayload.MempoolUpdateProposal' transactions; one is included in +-- the return value of this function. In the smoke test, we immediately and +-- repeatedly throughout the test add the proposal to @CoreNodeId 0@'s +-- mempool; this seems realistic. +-- +-- * Vote transactions. A sufficient number of nodes (@floor (0.6 * +-- 'pbftNumNodes')@ as of this writing) must vote for the proposal. Votes +-- are 'MempoolPayload.MempoolUpdateVote' transactions; one per node is +-- included in the return value of this function. In the smoke test, we +-- immediately and repeatedly throughout the test add each node's vote to +-- its own mempool; this seems realistic. +-- +-- * Endorsement header field. After enough votes are 2k slots old, a +-- sufficient number of nodes (@floor (0.6 * 'pbftNumNodes')@ as of this +-- writing) must then endorse the proposal. Endorsements are not +-- transactions. Instead, every Byron header includes a field that specifies +-- a protocol version to endorse. At a particular stage of a corresponding +-- proposal's lifetime, that field constitutes an endorsement. At all other +-- times, it is essentially ignored. In the smoke test, we take advantage of +-- that to avoid having to restart our nodes: the nodes' initial +-- configuration causes them to immediately and always attempt to endorse +-- the proposed protocol version; this seems only slightly unrealistic. +-- +-- * Epoch transition. After enough endorsements are 2k slots old, the +-- protocol version will be adopted at the next epoch transition, unless +-- something else prevents it. In the smoke test, we check the validation +-- state of the final chains for the new protocol version when we detect no +-- mitigating circumstances, such as the test not even being scheduled to +-- reach the second epoch. +-- +mkProtocolRealPBftAndHardForkTxs + :: HasCallStack + => PBftParams + -> CoreNodeId + -> Genesis.Config + -> Genesis.GeneratedSecrets + -> TestNodeInitialization ByronBlock +mkProtocolRealPBftAndHardForkTxs params cid genesisConfig genesisSecrets = + TestNodeInitialization + { tniCrucialTxs = proposals ++ votes + , tniProtocolInfo = pInfo + } + where + ProtocolInfo{pInfoConfig} = pInfo + TopLevelConfig{configBlock, configConsensus} = pInfoConfig + + pInfo :: ProtocolInfo ByronBlock + pInfo = mkProtocolRealPBFT params cid genesisConfig genesisSecrets + + proposals :: [Byron.GenTx ByronBlock] + proposals = + if cid /= CoreNodeId 0 then [] else + (:[]) $ + Byron.fromMempoolPayload $ + MempoolPayload.MempoolUpdateProposal proposal + + votes :: [Byron.GenTx ByronBlock] + votes = + (:[]) $ + Byron.fromMempoolPayload $ + MempoolPayload.MempoolUpdateVote vote + + vote :: AVote ByteString + vote = + loopbackAnnotations $ + -- signed by delegate SK + Vote.signVote + (Byron.byronProtocolMagicId configBlock) + (Update.recoverUpId proposal) + True -- the serialization hardwires this value anyway + (Crypto.noPassSafeSigner opKey) + where + Crypto.SignKeyByronDSIGN opKey = getOpKey configConsensus + + proposal :: AProposal ByteString + proposal = + loopbackAnnotations $ + mkHardForkProposal params genesisConfig genesisSecrets + +-- | A protocol parameter update proposal that doesn't actually change any +-- parameter value but does propose 'theProposedProtocolVersion' +-- +-- Without loss of generality, the proposal is signed by @'CoreNodeId' 0@. +-- +mkHardForkProposal + :: HasCallStack + => PBftParams + -> Genesis.Config + -> Genesis.GeneratedSecrets + -> AProposal () +mkHardForkProposal params genesisConfig genesisSecrets = + -- signed by delegate SK + Proposal.signProposal + (Byron.byronProtocolMagicId configBlock) + propBody + (Crypto.noPassSafeSigner opKey) + where + pInfo :: ProtocolInfo ByronBlock + pInfo = mkProtocolRealPBFT params (CoreNodeId 0) genesisConfig genesisSecrets + + ProtocolInfo{pInfoConfig} = pInfo + TopLevelConfig{configBlock, configConsensus} = pInfoConfig + + Crypto.SignKeyByronDSIGN opKey = getOpKey configConsensus + + propBody :: Proposal.ProposalBody + propBody = Proposal.ProposalBody + { Proposal.protocolVersion = theProposedProtocolVersion + , Proposal.protocolParametersUpdate = Update.ProtocolParametersUpdate + { Update.ppuScriptVersion = Nothing + , Update.ppuSlotDuration = Nothing + , Update.ppuMaxBlockSize = Nothing + , Update.ppuMaxHeaderSize = Nothing + , Update.ppuMaxTxSize = Nothing + , Update.ppuMaxProposalSize = Nothing + , Update.ppuMpcThd = Nothing + , Update.ppuHeavyDelThd = Nothing + , Update.ppuUpdateVoteThd = Nothing + , Update.ppuUpdateProposalThd = Nothing + , Update.ppuUpdateProposalTTL = Nothing + , Update.ppuSoftforkRule = Nothing + , Update.ppuTxFeePolicy = Nothing + , Update.ppuUnlockStakeEpoch = Nothing + } + , Proposal.softwareVersion = theProposedSoftwareVersion + , Proposal.metadata = Map.empty + } + +-- | Get the delegate's operational signing key +-- +getOpKey + :: ConsensusConfig (BlockProtocol ByronBlock) + -> Crypto.SignKeyDSIGN Crypto.ByronDSIGN +getOpKey cfgConsensus = case pbftIsLeader of + PBftIsALeader PBftIsLeader{pbftSignKey} -> pbftSignKey + PBftIsNotALeader -> error "impossible!" + where + PBftConfig{pbftIsLeader} = cfgConsensus + +-- | Add the bytestring annotations that would be present if we were to +-- serialize the argument, send it to ourselves, receive it, and deserialize it +-- +-- The mempool payloads require the serialized bytes as annotations. It's +-- tricky to get right, and this function lets use reuse the existing CBOR +-- instances. +-- +loopbackAnnotations + :: ( Cardano.Binary.FromCBOR (f Cardano.Binary.ByteSpan) + , Cardano.Binary.ToCBOR (f ()) + , Functor f + ) + => f () + -> f ByteString +loopbackAnnotations = + ByronAPI.reAnnotateUsing + Cardano.Binary.toCBOR + Cardano.Binary.fromCBOR diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/BFT.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/BFT.hs index 7544c95ebdb..4d6974092ab 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/BFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/BFT.hs @@ -70,6 +70,7 @@ prop_simple_bft_convergence k runTestNetwork testConfig epochSize TestConfigBlock { forgeEbbEnv = Nothing , nodeInfo = \nid -> + plainTestNodeInitialization $ protocolInfoBft numCoreNodes nid k slotLengths , rekeying = Nothing } diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/LeaderSchedule.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/LeaderSchedule.hs index 2baa60f0faa..221446e01b1 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/LeaderSchedule.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/LeaderSchedule.hs @@ -103,7 +103,8 @@ prop_simple_leader_schedule_convergence testOutput@TestOutput{testOutputNodes} = runTestNetwork testConfig epochSize TestConfigBlock { forgeEbbEnv = Nothing - , nodeInfo = \nid -> protocolInfoPraosRule + , nodeInfo = \nid -> plainTestNodeInitialization $ + protocolInfoPraosRule numCoreNodes nid params diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs index a3a8fef0899..ecdf7ad1d88 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs @@ -97,7 +97,8 @@ prop_simple_pbft_convergence testOutput = runTestNetwork testConfig epochSize TestConfigBlock { forgeEbbEnv = Nothing - , nodeInfo = protocolInfoMockPBFT + , nodeInfo = plainTestNodeInitialization . + protocolInfoMockPBFT params (singletonSlotLengths pbftSlotLength) , rekeying = Nothing diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs index 38a2110cc61..77ef491367d 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs @@ -107,7 +107,8 @@ prop_simple_praos_convergence testOutput@TestOutput{testOutputNodes} = runTestNetwork testConfig epochSize TestConfigBlock { forgeEbbEnv = Nothing - , nodeInfo = \nid -> protocolInfoPraos + , nodeInfo = \nid -> plainTestNodeInitialization $ + protocolInfoPraos numCoreNodes nid params diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs index cb14f20be04..0c666b295c5 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs @@ -21,6 +21,7 @@ module Test.ThreadNet.General ( -- * Re-exports , ForgeEbbEnv (..) , TestOutput (..) + , plainTestNodeInitialization ) where import Control.Monad (guard) @@ -44,7 +45,6 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.BlockchainTime.Mock import Ouroboros.Consensus.Ledger.Extended (ExtValidationError) -import Ouroboros.Consensus.Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run import Ouroboros.Consensus.NodeId @@ -165,7 +165,7 @@ instance Arbitrary TestConfig where data TestConfigBlock blk = TestConfigBlock { forgeEbbEnv :: Maybe (ForgeEbbEnv blk) - , nodeInfo :: CoreNodeId -> ProtocolInfo blk + , nodeInfo :: CoreNodeId -> TestNodeInitialization blk , rekeying :: Maybe (Rekeying blk) } @@ -178,7 +178,7 @@ data Rekeying blk = forall opKey. Rekeying ProtocolInfo blk -> EpochNo -> opKey - -> Maybe (ProtocolInfo blk, GenTx blk) + -> Maybe (TestNodeInitialization blk) -- ^ new config and any corresponding delegation certificate transactions , rekeyFreshSKs :: Stream opKey -- ^ a stream that only repeats itself after an *effectively* *infinite* @@ -238,15 +238,15 @@ runTestNetwork rekeyVar <- uncheckedNewTVarM rekeyFreshSKs runThreadNetwork tna { tnaRekeyM = Just $ \cid pInfo s mkEno -> case rekeyOracle cid s of - Nothing -> pure (pInfo, Nothing) + Nothing -> pure $ plainTestNodeInitialization pInfo Just s' -> do x <- atomically $ do x :< xs <- readTVar rekeyVar x <$ writeTVar rekeyVar xs eno <- mkEno s' pure $ case rekeyUpd pInfo eno x of - Nothing -> (pInfo, Nothing) - Just (pInfo', tx) -> (pInfo', Just tx) + Nothing -> plainTestNodeInitialization pInfo + Just tni -> tni } {------------------------------------------------------------------------------- diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Network.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Network.hs index 5e832ae861e..75afbc61d57 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Network.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Network.hs @@ -18,6 +18,8 @@ module Test.ThreadNet.Network ( , ForgeEbbEnv (..) , RekeyM , ThreadNetworkArgs (..) + , TestNodeInitialization (..) + , plainTestNodeInitialization , TracingConstraints -- * Tracers , MiniProtocolExpectedException (..) @@ -41,7 +43,6 @@ import qualified Data.List as List import qualified Data.List.NonEmpty as NE import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (maybeToList) import Data.Proxy (Proxy (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -137,15 +138,32 @@ type RekeyM m blk = -> SlotNo -- ^ The slot in which the node is rekeying -> (SlotNo -> m EpochNo) - -> m (ProtocolInfo blk, Maybe (GenTx blk)) - -- ^ resulting config and any corresponding delegation certificate transaction + -> m (TestNodeInitialization blk) + -- ^ 'tniProtocolInfo' should include new delegation cert/operational key, + -- and 'tniCrucialTxs' should include the new delegation certificate + -- transaction + +-- | Data used when starting/restarting a node +data TestNodeInitialization blk = TestNodeInitialization + { tniCrucialTxs :: [GenTx blk] + -- ^ these transactions are added immediately and repeatedly (whenever the + -- 'ledgerTipSlot' changes) + , tniProtocolInfo :: ProtocolInfo blk + } + +plainTestNodeInitialization + :: ProtocolInfo blk -> TestNodeInitialization blk +plainTestNodeInitialization pInfo = TestNodeInitialization + { tniCrucialTxs = [] + , tniProtocolInfo = pInfo + } -- | Parameters for the test node net -- data ThreadNetworkArgs m blk = ThreadNetworkArgs { tnaForgeEbbEnv :: Maybe (ForgeEbbEnv blk) , tnaJoinPlan :: NodeJoinPlan - , tnaNodeInfo :: CoreNodeId -> ProtocolInfo blk + , tnaNodeInfo :: CoreNodeId -> TestNodeInitialization blk , tnaNumCoreNodes :: NumCoreNodes , tnaNumSlots :: NumSlots , tnaRNG :: ChaChaDRG @@ -182,9 +200,10 @@ data ThreadNetworkArgs m blk = ThreadNetworkArgs -- context. -- data VertexStatus m blk - = VDown (Chain blk) + = VDown (Chain blk) (LedgerState blk) -- ^ The vertex does not currently have a node instance; its previous - -- instance stopped with this chain (empty before first instance) + -- instance stopped with this chain and ledger state (empty/initial before + -- first instance) | VFalling -- ^ The vertex has a node instance, but it is about to transition to -- 'VDown' as soon as its edges transition to 'EDown'. @@ -277,7 +296,13 @@ runThreadNetwork ThreadNetworkArgs -- allocate the status variable for each vertex vertexStatusVars <- fmap Map.fromList $ do forM coreNodeIds $ \nid -> do - v <- uncheckedNewTVarM (VDown Genesis) + -- assume they all start with the empty chain and the same initial + -- ledger + let nodeInitData = mkProtocolInfo (CoreNodeId 0) + TestNodeInitialization{tniProtocolInfo} = nodeInitData + ProtocolInfo{pInfoInitLedger} = tniProtocolInfo + ExtLedgerState{ledgerState} = pInfoInitLedger + v <- uncheckedNewTVarM (VDown Genesis ledgerState) pure (nid, v) -- fork the directed edges, which also allocates their status variables @@ -353,7 +378,7 @@ runThreadNetwork ThreadNetworkArgs atomically $ forM vertexInfos0 $ \(coreNodeId, vertexStatusVar, readNodeInfo) -> do readTVar vertexStatusVar >>= \case - VDown ch -> pure (coreNodeId, readNodeInfo, ch) + VDown ch ldgr -> pure (coreNodeId, readNodeInfo, ch, ldgr) _ -> retry mkTestOutput vertexInfos @@ -387,8 +412,13 @@ runThreadNetwork ThreadNetworkArgs edgeStatusVars nodeInfo = void $ forkLinkedThread sharedRegistry $ do - loop 0 (mkProtocolInfo coreNodeId) NodeRestart restarts0 + loop 0 tniProtocolInfo NodeRestart restarts0 where + TestNodeInitialization + { tniCrucialTxs + , tniProtocolInfo + } = mkProtocolInfo coreNodeId + restarts0 :: Map SlotNo NodeRestart restarts0 = Map.mapMaybe (Map.lookup coreNodeId) m where @@ -397,16 +427,21 @@ runThreadNetwork ThreadNetworkArgs loop :: SlotNo -> ProtocolInfo blk -> NodeRestart -> Map SlotNo NodeRestart -> m () loop s pInfo nr rs = do -- a registry solely for the resources of this specific node instance - (again, finalChain) <- withRegistry $ \nodeRegistry -> do + (again, finalChain, finalLdgr) <- withRegistry $ \nodeRegistry -> do let nodeTestBtime = testBlockchainTimeClone sharedTestBtime nodeRegistry nodeBtime = testBlockchainTime nodeTestBtime -- change the node's key and prepare a delegation transaction if -- the node is restarting because it just rekeyed - (pInfo', txs0) <- case (nr, mbRekeyM) of + tni' <- case (nr, mbRekeyM) of (NodeRekey, Just rekeyM) -> do - fmap maybeToList <$> rekeyM coreNodeId pInfo s (epochInfoEpoch epochInfo) - _ -> pure (pInfo, []) + rekeyM coreNodeId pInfo s (epochInfoEpoch epochInfo) + _ -> + pure $ plainTestNodeInitialization pInfo + let TestNodeInitialization + { tniCrucialTxs = crucialTxs' + , tniProtocolInfo = pInfo' + } = tni' -- allocate the node's internal state and fork its internal threads -- (specifically not the communication threads running the Mini @@ -417,7 +452,7 @@ runThreadNetwork ThreadNetworkArgs nodeRegistry pInfo' nodeInfo - txs0 + (crucialTxs' ++ tniCrucialTxs) atomically $ writeTVar vertexStatusVar $ VUp kernel app -- wait until this node instance should stop @@ -442,11 +477,15 @@ runThreadNetwork ThreadNetworkArgs -- assuming nothing else is changing it, read the final chain let chainDB = getChainDB kernel + ExtLedgerState{ledgerState} <- atomically $ + ChainDB.getCurrentLedger chainDB finalChain <- ChainDB.toChain chainDB - pure (again, finalChain) -- end of the node's withRegistry + pure (again, finalChain, ledgerState) + -- end of the node's withRegistry - atomically $ writeTVar vertexStatusVar $ VDown finalChain + atomically $ writeTVar vertexStatusVar $ + VDown finalChain finalLdgr case again of Nothing -> pure () @@ -458,7 +497,7 @@ runThreadNetwork ThreadNetworkArgs -- If we add the transaction and then the mempools discards it for some -- reason, this thread will add it again. -- - forkTxs0 + forkCrucialTxs :: HasCallStack => ResourceRegistry m -> STM m (WithOrigin SlotNo) @@ -467,7 +506,7 @@ runThreadNetwork ThreadNetworkArgs -> [GenTx blk] -- ^ valid transactions the node should immediately propagate -> m () - forkTxs0 registry get mempool txs0 = + forkCrucialTxs registry get mempool txs0 = void $ forkLinkedThread registry $ do let loop mbSlot = do _ <- addTxs mempool txs0 @@ -708,7 +747,7 @@ runThreadNetwork ThreadNetworkArgs -- -- TODO Is there a risk that this will block because the 'forkTxProducer' -- fills up the mempool too quickly? - forkTxs0 + forkCrucialTxs registry ((ledgerTipSlot . ledgerState) <$> ChainDB.getCurrentLedger chainDB) mempool @@ -1036,11 +1075,12 @@ newNodeInfo = do -------------------------------------------------------------------------------} data NodeOutput blk = NodeOutput - { nodeOutputAdds :: Map SlotNo (Set (RealPoint blk, BlockNo)) - , nodeOutputFinalChain :: Chain blk - , nodeOutputNodeDBs :: NodeDBs MockFS - , nodeOutputForges :: Map SlotNo blk - , nodeOutputInvalids :: Map (RealPoint blk) [ExtValidationError blk] + { nodeOutputAdds :: Map SlotNo (Set (RealPoint blk, BlockNo)) + , nodeOutputFinalChain :: Chain blk + , nodeOutputFinalLedger :: LedgerState blk + , nodeOutputNodeDBs :: NodeDBs MockFS + , nodeOutputForges :: Map SlotNo blk + , nodeOutputInvalids :: Map (RealPoint blk) [ExtValidationError blk] } data TestOutput blk = TestOutput @@ -1054,11 +1094,12 @@ mkTestOutput :: => [( CoreNodeId , m (NodeInfo blk MockFS []) , Chain blk + , LedgerState blk )] -> m (TestOutput blk) mkTestOutput vertexInfos = do (nodeOutputs', tipBlockNos') <- fmap unzip $ forM vertexInfos $ - \(cid, readNodeInfo, ch) -> do + \(cid, readNodeInfo, ch, ldgr) -> do let nid = fromCoreNodeId cid nodeInfo <- readNodeInfo let NodeInfo @@ -1072,15 +1113,16 @@ mkTestOutput vertexInfos = do , nodeEventsTipBlockNos } = nodeInfoEvents let nodeOutput = NodeOutput - { nodeOutputAdds = + { nodeOutputAdds = Map.fromListWith Set.union $ [ (s, Set.singleton (p, bno)) | (s, p, bno) <- nodeEventsAdds ] - , nodeOutputFinalChain = ch - , nodeOutputNodeDBs = nodeInfoDBs - , nodeOutputForges = + , nodeOutputFinalChain = ch + , nodeOutputFinalLedger = ldgr + , nodeOutputNodeDBs = nodeInfoDBs + , nodeOutputForges = Map.fromList $ [ (s, b) | TraceForgedBlock s _ b _ <- nodeEventsForges ] - , nodeOutputInvalids = (:[]) <$> Map.fromList nodeEventsInvalids + , nodeOutputInvalids = (:[]) <$> Map.fromList nodeEventsInvalids } pure