Skip to content

Commit

Permalink
Merge pull request #5830 from IntersectMBO/ci/debug-drep-activity
Browse files Browse the repository at this point in the history
Address issues with flakiness of DRep Activity test
  • Loading branch information
palas authored May 13, 2024
2 parents e918562 + 88c6839 commit 6c866f0
Show file tree
Hide file tree
Showing 3 changed files with 131 additions and 100 deletions.
36 changes: 35 additions & 1 deletion cardano-testnet/src/Testnet/EpochStateProcessing.hs
Original file line number Diff line number Diff line change
@@ -1,14 +1,16 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Testnet.EpochStateProcessing
( maybeExtractGovernanceActionIndex
, findCondition
, watchEpochStateView
) where

import Cardano.Api
import Cardano.Api.Ledger (GovActionId (..))
import Cardano.Api.Ledger (EpochInterval (..), GovActionId (..))
import qualified Cardano.Api.Ledger as L

import qualified Cardano.Ledger.Conway.Governance as L
Expand All @@ -23,7 +25,11 @@ import Data.Word (Word32)
import GHC.Stack
import Lens.Micro ((^.))

import Testnet.Components.Query (EpochStateView, getEpochState)

import Hedgehog
import Hedgehog.Extras (MonadAssertion)
import qualified Hedgehog.Extras as H

findCondition
:: HasCallStack
Expand Down Expand Up @@ -72,3 +78,31 @@ maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState) =
| ti1 == L.extractHash ti2 = Just gai
compareWithTxId _ x _ _ = x

-- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch is reached.
-- Wait for at most @maxWait@ epochs.
-- The function will return the result of the guard function if it is met, otherwise it will return @Nothing@.
watchEpochStateView
:: forall m a. (HasCallStack, MonadIO m, MonadTest m, MonadAssertion m)
=> EpochStateView -- ^ The info to access the epoch state
-> (AnyNewEpochState -> m (Maybe a)) -- ^ The guard function (@Just@ if the condition is met, @Nothing@ otherwise)
-> EpochInterval -- ^ The maximum number of epochs to wait
-> m (Maybe a)
watchEpochStateView epochStateView f (EpochInterval maxWait) = withFrozenCallStack $ do
AnyNewEpochState _ newEpochState <- getEpochState epochStateView
let EpochNo currentEpoch = L.nesEL newEpochState
go (EpochNo $ currentEpoch + fromIntegral maxWait)
where
go :: EpochNo -> m (Maybe a)
go (EpochNo timeout) = do
epochState@(AnyNewEpochState _ newEpochState') <- getEpochState epochStateView
let EpochNo currentEpoch = L.nesEL newEpochState'
condition <- f epochState
case condition of
Just result -> pure (Just result)
Nothing -> do
if currentEpoch > timeout
then pure Nothing
else do
H.threadDelay 100_000
go (EpochNo timeout)

Original file line number Diff line number Diff line change
Expand Up @@ -11,19 +11,18 @@ module Cardano.Testnet.Test.Gov.DRepActivity

import Cardano.Api as Api
import Cardano.Api.Error (displayError)
import Cardano.Api.Ledger (EpochInterval (EpochInterval), drepExpiry)
import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval), drepExpiry)

import Cardano.Ledger.Conway.Core (curPParamsGovStateL)
import Cardano.Ledger.Conway.PParams (ppDRepActivityL)
import Cardano.Ledger.Shelley.API (NewEpochState (..))
import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEpochStateL)
import Cardano.Testnet

import Prelude

import Control.Monad
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Trans.State.Strict (StateT)
import Data.Data (Typeable)
import qualified Data.Map as Map
import Data.String
import qualified Data.Text as Text
Expand All @@ -38,14 +37,17 @@ import Testnet.Components.DRep (createVotingTxBody, delegateToDRep, ge
import Testnet.Components.Query (EpochStateView, checkDRepState,
findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView,
getMinDRepDeposit)
import Testnet.Components.TestWatchdog
import Testnet.Defaults
import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_)
import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair)
import Testnet.EpochStateProcessing (watchEpochStateView)
import qualified Testnet.Process.Cli as P
import qualified Testnet.Process.Run as H
import qualified Testnet.Property.Util as H
import Testnet.Types
import Testnet.Types (KeyPair (..), PaymentKeyInfo (..), PoolNode (..), SomeKeyPair (..),
TestnetRuntime (TestnetRuntime, configurationFile, poolNodes, testnetMagic, wallets),
nodeSocketPath)

