Merge remote-tracking branch 'upstream/master'

cardano-testnet/cardano-testnet.cabal

@@ -198,6 +198,8 @@ test-suite cardano-testnet-test
  Cardano.Testnet.Test.Gov.TreasuryGrowth
  Cardano.Testnet.Test.Gov.TreasuryWithdrawal
  Cardano.Testnet.Test.Misc
+ Cardano.Testnet.Test.Gov.DRepActivity
+ Cardano.Testnet.Test.Gov.PredefinedAbstainDRep
  Cardano.Testnet.Test.Node.Shutdown
  Cardano.Testnet.Test.SanityCheck
  Cardano.Testnet.Test.SubmitApi.Babbage.Transaction

cardano-testnet/src/Cardano/Testnet.hs

@@ -27,7 +27,6 @@ module Cardano.Testnet (
 
  -- * EpochState processsing helper functions
  maybeExtractGovernanceActionIndex,
- findCondition,
 
  -- * Processes
  procChairman,

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

@@ -1,7 +1,10 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Testnet.Components.Query
@@ -20,21 +23,24 @@ module Testnet.Components.Query
  , findUtxosWithAddress
  , findLargestUtxoWithAddress
  , findLargestUtxoForPaymentKey
+ , assertNewEpochState
+ , watchEpochStateView
  ) where
 
 import Cardano.Api as Api
-import Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto)
+import Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole),
+ StandardCrypto)
 import Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
 import qualified Cardano.Ledger.Api as L
-import Cardano.Ledger.BaseTypes (EpochInterval, addEpochInterval)
 import qualified Cardano.Ledger.Coin as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UTxO as L
 
 import Control.Exception.Safe (MonadCatch)
+import Control.Monad (void)
 import Control.Monad.Trans.Resource
 import Control.Monad.Trans.State.Strict (put)
 import Data.Bifunctor (bimap)
@@ -50,7 +56,7 @@ import qualified Data.Text as T
 import Data.Type.Equality
 import GHC.Exts (IsList (..))
 import GHC.Stack
