wip single top-level temp dir

cardano-foundation · Jun 20, 2020 · c87eb54 · c87eb54
1 parent c44a95b
commit c87eb54
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 16 deletions.
diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs
@@ -32,6 +32,8 @@ module Cardano.Wallet.Shelley.Launch
     , nodeSocketOption
     , networkConfigurationOption
     , parseGenesisData
+    , withTempDir
+    , withSystemTempDir
 
     -- * Logging
     , ClusterLog (..)
@@ -274,14 +276,16 @@ withCluster
     -- ^ Minimum logging severity for @cardano-node@
     -> Int
     -- ^ How many pools should the cluster spawn.
+    -> FilePath
+    -- ^ Parent state directory for cluster
     -> (FilePath -> Block -> (NetworkParameters, NodeVersionData) -> IO a)
     -- ^ Action to run with the cluster up
     -> IO a
-withCluster tr severity n action = bracketTracer' tr "withCluster" $ do
+withCluster tr severity n dir action = bracketTracer' tr "withCluster" $ do
     systemStart <- addUTCTime 1 <$> getCurrentTime
     ports <- randomUnusedTCPPorts (n + 1)
     let bftCfg = NodeParams severity systemStart (head $ rotate ports)
-    withBFTNode tr bftCfg $ \socket block0 params -> do
+    withBFTNode tr dir bftCfg $ \socket block0 params -> do
         waitForSocket tr socket
         waitGroup <- newChan
         doneGroup <- newChan
@@ -333,13 +337,14 @@ data NodeParams = NodeParams
 withBFTNode
     :: Tracer IO ClusterLog
     -- ^ Trace for subprocess control logging
+    -> FilePath
+    -- ^ Parent state directory
     -> NodeParams
     -> (FilePath -> Block -> (NetworkParameters, NodeVersionData) -> IO a)
     -- ^ Callback function with genesis parameters
     -> IO a
-withBFTNode tr (NodeParams severity systemStart (port, peers)) action =
-    bracketTracer' tr "withBFTNode" $
-    withTempDir tr name $ \dir -> do
+withBFTNode tr baseDir (NodeParams severity systemStart (port, peers)) action =
+    bracketTracer' tr "withBFTNode" $ do
         [vrfPrv, kesPrv, opCert] <- forM
             ["node-vrf.skey", "node-kes.skey", "node.opcert"]
             (\f -> copyFile (source </> f) (dir </> f) $> (dir </> f))
@@ -369,6 +374,7 @@ withBFTNode tr (NodeParams severity systemStart (port, peers)) action =
     source = $(getTestData) </> "cardano-node-shelley"
 
     name = "bft-node"
+    dir = baseDir </> name
 
 singleNodeParams :: Severity -> IO NodeParams
 singleNodeParams severity = do
@@ -431,23 +437,25 @@ setupStakePoolData tr name dir (NodeParams severity systemStart (port, peers)) u
 withStakePool
     :: Tracer IO ClusterLog
     -- ^ Trace for subprocess control logging
+    -> FilePath
+    -- ^ Parent state directory
     -> Int
     -- ^ Stake pool index in the cluster
     -> NodeParams
     -- ^ Configuration for the underlying node
     -> IO a
     -- ^ Action to run with the stake pool running
     -> IO a
-withStakePool tr idx params action =
+withStakePool tr baseDir idx params action =
     bracketTracer' tr "withStakePool" $
-        withTempDir tr name $ \dir -> do
-            withStaticServer dir $ \url -> do
-                (cfg, opPub, tx) <- setupStakePoolData tr dir name params url
-                withCardanoNodeProcess tr name cfg $ \_ -> do
-                    submitTx tr name tx
-                    timeout 120 ("pool registration", waitUntilRegistered tr name opPub)
-                    action
+        withStaticServer dir $ \url -> do
+            (cfg, opPub, tx) <- setupStakePoolData tr dir name params url
+            withCardanoNodeProcess tr name cfg $ \_ -> do
+                submitTx tr name tx
+                timeout 120 ("pool registration", waitUntilRegistered tr name opPub)
+                action
   where
+    dir = baseDir </> name
     name = "stake-pool-" ++ show idx
 
 withCardanoNodeProcess
@@ -974,7 +982,8 @@ blake2b256S =
 -- finished -- unless the @NO_CLEANUP@ environment variable has been set.
 withTempDir
     :: Tracer IO ClusterLog
-    -> String   -- ^ Directory name template
+    -> FilePath -- ^ Parent directory
+    -> String -- ^ Directory name template
     -> (FilePath -> IO a) -- ^ Callback that can use the directory
     -> IO a
 withTempDir tr name action = isEnvSet "NO_CLEANUP" >>= \case
@@ -991,6 +1000,15 @@ withTempDir tr name action = isEnvSet "NO_CLEANUP" >>= \case
         Just "" -> False
         Just _ -> True
 
+withSystemTempDir
+    :: Tracer IO ClusterLog
+    -> String   -- ^ Directory name template
+    -> (FilePath -> IO a) -- ^ Callback that can use the directory
+    -> IO a
+withSystemTempDir tr name action = do
+    parent <- getCanonicalTemporaryDirectory
+    withTempDir tr parent name action
+
 {-------------------------------------------------------------------------------
                                     Logging
 -------------------------------------------------------------------------------}

diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs
@@ -63,7 +63,7 @@ import Cardano.Wallet.Shelley.Compatibility
 import Cardano.Wallet.Shelley.Faucet
     ( initFaucet )
 import Cardano.Wallet.Shelley.Launch
-    ( ClusterLog, withCluster )
+    ( ClusterLog, withCluster, withTempDir, withSystemTempDir )
 import Cardano.Wallet.Shelley.Transaction
     ( _minimumFee )
 import Cardano.Wallet.Transaction
@@ -213,8 +213,9 @@ specWithServer (tr, tracers) = aroundAll withContext . after tearDown
     withServer onStart = bracketTracer' tr "withServer" $ do
         minSev <- nodeMinSeverityFromEnv
         let tr' = contramap MsgCluster tr
+        withSystemTempDir tr' "integration" $ \dir ->
         withCluster tr' minSev 3 $ \socketPath block0 (gp, vData) ->
-            withSystemTempDirectory "cardano-wallet-databases" $ \db ->
+            withTempDir tr' dir "wallets" $ \db ->
                 serveWallet @(IO Shelley)
                     (SomeNetworkDiscriminant $ Proxy @'Mainnet)
                     tracers