Test fix

IntersectMBO · May 8, 2024 · cb0ba1e · cb0ba1e
1 parent a43bf59
commit cb0ba1e
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 11 deletions.
diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs
@@ -345,18 +345,18 @@ getCurrentEpochNo epochStateView = withFrozenCallStack $ do
   pure $ newEpochState ^. L.nesELL
 
 watchEpochStateView
-  :: forall m a. (MonadIO m, MonadTest m, MonadAssertion m, HasCallStack)
+  :: forall m a. (MonadIO m, MonadTest m, MonadAssertion m)
   => EpochStateView
   -> (AnyNewEpochState -> m (Maybe a))
   -> Word64
   -> Word64
-  -> m a
+  -> m (Maybe a)
 watchEpochStateView epochStateView f minWait maxWait = do
   AnyNewEpochState _ newEpochState <- getEpochState epochStateView
   let (EpochNo currentEpoch) = L.nesEL newEpochState
   go (EpochNo $ currentEpoch + minWait) (EpochNo $ currentEpoch + maxWait)
     where
-      go :: EpochNo -> EpochNo -> m a
+      go :: EpochNo -> EpochNo -> m (Maybe a)
       go (EpochNo startEpoch) (EpochNo timeout) = do
         epochState@(AnyNewEpochState _ newEpochState') <- getEpochState epochStateView
         let (EpochNo currentEpoch) = L.nesEL newEpochState'
@@ -365,10 +365,10 @@ watchEpochStateView epochStateView f minWait maxWait = do
                 go (EpochNo startEpoch) (EpochNo timeout)
         else do condition <- f epochState
                 case condition of
-                  Just result -> pure result
+                  Just result -> pure (Just result)
                   Nothing ->
                     if currentEpoch > timeout
-                    then H.failMessage callStack $ "foldEpochStateView reached timeout: " <> show timeout
+                    then pure Nothing
                     else do H.threadDelay 100_000
                             go (EpochNo startEpoch) (EpochNo timeout)
 
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
@@ -46,6 +46,7 @@ import           Testnet.Runtime
 import           Hedgehog
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+import System.Directory (removeDirectoryRecursive)
 
 -- | Execute me with:
 -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRep Activity/"'@
@@ -63,8 +64,9 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
       era = toCardanoEra sbe
       cEra = AnyCardanoEra era
       fastTestnetOptions = cardanoDefaultTestnetOptions
-        { cardanoEpochLength = 100
+        { cardanoEpochLength = 200
         , cardanoNodeEra = cEra
+        , cardanoSlotLength = 0.1
         , cardanoNumDReps = 1
         }
 
@@ -95,8 +97,8 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
 
   -- 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
+      minEpochsToWaitIfNotChanging = 2 -- We cannot wait for change since there is no change (we wait a bit)
+      maxEpochsToWaitAfterProposal = 2 -- If it takes more than 10 epochs we give up in any case
       firstTargetDRepActivity = 3
   void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov
                                     "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity
@@ -190,10 +192,13 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat
   (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
   H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp
 
-  watchEpochStateView epochStateView isSuccess minWait maxWait
-
-  return thisProposal
+  mResult <- watchEpochStateView epochStateView isSuccess minWait maxWait
 
+  case mResult of
+    Nothing -> do liftIO $ removeDirectoryRecursive baseDir
+                  activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix
+                                             wallet votes change minWait mExpected maxWait
+    Just () -> return thisProposal
   where
     isSuccess :: (HasCallStack, MonadTest m)
               => AnyNewEpochState -> m (Maybe ())