From 8d36cf466ca4e7a7047ef915b0ac833eaacbc10b Mon Sep 17 00:00:00 2001 From: John Ky Date: Mon, 3 Aug 2020 11:02:34 +1000 Subject: [PATCH] Stuff --- cardano-node/cardano-node.cabal | 3 +- .../test/Test/Cardano/Node/Chairman.hs | 25 +++++++--------- cardano-node/test/Test/Common/Base.hs | 16 +++++++++- cardano-node/test/Test/Common/Process.hs | 29 ++++++++++++++++--- nix/haskell.nix | 3 ++ 5 files changed, 54 insertions(+), 22 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index f248cfe017a..8216e582bff 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -263,6 +263,7 @@ test-suite cardano-node-test build-depends: base >= 4.12 && < 5 , aeson + , async , bytestring , cardano-config , cardano-crypto-class @@ -301,5 +302,3 @@ test-suite cardano-node-test -Wpartial-fields -Wcompat -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T - - build-tool-depends: cardano-node:cardano-node diff --git a/cardano-node/test/Test/Cardano/Node/Chairman.hs b/cardano-node/test/Test/Cardano/Node/Chairman.hs index a9400422e3b..2bd59c40e4d 100644 --- a/cardano-node/test/Test/Cardano/Node/Chairman.hs +++ b/cardano-node/test/Test/Cardano/Node/Chairman.hs @@ -9,26 +9,21 @@ import Cardano.Prelude import Hedgehog (Property, discover) import qualified Hedgehog as H -import qualified System.Process as IO import qualified Test.Common.Base as H import qualified Test.Common.Process as H prop_spawnOneNode :: Property prop_spawnOneNode = H.propertyOnce $ do - (_mIn, _mOut, _mErr, hProcess) <- H.createProcess $ - ( IO.proc "cardano-node" - [ "run" - , "--database-path", "../db/node-2/" - , "--socket-path", "../socket/node-2-socket" - , "--port", "3002" - , "--topology", "../configuration/defaults/simpleview/topology-node-2.json" - , "--config", "../configuration/defaults/simpleview/config-2.yaml" - , "--signing-key", "../configuration/defaults/simpleview/genesis/delegate-keys.002.key" - , "--delegation-certificate", "../configuration/defaults/simpleview/genesis/delegation-cert.002.json" - ] - ) - { IO.create_group = True - } + (_mIn, _mOut, _mErr, hProcess) <- H.createProcess =<< H.procNode + [ "run" + , "--database-path", "../db/node-2/" + , "--socket-path", "../socket/node-2-socket" + , "--port", "3002" + , "--topology", "../configuration/defaults/simpleview/topology-node-2.json" + , "--config", "../configuration/defaults/simpleview/config-2.yaml" + , "--signing-key", "../configuration/defaults/simpleview/genesis/delegate-keys.002.key" + , "--delegation-certificate", "../configuration/defaults/simpleview/genesis/delegation-cert.002.json" + ] H.threadDelay 10000000 diff --git a/cardano-node/test/Test/Common/Base.hs b/cardano-node/test/Test/Common/Base.hs index 9d5a2991171..89316601f2f 100644 --- a/cardano-node/test/Test/Common/Base.hs +++ b/cardano-node/test/Test/Common/Base.hs @@ -1,18 +1,32 @@ module Test.Common.Base ( propertyOnce + , failWithCustom , threadDelay ) where import Control.Monad.IO.Class (liftIO) +import Data.Either (Either (..)) import Data.Function (($), (.)) import Data.Int +import Data.Maybe (Maybe (..)) +import Data.Monoid (Monoid (..)) +import Data.String (String) +import GHC.Stack (CallStack) +import Hedgehog (MonadTest) +import Hedgehog.Internal.Property (Diff, liftTest, mkTest) +import Hedgehog.Internal.Source (getCaller) import System.IO (IO) import qualified Control.Concurrent as IO import qualified Hedgehog as H +import qualified Hedgehog.Internal.Property as H propertyOnce :: H.PropertyT IO () -> H.Property propertyOnce = H.withTests 1 . H.property threadDelay :: Int -> H.PropertyT IO () -threadDelay n = liftIO $ IO.threadDelay n +threadDelay = liftIO . IO.threadDelay + +-- | Takes a 'CallStack' so the error can be rendered at the appropriate call site. +failWithCustom :: MonadTest m => CallStack -> Maybe Diff -> String -> m a +failWithCustom cs mdiff msg = liftTest $ mkTest (Left $ H.Failure (getCaller cs) msg mdiff, mempty) diff --git a/cardano-node/test/Test/Common/Process.hs b/cardano-node/test/Test/Common/Process.hs index 48e0d3c9fd5..c91d80af87e 100644 --- a/cardano-node/test/Test/Common/Process.hs +++ b/cardano-node/test/Test/Common/Process.hs @@ -1,13 +1,21 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + module Test.Common.Process ( createProcess + , procNode , interruptProcessGroupOf , waitForProcess ) where +import Control.Concurrent.Async +import Control.Exception +import Control.Monad import Control.Monad.IO.Class -import Data.Function ((.)) -import Data.Function (($)) +import Data.Bool +import Data.Function import Data.Maybe (Maybe (..)) +import Data.String (String) import GHC.Stack (HasCallStack) import System.Exit (ExitCode) import System.IO (Handle, IO) @@ -15,6 +23,7 @@ import System.Process (CreateProcess (..), ProcessHandle) import qualified GHC.Stack as GHC import qualified Hedgehog as H +import qualified System.Environment as IO import qualified System.Process as IO createProcess :: HasCallStack @@ -31,6 +40,18 @@ interruptProcessGroupOf hProcess = GHC.withFrozenCallStack $ do waitForProcess :: HasCallStack => ProcessHandle - -> H.PropertyT IO ExitCode + -> H.PropertyT IO (Maybe ExitCode) waitForProcess hProcess = GHC.withFrozenCallStack $ do - H.evalM . liftIO $ IO.waitForProcess hProcess + H.evalM . liftIO $ catch (fmap Just (IO.waitForProcess hProcess)) $ \(_ :: AsyncCancelled) -> return Nothing + +procNode + :: [String] + -- ^ Arguments to the CLI command + -> H.PropertyT IO CreateProcess + -- ^ Captured stdout +procNode arguments = do + maybeCardanoCli <- liftIO $ IO.lookupEnv "CARDANO_NODE" + cp <- case maybeCardanoCli of + Just cardanoCli -> return $ IO.proc cardanoCli arguments + Nothing -> return $ IO.proc "cabal" ("exec":"--":"cardano-node":arguments) + return $ cp { IO.create_group = True } diff --git a/nix/haskell.nix b/nix/haskell.nix index 6906ef72a49..e172ce43896 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -102,6 +102,9 @@ let # cardano-cli-test depends on cardano-cli packages.cardano-cli.preCheck = "export CARDANO_CLI=${pkgSet.cardano-cli.components.exes.cardano-cli}/bin/cardano-cli"; + + # cardano-node-test depends on cardano-node + packages.cardano-node.preCheck = "export CARDANO_NODE=${pkgSet.cardano-node.components.exes.cardano-node}/bin/cardano-node"; } { packages = lib.genAttrs projectPackages