Skip to content

Commit 051bd1b

Browse files
MarcFontaineMarcFontaine
committed
address feedback from review
1 parent 242c006 commit 051bd1b

File tree

11 files changed

+113
-165
lines changed

11 files changed

+113
-165
lines changed

‎cardano-node-chairman/test/Spec/Chairman/Shelley.hs

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,7 @@ module Spec.Chairman.Shelley
44
( hprop_chairman
55
) where
66

7-
import Control.Monad ((=<<))
8-
import Data.Function
9-
import Data.Functor
10-
import Data.Maybe
7+
import Prelude
118
import Spec.Chairman.Chairman (chairmanOver)
129
import System.FilePath ((</>))
1310

@@ -20,10 +17,6 @@ import qualified Test.Runtime as H
2017
import qualified Testnet.Conf as H
2118
import qualified Testnet.Shelley as H
2219

23-
{- HLINT ignore "Reduce duplication" -}
24-
{- HLINT ignore "Redundant <&>" -}
25-
{- HLINT ignore "Redundant flip" -}
26-
2720
hprop_chairman :: H.Property
2821
hprop_chairman = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsPath' -> do
2922
base <- H.note =<< H.noteIO . IO.canonicalizePath =<< H.getProjectBase

‎cardano-testnet/src/Test/Runtime.hs

Lines changed: 71 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ module Test.Runtime
1010
, StakingKeyPair(..)
1111
, TestnetRuntime(..)
1212
, NodeRuntime(..)
13-
, TestnetNode(..)
1413
, PoolNode(..)
1514
, PoolNodeKeys(..)
1615
, Delegator(..)
@@ -19,22 +18,28 @@ module Test.Runtime
1918
, poolSprockets
2019
, poolNodeStdout
2120
, readNodeLoggingFormat
21+
, startNode
2222
) where
2323

24+
import Prelude
25+
26+
import Control.Monad
2427
import Data.Aeson (FromJSON)
25-
import Data.Either (Either (..))
26-
import Data.Eq (Eq)
27-
import Data.Function (($), (.))
28-
import Data.Functor (fmap)
29-
import Data.Int (Int)
30-
import Data.Semigroup (Semigroup ((<>)))
31-
import Data.String (String)
28+
import qualified Data.List as L
29+
3230
import Data.Text (Text)
3331
import GHC.Generics (Generic)
32+
import qualified Hedgehog as H
3433
import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
35-
import System.IO (FilePath)
36-
import Text.Show (Show (..))
37-
34+
import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
35+
import qualified Hedgehog.Extras.Stock.String as S
36+
import qualified Hedgehog.Extras.Test.Base as H
37+
import qualified Hedgehog.Extras.Test.File as H
38+
import qualified Hedgehog.Extras.Test.Process as H
39+
import qualified Test.Process as H
40+
41+
import System.FilePath.Posix ((</>))
42+
import qualified System.Info as OS
3843
import qualified System.IO as IO
3944
import qualified System.Process as IO
4045

@@ -44,7 +49,7 @@ data TestnetRuntime = TestnetRuntime
4449
{ configurationFile :: FilePath
4550
, shelleyGenesisFile :: FilePath
4651
, testnetMagic :: Int
47-
, bftNodes :: [TestnetNode]
52+
, bftNodes :: [NodeRuntime]
4853
, poolNodes :: [PoolNode]
4954
, wallets :: [PaymentKeyPair]
5055
, delegators :: [Delegator]
@@ -59,8 +64,6 @@ data NodeRuntime = NodeRuntime
5964
, nodeProcessHandle :: IO.ProcessHandle
6065
}
6166