import Hedgehog
import Hedgehog (MonadTest, Property, annotateShow)
import qualified Hedgehog.Extras as H

-- | Execute me with:
Expand All @@ -64,7 +66,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
era = toCardanoEra sbe
cEra = AnyCardanoEra era
fastTestnetOptions = cardanoDefaultTestnetOptions
{ cardanoEpochLength = 100
{ cardanoEpochLength = 200
, cardanoNodeEra = cEra
, cardanoNumDReps = 1
}
Expand Down Expand Up @@ -92,10 +94,16 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
gov <- H.createDirectoryIfMissing $ work </> "governance"

-- This proposal should pass
let minEpochsToWaitIfChanging = 0 -- The change already provides a min bound
minEpochsToWaitIfNotChanging = 3 -- We cannot wait for change since there is no change (we wait a bit)
maxEpochsToWaitAfterProposal = 10 -- If it takes more than 10 epochs we give up in any case
firstTargetDRepActivity = 3
let minEpochsToWaitIfChanging = EpochInterval 0 -- We don't need a min wait since we are changing
-- the parameter, to a new value, if the parameter
-- becomes the new value we will know the proposal
-- passed.
minEpochsToWaitIfNotChanging = EpochInterval 2 -- We are not making a change to a parameter
-- so we are testing the absence of a change and
-- that means we have to wait some time to
-- make sure it doesn't change.
maxEpochsToWaitAfterProposal = EpochInterval 2 -- If it takes more than 2 epochs we give up in any case.
firstTargetDRepActivity = EpochInterval 3
void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov
"firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity
minEpochsToWaitIfChanging (Just firstTargetDRepActivity)
Expand All @@ -118,7 +126,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas

-- This proposal should fail because there is 2 DReps that don't vote (out of 3)
-- and we have the stake distributed evenly
let secondTargetDRepActivity = firstTargetDRepActivity + 1
let secondTargetDRepActivity = EpochInterval (unEpochInterval firstTargetDRepActivity + 1)
void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov
"failingProposal" wallet2 [(1, "yes")] secondTargetDRepActivity
minEpochsToWaitIfNotChanging (Just firstTargetDRepActivity)
Expand All @@ -131,7 +139,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
sequence_
[activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov
("fillerProposalNum" ++ show proposalNum) wallet [(1, "yes")]
(secondTargetDRepActivity + fromIntegral proposalNum)
(EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral proposalNum))
minEpochsToWaitIfNotChanging Nothing
maxEpochsToWaitAfterProposal
| (proposalNum, wallet) <- zip [1..numOfFillerProposals] (cycle [wallet0, wallet1, wallet2])]
Expand All @@ -141,31 +149,38 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas

-- Last proposal (set activity to something else again and it should pass, because of inactivity)
-- Because 2 out of 3 DReps were inactive, prop should pass
let lastTargetDRepActivity = secondTargetDRepActivity + fromIntegral numOfFillerProposals + 1
let lastTargetDRepActivity = EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral numOfFillerProposals + 1)
void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov
"lastProposal" wallet0 [(1, "yes")] lastTargetDRepActivity
minEpochsToWaitIfChanging (Just lastTargetDRepActivity)
maxEpochsToWaitAfterProposal

-- | This function creates a proposal to change the DRep activity interval
-- and issues the specified votes using default DReps. Optionally, it also
-- waits checks the expected effect of the proposal.
activityChangeProposalTest
:: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t)
=> H.ExecConfig
-> EpochStateView
-> NodeConfigFile In
-> SocketPath
-> ConwayEraOnwards ConwayEra
-> FilePath
-> FilePath
-> PaymentKeyInfo
-> t (Int, String)
-> Word32
-> Word64
-> Maybe Word32
-> Word64
-> m (String, Word32)
:: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t, Typeable era)
=> H.ExecConfig -- ^ Specifies the CLI execution configuration.
-> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
-- using the 'getEpochStateView' function.
-> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'.
-> SocketPath -- ^ Path to the cardano-node unix socket file.
-> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era.
-> FilePath -- ^ Base directory path where generated files will be stored.
-> String -- ^ Name for the subfolder that will be created under 'work' folder.
-> PaymentKeyInfo -- ^ Wallet that will pay for the transactions.
-> t (Int, String) -- ^ Votes to be casted for the proposal. Each tuple contains the number
-- of votes of each type and the type of vote (i.e: "yes", "no", "abstain").
-> EpochInterval -- ^ The target DRep activity interval to be set by the proposal.
-> EpochInterval -- ^ The minimum number of epochs to wait before checking the proposal result.
-> Maybe EpochInterval -- ^ The expected DRep activity interval after the proposal is applied,
-- or 'Nothing' if there are no expectations about whether the result of
-- the proposal.
-> EpochInterval -- ^ The maximum number of epochs to wait for the DRep activity interval to
-- become expected value.
-> m (String, Word32) -- ^ The transaction id and the index of the governance action.
activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix
wallet votes change minWait mExpected maxWait = do

