Merge pull request #5815 from IntersectMBO/automated-drep-scenario1

Automated drep (Scenario 1)

Author: palas

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
+