From 84b0092e187db172b996f15c1cea2242fbc00c65 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 4 Jun 2021 16:32:32 +0200 Subject: [PATCH] Factor out failAfter and re-use it between tests --- hydra-node/hydra-node.cabal | 1 + hydra-node/test/Hydra/BehaviorSpec.hs | 31 ++++++++++++++------------- hydra-node/test/Hydra/NetworkSpec.hs | 11 ++-------- hydra-node/test/Test/Util.hs | 12 +++++++++++ 4 files changed, 31 insertions(+), 24 deletions(-) create mode 100644 hydra-node/test/Test/Util.hs diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 5ddc57cdf11..1395450923b 100644 --- a/hydra-node/hydra-node.cabal +++ b/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: diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index 7b31a7ebac6..4efcfb61e16 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/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 <- diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index c79021ae959..c9280822a5b 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/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 () diff --git a/hydra-node/test/Test/Util.hs b/hydra-node/test/Test/Util.hs new file mode 100644 index 00000000000..e775762f775 --- /dev/null +++ b/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 ()