Factor out failAfter and re-use it between tests

hydra-node/hydra-node.cabal

@@ -170,6 +170,7 @@ test-suite tests
     Hydra.NetworkSpec
     Hydra.NodeSpec
     Hydra.OptionSpec
+    Test.Util
   main-is: Main.hs
   type: exitcode-stdio-1.0
   build-depends:

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -41,6 +41,7 @@ import Test.Hspec (
   shouldNotBe,
   shouldReturn,
  )
+import Test.Util (failAfter)
 
 spec :: Spec
 spec = describe "Behavior of one ore more hydra-nodes" $ do
@@ -72,9 +73,9 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       sendRequestAndWaitFor n1 (Init [1, 2]) ReadyToCommit
       sendRequest n1 (Commit 1)
 
-      wait1sForResponse n2 `shouldReturn` Just ReadyToCommit
+      failAfter 1 $ waitForResponse n2 `shouldReturn` ReadyToCommit
       sendRequest n2 (Commit 1)
-      wait1sForResponse n2 `shouldReturn` Just (HeadIsOpen [])
+      failAfter 1 $ waitForResponse n2 `shouldReturn` HeadIsOpen []
       sendRequest n2 (NewTx $ ValidTx 1)
 
     it "not accepts commits when the head is open" $ do
@@ -99,13 +100,13 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       sendRequestAndWaitFor n1 (Init [1, 2]) ReadyToCommit
       sendRequest n1 (Commit 1)
 
-      wait1sForResponse n2 `shouldReturn` Just ReadyToCommit
+      failAfter 1 $ waitForResponse n2 `shouldReturn` ReadyToCommit
       sendRequestAndWaitFor n2 (Commit 1) (HeadIsOpen [])
 
-      wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsOpen []
       sendRequest n1 Close
 
-      wait1sForResponse n2 `shouldReturn` Just (HeadIsClosed 3 [])
+      failAfter 1 $ waitForResponse n2 `shouldReturn` HeadIsClosed 3 []
 
     it "only opens the head after all nodes committed" $ do
       chain <- simulatedChainAndNetwork
@@ -114,12 +115,12 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
       sendRequestAndWaitFor n1 (Init [1, 2]) ReadyToCommit
       sendRequest n1 (Commit 1)
-      wait1sForResponse n1 >>= (`shouldNotBe` Just (HeadIsOpen []))
+      timeout 1 (waitForResponse n1) >>= (`shouldNotBe` Just (HeadIsOpen []))
 
-      wait1sForResponse n2 `shouldReturn` Just ReadyToCommit
+      failAfter 1 $ waitForResponse n2 `shouldReturn` ReadyToCommit
       sendRequestAndWaitFor n2 (Commit 1) (HeadIsOpen [])
 
-      wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsOpen []
 
     it "valid new transaction in open head is stored in ledger" $ do
       chain <- simulatedChainAndNetwork
@@ -128,9 +129,9 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
       sendRequestAndWaitFor n1 (Init [1, 2]) ReadyToCommit
       sendRequest n1 (Commit 1)
-      wait1sForResponse n2 `shouldReturn` Just ReadyToCommit
+      failAfter 1 $ waitForResponse n2 `shouldReturn` ReadyToCommit
       sendRequestAndWaitFor n2 (Commit 1) (HeadIsOpen [])
-      wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsOpen []
 
       sendRequest n1 (NewTx $ ValidTx 1)
 
@@ -163,8 +164,9 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       traces `shouldContain` [ProcessedEffect (ClientEffect ReadyToCommit)]
 
 sendRequestAndWaitFor :: HasCallStack => HydraProcess IO MockTx -> ClientRequest MockTx -> ClientResponse MockTx -> IO ()
-sendRequestAndWaitFor node req expected =
-  sendRequest node req >> (wait1sForResponse node `shouldReturn` Just expected)
+sendRequestAndWaitFor node req expected = do
+  sendRequest node req
+  failAfter 1 $ waitForResponse node `shouldReturn` expected
 
 data NodeState = NotReady | Ready
   deriving (Eq, Show)
@@ -173,7 +175,7 @@ data HydraProcess m tx = HydraProcess
   { nodeId :: Natural
   , stopHydraNode :: m ()
   , sendRequest :: ClientRequest tx -> m ()
-  , wait1sForResponse :: m (Maybe (ClientResponse MockTx))
+  , waitForResponse :: m (ClientResponse MockTx)
   , waitForLedgerState :: Maybe (LedgerState tx) -> m ()
   , queryNodeState :: m NodeState
   , capturedLogs :: TVar m [HydraNodeLog tx]
@@ -222,8 +224,7 @@ startHydraNode nodeId connectToChain = do
             Nothing -> pure Ready
             Just _ -> pure NotReady
       , sendRequest = handleClientRequest node
-      , wait1sForResponse =
-          timeout 1_000_000 $ takeMVar response
+      , waitForResponse = takeMVar response
       , waitForLedgerState =
           \st -> do
             result <-

hydra-node/test/Hydra/NetworkSpec.hs

@@ -10,14 +10,13 @@ import Cardano.Binary (FromCBOR, ToCBOR, fromCBOR, toCBOR)
 import Codec.CBOR.Read (deserialiseFromBytes)
 import Codec.CBOR.Write (toLazyByteString)
 import Codec.Serialise (Serialise, deserialiseOrFail, serialise)
-import Control.Monad.Class.MonadTime (DiffTime)
-import Control.Monad.Class.MonadTimer (timeout)
 import Hydra.HeadLogic (HydraMessage (..), NetworkEvent (MessageReceived, NetworkConnected))
 import Hydra.Logging (nullTracer)
 import Hydra.Network.Ouroboros (broadcast, withOuroborosHydraNetwork)
 import Hydra.Network.ZeroMQ (withZeroMQHydraNetwork)
-import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldReturn)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldReturn)
 import Test.QuickCheck (Arbitrary (..), arbitrary, oneof, property)
+import Test.Util (failAfter)
 
 type MockTx = ()
 
@@ -116,9 +115,3 @@ prop_canRoundtripCBOREncoding ::
 prop_canRoundtripCBOREncoding a =
   let encoded = toLazyByteString $ toCBOR a
    in (snd <$> deserialiseFromBytes fromCBOR encoded) == Right a
-
-failAfter :: HasCallStack => DiffTime -> IO () -> IO ()
-failAfter seconds action =
-  timeout seconds action >>= \case
-    Nothing -> expectationFailure $ "Test timed out after " <> show seconds <> " seconds"
-    Just _ -> pure ()

hydra-node/test/Test/Util.hs

@@ -0,0 +1,12 @@
+module Test.Util where
+
+import Cardano.Prelude
+import Control.Monad.Class.MonadTime (DiffTime)
+import Control.Monad.Class.MonadTimer (timeout)
+import Test.Hspec (expectationFailure)
+
+failAfter :: HasCallStack => DiffTime -> IO () -> IO ()
+failAfter seconds action =
+  timeout seconds action >>= \case
+    Nothing -> expectationFailure $ "Test timed out after " <> show seconds <> " seconds"
+    Just _ -> pure ()