Stuff

IntersectMBO · Aug 3, 2020 · 6651321 · 6651321
1 parent 3d4ab28
commit 6651321
Show file tree

Hide file tree

Showing 9 changed files with 17 additions and 6 deletions.
diff --git a/cardano-node/test/Test/Cardano/Node/Chairman.hs b/cardano-node/test/Test/Cardano/Node/Chairman.hs
@@ -14,7 +14,13 @@ import qualified Test.Common.Base as H
 import qualified Test.Common.Process as H
 
 prop_spawnOneNode :: Property
-prop_spawnOneNode = H.propertyOnce $ do
+prop_spawnOneNode = H.propertyOnce . H.workspace "temp/chairman" $ \tempDir -> do
+  let dbDir = tempDir <> "/db/node-2"
+  let socketDir = tempDir <> "/socket"
+
+  H.createDirectoryIfMissing dbDir
+  H.createDirectoryIfMissing socketDir
+
   base <- H.getProjectBase
 
   dirContents <- liftIO $ IO.listDirectory base
@@ -23,8 +29,8 @@ prop_spawnOneNode = H.propertyOnce $ do
 
   (_mIn, _mOut, _mErr, hProcess) <- H.createProcess =<< H.procNode
     [ "run"
-    , "--database-path", base <> "/chairman/db/node-2"
-    , "--socket-path", base <> "/chairman/socket/node-2-socket"
+    , "--database-path", dbDir
+    , "--socket-path", socketDir <> "/node-2-socket"
     , "--port", "3002"
     , "--topology", base <> "/chairman/configuration/defaults/simpleview/topology-node-2.json"
     , "--config", base <> "/chairman/configuration/defaults/simpleview/config-2.yaml"

diff --git a/cardano-node/test/Test/Common/Base.hs b/cardano-node/test/Test/Common/Base.hs
@@ -4,6 +4,7 @@ module Test.Common.Base
   , threadDelay
   , workspace
   , moduleWorkspace
+  , createDirectoryIfMissing
   ) where
 
 import           Control.Monad.IO.Class (liftIO)
@@ -53,8 +54,10 @@ failWithCustom cs mdiff msg = liftTest $ mkTest (Left $ H.Failure (getCaller cs)
 -- the block fails.
 workspace :: HasCallStack => FilePath -> (FilePath -> H.PropertyT IO ()) -> H.PropertyT IO ()
 workspace prefixPath f = GHC.withFrozenCallStack $ do
-  liftIO $ IO.createDirectoryIfMissing True prefixPath
-  ws <- liftIO $ IO.createTempDirectory prefixPath "test"
+  systemTemp <- liftIO $ IO.getCanonicalTemporaryDirectory
+  let systemPrefixPath = systemTemp <> "/" <> prefixPath
+  liftIO $ IO.createDirectoryIfMissing True systemPrefixPath
+  ws <- liftIO $ IO.createTempDirectory systemPrefixPath "test"
   H.annotate $ "Workspace: " <> cardanoCliPath <> "/" <> ws
   f ws
   liftIO $ IO.removeDirectoryRecursive ws
@@ -71,3 +74,6 @@ moduleWorkspace :: HasCallStack => FilePath -> (FilePath -> H.PropertyT IO ()) -
 moduleWorkspace prefixPath f = GHC.withFrozenCallStack $ do
   let srcModule = fromMaybe "UnknownModule" (fmap (GHC.srcLocModule . snd) (listToMaybe (getCallStack callStack)))
   workspace (prefixPath <> "/" <> srcModule) f
+
+createDirectoryIfMissing :: HasCallStack => FilePath -> H.PropertyT IO ()
+createDirectoryIfMissing filePath = H.evalM . liftIO $ IO.createDirectoryIfMissing True filePath
diff --git a/chairman/db/node-2/clean b/chairman/db/node-2/clean
diff --git a/chairman/db/node-2/immutable/00000.chunk b/chairman/db/node-2/immutable/00000.chunk
diff --git a/chairman/db/node-2/immutable/00000.primary b/chairman/db/node-2/immutable/00000.primary
diff --git a/chairman/db/node-2/immutable/00000.secondary b/chairman/db/node-2/immutable/00000.secondary
diff --git a/chairman/db/node-2/lock b/chairman/db/node-2/lock
diff --git a/chairman/db/node-2/protocolMagicId b/chairman/db/node-2/protocolMagicId
diff --git a/chairman/db/node-2/volatile/blocks-0.dat b/chairman/db/node-2/volatile/blocks-0.dat