From 76434e0e2870875a1b119cd9f9bd44bef20cea9d Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Wed, 17 Sep 2025 20:01:06 +0200 Subject: [PATCH 1/4] ThreadNet: refactor `TestSetup` in era-crossing tests - move `TestSetup` to an existing shared module - abstract `TestSetup` over the protocol - abstract `protocolInfoShelleyBasedHardFork` - minimise syntactic differences --- .../ThreadNet/Infra/ShelleyBasedHardFork.hs | 60 ++++---- .../Test/ThreadNet/Infra/TwoEras.hs | 129 ++++++++++++++++-- .../Test/ThreadNet/AllegraMary.hs | 95 ++----------- .../cardano-test/Test/ThreadNet/Cardano.hs | 2 +- .../cardano-test/Test/ThreadNet/MaryAlonzo.hs | 102 ++------------ .../Test/ThreadNet/ShelleyAllegra.hs | 114 +++------------- 6 files changed, 202 insertions(+), 300 deletions(-) diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs index 7394a16518..4be9126038 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs @@ -8,7 +8,6 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -193,7 +192,6 @@ type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 = , -- At the moment, fix the protocols together ProtoCrypto proto1 ~ ProtoCrypto proto2 , PraosCrypto (ProtoCrypto proto1) - , proto1 ~ TPraos (ProtoCrypto proto1) , proto1 ~ proto2 , MemPack (TxOut (LedgerState (ShelleyBlock proto1 era1))) , MemPack (TxOut (LedgerState (ShelleyBlock proto2 era2))) @@ -237,19 +235,19 @@ instance hardForkEraTranslation = EraTranslation - { translateLedgerState = PCons translateLedgerState PNil - , translateLedgerTables = PCons translateLedgerTables PNil + { translateLedgerState = PCons translateLedgerStateInstance PNil + , translateLedgerTables = PCons translateLedgerTablesInstance PNil , translateChainDepState = PCons translateChainDepStateAcrossShelley PNil , crossEraForecast = PCons crossEraForecastAcrossShelley PNil } where - translateLedgerState :: + translateLedgerStateInstance :: InPairs.RequiringBoth WrapLedgerConfig TranslateLedgerState (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2) - translateLedgerState = + translateLedgerStateInstance = InPairs.RequireBoth $ \_cfg1 cfg2 -> HFC.TranslateLedgerState @@ -263,11 +261,11 @@ instance . Flip } - translateLedgerTables :: + translateLedgerTablesInstance :: TranslateLedgerTables (ShelleyBlock proto1 era1) (ShelleyBlock proto2 era2) - translateLedgerTables = + translateLedgerTablesInstance = HFC.TranslateLedgerTables { translateTxInWith = coerce , translateTxOutWith = SL.upgradeTxOut @@ -390,7 +388,23 @@ protocolInfoShelleyBasedHardFork :: ( KESAgentContext (ProtoCrypto proto2) m , ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 ) => + ( ProtocolParamsShelleyBased (ProtoCrypto proto1) -> + L.TransitionConfig era1 -> + SL.ProtVer -> + ( ProtocolInfo (ShelleyBlock proto1 era1) + , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto1 era1)] + ) + ) -> + ( ProtocolParamsShelleyBased (ProtoCrypto proto2) -> + L.TransitionConfig era2 -> + SL.ProtVer -> + ( ProtocolInfo (ShelleyBlock proto2 era2) + , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto2 era2)] + ) + ) -> ProtocolParamsShelleyBased (ProtoCrypto proto1) -> + (ConsensusConfig proto1 -> PartialConsensusConfig proto1) -> + (ConsensusConfig proto2 -> PartialConsensusConfig proto2) -> SL.ProtVer -> SL.ProtVer -> L.TransitionConfig era2 -> @@ -400,7 +414,11 @@ protocolInfoShelleyBasedHardFork :: m [MkBlockForging m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)] ) protocolInfoShelleyBasedHardFork + protocolInfoProtoShelleyBased1 -- TODO(geo2a): come up with a better name for this argument + protocolInfoProtoShelleyBased2 protocolParamsShelleyBased + toPartialConsensusConfig1 + toPartialConsensusConfig2 protVer1 protVer2 transCfg2 @@ -410,20 +428,15 @@ protocolInfoShelleyBasedHardFork protocolInfo1 blockForging1 eraParams1 - tpraosParams + toPartialConsensusConfig1 toPartialLedgerConfig1 -- Era 2 protocolInfo2 blockForging2 eraParams2 - tpraosParams + toPartialConsensusConfig2 toPartialLedgerConfig2 where - ProtocolParamsShelleyBased - { shelleyBasedInitialNonce - , shelleyBasedLeaderCredentials - } = protocolParamsShelleyBased - -- Era 1 genesis :: SL.ShelleyGenesis @@ -433,7 +446,7 @@ protocolInfoShelleyBasedHardFork blockForging1 :: Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto1 era1)] (protocolInfo1, blockForging1) = - protocolInfoTPraosShelleyBased + protocolInfoProtoShelleyBased1 protocolParamsShelleyBased (transCfg2 ^. L.tcPreviousEraConfigL) protVer1 @@ -444,9 +457,9 @@ protocolInfoShelleyBasedHardFork toPartialLedgerConfig1 :: LedgerConfig (ShelleyBlock proto1 era1) -> PartialLedgerConfig (ShelleyBlock proto1 era1) - toPartialLedgerConfig1 cfg = + toPartialLedgerConfig1 cfg1 = ShelleyPartialLedgerConfig - { shelleyLedgerConfig = cfg + { shelleyLedgerConfig = cfg1 , shelleyTriggerHardFork = hardForkTrigger } @@ -456,11 +469,8 @@ protocolInfoShelleyBasedHardFork blockForging2 :: Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto2 era2)] (protocolInfo2, blockForging2) = - protocolInfoTPraosShelleyBased - ProtocolParamsShelleyBased - { shelleyBasedInitialNonce - , shelleyBasedLeaderCredentials - } + protocolInfoProtoShelleyBased2 + protocolParamsShelleyBased transCfg2 protVer2 @@ -470,9 +480,9 @@ protocolInfoShelleyBasedHardFork toPartialLedgerConfig2 :: LedgerConfig (ShelleyBlock proto2 era2) -> PartialLedgerConfig (ShelleyBlock proto2 era2) - toPartialLedgerConfig2 cfg = + toPartialLedgerConfig2 cfg2 = ShelleyPartialLedgerConfig - { shelleyLedgerConfig = cfg + { shelleyLedgerConfig = cfg2 , shelleyTriggerHardFork = TriggerHardForkNotDuringThisExecution } diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs index 59a644749e..b4cbb84d1c 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs @@ -1,20 +1,33 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | Definitions used in ThreadNet tests that involve two eras. module Test.ThreadNet.Infra.TwoEras - ( -- * Generators - Partition (..) + ( -- * Common infrastructure used in the ThreadNet tests that perform an era crossing + + -- ** A hard-fork block for two eras + DualBlock + + -- ** The varying data of the tests crossing between Shelley-based eras + , TestSetup (..) + + -- ** Generators + , Partition (..) , genNonce , genPartition , genTestConfig - -- * Era inspection + -- ** Era inspection , ReachesEra2 (..) , activeSlotCoeff , isFirstEraBlock @@ -25,7 +38,7 @@ module Test.ThreadNet.Infra.TwoEras , secondEraOverlaySlots , shelleyEpochSize - -- * Properties + -- ** Properties , label_ReachesEra2 , label_hadActiveNonOverlaySlots , prop_ReachesEra2 @@ -37,42 +50,138 @@ module Test.ThreadNet.Infra.TwoEras import qualified Cardano.Chain.Common as CC.Common import Cardano.Chain.ProtocolConstants (kEpochSlots) import Cardano.Chain.Slotting (unEpochSlots) -import Cardano.Ledger.BaseTypes (unNonZero) +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Protocol.TPraos.Rules.Overlay as SL import Cardano.Slotting.EpochInfo -import Cardano.Slotting.Slot - ( EpochNo (..) - , EpochSize (..) - , SlotNo (..) - ) +import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..)) import Control.Exception (assert) import Data.Functor ((<&>)) import qualified Data.Map.Strict as Map import Data.Maybe (isJust) +import Data.Proxy (Proxy (..)) import Data.SOP.Strict (NS (..)) import Data.Set (Set) import qualified Data.Set as Set import Data.Word (Word64) import GHC.Generics (Generic) +import Ouroboros.Consensus.BlockchainTime +import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Config.SecurityParam import Ouroboros.Consensus.HardFork.Combinator ( HardForkBlock (..) , OneEraBlock (..) ) +import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common + ( isHardForkNodeToNodeEnabled + ) import qualified Ouroboros.Consensus.HardFork.History.Util as Util +import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId +import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () +import Test.Consensus.Shelley.MockCrypto (MockCrypto) import Test.QuickCheck import Test.ThreadNet.General import qualified Test.ThreadNet.Infra.Shelley as Shelley +import Test.ThreadNet.Infra.ShelleyBasedHardFork import Test.ThreadNet.Network (CalcMessageDelay (..), NodeOutput (..)) +import Test.ThreadNet.TxGen.Allegra () import Test.ThreadNet.Util.Expectations (NumBlocks (..)) +import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered) import qualified Test.ThreadNet.Util.NodeTopology as Topo import qualified Test.Util.BoolProps as BoolProps import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) +{------------------------------------------------------------------------------- + Block Type +-------------------------------------------------------------------------------} + +-- | A hard-fork block for two Shelley-based eras +type DualBlock proto era1 era2 = + ShelleyBasedHardForkBlock (proto MockCrypto) era1 (proto MockCrypto) era2 + +{------------------------------------------------------------------------------- + Test Setup +-------------------------------------------------------------------------------} + +-- | The varying data of the tests crossing between Shelley-based eras +-- +-- Note: The Shelley nodes in this test all join, propose an update, and endorse +-- it literally as soon as possible. Therefore, if the test reaches the end of +-- the first epoch, the proposal will be adopted. +data TestSetup proto era1 era2 = TestSetup + { setupD :: Shelley.DecentralizationParam + , setupHardFork :: Bool + -- ^ whether the proposal should trigger a hard fork or not + , setupInitialNonce :: SL.Nonce + -- ^ the initial Shelley 'SL.ticknStateEpochNonce' + -- + -- We vary it to ensure we explore different leader schedules. + , setupK :: SecurityParam + , setupPartition :: Partition + , setupSlotLength :: SlotLength + , setupTestConfig :: TestConfig + , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion (DualBlock proto era1 era2)) + } + +deriving instance Show (TestSetup proto era1 era2) + +instance + SupportedNetworkProtocolVersion (DualBlock proto era1 era2) => + Arbitrary (TestSetup proto era1 era2) + where + arbitrary = do + setupD <- + arbitrary + -- The decentralization parameter cannot be 0 in the first + -- Shelley epoch, since stake pools can only be created and + -- delegated to via Shelley transactions. + `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) + setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero + -- If k < 8, common prefix violations become too likely in + -- Praos mode for thin overlay schedules (ie low d), even for + -- f=0.2. + + setupInitialNonce <- genNonce + + setupSlotLength <- arbitrary + + let epochSize = EpochSize $ shelleyEpochSize setupK + setupTestConfig <- + genTestConfig + setupK + (epochSize, epochSize) + let TestConfig{numCoreNodes, numSlots} = setupTestConfig + + setupHardFork <- frequency [(49, pure True), (1, pure False)] + + -- TODO How reliable is the Byron-based partition duration logic when + -- reused for Shelley? + setupPartition <- genPartition numCoreNodes numSlots setupK + + setupVersion <- + genVersionFiltered + isHardForkNodeToNodeEnabled + (Proxy @(DualBlock proto era1 era2)) + + pure + TestSetup + { setupD + , setupHardFork + , setupInitialNonce + , setupK + , setupPartition + , setupSlotLength + , setupTestConfig + , setupVersion + } + +{------------------------------------------------------------------------------- + Network Partitions +-------------------------------------------------------------------------------} + -- | When and for how long the nodes are partitioned -- -- The nodes are divided via message delays into two sub-networks by the parity diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs index b6d2a37778..de5b292d2d 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs @@ -14,7 +14,7 @@ module Test.ThreadNet.AllegraMary (tests) where import qualified Cardano.Ledger.Api.Transition as L -import Cardano.Ledger.BaseTypes (nonZero, unNonZero) +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.Core as SL import qualified Cardano.Protocol.TPraos.OCert as SL @@ -29,23 +29,20 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Word (Word64) import Lens.Micro ((^.)) -import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..)) import Ouroboros.Consensus.Config.SecurityParam -import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common - ( isHardForkNodeToNodeEnabled - ) import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs) -import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node ( ProtocolParamsShelleyBased (..) , ShelleyGenesis (..) + , protocolInfoTPraosShelleyBased ) import Test.Consensus.Shelley.MockCrypto (MockCrypto) import Test.QuickCheck @@ -65,7 +62,6 @@ import Test.ThreadNet.TxGen.Mary () import Test.ThreadNet.Util.Expectations (NumBlocks (..)) import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan) import Test.ThreadNet.Util.NodeRestarts (noRestarts) -import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered) import Test.ThreadNet.Util.Seed (runGen) import qualified Test.Util.BoolProps as BoolProps import Test.Util.HardFork.Future (EraSize (..), Future (..)) @@ -73,84 +69,13 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv -type AllegraMaryBlock = - ShelleyBasedHardForkBlock (TPraos MockCrypto) AllegraEra (TPraos MockCrypto) MaryEra - --- | The varying data of this test --- --- Note: The Shelley nodes in this test all join, propose an update, and endorse --- it literally as soon as possible. Therefore, if the test reaches the end of --- the first epoch, the proposal will be adopted. -data TestSetup = TestSetup - { setupD :: Shelley.DecentralizationParam - , setupHardFork :: Bool - -- ^ whether the proposal should trigger a hard fork or not - , setupInitialNonce :: SL.Nonce - -- ^ the initial Shelley 'SL.ticknStateEpochNonce' - -- - -- We vary it to ensure we explore different leader schedules. - , setupK :: SecurityParam - , setupPartition :: Partition - , setupSlotLength :: SlotLength - , setupTestConfig :: TestConfig - , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion AllegraMaryBlock) - } - deriving Show - -instance Arbitrary TestSetup where - arbitrary = do - setupD <- - arbitrary - -- The decentralization parameter cannot be 0 in the first - -- Shelley epoch, since stake pools can only be created and - -- delegated to via Shelley transactions. - `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero - -- If k < 8, common prefix violations become too likely in - -- Praos mode for thin overlay schedules (ie low d), even for - -- f=0.2. - - setupInitialNonce <- genNonce - - setupSlotLength <- arbitrary - - let epochSize = EpochSize $ shelleyEpochSize setupK - setupTestConfig <- - genTestConfig - setupK - (epochSize, epochSize) - let TestConfig{numCoreNodes, numSlots} = setupTestConfig - - setupHardFork <- frequency [(49, pure True), (1, pure False)] - - -- TODO How reliable is the Byron-based partition duration logic when - -- reused for Shelley? - setupPartition <- genPartition numCoreNodes numSlots setupK - - setupVersion <- - genVersionFiltered - isHardForkNodeToNodeEnabled - (Proxy @AllegraMaryBlock) - - pure - TestSetup - { setupD - , setupHardFork - , setupInitialNonce - , setupK - , setupPartition - , setupSlotLength - , setupTestConfig - , setupVersion - } - --- TODO shrink - tests :: TestTree tests = testGroup "AllegraMary ThreadNet" - [ askTestEnv $ adjustTestEnv $ testProperty "simple convergence" prop_simple_allegraMary_convergence + [ askTestEnv $ + adjustTestEnv $ + testProperty "simple convergence" prop_simple_allegraMary_convergence ] where adjustTestEnv :: TestTree -> TestEnv -> TestTree @@ -158,7 +83,7 @@ tests = Nightly -> tree _ -> adjustQuickCheckTests (`div` 10) tree -prop_simple_allegraMary_convergence :: TestSetup -> Property +prop_simple_allegraMary_convergence :: TestSetup TPraos AllegraEra MaryEra -> Property prop_simple_allegraMary_convergence TestSetup { setupD @@ -235,7 +160,7 @@ prop_simple_allegraMary_convergence , version = setupVersion } - testOutput :: TestOutput AllegraMaryBlock + testOutput :: TestOutput (DualBlock TPraos AllegraEra MaryEra) testOutput = runTestNetwork setupTestConfig @@ -254,7 +179,11 @@ prop_simple_allegraMary_convergence TriggerHardForkAtVersion $ SL.getVersion majorVersion2 (protocolInfo, blockForging) = protocolInfoShelleyBasedHardFork + protocolInfoTPraosShelleyBased + protocolInfoTPraosShelleyBased protocolParamsShelleyBased + TPraos.tpraosParams + TPraos.tpraosParams (SL.ProtVer majorVersion1 0) (SL.ProtVer majorVersion2 0) ( L.mkTransitionConfig L.NoGenesis $ diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs index 6364caede9..3a1258ffc1 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs @@ -73,7 +73,7 @@ import Test.Tasty.QuickCheck import Test.ThreadNet.General import qualified Test.ThreadNet.Infra.Byron as Byron import qualified Test.ThreadNet.Infra.Shelley as Shelley -import Test.ThreadNet.Infra.TwoEras +import Test.ThreadNet.Infra.TwoEras hiding (TestSetup (..)) import Test.ThreadNet.Network ( NodeOutput (..) , TestNodeInitialization (..) diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs index f8041f6926..912e1d2fbc 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs @@ -14,7 +14,7 @@ module Test.ThreadNet.MaryAlonzo (tests) where import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import qualified Cardano.Ledger.Api.Transition as L -import Cardano.Ledger.BaseTypes (nonZero, unNonZero) +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.BaseTypes as SL ( Version , getVersion @@ -34,23 +34,20 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Word (Word64) import Lens.Micro -import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..)) import Ouroboros.Consensus.Config.SecurityParam -import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common - ( isHardForkNodeToNodeEnabled - ) import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs) -import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node ( ProtocolParamsShelleyBased (..) , ShelleyGenesis (..) + , protocolInfoTPraosShelleyBased ) import qualified Test.Cardano.Ledger.Alonzo.Examples as SL import Test.Consensus.Shelley.MockCrypto (MockCrypto) @@ -71,7 +68,6 @@ import Test.ThreadNet.TxGen.Mary () import Test.ThreadNet.Util.Expectations (NumBlocks (..)) import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan) import Test.ThreadNet.Util.NodeRestarts (noRestarts) -import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered) import Test.ThreadNet.Util.Seed (runGen) import qualified Test.Util.BoolProps as BoolProps import Test.Util.HardFork.Future (EraSize (..), Future (..)) @@ -79,95 +75,21 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv -type MaryAlonzoBlock = - ShelleyBasedHardForkBlock (TPraos MockCrypto) MaryEra (TPraos MockCrypto) AlonzoEra - --- | The varying data of this test --- --- Note: The Shelley nodes in this test all join, propose an update, and endorse --- it literally as soon as possible. Therefore, if the test reaches the end of --- the first epoch, the proposal will be adopted. -data TestSetup = TestSetup - { setupD :: Shelley.DecentralizationParam - , setupHardFork :: Bool - -- ^ whether the proposal should trigger a hard fork or not - , setupInitialNonce :: SL.Nonce - -- ^ the initial Shelley 'SL.ticknStateEpochNonce' - -- - -- We vary it to ensure we explore different leader schedules. - , setupK :: SecurityParam - , setupPartition :: Partition - , setupSlotLength :: SlotLength - , setupTestConfig :: TestConfig - , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion MaryAlonzoBlock) - } - deriving Show - -instance Arbitrary TestSetup where - arbitrary = do - setupD <- - arbitrary - -- The decentralization parameter cannot be 0 in the first - -- Shelley epoch, since stake pools can only be created and - -- delegated to via Shelley transactions. - `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero - -- If k < 8, common prefix violations become too likely in - -- Praos mode for thin overlay schedules (ie low d), even for - -- f=0.2. - - setupInitialNonce <- genNonce - - setupSlotLength <- arbitrary - - let epochSize = EpochSize $ shelleyEpochSize setupK - setupTestConfig <- - genTestConfig - setupK - (epochSize, epochSize) - let TestConfig{numCoreNodes, numSlots} = setupTestConfig - - setupHardFork <- frequency [(49, pure True), (1, pure False)] - - -- TODO How reliable is the Byron-based partition duration logic when - -- reused for Shelley? - setupPartition <- genPartition numCoreNodes numSlots setupK - - setupVersion <- - genVersionFiltered - isHardForkNodeToNodeEnabled - (Proxy @MaryAlonzoBlock) - - pure - TestSetup - { setupD - , setupHardFork - , setupInitialNonce - , setupK - , setupPartition - , setupSlotLength - , setupTestConfig - , setupVersion - } - --- TODO shrink - tests :: TestTree tests = testGroup "MaryAlonzo ThreadNet" - [ let name = "simple convergence" - in askTestEnv $ - adjustTestMode $ - testProperty name prop_simple_allegraAlonzo_convergence + [ askTestEnv $ + adjustTestEnv $ + testProperty "simple convergence" prop_simple_allegraAlonzo_convergence ] where - adjustTestMode :: TestTree -> TestEnv -> TestTree - adjustTestMode tree = \case + adjustTestEnv :: TestTree -> TestEnv -> TestTree + adjustTestEnv tree = \case Nightly -> tree _ -> adjustQuickCheckTests (`div` 10) tree -prop_simple_allegraAlonzo_convergence :: TestSetup -> Property +prop_simple_allegraAlonzo_convergence :: TestSetup TPraos MaryEra AlonzoEra -> Property prop_simple_allegraAlonzo_convergence TestSetup { setupD @@ -244,7 +166,7 @@ prop_simple_allegraAlonzo_convergence , version = setupVersion } - testOutput :: TestOutput MaryAlonzoBlock + testOutput :: TestOutput (DualBlock TPraos MaryEra AlonzoEra) testOutput = runTestNetwork setupTestConfig @@ -263,7 +185,11 @@ prop_simple_allegraAlonzo_convergence TriggerHardForkAtVersion $ SL.getVersion majorVersion2 (protocolInfo, blockForging) = protocolInfoShelleyBasedHardFork + protocolInfoTPraosShelleyBased + protocolInfoTPraosShelleyBased protocolParamsShelleyBased + TPraos.tpraosParams + TPraos.tpraosParams (SL.ProtVer majorVersion1 0) (SL.ProtVer majorVersion2 0) ( L.mkTransitionConfig alonzoGenesis $ diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs index 783ea08dc3..aa2f668f45 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs @@ -14,7 +14,7 @@ module Test.ThreadNet.ShelleyAllegra (tests) where import qualified Cardano.Ledger.Api.Transition as L -import Cardano.Ledger.BaseTypes (nonZero, unNonZero) +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.Core as SL import qualified Cardano.Protocol.TPraos.OCert as SL @@ -29,23 +29,20 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Word (Word64) import Lens.Micro ((^.)) -import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..)) import Ouroboros.Consensus.Config.SecurityParam -import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common - ( isHardForkNodeToNodeEnabled - ) import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs) -import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node ( ProtocolParamsShelleyBased (..) , ShelleyGenesis (..) + , protocolInfoTPraosShelleyBased ) import Test.Consensus.Shelley.MockCrypto (MockCrypto) import Test.QuickCheck @@ -65,7 +62,6 @@ import Test.ThreadNet.TxGen.Shelley import Test.ThreadNet.Util.Expectations (NumBlocks (..)) import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan) import Test.ThreadNet.Util.NodeRestarts (noRestarts) -import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered) import Test.ThreadNet.Util.Seed (runGen) import qualified Test.Util.BoolProps as BoolProps import Test.Util.HardFork.Future (EraSize (..), Future (..)) @@ -73,93 +69,21 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv -type ShelleyAllegraBlock = - ShelleyBasedHardForkBlock (TPraos MockCrypto) ShelleyEra (TPraos MockCrypto) AllegraEra - --- | The varying data of this test --- --- Note: The Shelley nodes in this test all join, propose an update, and endorse --- it literally as soon as possible. Therefore, if the test reaches the end of --- the first epoch, the proposal will be adopted. -data TestSetup = TestSetup - { setupD :: Shelley.DecentralizationParam - , setupHardFork :: Bool - -- ^ whether the proposal should trigger a hard fork or not - , setupInitialNonce :: SL.Nonce - -- ^ the initial Shelley 'SL.ticknStateEpochNonce' - -- - -- We vary it to ensure we explore different leader schedules. - , setupK :: SecurityParam - , setupPartition :: Partition - , setupSlotLength :: SlotLength - , setupTestConfig :: TestConfig - , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock) - } - deriving Show - -instance Arbitrary TestSetup where - arbitrary = do - setupD <- - arbitrary - -- The decentralization parameter cannot be 0 in the first - -- Shelley epoch, since stake pools can only be created and - -- delegated to via Shelley transactions. - `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero - -- If k < 8, common prefix violations become too likely in - -- Praos mode for thin overlay schedules (ie low d), even for - -- f=0.2. - - setupInitialNonce <- genNonce - - setupSlotLength <- arbitrary - - let epochSize = EpochSize $ shelleyEpochSize setupK - setupTestConfig <- - genTestConfig - setupK - (epochSize, epochSize) - let TestConfig{numCoreNodes, numSlots} = setupTestConfig - - setupHardFork <- frequency [(49, pure True), (1, pure False)] - - -- TODO How reliable is the Byron-based partition duration logic when - -- reused for Shelley? - setupPartition <- genPartition numCoreNodes numSlots setupK - - setupVersion <- - genVersionFiltered - isHardForkNodeToNodeEnabled - (Proxy @ShelleyAllegraBlock) - - pure - TestSetup - { setupD - , setupHardFork - , setupInitialNonce - , setupK - , setupPartition - , setupSlotLength - , setupTestConfig - , setupVersion - } - --- TODO shrink - tests :: TestTree tests = - testGroup "ShelleyAllegra ThreadNet" $ - [ let name = "simple convergence" - in askTestEnv $ adjustTestMode $ testProperty name $ \setup -> - prop_simple_shelleyAllegra_convergence setup + testGroup + "ShelleyAllegra ThreadNet" + [ askTestEnv $ + adjustTestEnv $ + testProperty "simple convergence" prop_simple_shelleyAllegra_convergence ] where - adjustTestMode :: TestTree -> TestEnv -> TestTree - adjustTestMode tree = \case + adjustTestEnv :: TestTree -> TestEnv -> TestTree + adjustTestEnv tree = \case Nightly -> tree _ -> adjustQuickCheckTests (`div` 10) tree -prop_simple_shelleyAllegra_convergence :: TestSetup -> Property +prop_simple_shelleyAllegra_convergence :: TestSetup TPraos ShelleyEra AllegraEra -> Property prop_simple_shelleyAllegra_convergence TestSetup { setupD @@ -245,7 +169,7 @@ prop_simple_shelleyAllegra_convergence , version = setupVersion } - testOutput :: TestOutput ShelleyAllegraBlock + testOutput :: TestOutput (DualBlock TPraos ShelleyEra AllegraEra) testOutput = runTestNetwork setupTestConfig @@ -264,11 +188,15 @@ prop_simple_shelleyAllegra_convergence TriggerHardForkAtVersion $ SL.getVersion majorVersion2 (protocolInfo, blockForging) = protocolInfoShelleyBasedHardFork + protocolInfoTPraosShelleyBased + protocolInfoTPraosShelleyBased protocolParamsShelleyBased + TPraos.tpraosParams + TPraos.tpraosParams (SL.ProtVer majorVersion1 0) (SL.ProtVer majorVersion2 0) ( L.mkTransitionConfig L.NoGenesis $ - L.mkShelleyTransitionConfig genesisShelley + L.mkShelleyTransitionConfig shelleyGenesis ) hardForkTrigger in TestNodeInitialization @@ -306,8 +234,8 @@ prop_simple_shelleyAllegra_convergence maxLovelaceSupply = fromIntegral (length coreNodes) * Shelley.initialLovelacePerCoreNode - genesisShelley :: ShelleyGenesis - genesisShelley = + shelleyGenesis :: ShelleyGenesis + shelleyGenesis = Shelley.mkGenesisConfig (SL.ProtVer majorVersion1 0) setupK @@ -321,7 +249,7 @@ prop_simple_shelleyAllegra_convergence -- the Shelley ledger is designed to use a fixed epoch size, so this test -- does not randomize it epochSize :: EpochSize - epochSize = sgEpochLength genesisShelley + epochSize = sgEpochLength shelleyGenesis firstEraSize :: EraSize firstEraSize = EraSize numFirstEraEpochs @@ -361,7 +289,7 @@ prop_simple_shelleyAllegra_convergence secondEraOverlaySlots numSlots (NumSlots numFirstEraSlots) - (sgProtocolParams genesisShelley ^. SL.ppDG) + (sgProtocolParams shelleyGenesis ^. SL.ppDG) epochSize numFirstEraSlots :: Word64 From 7fad20f789efd6f6fd3bc45810d17d81255546cf Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Tue, 30 Sep 2025 17:56:22 +0200 Subject: [PATCH 2/4] ThreadNet: move the validateGenesis` helper function --- .../shelley/Ouroboros/Consensus/Shelley/Node.hs | 1 + .../Ouroboros/Consensus/Shelley/Node/Common.hs | 15 +++++++++++++++ .../Ouroboros/Consensus/Shelley/Node/TPraos.hs | 15 +-------------- 3 files changed, 17 insertions(+), 14 deletions(-) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs index ac9256e7cc..b7f88cc219 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs @@ -43,6 +43,7 @@ import Ouroboros.Consensus.Protocol.TPraos import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Inspect () import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion () +import Ouroboros.Consensus.Shelley.Node.Common (validateGenesis) import Ouroboros.Consensus.Shelley.Node.DiffusionPipelining () import Ouroboros.Consensus.Shelley.Node.Serialisation () import Ouroboros.Consensus.Shelley.Node.TPraos diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs index 0627992c1a..79d7ff54fb 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -17,13 +18,16 @@ module Ouroboros.Consensus.Shelley.Node.Common , ShelleyEraWithCrypto , ShelleyLeaderCredentials (..) , shelleyBlockIssuerVKey + , validateGenesis ) where import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.Keys as SL import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Ledger.Slot +import Data.Bifunctor (first) import Data.Text (Text) +import qualified Data.Text as Text import Ouroboros.Consensus.Block ( CannotForge , ForgeStateInfo @@ -134,3 +138,14 @@ data ProtocolParamsShelleyBased c = ProtocolParamsShelleyBased -- mutually incompatible. , shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials c] } + +-- | Check the validity of the genesis config. To be used in conjunction with +-- 'assertWithMsg'. +validateGenesis :: SL.ShelleyGenesis -> Either String () +validateGenesis = first errsToString . SL.validateGenesis + where + errsToString :: [SL.ValidationErr] -> String + errsToString errs = + Text.unpack $ + Text.unlines + ("Invalid genesis config:" : map SL.describeValidationErr errs) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs index a4889b98b5..89609b4755 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs @@ -27,7 +27,6 @@ module Ouroboros.Consensus.Shelley.Node.TPraos , protocolInfoTPraosShelleyBased , shelleyBlockForging , shelleySharedBlockForging - , validateGenesis ) where import Cardano.Crypto.Hash (Hash) @@ -44,9 +43,7 @@ import Cardano.Slotting.EpochInfo import Cardano.Slotting.Time (mkSlotLength) import Control.Monad.Except (Except) import qualified Control.Tracer as Tracer -import Data.Bifunctor (first) import qualified Data.Text as T -import qualified Data.Text as Text import Lens.Micro ((^.)) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config @@ -72,6 +69,7 @@ import Ouroboros.Consensus.Shelley.Node.Common , ShelleyEraWithCrypto , ShelleyLeaderCredentials (..) , shelleyBlockIssuerVKey + , validateGenesis ) import Ouroboros.Consensus.Shelley.Node.Serialisation () import Ouroboros.Consensus.Shelley.Protocol.TPraos () @@ -154,17 +152,6 @@ shelleySharedBlockForging hotKey slotToPeriod credentials = ProtocolInfo -------------------------------------------------------------------------------} --- | Check the validity of the genesis config. To be used in conjunction with --- 'assertWithMsg'. -validateGenesis :: SL.ShelleyGenesis -> Either String () -validateGenesis = first errsToString . SL.validateGenesis - where - errsToString :: [SL.ValidationErr] -> String - errsToString errs = - Text.unpack $ - Text.unlines - ("Invalid genesis config:" : map SL.describeValidationErr errs) - protocolInfoShelley :: forall m c. ( IOLike m From 2c2f487b582f7a4ad7b43e737a7bdf689259d06a Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Thu, 2 Oct 2025 09:20:26 +0200 Subject: [PATCH 3/4] ThreadNet: refactor critical transaction constructors - make the transactions' intent more clear by only including the relevant payloads - add comments --- .../Test/ThreadNet/Infra/Shelley.hs | 278 +++++++++--------- .../Test/ThreadNet/AllegraMary.hs | 6 +- .../cardano-test/Test/ThreadNet/MaryAlonzo.hs | 6 +- .../Test/ThreadNet/ShelleyAllegra.hs | 6 +- .../shelley-test/Test/ThreadNet/Shelley.hs | 13 +- 5 files changed, 150 insertions(+), 159 deletions(-) diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs index db30a8e3e1..f92be57cf0 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs @@ -28,9 +28,10 @@ module Test.ThreadNet.Infra.Shelley , mkKeyHashVrf , mkKeyPair , mkLeaderCredentials - , mkMASetDecentralizationParamTxs , mkProtocolShelley - , mkSetDecentralizationParamTxs + , mkSetDecentralizationParamTx + , mkUpdateProtVerTxShelley + , mkUpdateProtVerTxAllegra , mkVerKey , networkId , tpraosSlotLength @@ -60,9 +61,7 @@ import Cardano.Crypto.VRF import qualified Cardano.Ledger.Allegra.Scripts as SL import Cardano.Ledger.BaseTypes (boundRational, unNonZero) import Cardano.Ledger.Hashes - ( EraIndependentTxBody - , HashAnnotated (..) - , SafeHash + ( HashAnnotated (..) , hashAnnotated ) import qualified Cardano.Ledger.Keys as LK @@ -81,7 +80,6 @@ import qualified Cardano.Protocol.TPraos.OCert as SL import Control.Monad.Except (throwError) import qualified Control.Tracer as Tracer import qualified Data.ByteString as BS -import Data.Coerce (coerce) import Data.ListMap (ListMap (ListMap)) import qualified Data.ListMap as ListMap import Data.Map.Strict (Map) @@ -128,7 +126,7 @@ import qualified Test.Cardano.Ledger.Core.KeyPair as TL ) import qualified Test.Cardano.Ledger.Shelley.Generator.Core as Gen import Test.Cardano.Ledger.Shelley.Utils (unsafeBoundRational) -import Test.QuickCheck +import Test.QuickCheck hiding (Result (..)) import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.Time (dawnOfTime) @@ -484,75 +482,54 @@ mkProtocolShelley genesis initialNonce protVer coreNode = Necessary transactions for updating the 'DecentralizationParam' -------------------------------------------------------------------------------} -incrementMinorProtVer :: SL.ProtVer -> SL.ProtVer -incrementMinorProtVer (SL.ProtVer major minor) = SL.ProtVer major (succ minor) - -mkSetDecentralizationParamTxs :: - forall c. - ShelleyBasedEra ShelleyEra => - [CoreNode c] -> +-- | A Shelley transaction to update the protocol version. +-- +-- See 'mkUpdateProtVerTxAllegra' for later eras. +mkUpdateProtVerTxShelley :: + forall proto. + [CoreNode (ProtoCrypto proto)] -> + -- | The proposed protocol version + ProtVer -> + -- | The TTL + SlotNo -> + GenTx (ShelleyBlock proto ShelleyEra) +mkUpdateProtVerTxShelley coreNodes pVer ttl = + let txBody = + mkUpdateProtVerShelleyEraTxBody @proto @ShelleyEra coreNodes pVer + & (SL.ttlTxBodyL .~ ttl) + in mkShelleyTx $ + SL.mkBasicTx txBody + & (SL.witsTxL .~ witnesses @proto coreNodes txBody) + +-- | A Shelley transaction to update the protocol version +-- and the decentralisation parameter. +-- +-- It is very similar to 'mkUpdateProtVerTxShelley', but additionally +-- includes the decentralisation parameter update. +mkSetDecentralizationParamTx :: + forall proto. + [CoreNode (ProtoCrypto proto)] -> -- | The proposed protocol version ProtVer -> -- | The TTL SlotNo -> -- | The new value DecentralizationParam -> - [GenTx (ShelleyBlock (TPraos c) ShelleyEra)] -mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = - (: []) $ - mkShelleyTx $ - SL.mkBasicTx body & SL.witsTxL .~ witnesses + GenTx (ShelleyBlock proto ShelleyEra) +mkSetDecentralizationParamTx coreNodes pVer ttl dNew = + let txBody = + mkUpdateProtVerShelleyEraTxBody @proto @ShelleyEra coreNodes pVer + & (SL.ttlTxBodyL .~ ttl) + & (SL.updateTxBodyL .~ SL.SJust update) + in mkShelleyTx $ + SL.mkBasicTx txBody + & (SL.witsTxL .~ witnesses @proto coreNodes txBody) where -- The funds touched by this transaction assume it's the first transaction -- executed. scheduledEpoch :: EpochNo scheduledEpoch = EpochNo 0 - witnesses :: SL.TxWits ShelleyEra - witnesses = SL.mkBasicTxWits & SL.addrTxWitsL .~ signatures - - -- Every node signs the transaction body, since it includes a " vote " from - -- every node. - signatures :: Set (SL.WitVKey 'SL.Witness) - signatures = - TL.mkWitnessesVKey - (hashAnnotated body) - [ TL.KeyPair (SL.VKey vk) sk - | cn <- coreNodes - , let sk = cnDelegateKey cn - , let vk = deriveVerKeyDSIGN sk - ] - - -- Nothing but the parameter update and the obligatory touching of an - -- input. - body :: SL.TxBody ShelleyEra - body = - SL.mkBasicTxBody - & SL.inputsTxBodyL .~ Set.singleton (fst touchCoins) - & SL.outputsTxBodyL .~ Seq.singleton (snd touchCoins) - & SL.ttlTxBodyL .~ ttl - & SL.updateTxBodyL .~ SL.SJust update - - -- Every Shelley transaction requires one input. - -- - -- We use the input of the first node, but we just put it all right back. - -- - -- ASSUMPTION: This transaction runs in the first slot. - touchCoins :: (SL.TxIn, SL.TxOut ShelleyEra) - touchCoins = case coreNodes of - [] -> error "no nodes!" - cn : _ -> - ( SL.initialFundsPseudoTxIn addr - , SL.ShelleyTxOut addr coin - ) - where - addr = - SL.Addr - networkId - (mkCredential (cnDelegateKey cn)) - (SL.StakeRefBase (mkCredential (cnStakingKey cn))) - coin = SL.Coin $ fromIntegral initialLovelacePerCoreNode - -- One replicant of the parameter update per each node. update :: SL.Update ShelleyEra update = @@ -566,102 +543,77 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = boundRational $ decentralizationParamToRational dNew ) - & SL.ppuProtocolVersionL .~ SL.SJust pVer ) | cn <- coreNodes ] -{------------------------------------------------------------------------------- - Auxiliary --------------------------------------------------------------------------------} - -initialLovelacePerCoreNode :: Word64 -initialLovelacePerCoreNode = 1000000 - -mkCredential :: SignKeyDSIGN LK.DSIGN -> SL.Credential r -mkCredential = SL.KeyHashObj . mkKeyHash - -mkKeyHash :: SignKeyDSIGN LK.DSIGN -> SL.KeyHash r -mkKeyHash = SL.hashKey . mkVerKey - -mkVerKey :: SignKeyDSIGN LK.DSIGN -> SL.VKey r -mkVerKey = SL.VKey . deriveVerKeyDSIGN - -mkKeyPair :: SignKeyDSIGN LK.DSIGN -> TL.KeyPair r -mkKeyPair sk = TL.KeyPair{vKey = mkVerKey sk, sKey = sk} - -mkKeyHashVrf :: forall c r. Crypto c => SignKeyVRF (VRF c) -> LK.VRFVerKeyHash (r :: LK.KeyRoleVRF) -mkKeyHashVrf = hashVerKeyVRF @c . deriveVerKeyVRF - -networkId :: SL.Network -networkId = SL.Testnet - -{------------------------------------------------------------------------------- - Temporary Workaround --------------------------------------------------------------------------------} - --- | TODO This is a copy-paste-edit of 'mkSetDecentralizationParamTxs' +-- | An Allegra transaction to update the protocol version. -- --- Our current plan is to replace all of this infrastructure with the ThreadNet --- rewrite; so we're minimizing the work and maintenance here for now. -mkMASetDecentralizationParamTxs :: +-- This transaction is also valid for Mary, Alonzo and Babbage. +-- See 'mkUpdateProtVerTxConway' for later eras. +mkUpdateProtVerTxAllegra :: forall proto era. ( ShelleyBasedEra era - , SL.AllegraEraTxBody era , SL.ShelleyEraTxBody era - , SL.AtMostEra "Alonzo" era + , SL.AllegraEraTxBody era ) => [CoreNode (ProtoCrypto proto)] -> -- | The proposed protocol version ProtVer -> -- | The TTL SlotNo -> - -- | The new value - DecentralizationParam -> - [GenTx (ShelleyBlock proto era)] -mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = - (: []) $ - mkShelleyTx $ - SL.mkBasicTx body & SL.witsTxL .~ witnesses + GenTx (ShelleyBlock proto era) +mkUpdateProtVerTxAllegra coreNodes pVer ttl = + let txBody = + mkUpdateProtVerShelleyEraTxBody @proto @era coreNodes pVer + & (SL.vldtTxBodyL .~ vldt) + vldt = + SL.ValidityInterval + { invalidBefore = SL.SNothing + , invalidHereafter = SL.SJust ttl + } + in mkShelleyTx $ + SL.mkBasicTx txBody + & (SL.witsTxL .~ witnesses @proto coreNodes txBody) + +-- | A transaction body template for ThreadNet tests with the following features: +-- - minimal era constraints +-- - contains a protocol parameter update signed by all core nodes +-- +-- The functions constructing the transations using this body will +-- need to create the witnesses using the core node's signatures, +-- see 'witnesses'. +-- +-- This transaction uses the Shelley era governance to update the protocol version. +-- Note that this transaction is not valid (and wouldn't even type check) in Conway. +mkUpdateProtVerShelleyEraTxBody :: + forall proto era. + ( ShelleyBasedEra era + , SL.ShelleyEraTxBody era + ) => + [CoreNode (ProtoCrypto proto)] -> + -- | The proposed protocol version + ProtVer -> + SL.TxBody era +mkUpdateProtVerShelleyEraTxBody coreNodes pVer = + body where -- The funds touched by this transaction assume it's the first transaction -- executed. scheduledEpoch :: EpochNo scheduledEpoch = EpochNo 0 - witnesses :: SL.TxWits era - witnesses = SL.mkBasicTxWits & SL.addrTxWitsL .~ signatures - - -- Every node signs the transaction body, since it includes a " vote " from - -- every node. - signatures :: Set (SL.WitVKey 'SL.Witness) - signatures = - TL.mkWitnessesVKey - (eraIndTxBodyHash' body) - [ TL.KeyPair (SL.VKey vk) sk - | cn <- coreNodes - , let sk = cnDelegateKey cn - , let vk = deriveVerKeyDSIGN sk - ] - -- Nothing but the parameter update and the obligatory touching of an -- input. body :: SL.TxBody era body = SL.mkBasicTxBody - & SL.inputsTxBodyL .~ inputs - & SL.outputsTxBodyL .~ outputs - & SL.vldtTxBodyL .~ vldt - & SL.updateTxBodyL .~ update' + & (SL.inputsTxBodyL .~ inputs) + & (SL.outputsTxBodyL .~ outputs) + & (SL.updateTxBodyL .~ SL.SJust update) where inputs = Set.singleton (fst touchCoins) outputs = Seq.singleton (snd touchCoins) - vldt = - SL.ValidityInterval - { invalidBefore = SL.SNothing - , invalidHereafter = SL.SJust ttl - } - update' = SL.SJust update -- Every Shelley transaction requires one input. -- @@ -683,7 +635,7 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = (SL.StakeRefBase (mkCredential (cnStakingKey cn))) coin = SL.inject $ SL.Coin $ fromIntegral initialLovelacePerCoreNode - -- One replicant of the parameter update per each node. + -- One replicant of the protocol version update per each node. update :: SL.Update era update = flip SL.Update scheduledEpoch $ @@ -691,19 +643,55 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = Map.fromList $ [ ( SL.hashKey $ SL.VKey $ deriveVerKeyDSIGN $ cnGenesisKey cn , SL.emptyPParamsUpdate - & SL.ppuDL - .~ ( maybeToStrictMaybe $ - boundRational $ - decentralizationParamToRational dNew - ) - & SL.ppuProtocolVersionL .~ SL.SJust pVer + & (SL.ppuProtocolVersionL .~ SL.SJust pVer) ) | cn <- coreNodes ] -eraIndTxBodyHash' :: - HashAnnotated body EraIndependentTxBody => - body -> - SafeHash - EraIndependentTxBody -eraIndTxBodyHash' = coerce . hashAnnotated +{------------------------------------------------------------------------------- + Auxiliary +-------------------------------------------------------------------------------} + +initialLovelacePerCoreNode :: Word64 +initialLovelacePerCoreNode = 1000000 + +mkCredential :: SignKeyDSIGN LK.DSIGN -> SL.Credential r +mkCredential = SL.KeyHashObj . mkKeyHash + +mkKeyHash :: SignKeyDSIGN LK.DSIGN -> SL.KeyHash r +mkKeyHash = SL.hashKey . mkVerKey + +mkVerKey :: SignKeyDSIGN LK.DSIGN -> SL.VKey r +mkVerKey = SL.VKey . deriveVerKeyDSIGN + +mkKeyPair :: SignKeyDSIGN LK.DSIGN -> TL.KeyPair r +mkKeyPair sk = TL.KeyPair{vKey = mkVerKey sk, sKey = sk} + +mkKeyHashVrf :: forall c r. Crypto c => SignKeyVRF (VRF c) -> LK.VRFVerKeyHash (r :: LK.KeyRoleVRF) +mkKeyHashVrf = hashVerKeyVRF @c . deriveVerKeyVRF + +networkId :: SL.Network +networkId = SL.Testnet + +incrementMinorProtVer :: SL.ProtVer -> SL.ProtVer +incrementMinorProtVer (SL.ProtVer major minor) = SL.ProtVer major (succ minor) + +-- | Create a witness for a transaction body. +-- +-- Every node signs the transaction body, since it includes a " vote " from +-- every node. +witnesses :: + forall proto era. + ShelleyBasedEra era => + [CoreNode (ProtoCrypto proto)] -> SL.TxBody era -> SL.TxWits era +witnesses coreNodes body = SL.mkBasicTxWits & SL.addrTxWitsL .~ signatures + where + signatures :: Set (SL.WitVKey 'SL.Witness) + signatures = + TL.mkWitnessesVKey + (hashAnnotated body) + [ TL.KeyPair (SL.VKey vk) sk + | cn <- coreNodes + , let sk = cnDelegateKey cn + , let vk = deriveVerKeyDSIGN sk + ] diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs index de5b292d2d..e6df815688 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs @@ -196,12 +196,12 @@ prop_simple_allegraMary_convergence if not setupHardFork then [] else - fmap GenTxShelley1 $ - Shelley.mkMASetDecentralizationParamTxs + -- a single transation to update the protocol version + fmap GenTxShelley1 . (: []) $ + Shelley.mkUpdateProtVerTxAllegra coreNodes (SL.ProtVer majorVersion2 0) (SlotNo $ unNumSlots numSlots) -- never expire - setupD -- unchanged , tniProtocolInfo = protocolInfo , tniBlockForging = blockForging nullTracer } diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs index 912e1d2fbc..c8324f7156 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs @@ -203,12 +203,12 @@ prop_simple_allegraAlonzo_convergence if not setupHardFork then [] else - fmap GenTxShelley1 $ - Shelley.mkMASetDecentralizationParamTxs + -- a single transation to update the protocol version + fmap GenTxShelley1 . (: []) $ + Shelley.mkUpdateProtVerTxAllegra coreNodes (SL.ProtVer majorVersion2 0) (SlotNo $ unNumSlots numSlots) -- never expire - setupD -- unchanged , tniProtocolInfo = protocolInfo , tniBlockForging = blockForging nullTracer } diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs index aa2f668f45..8e0178efd3 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs @@ -204,12 +204,12 @@ prop_simple_shelleyAllegra_convergence if not setupHardFork then [] else - fmap GenTxShelley1 $ - Shelley.mkSetDecentralizationParamTxs + -- a single transation to update the protocol version + fmap GenTxShelley1 . (: []) $ + Shelley.mkUpdateProtVerTxShelley coreNodes (SL.ProtVer majorVersion2 0) (SlotNo $ unNumSlots numSlots) -- never expire - setupD -- unchanged , tniProtocolInfo = protocolInfo , tniBlockForging = blockForging nullTracer } diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs index a795b26671..88075ac9cd 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs @@ -292,11 +292,14 @@ prop_simple_real_tpraos_convergence if not includingDUpdateTx then [] else - mkSetDecentralizationParamTxs - coreNodes - nextProtVer - sentinel -- Does not expire during test - setupD2 + -- a single transation to update the protocol version + -- and set the decentralisation parameter + (: []) $ + mkSetDecentralizationParamTx + coreNodes + nextProtVer + sentinel -- Does not expire during test + setupD2 , tniBlockForging = blockForging nullTracer } , mkRekeyM = Nothing From 77b1e22898d56ad92fe958ab132dedc6b9561f80 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Tue, 14 Oct 2025 12:52:48 +0200 Subject: [PATCH 4/4] ThreadNet: add high-level doc under "References" --- .../contents/references/threadnet_tests.md | 59 +++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 docs/website/contents/references/threadnet_tests.md diff --git a/docs/website/contents/references/threadnet_tests.md b/docs/website/contents/references/threadnet_tests.md new file mode 100644 index 0000000000..5b8baaf984 --- /dev/null +++ b/docs/website/contents/references/threadnet_tests.md @@ -0,0 +1,59 @@ +# ThreadNet tests + +The ThreadNet tests spin up a network of nodes, but they are all within a single process --- a network of threads. + +The purpose of the ThreadNet tests is to run a simple testnet within a Haskell process, and leverage the QuickCheck infrastructure to vary the parameters of the testnet. The following basic ideas apply: +- all the nodes are honest --- can a few honest nodes build a chain together? +- The test have an ability to partition the network, in order to check that the node can recover from the network partition. The test only supports an "easy" case of partition, half-in-half. +- The leader schedule is not prescribed, but rather evolved naturally as it would in the real system. + +## Enumeration and description of the ThreadNet tests + +### Shelley era crossing tests + +These exercise an era transitions between two consecutive Cardano eras. + +We currently the following Shelley-based era crossing tests: + +- [Test.ThreadNet.ShelleyAllegra](./../../../../ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs) +- [Test.ThreadNet.AllegraMary](./../../../../ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs) +- [Test.ThreadNet.MaryAlonzo](./../../../../ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs) + +The test scenario is roughly as follows: + +- generate credentials of several core nodes. +- Craft a protocol version update transaction that is signed by all core nodes. The meaning of the transaction is "every node proposes to increment the protocol version". +- Spin up a network of core nodes. +- Repeatedly submit the update transaction to the mempool of every core node, so that it end ups in the first minted block. +- Wait for several slots +- Stop the nodes, examine their final chains, and make sure the hard fork has happened. + +### Shelley test that updates the decentralisation parameter + +- [Test.ThreadNet.Shelley](./../../../../ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs) + +This test has a structure similar to the Shelley era crossing tests, but actually does not cross between eras, but rather updates the decentralisation parameter. + +### Test that crosses from Byron to Shelley, the "Cardano" test + +- [Test.ThreadNet.Cardano](./../../../../ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs) + +The `Test.ThreadNet.Cardano` module contains the test that crosses from Byron to Shelley. Notably, it uses the Cardano block type, rather than the more specialised two-era `ShelleyBasedHardForkBlock`. Otherwise the flow of the test is very similar to the Shelley-based era crossing tests described above. + +### Byron tests + +There are two more ThreadNet tests that test the Byron-era consensus code: + +- the [Test.ThreadNet.Byron](./../../../../ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs) tests an ability of the nodes to build a chain using the old BFT protocol and also a bunch of Byron-specific chain properties related to epoch boundary blocks (EBBs). +- The [Test.ThreadNet.DualByron](./../../../../ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/DualByron.hs) test runs the Byron ledger and the Byron specification in lockstep, verifying that they agree at every point. + +These are very old tests that are mostly irrelevant today. + +### Mock block tests + +There are four ThreadNet tests that use a mock block, rather than a real Shelley block: + +- [Test.ThreadNet.BFT](./../../../../ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs) --- tests convergence of the Byron-era BFT consensus. +- [Test.ThreadNet.PBFT](./../../../../ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/PBFT.hs) --- tests convergence of the Shelley-era Permissive BFT (PBFT) consensus. +- [Test.ThreadNet.Praos](./../../../../ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/Praos.hs) --- tests convergence of Praos. +- [Test.ThreadNet.LeaderSchedule](./../../../../ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/LeaderSchedule.hs) --- looks very similar to the Praos test, but I don't know what exactly it tests.