diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 5787a62bd5e..8592b540264 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,22 +10,29 @@ module Testnet.Components.Query ( EpochStateView - , checkDRepsNumber - , checkDRepState + , getEpochStateView , getEpochState + , getSlotNumber + , getBlockNumber + , watchEpochStateUpdate + , getMinDRepDeposit , getMinGovActionDeposit , getGovState , getCurrentEpochNo - , waitUntilEpoch + , waitForEpochs - , getEpochStateView + , waitUntilEpoch + , waitForBlocks + , findAllUtxos , findUtxosWithAddress , findLargestUtxoWithAddress , findLargestUtxoForPaymentKey + + , checkDRepsNumber + , checkDRepState , assertNewEpochState - , watchEpochStateView ) where import Cardano.Api as Api @@ -40,7 +48,7 @@ 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 import Control.Monad.Trans.Resource import Control.Monad.Trans.State.Strict (put) import Data.Bifunctor (bimap) @@ -49,11 +57,12 @@ import Data.List (sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map -import Data.Maybe (listToMaybe) +import Data.Maybe import Data.Ord (Down (..)) import Data.Text (Text) import qualified Data.Text as T import Data.Type.Equality +import Data.Word (Word64) import GHC.Exts (IsList (..)) import GHC.Stack import Lens.Micro (Lens', to, (^.)) @@ -101,28 +110,87 @@ waitForEpochs -> EpochInterval -- ^ Number of epochs to wait -> m EpochNo -- ^ The epoch number reached waitForEpochs epochStateView interval = withFrozenCallStack $ do - void $ watchEpochStateView epochStateView (const $ pure Nothing) interval + void $ watchEpochStateUpdate epochStateView interval $ \_ -> pure Nothing getCurrentEpochNo epochStateView + +-- | Wait for the requested number of blocks +waitForBlocks + :: HasCallStack + => MonadIO m + => MonadTest m + => MonadAssertion m + => MonadCatch m + => EpochStateView + -> Word64 -- ^ Number of blocks to wait + -> m BlockNo -- ^ The block number reached +waitForBlocks epochStateView numberOfBlocks = withFrozenCallStack $ do + BlockNo startingBlockNumber <- getBlockNumber epochStateView + H.note_ $ "Current block number: " <> show startingBlockNumber <> ". " + <> "Waiting for " <> show numberOfBlocks <> " blocks" + H.noteShowM . H.nothingFailM . fmap (fmap BlockNo) $ + watchEpochStateUpdate epochStateView (EpochInterval maxBound) $ \(_, _, BlockNo blockNumber) -> + pure $ + if blockNumber >= startingBlockNumber + numberOfBlocks + then Just blockNumber + else Nothing + -- | A read-only mutable pointer to an epoch state, updated automatically data EpochStateView = EpochStateView { nodeConfigPath :: !(NodeConfigFile In) + -- ^ node configuration file path , socketPath :: !SocketPath - , epochStateView :: !(IORef (Maybe AnyNewEpochState)) + -- ^ node socket path, to which foldEpochState is connected to + , epochStateView :: !(IORef (Maybe (AnyNewEpochState, SlotNo, BlockNo))) + -- ^ Automatically updated current NewEpochState. Use 'getEpochState', 'getBlockNumber', 'getSlotNumber' + -- to access the values. } -- | Get epoch state from the view. If the state isn't available, retry waiting up to 15 seconds. Fails when -- the state is not available after 15 seconds. -getEpochState :: MonadTest m - => MonadAssertion m - => MonadIO m - => EpochStateView - -> m AnyNewEpochState -getEpochState EpochStateView{epochStateView} = +getEpochState + :: HasCallStack + => MonadTest m + => MonadAssertion m + => MonadIO m + => EpochStateView + -> m AnyNewEpochState +getEpochState epochStateView = + withFrozenCallStack $ getEpochStateDetails epochStateView $ \(nes, _, _) -> pure nes + +getBlockNumber + :: HasCallStack + => MonadIO m + => MonadTest m + => MonadAssertion m + => EpochStateView + -> m BlockNo -- ^ The number of last produced block +getBlockNumber epochStateView = + withFrozenCallStack $ getEpochStateDetails epochStateView $ \(_, _, blockNumber) -> pure blockNumber + +getSlotNumber + :: HasCallStack + => MonadIO m + => MonadTest m + => MonadAssertion m + => EpochStateView + -> m SlotNo -- ^ The current slot number +getSlotNumber epochStateView = + withFrozenCallStack $ getEpochStateDetails epochStateView $ \(_, slotNumber, _) -> pure slotNumber + +-- | Utility function for accessing epoch state in `IORef` +getEpochStateDetails + :: HasCallStack + => MonadAssertion m + => MonadTest m + => MonadIO m + => EpochStateView + -> ((AnyNewEpochState, SlotNo, BlockNo) -> m a) + -> m a +getEpochStateDetails EpochStateView{epochStateView} f = withFrozenCallStack $ H.byDurationM 0.5 15 "EpochStateView has not been initialized within 15 seconds" $ - H.evalIO (readIORef epochStateView) >>= maybe H.failure pure - + H.evalIO (readIORef epochStateView) >>= maybe H.failure f -- | Create a background thread listening for new epoch states. New epoch states are available to access -- through 'EpochStateView', using query functions. @@ -137,11 +205,38 @@ getEpochStateView getEpochStateView nodeConfigFile socketPath = withFrozenCallStack $ do epochStateView <- H.evalIO $ newIORef Nothing runInBackground . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing - $ \epochState _slotNb _blockNb -> do - liftIO $ writeIORef epochStateView (Just epochState) + $ \epochState slotNumber blockNumber -> do + liftIO . writeIORef epochStateView $ Just (epochState, slotNumber, blockNumber) pure ConditionNotMet pure $ EpochStateView nodeConfigFile socketPath epochStateView +-- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch is reached. +-- Executes the guard function every 100ms. Waits for at most @maxWait@ epochs. +-- The function will return the result of the guard function if it is met within the number of epochs, +-- otherwise it will return @Nothing@. +watchEpochStateUpdate + :: forall m a. (HasCallStack, MonadIO m, MonadTest m, MonadAssertion m) + => EpochStateView -- ^ The info to access the epoch state + -> EpochInterval -- ^ The maximum number of epochs to wait + -> ((AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe a)) -- ^ The guard function (@Just@ if the condition is met, @Nothing@ otherwise) + -> m (Maybe a) +watchEpochStateUpdate epochStateView (EpochInterval maxWait) f = withFrozenCallStack $ do + AnyNewEpochState _ newEpochState <- getEpochState epochStateView + let EpochNo currentEpoch = L.nesEL newEpochState + go $ currentEpoch + fromIntegral maxWait + where + go :: Word64 -> m (Maybe a) + go timeout = do + newEpochStateDetails@(AnyNewEpochState _ newEpochState', _, _) <- getEpochStateDetails epochStateView pure + let EpochNo currentEpoch = L.nesEL newEpochState' + f newEpochStateDetails >>= \case + Just result -> pure (Just result) + Nothing + | currentEpoch > timeout -> pure Nothing + | otherwise -> do + H.threadDelay 100_000 + go timeout + -- | Retrieve all UTxOs map from the epoch state view. findAllUtxos :: forall era m. HasCallStack @@ -210,7 +305,7 @@ findLargestUtxoWithAddress epochStateView sbe address = withFrozenCallStack $ do $ sortOn (\(_, TxOut _ txOutValue _ _) -> Down $ txOutValueToLovelace txOutValue) utxos -- | Retrieve a largest UTxO for a payment key info - a convenience wrapper for --- 'findLargestUtxoForPaymentKey'. +-- 'findLargestUtxoWithAddress'. findLargestUtxoForPaymentKey :: MonadTest m => MonadAssertion m @@ -268,7 +363,7 @@ checkDRepState epochStateView@EpochStateView{nodeConfigPath, socketPath} sbe f = currentEpoch <- getCurrentEpochNo epochStateView let terminationEpoch = succ . succ $ currentEpoch result <- H.evalIO . runExceptT $ foldEpochState nodeConfigPath socketPath QuickValidation terminationEpoch Nothing - $ \(AnyNewEpochState actualEra newEpochState) _slotNb _blockNb -> do + $ \(AnyNewEpochState actualEra newEpochState) _slotNumber _blockNumber -> do Refl <- either error pure $ assertErasEqual sbe actualEra let dreps = shelleyBasedEraConstraints sbe newEpochState ^. L.nesEsL @@ -364,65 +459,43 @@ getCurrentEpochNo epochStateView = withFrozenCallStack $ do -- 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) + :: forall m era value. HasCallStack + => Show value + => Eq value + => MonadAssertion m + => MonadTest m + => MonadIO m => 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. + -> ShelleyBasedEra era -- ^ The ShelleyBasedEra witness for current era. -> EpochInterval -- ^ The maximum wait time in epochs. - -> Lens' (L.NewEpochState (ShelleyLedgerEra era)) value -- ^ The lens to access the specific value in the epoch state. + -> Lens' (L.NewEpochState (ShelleyLedgerEra era)) value + -- ^ The lens to access the specific value in the epoch state. + -> value -- ^ The expected value to check 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 - ] +assertNewEpochState epochStateView sbe maxWait lens expected = withFrozenCallStack $ do + mStateView <- watchEpochStateUpdate epochStateView maxWait (const checkEpochState) + when (isNothing mStateView) $ do + val <- getFromEpochStateForEra + 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 + checkEpochState + :: HasCallStack + => m (Maybe ()) + checkEpochState = withFrozenCallStack $ do + val <- getFromEpochStateForEra + pure $ if val == expected then Just () else Nothing + + getFromEpochStateForEra + :: HasCallStack + => m value + getFromEpochStateForEra = withFrozenCallStack $ getEpochStateDetails epochStateView $ + \(AnyNewEpochState actualEra newEpochState, _, _) -> do + Refl <- H.leftFail $ assertErasEqual sbe actualEra + pure $ 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) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 568c624207e..1fc0613ecc8 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,6 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -10,7 +8,7 @@ module Testnet.EpochStateProcessing ) 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) @@ -21,17 +19,19 @@ import qualified Cardano.Ledger.Shelley.LedgerState as L import Prelude +import Control.Monad import Data.Data ((:~:) (..)) import qualified Data.Map as Map +import Data.Maybe import Data.Word (Word32) import GHC.Exts (IsList (toList), toList) import GHC.Stack import Lens.Micro (to, (^.)) -import Testnet.Components.Query (EpochStateView, watchEpochStateView) +import Testnet.Components.Query (EpochStateView, watchEpochStateUpdate) import Testnet.Property.Assert (assertErasEqual) -import Hedgehog (MonadTest) +import Hedgehog import Hedgehog.Extras (MonadAssertion) import qualified Hedgehog.Extras as H @@ -55,24 +55,28 @@ maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState) = -- | 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) + :: forall m era. HasCallStack + => MonadAssertion m + => MonadTest m + => MonadIO m => 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." + mResult <- watchEpochStateUpdate epochStateView maxWait checkForVotes + when (isNothing mResult) $ + H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout." where - getFromEpochState :: HasCallStack - => AnyNewEpochState -> m (Maybe ()) - getFromEpochState (AnyNewEpochState actualEra newEpochState) = do + checkForVotes + :: HasCallStack + => (AnyNewEpochState, SlotNo, BlockNo) + -> m (Maybe ()) + checkForVotes (AnyNewEpochState actualEra newEpochState, _, _) = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo Refl <- H.leftFail $ assertErasEqual sbe actualEra - let govState :: L.ConwayGovState (ShelleyLedgerEra era) = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL + let govState :: L.ConwayGovState (ShelleyLedgerEra era) + govState = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList if null proposals then pure Nothing @@ -83,3 +87,4 @@ waitForGovActionVotes epochStateView ceo maxWait = withFrozenCallStack $ do if null gaDRepVotes && null gaSpoVotes then pure Nothing else pure $ Just () + diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index f96de449fe3..7f352d94237 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -141,6 +141,8 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa , "--tx-file", sendAdaToScriptAddressTx ] + _ <- waitForBlocks epochStateView 1 + -- 2. Successfully spend conway spending script txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 plutusScriptTxIn <- fmap fst . waitForJustM $ diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 4900e710565..d9e02b55149 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -176,7 +176,9 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co governanceActionTxId <- H.noteM $ retrieveTransactionId execConfig signedProposalTx - governanceActionIx <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (L.EpochInterval 1) + governanceActionIx <- + H.nothingFailM . watchEpochStateUpdate epochStateView (L.EpochInterval 1) $ \(anyNewEpochState, _, _) -> + pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState dRepVoteFiles <- DRep.generateVoteFiles @@ -220,7 +222,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co length (filter ((== L.VoteYes) . snd) gaSpoVotes) === 1 length spoVotes === length gaSpoVotes - H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent) (L.EpochInterval 1) + H.nothingFailM $ watchEpochStateUpdate epochStateView (L.EpochInterval 1) (return . committeeIsPresent) -- show proposed committe meembers H.noteShow_ ccCredentials @@ -250,8 +252,8 @@ getCommitteeMembers epochStateView ceo = withFrozenCallStack $ do govState <- getGovState epochStateView ceo fmap (Map.keys . L.committeeMembers) . H.nothingFail $ strictMaybeToMaybe $ govState ^. L.cgsCommitteeL -committeeIsPresent :: AnyNewEpochState -> Maybe () -committeeIsPresent (AnyNewEpochState sbe newEpochState) = +committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> Maybe () +committeeIsPresent (AnyNewEpochState sbe newEpochState, _, _) = caseShelleyToBabbageOrConwayEraOnwards (const $ error "Constitutional committee does not exist pre-Conway era") (\_ -> do diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index 07c9d552b45..629dfe5a4ec 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -30,9 +30,7 @@ import Data.Word (Word32) import GHC.Stack (HasCallStack, withFrozenCallStack) import System.FilePath (()) -import Testnet.Components.Query (EpochStateView, assertNewEpochState, checkDRepState, - findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, - getMinDRepDeposit, watchEpochStateView) +import Testnet.Components.Query import Testnet.Components.TestWatchdog (kickWatchdog, runWithDefaultWatchdog) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep @@ -203,13 +201,14 @@ activityChangeProposalTest execConfig epochStateView ceo work prefix void $ waitForEpochs epochStateView minWait - case mExpected of - Nothing -> return () - Just expected -> assertNewEpochState epochStateView ceo expected maxWait - (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL) + forM_ mExpected $ + assertNewEpochState epochStateView sbe maxWait + (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL) - return thisProposal + pure thisProposal +-- | 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, Typeable era) => H.ExecConfig -- ^ Specifies the CLI execution configuration. @@ -285,7 +284,9 @@ makeActivityChangeProposal execConfig epochStateView ceo work prefix governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) timeout + governanceActionIndex <- + H.nothingFailM $ watchEpochStateUpdate epochStateView timeout $ \(anyNewEpochState, _, _) -> + return $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState return (governanceActionTxId, governanceActionIndex) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index 4799aef74a9..0fe08b762f0 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -145,7 +145,9 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem , "--tx-file", txbodySignedFp ] - governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString txidString)) (EpochInterval 1) + governanceActionIndex <- + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> + pure $ maybeExtractGovernanceActionIndex (fromString txidString) anyNewEpochState let voteFp :: Int -> FilePath voteFp n = work gov "vote-" <> show n diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 93996d8c082..0fe251dedcd 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -131,8 +131,8 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat epochStateView <- getEpochStateView configurationFile (File socketPath) - H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent True) (EpochInterval 3) - + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 3) $ \(anyNewEpochState, _, _) -> + pure $ committeeIsPresent True anyNewEpochState -- Step 2. Propose motion of no confidence. DRep and SPO voting thresholds must be met. @@ -190,7 +190,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 10) + governanceActionIndex <- + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> + pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState let spoVotes :: [(String, Int)] spoVotes = [("yes", 1), ("yes", 2), ("yes", 3)] @@ -222,7 +224,8 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat -- Step 4. We confirm the no confidence motion has been ratified by checking -- for an empty constitutional committee. - H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent False) (EpochInterval 10) + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> + pure $ committeeIsPresent False anyNewEpochState -- | Checks if the committee is empty or not. committeeIsPresent :: Bool -> AnyNewEpochState -> Maybe () diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 9f65bde583b..8ceeefa211d 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -21,7 +21,7 @@ import Cardano.Testnet import Prelude -import Control.Monad (void) +import Control.Monad import Control.Monad.Catch (MonadCatch) import Data.Data (Typeable) import Data.String (fromString) @@ -32,9 +32,7 @@ import Lens.Micro ((^.)) import System.FilePath (()) import Testnet.Components.Configuration (anyEraToString) -import Testnet.Components.Query (EpochStateView, assertNewEpochState, - findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, getGovState, - getMinDRepDeposit, watchEpochStateView) +import Testnet.Components.Query import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody, @@ -209,12 +207,12 @@ desiredPoolNumberProposalTest execConfig epochStateView ceo work prefix wallet H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp void $ waitForEpochs epochStateView (EpochInterval $ fromIntegral minWait) - - case mExpected of - Nothing -> return () - Just expected -> assertNewEpochState epochStateView ceo (fromIntegral expected) - (EpochInterval $ fromIntegral maxWait) - (nesEpochStateL . epochStateGovStateL . cgsCurPParamsL . ppNOptL) + forM_ mExpected $ + assertNewEpochState epochStateView + sbe + (EpochInterval $ fromIntegral maxWait) + (nesEpochStateL . epochStateGovStateL . cgsCurPParamsL . ppNOptL) + . fromIntegral return thisProposal @@ -292,9 +290,11 @@ makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 1) + governanceActionIndex <- + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> + pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState - return (governanceActionTxId, governanceActionIndex) + pure (governanceActionTxId, governanceActionIndex) -- A pair of a vote string (i.e: "yes", "no", or "abstain") and the number of -- a default DRep (from the ones created by 'cardanoTestnetDefault') diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index bd6bd73624c..9fff1cbedcc 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -167,7 +167,9 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 1) + governanceActionIndex <- + H.nothingFailM . watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> + pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified voteFiles <- generateVoteFiles execConfig work "vote-files" diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index ccf06d80166..84db28d0e8b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -164,8 +164,8 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury txbodyFp <- H.note $ work "tx.body" txbodySignedFp <- H.note $ work "tx.body.signed" - -- wait for an epoch before using wallet0 again - void $ waitForEpochs epochStateView (EpochInterval 1) + -- wait for one block before using wallet0 again + _ <- waitForBlocks epochStateView 1 txin3 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0