-import Lens.Micro (to, (^.))
+import Lens.Micro (Lens', to, (^.))
 
 import Testnet.Property.Assert
 import Testnet.Property.Util (runInBackground)
@@ -94,9 +100,9 @@ waitForEpochs
  => EpochStateView
  -> EpochInterval -- ^ Number of epochs to wait
  -> m EpochNo -- ^ The epoch number reached
-waitForEpochs epochStateView@EpochStateView{nodeConfigPath, socketPath} interval = withFrozenCallStack $ do
- currentEpoch <- getCurrentEpochNo epochStateView
- waitUntilEpoch nodeConfigPath socketPath $ addEpochInterval currentEpoch interval
+waitForEpochs epochStateView interval = withFrozenCallStack $ do
+ void $ watchEpochStateView epochStateView (const $ pure Nothing) interval
+ getCurrentEpochNo epochStateView
 
 -- | A read-only mutable pointer to an epoch state, updated automatically
 data EpochStateView = EpochStateView
@@ -353,3 +359,70 @@ getCurrentEpochNo
 getCurrentEpochNo epochStateView = withFrozenCallStack $ do
  AnyNewEpochState _ newEpochState <- getEpochState epochStateView
  pure $ newEpochState ^. L.nesELL
+
+-- | Assert that the value pointed by the @lens@ in the epoch state is the same as the @expected@ value
+-- or it becomes the same within the @maxWait@ epochs. If the value is not reached within the time frame,
+-- the test fails.
+assertNewEpochState
+ :: forall m era value.
+ (Show value, MonadAssertion m, MonadTest m, MonadIO m, Eq value, HasCallStack)
+ => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function.
+ -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era.
+ -> value -- ^ The expected value to check in the epoch state.
+ -> EpochInterval -- ^ The maximum wait time in epochs.
+ -> Lens' (L.NewEpochState (ShelleyLedgerEra era)) value -- ^ The lens to access the specific value in the epoch state.
+ -> m ()
+assertNewEpochState epochStateView ceo expected maxWait lens = withFrozenCallStack $ do
+ let sbe = conwayEraOnwardsToShelleyBasedEra ceo
+ mStateView <- watchEpochStateView epochStateView (checkEpochState sbe) maxWait
+ case mStateView of
+ Just () -> pure ()
+ Nothing -> do epochState <- getEpochState epochStateView
+ val <- getFromEpochState sbe epochState
+ if val == expected
+ then pure ()
+ else H.failMessage callStack $ unlines
+ [ "assertNewEpochState: expected value not reached within the time frame."
+ , "Expected value: " <> show expected
+ , "Actual value: " <> show val
+ ]
+ where
+ checkEpochState :: HasCallStack
+ => ShelleyBasedEra era -> AnyNewEpochState -> m (Maybe ())
+ checkEpochState sbe newEpochState = do
+ val <- getFromEpochState sbe newEpochState
+ return $ if val == expected then Just () else Nothing
+
+ getFromEpochState :: HasCallStack
+ => ShelleyBasedEra era -> AnyNewEpochState -> m value
+ getFromEpochState sbe (AnyNewEpochState actualEra newEpochState) = do
+ Refl <- either error pure $ assertErasEqual sbe actualEra
+ return $ newEpochState ^. lens
+
+-- | 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 10_000
+ go (EpochNo timeout)

cardano-testnet/src/Testnet/EpochStateProcessing.hs

@@ -1,65 +1,40 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Testnet.EpochStateProcessing
  ( maybeExtractGovernanceActionIndex
- , findCondition
- , watchEpochStateView
+ , waitForGovActionVotes
  ) where
 
 import Cardano.Api
-import Cardano.Api.Ledger (EpochInterval (..), GovActionId (..))
+import Cardano.Api.Ledger (EpochInterval, GovActionId (..))
 import qualified Cardano.Api.Ledger as L
+import Cardano.Api.Shelley (ShelleyLedgerEra)
 
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Shelley.API as L
+import Cardano.Ledger.Shelley.LedgerState (newEpochStateGovStateL)
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 
 import Prelude
 
-import Control.Monad.State.Strict (MonadState (put), StateT)
+import Data.Data ((:~:) (..))
 import qualified Data.Map as Map
 import Data.Word (Word32)
+import GHC.Exts (IsList (toList), toList)
 import GHC.Stack
-import Lens.Micro ((^.))
+import Lens.Micro (to, (^.))
 
-import Testnet.Components.Query (EpochStateView, getEpochState)
+import Testnet.Components.Query (EpochStateView, watchEpochStateView)
+import Testnet.Property.Assert (assertErasEqual)
 
-import Hedgehog
+import Hedgehog (MonadTest)
 import Hedgehog.Extras (MonadAssertion)
 import qualified Hedgehog.Extras as H
 
-findCondition
- :: HasCallStack
- => MonadTest m
- => MonadIO m
- => (AnyNewEpochState -> Maybe a)
- -> NodeConfigFile In
- -> SocketPath
- -> EpochNo -- ^ The termination epoch: the condition must be found *before* this epoch
- -> m (Either FoldBlocksError (Maybe a))
-findCondition epochStateFoldFunc configurationFile socketPath maxEpochNo = withFrozenCallStack $ evalIO . runExceptT $ do
- result <-
- foldEpochState
- configurationFile
- socketPath
- FullValidation
- maxEpochNo
- Nothing
- (\epochState _ _ -> go epochStateFoldFunc epochState)
- pure $ case result of
- (ConditionMet, Just x) -> Just x
- _ -> Nothing
-
- where
- go :: (AnyNewEpochState -> Maybe a) -> AnyNewEpochState -> StateT (Maybe a) IO LedgerStateCondition
- go f epochState = do
- case f epochState of
- Just x -> put (Just x) >> pure ConditionMet
- Nothing -> pure ConditionNotMet
-
 maybeExtractGovernanceActionIndex
  :: HasCallStack
  => TxId -- ^ transaction id searched for
@@ -78,31 +53,33 @@ 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)
-
+-- | Wait for the last gov action proposal in the list to have DRep or SPO votes.
+waitForGovActionVotes
+ :: forall m era.
+ (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack)
+ => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function.
+ -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era.
+ -> EpochInterval -- ^ The maximum wait time in epochs.
+ -> m ()
+waitForGovActionVotes epochStateView ceo maxWait = withFrozenCallStack $ do
+ mResult <- watchEpochStateView epochStateView getFromEpochState maxWait
+ case mResult of
+ Just () -> pure ()
+ Nothing -> H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout."
+ where
+ getFromEpochState :: HasCallStack
+ => AnyNewEpochState -> m (Maybe ())
+ getFromEpochState (AnyNewEpochState actualEra newEpochState) = do
+ let sbe = conwayEraOnwardsToShelleyBasedEra ceo
+ Refl <- H.leftFail $ assertErasEqual sbe actualEra
+ let govState :: L.ConwayGovState (ShelleyLedgerEra era) = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL
+ proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList
+ if null proposals
+ then pure Nothing
+ else do
+ let lastProposal = last proposals
+ gaDRepVotes = lastProposal ^. L.gasDRepVotesL . to toList
+ gaSpoVotes = lastProposal ^. L.gasStakePoolVotesL . to toList
+ if null gaDRepVotes && null gaSpoVotes
+ then pure Nothing
+ else pure $ Just ()