wallet votes change minWait mExpected maxWait@(EpochInterval maxWaitNum) = do
let sbe = conwayEraOnwardsToShelleyBasedEra ceo

mPreviousProposalInfo <- getLastPParamUpdateActionId execConfig
Expand All @@ -180,68 +195,50 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat

thisProposal@(governanceActionTxId, governanceActionIndex) <-
makeActivityChangeProposal execConfig epochStateView configurationFile socketPath
ceo baseDir "proposal" mPreviousProposalInfo change wallet (epochBeforeProp + maxWait)
ceo baseDir "proposal" mPreviousProposalInfo change wallet (epochBeforeProp + fromIntegral maxWaitNum)

voteChangeProposal execConfig epochStateView sbe baseDir "vote"
governanceActionTxId governanceActionIndex propVotes wallet

(EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp

waitAndCheck epochAfterProp
void $ waitForEpochs epochStateView minWait
case mExpected of
Nothing -> return ()
Just expected -> H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait

return thisProposal

where
waitAndCheck :: (MonadTest m, MonadIO m)
=> Word64 -> m ()
waitAndCheck epochAfterProp = do
!eProposalResult
<- evalIO . runExceptT $ foldEpochState
configurationFile
socketPath
FullValidation
(EpochNo (epochAfterProp + maxWait))
()
(\epochState _ _ -> filterEpochState (isSuccess epochAfterProp) epochState)
void $ evalEither eProposalResult

filterEpochState :: (EpochNo -> EpochInterval -> Bool) -> AnyNewEpochState -> StateT () IO LedgerStateCondition
filterEpochState f (AnyNewEpochState sbe newEpochState) =
caseShelleyToBabbageOrConwayEraOnwards
(const $ error "activityChangeProposalTest: Only conway era onwards supported")
(const $ do
let pParams = newEpochState ^. nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL
currEpoch = nesEL newEpochState
return (if f currEpoch pParams
then ConditionMet
else ConditionNotMet)
)
sbe

isSuccess :: Word64 -> EpochNo -> EpochInterval -> Bool
isSuccess epochAfterProp (EpochNo epochNo) (EpochInterval epochInterval) =
(epochAfterProp + minWait <= epochNo) &&
(case mExpected of
Nothing -> True
Just expected -> epochInterval == expected) &&
(epochNo <= epochAfterProp + maxWait)


isDRepActivityUpdated :: (HasCallStack, MonadTest m)
=> EpochInterval -> AnyNewEpochState -> m (Maybe ())
isDRepActivityUpdated (EpochInterval expected) (AnyNewEpochState sbe newEpochState) =
caseShelleyToBabbageOrConwayEraOnwards
(const $ error "activityChangeProposalTest: Only conway era onwards supported")
(const $ do
let (EpochInterval epochInterval) = newEpochState ^. nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL
return (if epochInterval == expected then Just () else Nothing)
)
sbe

-- | Create a proposal to change the DRep activity interval.
-- Return the transaction id and the index of the governance action.
makeActivityChangeProposal
:: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
=> H.ExecConfig
-> EpochStateView
-> NodeConfigFile 'In
-> SocketPath
-> ConwayEraOnwards ConwayEra
-> FilePath
-> String
-> Maybe (String, Word32)
-> Word32
-> PaymentKeyInfo
-> Word64
-> m (String, Word32)
:: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, Typeable era)
=> H.ExecConfig -- ^ Specifies the CLI execution configuration.
-> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
-- using the 'getEpochStateView' function.
-> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'.
-> SocketPath -- ^ Path to the cardano-node unix socket file.
-> ConwayEraOnwards era -- ^ The 'ConwayEraOnwards' witness for current era.
-> FilePath -- ^ Base directory path where generated files will be stored.
-> String -- ^ Name for the subfolder that will be created under 'work' folder.
-> Maybe (String, Word32) -- ^ The transaction id and the index of the previosu governance action if any.
-> EpochInterval -- ^ The target DRep activity interval to be set by the proposal.
-> PaymentKeyInfo -- ^ Wallet that will pay for the transaction.
-> Word64 -- ^ The latest epoch until which to wait for the proposal to be registered by the chain.
-> m (String, Word32) -- ^ The transaction id and the index of the governance action.
makeActivityChangeProposal execConfig epochStateView configurationFile socketPath
ceo work prefix prevGovActionInfo drepActivity wallet timeout = do