62-
newtype TestnetNode = TestnetNode {unTestnetNode :: NodeRuntime}
63-
6467
data PoolNode = PoolNode
6568
{ poolRuntime :: NodeRuntime
6669
, poolKeys :: PoolNodeKeys
@@ -99,7 +102,7 @@ poolNodeStdout :: PoolNode -> FilePath
99102
poolNodeStdout = nodeStdout . poolRuntime
100103

101104
bftSprockets :: TestnetRuntime -> [Sprocket]
102-
bftSprockets = fmap (nodeSprocket . unTestnetNode) . bftNodes
105+
bftSprockets = fmap nodeSprocket . bftNodes
103106

104107
poolSprockets :: TestnetRuntime -> [Sprocket]
105108
poolSprockets = fmap (nodeSprocket . poolRuntime) . poolNodes
@@ -111,4 +114,56 @@ readNodeLoggingFormat = \case
111114
s -> Left $ "Unrecognised node logging format: " <> show s <> ". Valid options: \"json\", \"text\""
112115

113116
allNodes :: TestnetRuntime -> [NodeRuntime]
114-
allNodes tr = fmap unTestnetNode (bftNodes tr) <> fmap poolRuntime (poolNodes tr)
117+
allNodes tr = bftNodes tr <> fmap poolRuntime (poolNodes tr)
118+
119+
-- | Start a node, creating file handles, sockets and temp-dirs.
120+
startNode
121+
:: String
122+
-- ^ The tempBaseAbsPath
123+
-> FilePath
124+
-- ^ The tempAbsPath
125+
-> FilePath
126+
-- ^ The log directory
127+
-> FilePath
128+
-- ^ The directory where the sockets are created
129+
-> String
130+
-- ^ The name of the node
131+
-> [String]
132+
-- ^ The command --socket-path and --port will be added automatically.
133+
-> H.Integration NodeRuntime
134+
startNode tempBaseAbsPath tempAbsPath logDir socketDir node nodeCmd = do
135+
dbDir <- H.noteShow $ tempAbsPath </> "db/" <> node
136+
nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log"
137+
nodeStderrFile <- H.noteTempFile logDir $ node <> ".stderr.log"
138+
sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir </> node)
139+
140+
H.createDirectoryIfMissing dbDir
141+
H.createDirectoryIfMissing $ tempBaseAbsPath </> socketDir
142+
143+
hNodeStdout <- H.openFile nodeStdoutFile IO.WriteMode
144+
hNodeStderr <- H.openFile nodeStderrFile IO.WriteMode
145+
146+
H.diff (L.length (IO.sprocketArgumentName sprocket)) (<=) IO.maxSprocketArgumentNameLength
147+
148+
portString <- fmap S.strip . H.readFile $ tempAbsPath </> node </> "port"
149+
150+
(Just stdIn, _, _, hProcess, _) <- H.createProcess
151+
. (\ cp
152+
-> cp
153+
{IO.std_in = IO.CreatePipe, IO.std_out = IO.UseHandle hNodeStdout,
154+
IO.std_err = IO.UseHandle hNodeStderr,
155+
IO.cwd = Just tempBaseAbsPath})
156+
=<<
157+
H.procNode
158+
(nodeCmd
159+
<>
160+
[ "--socket-path", IO.sprocketArgumentName sprocket
161+
, "--port", portString
162+
])
163+
164+
H.noteShowM_ $ H.getPid hProcess
165+
166+
when (OS.os `L.elem` ["darwin", "linux"]) $ do
167+
H.onFailure . H.noteIO_ $ IO.readProcess "lsof" ["-iTCP:" <> portString, "-sTCP:LISTEN", "-n", "-P"] ""
168+
169+
return $ NodeRuntime node sprocket stdIn nodeStdoutFile nodeStderrFile hProcess

‎cardano-testnet/src/Testnet.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -13,10 +13,10 @@ import Testnet.Cardano
1313
import Testnet.Conf
1414
import Testnet.Shelley
1515

16-
data TestnetOptions
17-
= ShelleyOnlyTestnetOptions ShelleyTestnetOptions
18-
| BabbageOnlyTestnetOptions BabbageTestnetOptions
19-
| CardanoOnlyTestnetOptions CardanoTestnetOptions
16+
data TestnetOptions
17+
= ShelleyOnlyTestnetOptions ShelleyTestnetOptions
18+
| BabbageOnlyTestnetOptions BabbageTestnetOptions
19+
| CardanoOnlyTestnetOptions CardanoTestnetOptions
2020
deriving (Eq, Show)
2121

2222
testnet :: TestnetOptions -> Conf -> H.Integration TestnetRuntime

‎cardano-testnet/src/Testnet/Babbage.hs

Lines changed: 5 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -14,31 +14,20 @@ module Testnet.Babbage
1414
, defaultTestnetNodeOptions
1515

1616
, TestnetRuntime (..)
17-
, TestnetNode (..)
1817
, PaymentKeyPair(..)
1918

2019
, babbageTestnet
2120
) where
2221

23-
import Control.Applicative (Applicative (..))
22+
import Prelude
2423
import Control.Monad
2524
import Data.Aeson (encode, object, toJSON, (.=))
26-
import Data.Bool (Bool (..))
27-
import Data.Eq (Eq)
28-
import Data.Function (flip, ($), (.))
29-
import Data.Functor
30-
import Data.Int (Int)
31-
import Data.Semigroup (Semigroup ((<>)))
32-
import Data.String (String)
33-
import GHC.Float (Double)
3425
import Hedgehog.Extras.Stock.Time (showUTCTimeSeconds)
3526
import System.FilePath.Posix ((</>))
3627

