check that Byron can increment its adopted protocol version

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

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

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

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