diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 348f0300a97..e9fb93d34e5 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -187,6 +187,7 @@ test-suite tests , QuickCheck , serialise , typed-protocols-examples + , HUnit build-tool-depends: hspec-discover:hspec-discover ghc-options: diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index 447f3c5f6b8..7880d3605fe 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -55,7 +55,7 @@ import Test.Hspec ( shouldNotBe, shouldReturn, ) -import Test.Util (failAfter) +import Test.Util (failAfter, failure) import Prelude (error) spec :: Spec @@ -298,8 +298,7 @@ startHydraNode' snapshotStrategy nodeId connectToChain = do atomically $ do st' <- queryLedgerState node check (st == st') - -- TODO(SN): use MonadThrow instead? - when (isNothing result) $ error ("Expected ledger state of node " <> show nodeId <> " to be " <> show st) + when (isNothing result) $ failure ("Expected ledger state of node " <> show nodeId <> " to be " <> show st) , nodeId , capturedLogs } diff --git a/hydra-node/test/Test/Util.hs b/hydra-node/test/Test/Util.hs index 1bf655ac991..ff504bf692c 100644 --- a/hydra-node/test/Test/Util.hs +++ b/hydra-node/test/Test/Util.hs @@ -1,12 +1,22 @@ module Test.Util where -import Cardano.Prelude +import Cardano.Prelude hiding (callStack, throwIO) +import Control.Monad.Class.MonadThrow (MonadThrow (throwIO)) import Control.Monad.Class.MonadTimer (DiffTime, MonadTimer, timeout) -import Prelude (error) +import Data.String (String) +import GHC.Stack (callStack) +import Test.HUnit.Lang (FailureReason (Reason), HUnitFailure (HUnitFailure)) -failAfter :: (HasCallStack, MonadTimer m) => DiffTime -> m () -> m () +failure :: (HasCallStack, MonadThrow m) => String -> m a +failure msg = + throwIO (HUnitFailure location $ Reason msg) + where + location = case reverse $ getCallStack callStack of + (_, loc) : _ -> Just loc + _ -> Nothing + +failAfter :: (HasCallStack, MonadTimer m, MonadThrow m) => DiffTime -> m () -> m () failAfter seconds action = timeout seconds action >>= \case - -- TODO(SN): use MonadThrow instead? - Nothing -> error $ "Test timed out after " <> show seconds <> " seconds" + Nothing -> failure $ "Test timed out after " <> show seconds <> " seconds" Just _ -> pure ()