1
+ {-# LANGUAGE NamedFieldPuns #-}
2
+
1
3
module Testnet.Property.Run
2
4
( runTestnet
3
5
-- Ignore tests on various OSs
@@ -19,11 +21,12 @@ import Data.Bool (bool)
19
21
import Data.String (IsString (.. ))
20
22
import qualified System.Console.ANSI as ANSI
21
23
import System.Console.ANSI (Color (.. ), ColorIntensity (.. ), ConsoleLayer (.. ), SGR (.. ))
24
+ import System.Directory
22
25
import qualified System.Exit as IO
23
26
import qualified System.Info as SYS
24
27
import qualified System.IO as IO
25
28
26
- import Testnet.Property.Util (integrationWorkspace )
29
+ import Testnet.Property.Util (integration , integrationWorkspace )
27
30
import Testnet.Start.Types
28
31
29
32
import Hedgehog (Property )
@@ -35,11 +38,11 @@ import qualified Test.Tasty.Hedgehog as H
35
38
import Test.Tasty.Providers (testPassed )
36
39
import Test.Tasty.Runners (Result (resultShortDescription ), TestTree )
37
40
38
- runTestnet :: (Conf -> H. Integration a ) -> IO ()
39
- runTestnet tn = do
41
+ runTestnet :: CardanoTestnetOptions -> (Conf -> H. Integration a ) -> IO ()
42
+ runTestnet tnOpts tn = do
40
43
tvRunning <- STM. newTVarIO False
41
44
42
- void . H. check $ testnetProperty $ \ c -> do
45
+ void . H. check $ testnetProperty tnOpts $ \ c -> do
43
46
void $ tn c
44
47
H. evalIO . STM. atomically $ STM. writeTVar tvRunning True
45
48
@@ -60,17 +63,30 @@ runTestnet tn = do
60
63
IO. exitFailure
61
64
62
65
63
- testnetProperty :: (Conf -> H. Integration () ) -> H. Property
64
- testnetProperty tn = integrationWorkspace " testnet" $ \ workspaceDir -> do
65
- conf <- mkConf workspaceDir
66
-
67
- -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
68
- void . H. evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO. threadDelay 10000000
69
-
70
- void $ tn conf
71
-
72
- H. failure -- Intentional failure to force failure report
73
-
66
+ testnetProperty :: CardanoTestnetOptions -> (Conf -> H. Integration () ) -> H. Property
67
+ testnetProperty CardanoTestnetOptions {cardanoOutputDir} runTn =
68
+ case cardanoOutputDir of
69
+ Nothing -> do
70
+ integrationWorkspace " testnet" $ \ workspaceDir -> do
71
+ mkConf workspaceDir >>= forkAndRunTestnet
72
+ Just userOutputDir ->
73
+ integration $ do
74
+ absUserOutputDir <- H. evalIO $ makeAbsolute userOutputDir
75
+ dirExists <- H. evalIO $ doesDirectoryExist absUserOutputDir
76
+ (if dirExists then
77
+ -- Likely dangerous, but who are we to judge the user?
78
+ H. note_ $ " Reusing " <> absUserOutputDir
79
+ else do
80
+ liftIO $ createDirectory absUserOutputDir
81
+ H. note_ $ " Created " <> absUserOutputDir)
82
+ conf <- mkConf absUserOutputDir
83
+ forkAndRunTestnet conf
84
+ where
85
+ forkAndRunTestnet conf = do
86
+ -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
87
+ void $ H. evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO. threadDelay 10000000
88
+ void $ runTn conf
89
+ H. failure -- Intentional failure to force failure report
74
90
75
91
-- Ignore properties on various OSs
76
92
0 commit comments