Expand Down Expand Up @@ -280,7 +277,7 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat
[ "--prev-governance-action-tx-id", prevGovernanceActionTxId
, "--prev-governance-action-index", show prevGovernanceActionIndex
]) prevGovActionInfo ++
[ "--drep-activity", show drepActivity
[ "--drep-activity", show (unEpochInterval drepActivity)
, "--anchor-url", "https://tinyurl.com/3wrwb2as"
, "--anchor-data-hash", proposalAnchorDataHash
, "--out-file", proposalFile
Expand Down Expand Up @@ -319,21 +316,21 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat

return (governanceActionTxId, governanceActionIndex)

-- | Cast votes for a governance action.
voteChangeProposal
:: HasCallStack
=> MonadTest m
=> MonadIO m
=> MonadCatch m
=> H.MonadAssertion m
=> H.ExecConfig
-> EpochStateView
-> ShelleyBasedEra ConwayEra
-> FilePath
-> FilePath
-> String
-> Word32
-> [([Char], Int)]
-> PaymentKeyInfo
:: (HasCallStack, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m, Typeable era)
=> H.ExecConfig -- ^ Specifies the CLI execution configuration.v
-> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
-- using the 'getEpochStateView' function.
-> ShelleyBasedEra era -- ^ The 'ShelleyBasedEra' witness for current era.
-> FilePath -- ^ Base directory path where generated files will be stored.
-> String -- ^ Name for the subfolder that will be created under 'work' folder.
-> String -- ^ The transaction id of the governance action to vote.
-> Word32 -- ^ The index of the governance action to vote.
-> [([Char], Int)] -- ^ Votes to be casted for the proposal. Each tuple contains the index
-- of the default DRep that will make the vote and the type of the vote
-- (i.e: "yes", "no", "abstain").
-> PaymentKeyInfo -- ^ Wallet that will pay for the transaction.
-> m ()
voteChangeProposal execConfig epochStateView sbe work prefix governanceActionTxId governanceActionIndex votes wallet = do
baseDir <- H.createDirectoryIfMissing $ work </> prefix
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ import qualified Cardano.Testnet.Test.Cli.Query
import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
import qualified Cardano.Testnet.Test.FoldEpochState
import qualified Cardano.Testnet.Test.Gov.CommitteeAddNew as Gov
import qualified Cardano.Testnet.Test.Gov.DRepActivity as Gov
import qualified Cardano.Testnet.Test.Gov.DRepDeposit as Gov
import qualified Cardano.Testnet.Test.Gov.DRepRetirement as Gov
import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov
Expand Down Expand Up @@ -49,8 +50,7 @@ tests = do
-- TODO: Replace foldBlocks with checkLedgerStateCondition
, T.testGroup "Governance"
[ H.ignoreOnMacAndWindows "Committee Add New" Gov.hprop_constitutional_committee_add_new
-- TODO: "DRep Activity" is too flaky at the moment. Disabling until we can fix it.
-- , H.ignoreOnWindows "DRep Activity" Cardano.Testnet.Test.LedgerEvents.Gov.DRepActivity.hprop_check_drep_activity
, H.ignoreOnWindows "DRep Activity" Gov.hprop_check_drep_activity
, H.ignoreOnWindows "DRep Deposits" Gov.hprop_ledger_events_drep_deposits
-- FIXME Those tests are flaky
-- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action
Expand Down

0 comments on commit 6c866f0

Please sign in to comment.