Add test for DRep Activity mechanism (#5796)

* Organize voting code in `ProposeNewConstitution` test

* Organize more code in `ProposeNewConstitution` test

* Initial version of DRepActivity test

* Extract function for activity change proposals in `DRepActivity`

* Register DReps after changing activity param

* Add activity so that DReps expire

* Refactor `activityChangeProposalTest` so that expected is optional

* Remove `previousProposalInfo` parameter from `activityChangeProposalTest`

* Fixes required by rebasing

* Refactor `getCurrentEpochNo` so that it doesn't depend on era

* Extract constants as variables for readability

* Use `foldEpochState` to wait for stability

* Fix hardcoded values

* Apply suggested fix for typo in file name

Co-authored-by: Mateusz Galazyn <[email protected]>

* Move parameter explanations to the argument Haddocks

* Move `KeyPair` class to `Testnet.Runtime`

* Apply suggestions from code reviews

Co-authored-by: Clément Hurlin <[email protected]>
Co-authored-by: Mateusz Galazyn <[email protected]>

---------

Co-authored-by: Mateusz Galazyn <[email protected]>
Co-authored-by: Clément Hurlin <[email protected]>

Author: 3 people

cardano-testnet/cardano-testnet.cabal

@@ -193,6 +193,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution
                         Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO
                         Cardano.Testnet.Test.LedgerEvents.Gov.TreasuryWithdrawal
+                        Cardano.Testnet.Test.LedgerEvents.Gov.DRepActivity
                         Cardano.Testnet.Test.LedgerEvents.SanityCheck
                         Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth
 
@@ -218,6 +219,7 @@ test-suite cardano-testnet-test
                       , cardano-testnet
                       , containers
                       , directory
+                      , exceptions
                       , filepath
                       , hedgehog
                       , hedgehog-extras

cardano-testnet/src/Testnet/Components/Configuration.hs

@@ -121,7 +121,9 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) era shell
   let genesisShelleyDirAbs = takeDirectory inputGenesisShelleyFp
   genesisShelleyDir <- H.createDirectoryIfMissing genesisShelleyDirAbs
   let testnetMagic = sgNetworkMagic shelleyGenesis
-      numStakeDelegators = 3 :: Int
+      -- At least there should be a delegator per DRep
+      -- otherwise some won't be representing anybody
+      numStakeDelegators = max 3 numDelReps :: Int
       startTime = sgSystemStart shelleyGenesis
 
  -- TODO: Remove this rewrite.

cardano-testnet/src/Testnet/Components/DReps.hs

@@ -20,6 +20,7 @@ module Testnet.Components.Query
   , findLargestUtxoWithAddress
   , findLargestUtxoForPaymentKey
   , startLedgerNewEpochStateLogging
+  , getCurrentEpochNo
   ) where
 
 import           Cardano.Api as Api
@@ -301,7 +302,12 @@ checkDRepState sbe configurationFile socketPath execConfig f = withFrozenCallSta
                   [ "checkDRepState: foldEpochState returned Nothing: "
                   , "This is probably an error related to foldEpochState." ]
       H.failure
-    Right (_, Just val) ->
+    Right (ConditionNotMet, Just _) -> do
+      H.note_ $ unlines
+                  [ "checkDRepState: foldEpochState returned Just and ConditionNotMet: "
+                  , "This is probably an error related to foldEpochState." ]
+      H.failure
+    Right (ConditionMet, Just val) ->
       return val
 
 -- | Obtain governance state from node (CLI query)
@@ -336,3 +342,10 @@ getMinDRepDeposit execConfig ceo = withFrozenCallStack $ do
                                   . _Integral
   H.evalMaybe mMinDRepDeposit
 
+-- | Obtain current epoch number using 'getEpochState'
+getCurrentEpochNo :: (MonadTest m, MonadAssertion m, MonadIO m)
+  => EpochStateView
+  -> m EpochNo
+getCurrentEpochNo epochStateView = do
+  AnyNewEpochState _ newEpochState <- getEpochState epochStateView
+  return $ newEpochState ^. L.nesELL

cardano-testnet/src/Testnet/Components/Query.hs

