Introduce test prelude

cabal.project

@@ -5,6 +5,7 @@ packages:
   hydra-node
   hydra-plutus
   hydra-prelude
+  hydra-test-utils
 
 tests: False
 package local-cluster

hydra-node/hydra-node.cabal

@@ -218,6 +218,7 @@ test-suite tests
     , hydra-node
     , hydra-plutus
     , hydra-prelude
+    , hydra-test-utils
     , io-sim
     , io-classes
     , iproute

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -16,15 +16,15 @@ import qualified Data.Aeson as Aeson
 import Hydra.API.Server (withAPIServer)
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Logging (nullTracer)
-import Hydra.Network.Ports (withFreePort)
+import Test.Network.Ports (withFreePort)
 import Hydra.Prelude
+import Hydra.ServerOutput (ServerOutput (InvalidInput, ReadyToCommit))
+import Test.Hydra.Prelude (failAfter, failure)
 import Network.WebSockets (Connection, receiveData, runClient, sendBinaryData)
 import Test.Hspec
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (cover)
 import Test.QuickCheck.Monadic (monadicIO, monitor, run)
-import Test.Util (failAfter, failure)
-import Hydra.ServerOutput (ServerOutput (InvalidInput, ReadyToCommit))
 
 spec :: Spec
 spec = describe "API Server" $ do
@@ -59,7 +59,7 @@ spec = describe "API Server" $ do
             received <- replicateM (length msgs) (receiveData conn)
             case traverse Aeson.eitherDecode received of
               Right msgs' -> msgs' `shouldBe` msgs
-              Left{} -> expectationFailure ("Failed to decode messages " <> show msgs)
+              Left{} -> failure $ "Failed to decode messages " <> show msgs
 
   it "sends an error when input cannot be decoded" $
     failAfter 5 $
@@ -83,7 +83,7 @@ testClient queue semaphore cnx = do
   msg <- receiveData cnx
   case Aeson.eitherDecode msg of
     Right resp -> atomically (writeTQueue queue resp)
-    Left{} -> expectationFailure ("Failed to decode message " <> show msg)
+    Left{} -> failure $ "Failed to decode message " <> show msg
 
 noop :: Applicative m => a -> m ()
 noop = const $ pure ()

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -41,8 +41,9 @@ import Hydra.Node (
  )
 import Hydra.ServerOutput (ServerOutput (..))
 import Hydra.Snapshot (Snapshot (..))
+import Test.Hydra.Prelude (failAfter, failure)
 import Test.Hspec (Spec, describe, it, shouldContain, shouldThrow)
-import Test.Util (failAfter, failure, shouldNotBe, shouldReturn, shouldRunInSim, traceInIOSim)
+import Test.Util (shouldNotBe, shouldReturn, shouldRunInSim, traceInIOSim)
 
 spec :: Spec
 spec = describe "Behavior of one ore more hydra nodes" $ do

hydra-node/test/Hydra/Chain/ExternalPABSpec.hs

@@ -14,12 +14,12 @@ import qualified Hydra.ContractSM as OnChain
 import Hydra.Ledger (Party (UnsafeParty))
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Logging (nullTracer)
+import Test.Hydra.Prelude (failAfter)
 import System.Process (CreateProcess (std_in, std_out), StdStream (CreatePipe), proc, withCreateProcess)
 import Test.Hspec (shouldReturn)
 import Test.Hspec.Core.Spec (Spec, describe, it)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (counterexample, property)
