Use waiting for blocks instead epochs, when waiting for transaction

Co-authored-by: Pablo Lamela <[email protected]>

cardano-testnet/cardano-testnet.cabal

@@ -77,7 +77,7 @@ library
                       , safe-exceptions
                       , scientific
                       , si-timers
-                      , stm
+                      , stm > 2.5.1
                       , tasty ^>= 1.5
                       , tasty-expected-failure
                       , tasty-hedgehog

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

@@ -1,29 +1,36 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Testnet.Components.Query
   ( EpochStateView
-  , checkDRepsNumber
-  , checkDRepState
+  , getEpochStateView
   , getEpochState
+  , getSlotNumber
+  , getBlockNumber
+  , watchEpochStateUpdate
   , getMinDRepDeposit
   , getMinGovActionDeposit
   , getGovState
   , getCurrentEpochNo
   , waitUntilEpoch
   , waitForEpochs
-  , getEpochStateView
+  , waitForBlocks
   , findAllUtxos
   , findUtxosWithAddress
   , findLargestUtxoWithAddress
   , findLargestUtxoForPaymentKey
+  , checkDRepsNumber
+  , checkDRepState
   ) where
 
 import           Cardano.Api as Api
-import           Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto)
+import           Cardano.Api.Ledger (Credential, DRepState, EpochInterval (EpochInterval),
+                   KeyRole (DRepRole), StandardCrypto)
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
 import qualified Cardano.Ledger.Api as L
@@ -48,6 +55,7 @@ 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 (to, (^.))
@@ -98,25 +106,81 @@ waitForEpochs epochStateView@EpochStateView{nodeConfigPath, socketPath} interval
   currentEpoch <- getCurrentEpochNo epochStateView
   waitUntilEpoch nodeConfigPath socketPath $ addEpochInterval currentEpoch interval
 
+
+-- | Wait for the requested number of blocks
+waitForBlocks
+  :: HasCallStack
+  => MonadIO m
+  => MonadTest m
+  => MonadAssertion m
+  => EpochStateView
+  -> Word64 -- ^ Number of blocks to wait
+  -> m BlockNo -- ^ The block number reached
+waitForBlocks epochStateView numberOfBlocks = withFrozenCallStack $ do
+  BlockNo startingBlockNumber <- getBlockNumber epochStateView
+  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)))
+  -- ^ Updated automatically 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, _, _) -> nes
+
+getBlockNumber
+  :: HasCallStack
+  => MonadIO m
+  => MonadTest m
+  => MonadAssertion m
+  => EpochStateView
+  -> m BlockNo -- ^ The number of last produced block
+getBlockNumber epochStateView =
+  withFrozenCallStack $ getEpochStateDetails epochStateView $ \(_, _, blockNumber) -> blockNumber
+
+getSlotNumber
+  :: HasCallStack
+  => MonadIO m
+  => MonadTest m
+  => MonadAssertion m
+  => EpochStateView
+  -> m SlotNo -- ^ The current slot number
+getSlotNumber epochStateView =
+  withFrozenCallStack $ getEpochStateDetails epochStateView $ \(_, slotNumber, _) -> slotNumber
+
+-- | Utility function for accessing epoch state in `IORef`
+getEpochStateDetails
+  :: HasCallStack
+  => MonadAssertion m
+  => MonadTest m
+  => MonadIO m
+  => EpochStateView
+  -> ((AnyNewEpochState, SlotNo, BlockNo) -> 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 (pure . f)
 
 -- | Create a background thread listening for new epoch states. New epoch states are available to access
 -- through 'EpochStateView', using query functions.
@@ -131,11 +195,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 id
+        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
@@ -204,7 +295,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
@@ -262,7 +353,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

cardano-testnet/src/Testnet/EpochStateProcessing.hs

@@ -1,16 +1,14 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Testnet.EpochStateProcessing
   ( maybeExtractGovernanceActionIndex
   , findCondition
-  , watchEpochStateView
   ) where
 
 import           Cardano.Api
-import           Cardano.Api.Ledger (EpochInterval (..), GovActionId (..))
+import           Cardano.Api.Ledger (GovActionId (..))
 import qualified Cardano.Api.Ledger as L
 
 import qualified Cardano.Ledger.Conway.Governance as L
@@ -25,11 +23,7 @@ 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
@@ -78,31 +72,3 @@ 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)
-

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,7 +141,7 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa
     , "--tx-file", sendAdaToScriptAddressTx
     ]
 
-  _ <- waitForEpochs epochStateView (L.EpochInterval 1)
+  H.noteShowM_ $ waitForBlocks epochStateView 1
 
   -- 2. Successfully spend conway spending script
   txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs

@@ -34,7 +34,6 @@ import           System.FilePath ((</>))
 import           Testnet.Components.Query
 import           Testnet.Components.TestWatchdog (runWithDefaultWatchdog_)
 import           Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair)
-import           Testnet.EpochStateProcessing (watchEpochStateView)
 import           Testnet.Process.Cli.DRep
 import           Testnet.Process.Cli.Keys
 import           Testnet.Process.Cli.Transaction
@@ -200,19 +199,22 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat
 
   void $ waitForEpochs epochStateView minWait
   forM_ mExpected $ \expected ->
-    H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait
+    watchEpochStateUpdate epochStateView maxWait $ isDRepActivityUpdated expected
 
   return thisProposal
 
   where
-    isDRepActivityUpdated :: (HasCallStack, MonadTest m)
-              => EpochInterval -> AnyNewEpochState -> m (Maybe ())
-    isDRepActivityUpdated (EpochInterval expected) (AnyNewEpochState sbe newEpochState) =
+    isDRepActivityUpdated
+      :: (HasCallStack, MonadTest m)
+      => EpochInterval
+      -> (AnyNewEpochState, SlotNo, BlockNo)
+      -> 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)
+          pure $ if epochInterval == expected then Just () else Nothing
         )
         sbe
 

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
+  H.noteShowM_ $ waitForBlocks epochStateView 1
 
   txin3 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0