From 6895cb67a57f4a97576fad864d4ec2325563f53a Mon Sep 17 00:00:00 2001 From: John Ky Date: Mon, 3 Aug 2020 15:58:40 +1000 Subject: [PATCH] Stuff --- cardano-cli/cardano-cli.cabal | 1 - cardano-node/cardano-node.cabal | 1 + cardano-node/src/Cardano/Node/Types.hs | 4 ++-- .../test/Test/Cardano/Node/Chairman.hs | 19 +++++++++++++------ cardano-node/test/Test/Common/Process.hs | 15 ++++++++++++++- nix/haskell.nix | 5 ++++- 6 files changed, 34 insertions(+), 11 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 9c279c62613..c0a6cb38cb8 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -225,7 +225,6 @@ test-suite cardano-cli-test Test.Pioneers.Exercise2 Test.Pioneers.Exercise3 Test.Pioneers.Exercise4 - Test.Process default-language: Haskell2010 default-extensions: NoImplicitPrelude diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 8216e582bff..39205fb689a 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -275,6 +275,7 @@ test-suite cardano-node-test , cardano-slotting , containers , cryptonite + , directory , hedgehog , hedgehog-corpus , iproute diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index f0416ba5b67..9c01dc5c9c5 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -45,7 +45,7 @@ import Data.IP (IP) import qualified Data.Text as Text import Data.Yaml (decodeFileThrow) import Network.Socket (PortNumber) -import System.FilePath (takeDirectory, ()) +import System.FilePath (takeDirectory) import System.Posix.Types (Fd) import Cardano.Api.Typed (EpochNo) @@ -545,7 +545,7 @@ parseNodeConfigurationFP :: ConfigYamlFilePath -> IO NodeConfiguration parseNodeConfigurationFP (ConfigYamlFilePath fp) = do nc <- decodeFileThrow fp -- Make all the files be relative to the location of the config file. - pure $ adjustFilePaths (takeDirectory fp ) nc + pure $ adjustFilePaths (\p -> takeDirectory fp <> "/" <> p) nc -- | A human readable name for the protocol -- diff --git a/cardano-node/test/Test/Cardano/Node/Chairman.hs b/cardano-node/test/Test/Cardano/Node/Chairman.hs index 2bd59c40e4d..88263ca50e7 100644 --- a/cardano-node/test/Test/Cardano/Node/Chairman.hs +++ b/cardano-node/test/Test/Cardano/Node/Chairman.hs @@ -9,20 +9,27 @@ import Cardano.Prelude import Hedgehog (Property, discover) import qualified Hedgehog as H +import qualified System.Directory as IO import qualified Test.Common.Base as H import qualified Test.Common.Process as H prop_spawnOneNode :: Property prop_spawnOneNode = H.propertyOnce $ do + base <- H.getProjectBase + + dirContents <- liftIO $ IO.listDirectory base + + H.annotateShow $ dirContents + (_mIn, _mOut, _mErr, hProcess) <- H.createProcess =<< H.procNode [ "run" - , "--database-path", "../db/node-2/" - , "--socket-path", "../socket/node-2-socket" + , "--database-path", base <> "/db/node-2/" + , "--socket-path", base <> "/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" + , "--topology", base <> "/configuration/defaults/simpleview/topology-node-2.json" + , "--config", base <> "/configuration/defaults/simpleview/config-2.yaml" + , "--signing-key", base <> "/configuration/defaults/simpleview/genesis/delegate-keys.002.key" + , "--delegation-certificate", base <> "/configuration/defaults/simpleview/genesis/delegation-cert.002.json" ] H.threadDelay 10000000 diff --git a/cardano-node/test/Test/Common/Process.hs b/cardano-node/test/Test/Common/Process.hs index c91d80af87e..757c997bf74 100644 --- a/cardano-node/test/Test/Common/Process.hs +++ b/cardano-node/test/Test/Common/Process.hs @@ -3,6 +3,7 @@ module Test.Common.Process ( createProcess + , getProjectBase , procNode , interruptProcessGroupOf , waitForProcess @@ -15,12 +16,14 @@ import Control.Monad.IO.Class import Data.Bool import Data.Function import Data.Maybe (Maybe (..)) +import Data.Semigroup ((<>)) import Data.String (String) import GHC.Stack (HasCallStack) import System.Exit (ExitCode) import System.IO (Handle, IO) -import System.Process (CreateProcess (..), ProcessHandle) +import System.Process (CmdSpec (..), CreateProcess (..), ProcessHandle) +import qualified Data.List as L import qualified GHC.Stack as GHC import qualified Hedgehog as H import qualified System.Environment as IO @@ -30,6 +33,9 @@ createProcess :: HasCallStack => CreateProcess -> H.PropertyT IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess cp = GHC.withFrozenCallStack $ do + case IO.cmdspec cp of + RawCommand cmd args -> H.annotate $ "Command line: " <> cmd <> " " <> L.intercalate " " args + ShellCommand cmd -> H.annotate $ "Command line: " <> cmd H.evalM . liftIO $ IO.createProcess cp interruptProcessGroupOf :: HasCallStack @@ -55,3 +61,10 @@ procNode arguments = do Just cardanoCli -> return $ IO.proc cardanoCli arguments Nothing -> return $ IO.proc "cabal" ("exec":"--":"cardano-node":arguments) return $ cp { IO.create_group = True } + +getProjectBase :: H.PropertyT IO String +getProjectBase = do + maybeCardanoCli <- liftIO $ IO.lookupEnv "CARDANO_NODE_SRC" + case maybeCardanoCli of + Just path -> return path + Nothing -> return ".." diff --git a/nix/haskell.nix b/nix/haskell.nix index e172ce43896..00aac2bc494 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -104,7 +104,10 @@ let 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.cardano-node.preCheck = " + export CARDANO_NODE=${pkgSet.cardano-node.components.exes.cardano-node}/bin/cardano-node + export CARDANO_NODE_SRC=${ ./.. } + "; } { packages = lib.genAttrs projectPackages