3728
import Test.Runtime (Delegator (..), NodeLoggingFormat (..), PaymentKeyPair (..),
38-
PoolNode (PoolNode), PoolNodeKeys (..), StakingKeyPair (..), TestnetNode (..),
39-
TestnetRuntime (..))
40-
import Testnet.Utils
41-
import Text.Show (Show (show))
29+
PoolNode (PoolNode), PoolNodeKeys (..), StakingKeyPair (..),
30+
TestnetRuntime (..), startNode)
4231

4332
import qualified Data.HashMap.Lazy as HM
4433
import qualified Data.List as L
@@ -52,11 +41,8 @@ import qualified Test.Assert as H
5241
import qualified Testnet.Conf as H
5342

5443
import Test.Process (execCli_)
55-
{- HLINT ignore "Reduce duplication" -}
56-
{- HLINT ignore "Redundant <&>" -}
44+
5745
{- HLINT ignore "Redundant flip" -}
58-
{- HLINT ignore "Redundant id" -}
59-
{- HLINT ignore "Use let" -}
6046

6147
data BabbageTestnetOptions = BabbageTestnetOptions
6248
{ numSpoNodes :: Int
@@ -334,7 +320,7 @@ babbageTestnet testnetOptions H.Conf {..} = do
334320
]
335321

336322
poolNodes <- forM (L.zip spoNodes poolKeys) $ \(node,key) -> do
337-
runtime <- startNode socketDir tempBaseAbsPath tempAbsPath logDir node
323+
runtime <- startNode tempBaseAbsPath tempAbsPath logDir socketDir node
338324
[ "run"
339325
, "--config", tempAbsPath </> "configuration.yaml"
340326
, "--topology", tempAbsPath </> node </> "topology.json"

‎cardano-testnet/src/Testnet/Cardano.hs

Lines changed: 6 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -12,44 +12,29 @@ module Testnet.Cardano
1212

1313
, Era(..)
1414
, TestnetRuntime (..)
15-
, TestnetNode (..)
1615
, PaymentKeyPair(..)
1716

1817
, cardanoTestnet
1918
) where
2019

21-
import Control.Applicative (pure)
20+
import Prelude
2221
import Control.Monad
2322
import Control.Monad.IO.Class (liftIO)
2423
import Data.Aeson ((.=))
25-
import Data.Bool (Bool (..))
2624
import Data.ByteString.Lazy (ByteString)
27-
import Data.Eq (Eq (..))
28-
import Data.Function (flip, id, ($), (.))
29-
import Data.Functor
30-
import Data.Int (Int)
3125
import Data.List ((\\))
32-
import Data.Maybe (fromJust)
33-
import Data.Semigroup (Semigroup ((<>)))
34-
import Data.String (IsString (fromString), String)
35-
import GHC.Enum (Bounded, Enum)
36-
import GHC.Float (Double)
37-
import GHC.Num (Num ((+), (-)))
38-
import GHC.Real (Integral (div), fromIntegral)
26+
import Data.Maybe
27+
import Data.String
3928
import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
4029
import Hedgehog.Extras.Stock.Time (formatIso8601, showUTCTimeSeconds)
4130
import Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
4231
import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
4332
import System.FilePath.Posix ((</>))
4433
import Test.Runtime as TR (NodeLoggingFormat (..), PaymentKeyPair (..), PoolNode (PoolNode),
45-
PoolNodeKeys (..), TestnetNode (..), TestnetRuntime (..))
46-
import Text.Read (Read)
47-
import Text.Show (Show (show))
34+
PoolNodeKeys (..), TestnetRuntime (..), startNode)
4835

4936
import Test.Process (execCli_)
5037

51-
import Testnet.Utils
52-
5338
import qualified Cardano.Node.Configuration.Topology as NonP2P
5439
import qualified Cardano.Node.Configuration.TopologyP2P as P2P
5540
import qualified Data.Aeson as J
@@ -72,8 +57,6 @@ import qualified Test.Assert as H
7257
import qualified Test.Process as H
7358
import qualified Testnet.Conf as H
7459

75-
{- HLINT ignore "Reduce duplication" -}
76-
{- HLINT ignore "Redundant <&>" -}
7760
{- HLINT ignore "Redundant flip" -}
7861
{- HLINT ignore "Redundant id" -}
7962
{- HLINT ignore "Use let" -}
@@ -728,7 +711,7 @@ cardanoTestnet testnetOptions H.Conf {..} = do
728711