cardano-testnet/src/Testnet/Process/Cli/DRep.hs

@@ -16,6 +16,7 @@ module Testnet.Process.Cli.DRep
  ) where
 
 import Cardano.Api hiding (Certificate, TxBody)
+import Cardano.Api.Ledger (EpochInterval (EpochInterval))
 
 import Prelude
 
@@ -248,16 +249,15 @@ delegateToDRep
  => MonadCatch m
  => H.ExecConfig -- ^ Specifies the CLI execution configuration.
  -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
- -> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'.
- -> SocketPath -- ^ Path to the cardano-node unix socket file.
+ -- using the 'getEpochStateView' function.
  -> ShelleyBasedEra ConwayEra -- ^ The Shelley-based era (e.g., 'ConwayEra') in which the transaction will be constructed.
  -> 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 transaction.
  -> KeyPair StakingKey -- ^ Staking key pair used for delegation.
  -> KeyPair PaymentKey -- ^ Delegate Representative (DRep) key pair ('PaymentKeyPair') to which delegate.
  -> m ()
-delegateToDRep execConfig epochStateView configurationFile' socketPath sbe work prefix
+delegateToDRep execConfig epochStateView sbe work prefix
  payingWallet skeyPair@KeyPair{verificationKey=File vKeyFile}
  KeyPair{verificationKey=File drepVKey} = do
 
@@ -287,9 +287,8 @@ delegateToDRep execConfig epochStateView configurationFile' socketPath sbe work
  -- Submit transaction
  submitTx execConfig cEra repRegSignedRegTx1
 
- -- Wait two epochs
- (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
- void $ waitUntilEpoch configurationFile' socketPath (EpochNo (epochAfterProp + 2))
+ -- Wait one epoch
+ void $ waitForEpochs epochStateView (EpochInterval 1)
 
 -- | This function obtains the identifier for the last enacted parameter update proposal
 -- if any.

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs

@@ -11,7 +11,6 @@ module Cardano.Testnet.Test.Cli.Conway.Plutus
  ) where
 
 import Cardano.Api
-import qualified Cardano.Api.Ledger as L
 
 import Cardano.Testnet
 
@@ -142,11 +141,9 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa
  , "--tx-file", sendAdaToScriptAddressTx
  ]
 
- _ <- waitForEpochs epochStateView (L.EpochInterval 1)
-
  -- 2. Successfully spend conway spending script
  txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
- plutusScriptTxIn <- fmap fst . H.nothingFailM $
+ plutusScriptTxIn <- fmap fst . waitForJustM $
  findLargestUtxoWithAddress epochStateView sbe $ Text.pack plutusSpendingScriptAddr
 
  let spendScriptUTxOTxBody = work </> "spend-script-utxo-tx-body"
@@ -187,4 +184,11 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa
  ]
  H.success
 
+waitForJustM :: (H.MonadTest m, MonadIO m) => m (Maybe a) -> m a
+waitForJustM src = do m <- src
+ case m of
+ Just a -> pure a
+ Nothing -> do H.threadDelay 100_000
+ waitForJustM src
+