@@ -16,12 +16,14 @@ module Testnet.Defaults
   , defaultConwayGenesis
   , defaultDRepVkeyFp
   , defaultDRepSkeyFp
+  , defaultDRepKeyPair
   , defaultShelleyGenesis
   , defaultGenesisFilepath
   , defaultYamlHardforkViaConfig
   , defaultMainnetTopology
   , plutusV3NonSpendingScript
   , plutusV3SpendingScript
+  , defaultDelegatorStakeKeyPair
   ) where
 
 import           Cardano.Api (AnyCardanoEra (..), CardanoEra (..), pshow)
@@ -70,6 +72,7 @@ import           Numeric.Natural
 import           System.FilePath ((</>))
 
 import           Test.Cardano.Ledger.Core.Rational
+import           Testnet.Runtime (PaymentKeyPair (PaymentKeyPair), StakingKeyPair (StakingKeyPair))
 import           Testnet.Start.Types
 
 {- HLINT ignore "Use underscore" -}
@@ -508,6 +511,26 @@ defaultDRepSkeyFp
   -> FilePath
 defaultDRepSkeyFp n = "drep-keys" </> ("drep" <> show n) </> "drep.skey"
 
+-- | The relative path to DRep key pairs in directories created by cardano-testnet
+defaultDRepKeyPair :: Int -> PaymentKeyPair
+defaultDRepKeyPair n = PaymentKeyPair (defaultDRepVkeyFp n) (defaultDRepSkeyFp n)
+
+-- | The relative path to stake delegator stake keys in directories created by cardano-testnet
+defaultDelegatorStakeVkeyFp
+  :: Int -- ^ The Stake delegator index (starts at 1)
+  -> FilePath
+defaultDelegatorStakeVkeyFp n = "stake-delegators" </> ("delegator" <> show n) </> "staking.vkey"
+
+-- | The relative path to stake delegator stake secret keys in directories created by cardano-testnet
+defaultDelegatorStakeSkeyFp
+  :: Int -- ^ The Stake delegator index (starts at 1)
+  -> FilePath
+defaultDelegatorStakeSkeyFp n = "stake-delegators" </> ("delegator" <> show n) </> "staking.skey"
+
+-- | The relative path to stake delegator key pairs in directories created by cardano-testnet
+defaultDelegatorStakeKeyPair :: Int -> StakingKeyPair
+defaultDelegatorStakeKeyPair n = StakingKeyPair (defaultDelegatorStakeVkeyFp n) (defaultDelegatorStakeSkeyFp n)
+
 -- TODO: We should not hardcode a script like this. We need to move
 -- plutus-example from plutus apps to cardano-node-testnet. This will
 -- let us directly compile the plutus validators and avoid bit rotting of

cardano-testnet/src/Testnet/Defaults.hs

@@ -6,6 +6,8 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE InstanceSigs #-}
 
 module Testnet.Runtime
   ( LeadershipSlot(..)
@@ -18,6 +20,8 @@ module Testnet.Runtime
   , PoolNode(..)
   , PoolNodeKeys(..)
   , Delegator(..)
+  , KeyPair(..)
+  , SomeKeyPair(..)
   , allNodes
   , poolSprockets
   , poolNodeStdout
@@ -134,6 +138,22 @@ data LeadershipSlot = LeadershipSlot
   , slotTime    :: Text
   } deriving (Eq, Show, Generic, FromJSON)
 
+class KeyPair a where
+  secretKey :: a -> FilePath
+
+instance KeyPair PaymentKeyPair where
+  secretKey :: PaymentKeyPair -> FilePath
+  secretKey = paymentSKey
+
+instance KeyPair StakingKeyPair where
+  secretKey :: StakingKeyPair -> FilePath
+  secretKey = stakingSKey
+
+data SomeKeyPair = forall a . KeyPair a => SomeKeyPair a
+
+instance KeyPair SomeKeyPair where
+  secretKey :: SomeKeyPair -> FilePath
+  secretKey (SomeKeyPair x) = secretKey x
 
 poolNodeStdout :: PoolNode -> FilePath
 poolNodeStdout = nodeStdout . poolRuntime