729712
let bftNodeNameAndOpts = L.zip bftNodeNames (bftNodeOptions testnetOptions)
730713
bftNodes <- forM bftNodeNameAndOpts $ \(node, nodeOpts) -> do
731-
runtime <- startNode socketDir tempBaseAbsPath tempAbsPath logDir node
714+
startNode tempBaseAbsPath tempAbsPath logDir socketDir node
732715
([ "run"
733716
, "--config", tempAbsPath </> "configuration.yaml"
734717
, "--topology", tempAbsPath </> node </> "topology.json"
@@ -739,12 +722,11 @@ cardanoTestnet testnetOptions H.Conf {..} = do
739722
, "--delegation-certificate", tempAbsPath </> node </> "byron/delegate.cert"
740723
, "--signing-key", tempAbsPath </> node </> "byron/delegate.key"
741724
] <> extraNodeCliArgs nodeOpts)
742-
return $ TestnetNode runtime
743725

744726
H.threadDelay 100000
745727

746728
poolNodes <- forM (L.zip poolNodeNames poolKeys) $ \(node, key) -> do
747-
runtime <- startNode socketDir tempBaseAbsPath tempAbsPath logDir node
729+
runtime <- startNode tempBaseAbsPath tempAbsPath logDir socketDir node
748730
[ "run"
749731
, "--config", tempAbsPath </> "configuration.yaml"
750732
, "--topology", tempAbsPath </> node </> "topology.json"

‎cardano-testnet/src/Testnet/Shelley.hs

Lines changed: 4 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -12,32 +12,24 @@ module Testnet.Shelley
1212
, hprop_testnet_pause
1313
) where
1414

15+
import Prelude
1516
import Control.Monad
1617
import Control.Monad.IO.Class (MonadIO(liftIO))
1718
import Control.Monad.Trans.Resource (MonadResource(liftResourceT), resourceForkIO)
1819
import Data.Aeson (Value, ToJSON(toJSON))
1920
import Data.ByteString.Lazy (ByteString)
20-
import Data.Eq (Eq)
21-
import Data.Function (($), (.), flip)
2221
import Data.Functor
23-
import Data.Int (Int)
2422
import Data.List ((\\))
2523
import Data.Maybe
26-
import Data.Semigroup (Semigroup((<>)))
27-
import Data.String (String, fromString)
24+
import Data.String
2825
import Data.Time.Clock (UTCTime)
29-
import GHC.Float (Double)
30-
import GHC.Real (fromIntegral)
3126
import Hedgehog.Extras.Stock.Aeson (rewriteObject)
3227
import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket(..))
3328
import Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter(..))
3429
import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint(..))
35-
import Prelude (Bool(..), Integer, (-))
3630
import System.FilePath.Posix ((</>))
37-
import Text.Show (Show(show))
3831
import Test.Process (execCli_)
3932
import Test.Runtime hiding (allNodes)
40-
import Testnet.Utils
4133

4234
import qualified Cardano.Node.Configuration.Topology as NonP2P
4335
import qualified Cardano.Node.Configuration.TopologyP2P as P2P
@@ -64,7 +56,6 @@ import qualified Test.Base as H
6456
import qualified Test.Process as H
6557
import qualified Testnet.Conf as H
6658

67-
{- HLINT ignore "Reduce duplication" -}
6859
{- HLINT ignore "Redundant <&>" -}
6960
{- HLINT ignore "Redundant flip" -}
7061

@@ -407,8 +398,8 @@ shelleyTestnet testnetOptions H.Conf {..} = do
407398
<&> L.unlines . fmap (rewriteConfiguration (enableP2P testnetOptions)) . L.lines
408399
>>= H.writeFile (tempAbsPath </> "configuration.yaml")
409400

410-
allNodeRuntimes <- forM allNodes $ \node -> do
411-
runtime <- startNode socketDir tempBaseAbsPath tempAbsPath logDir node
401+
allNodeRuntimes <- forM allNodes
402+
$ \node -> startNode tempBaseAbsPath tempAbsPath logDir socketDir node
412403
[ "run"
413404
, "--config", tempAbsPath </> "configuration.yaml"
414405
, "--topology", tempAbsPath </> node </> "topology.json"
@@ -418,7 +409,6 @@ shelleyTestnet testnetOptions H.Conf {..} = do
418409
, "--shelley-operational-certificate" , tempAbsPath </> node </> "node.cert"
419410
, "--host-addr", ifaceAddress
420411
]
421-
return $ TestnetNode runtime
422412

423413
now <- H.noteShowIO DTC.getCurrentTime
424414
deadline <- H.noteShow $ DTC.addUTCTime 90 now

0 commit comments

Comments
 (0)