-import Test.Util (failAfter)
 
 spec :: Spec
 spec = do

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -29,6 +29,7 @@ import Hydra.Ledger.Simple (SimpleTx (..), TxIn (..), aValidTx, simpleLedger, ut
 import Hydra.Network.Message (Message (AckSn, Connected, ReqSn, ReqTx))
 import Hydra.ServerOutput (ServerOutput (PeerConnected))
 import Hydra.Snapshot (Snapshot (..))
+import Test.Hydra.Prelude (failure)
 import Test.Hspec (
   Expectation,
   Spec,
@@ -43,7 +44,6 @@ import Test.QuickCheck (
   forAllShrink,
   (===),
  )
-import Test.Util (failure)
 
 spec :: Spec
 spec = describe "Hydra Coordinated Head Protocol" $ do

hydra-node/test/Hydra/Logging/MonitoringSpec.hs

@@ -12,14 +12,14 @@ import Hydra.Logging (nullTracer, traceWith)
 import Hydra.Logging.Messages (HydraLog (Node))
 import Hydra.Logging.Monitoring
 import Hydra.Network.Message (Message (ReqTx))
-import Hydra.Network.Ports (withFreePort)
+import Test.Network.Ports (withFreePort)
 import Hydra.Node (HydraNodeLog (ProcessedEffect, ProcessingEvent))
 import Hydra.Prelude
 import Hydra.ServerOutput (ServerOutput (SnapshotConfirmed))
 import Hydra.Snapshot (Snapshot (Snapshot))
+import Test.Hydra.Prelude (failAfter)
 import Network.HTTP.Req (GET (..), NoReqBody (..), bsResponse, defaultHttpConfig, http, port, req, responseBody, runReq, (/:))
 import Test.Hspec
-import Test.Util (failAfter)
 
 spec :: Spec
 spec = describe "Prometheus Metrics" $ do

hydra-node/test/Hydra/NetworkSpec.hs

@@ -17,8 +17,9 @@ import Hydra.Logging (showLogsOnFailure)
 import Hydra.Network (Host (..), Network, PortNumber)
 import Hydra.Network.Message (Message (..))
 import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork)
-import Hydra.Network.Ports (randomUnusedTCPPorts)
+import Test.Network.Ports (randomUnusedTCPPorts)
 import Hydra.Network.ZeroMQ (withZeroMQNetwork)
+import Test.Hydra.Prelude (failAfter)
 import Test.Hspec (Expectation, Spec, describe, it, shouldReturn)
 import Test.QuickCheck (
   oneof,
@@ -27,7 +28,6 @@ import Test.QuickCheck (
  )
 import Test.QuickCheck.Gen (Gen)
 import Test.QuickCheck.Instances.ByteString ()
-import Test.Util (failAfter)
 
 spec :: Spec
 spec = describe "Networking layer" $ do

hydra-node/test/Hydra/OptionsSpec.hs

@@ -3,7 +3,8 @@ module Hydra.OptionsSpec where
 import Hydra.Network (Host (Host), MockChainPorts (..))
 import Hydra.Options (Options (..), ParserResult (..), defaultOptions, parseHydraOptionsFromString)
 import Hydra.Prelude
-import Test.Hspec (Expectation, Spec, describe, expectationFailure, it, shouldBe)
+import Test.Hydra.Prelude (failure)
+import Test.Hspec (Expectation, Spec, describe, it, shouldBe)
 
 spec :: Spec
 spec = describe "Hydra Node Options" $ do
@@ -62,11 +63,11 @@ shouldParse :: [String] -> Options -> Expectation
 shouldParse args options =
   case parseHydraOptionsFromString args of
     Success a -> a `shouldBe` options
-    err -> expectationFailure (show err)
+    err -> failure (show err)
 
 shouldNotParse :: [String] -> Expectation
 shouldNotParse args =
   case parseHydraOptionsFromString args of
-    Success a -> expectationFailure $ "Unexpected successful parse to " <> show a
+    Success a -> failure $ "Unexpected successful parse to " <> show a
     Failure _ -> pure ()
-    CompletionInvoked _ -> expectationFailure "Unexpected completion invocation"
+    CompletionInvoked _ -> failure "Unexpected completion invocation"

hydra-node/test/Test/Util.hs

@@ -4,30 +4,14 @@ module Test.Util where
 
 import Hydra.Prelude
 
-import Control.Monad.Class.MonadTimer (timeout)
 import Control.Monad.IOSim (Failure (FailureException), IOSim, runSimTrace, selectTraceEventsDynamic, traceM, traceResult)
 import Control.Tracer (Tracer (Tracer))
 import Data.List (isInfixOf)
 import Data.Typeable (cast)
-import GHC.Stack (SrcLoc)
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Node (HydraNodeLog)
-import Test.HUnit.Lang (FailureReason (ExpectedButGot, Reason), HUnitFailure (HUnitFailure))
-
-failure :: (HasCallStack, MonadThrow m) => String -> m a
-failure msg =
-  throwIO (HUnitFailure location $ Reason msg)
-
-location :: HasCallStack => Maybe SrcLoc
-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
-    Nothing -> failure $ "Test timed out after " <> show seconds <> " seconds"
-    Just _ -> pure ()
+import Test.Hydra.Prelude (failure, location)
+import Test.HUnit.Lang (FailureReason (ExpectedButGot), HUnitFailure (HUnitFailure))
 
 -- | Run given 'action' in 'IOSim' and fail on exceptions. This runner has
 -- special support for detecting and re-throwing 'HUnitFailure' exceptions.

hydra-prelude/hydra-prelude.cabal

@@ -21,21 +21,16 @@ library
     src
   exposed-modules:
     Hydra.Prelude
-    Hydra.Network.Ports
   build-depends:
     aeson,
     base,
     cardano-binary,
-    filepath,
     generic-random,
     io-classes,
-    network,
     QuickCheck,
     quickcheck-instances,
     random-shuffle,
     relude,
-    temporary,
-    warp,
   default-extensions:
     NoImplicitPrelude
     FlexibleContexts

hydra-prelude/src/Hydra/Prelude.hs

@@ -19,7 +19,6 @@ module Hydra.Prelude (
   Arbitrary (..),
   genericArbitrary,
   genericShrink,
-  createSystemTempDirectory,
 ) where
 
 import Cardano.Binary (
@@ -124,7 +123,6 @@ import Relude.Extra.Map (
   elems,
   keys,
  )
-import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory)
 import Test.QuickCheck (
   Arbitrary (..),
   Gen,
@@ -144,13 +142,3 @@ genericArbitrary ::
   Gen a
 genericArbitrary =
   Random.genericArbitrary Random.uniform
-
--- | FIXME: Move into test-utils as soon as test-utils exists "globally"
--- And, really this should only be used in test code, when we want to preserve
--- log / tmp files on failure, but files should be cleaned up on success.
---
--- In brief: do not use.
-createSystemTempDirectory :: String -> IO FilePath
-createSystemTempDirectory template =
-  getCanonicalTemporaryDirectory >>= \tmpDir ->
-    createTempDirectory tmpDir template