From ed635811b8aebf1cf385dd93d92ea9965ca32138 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 24 Apr 2026 03:19:43 +0200 Subject: [PATCH 1/3] Implement `--testnet-config-dir` for `tx-generator json_highlevel` Add a `--testnet-config-dir` flag that auto-discovers the 4 infrastructure parameters (socket path, signing key, node config file, target nodes) from a `cardano-testnet` output directory. Discovered infrastructure always overrides user-provided values; all other config fields must be supplied by the user. --- .../src/Cardano/Benchmarking/Command.hs | 20 ++- .../TxGenerator/Setup/TestnetDiscovery.hs | 130 ++++++++++++++++++ bench/tx-generator/tx-generator.cabal | 2 + 3 files changed, 148 insertions(+), 4 deletions(-) create mode 100644 bench/tx-generator/src/Cardano/TxGenerator/Setup/TestnetDiscovery.hs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index e1a8bdb1781..4a25410d235 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -28,6 +28,7 @@ import Cardano.Benchmarking.Script.Selftest (runSelftest) import Cardano.Benchmarking.Version as Version import Cardano.TxGenerator.PlutusContext (readScriptData) import Cardano.TxGenerator.Setup.NixService +import Cardano.TxGenerator.Setup.TestnetDiscovery (TestnetConfig (..), discoverTestnetConfig) import Cardano.TxGenerator.Types (TxGenPlutusParams (..)) import Data.Aeson (fromJSON) import Data.ByteString.Lazy as BSL @@ -75,7 +76,7 @@ deriving instance Show SignalSpecificInfo data Command = Json FilePath - | JsonHL FilePath (Maybe FilePath) (Maybe FilePath) + | JsonHL FilePath (Maybe TestnetConfig) (Maybe FilePath) (Maybe FilePath) | Compile FilePath | Selftest (Maybe FilePath) | VersionCmd @@ -93,8 +94,12 @@ runCommand' iocp = do Json actionFile -> do script <- parseScriptFileAeson actionFile runScript emptyEnv script envConsts >>= handleError . fst - JsonHL nixSvcOptsFile nodeConfigOverwrite cardanoTracerOverwrite -> do - opts <- parseJSONFile fromJSON nixSvcOptsFile + JsonHL configFile maybeTestnetConfig nodeConfigOverwrite cardanoTracerOverwrite -> do + opts <- case maybeTestnetConfig of + Nothing -> parseJSONFile fromJSON configFile + Just tc -> do + userConfig <- parseJSONFile pure configFile + discoverTestnetConfig tc userConfig finalOpts <- mangleTracerConfig cardanoTracerOverwrite <$> mangleNodeConfig nodeConfigOverwrite opts let consts = envConsts { LogTypes.envNixSvcOpts = Just finalOpts } @@ -231,8 +236,15 @@ commandParser jsonHLCmd :: Parser Command jsonHLCmd = JsonHL <$> filePath "benchmarking options" + <*> optional testnetConfigOpt <*> nodeConfigOpt <*> tracerConfigOpt + + testnetConfigOpt :: Parser TestnetConfig + testnetConfigOpt = TestnetConfig + <$> strOption (long "testnet-config-dir" <> metavar "DIR" + <> help "cardano-testnet output directory; discovered infrastructure overrides config file") + compileCmd :: Parser Command compileCmd = Compile <$> filePath "benchmarking options" @@ -242,7 +254,7 @@ commandParser nodeConfigOpt = option (Just <$> str) ( long "nodeConfig" <> short 'n' - <> metavar "FILENAME" + <> metavar "FILEPATH" <> value Nothing <> help "the node configfile" ) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/TestnetDiscovery.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/TestnetDiscovery.hs new file mode 100644 index 00000000000..9c1f80fbfc4 --- /dev/null +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/TestnetDiscovery.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.TxGenerator.Setup.TestnetDiscovery + ( TestnetConfig (..) + , discoverTestnetConfig + ) where + +import Cardano.Node.Configuration.NodeAddress (NodeAddress' (..), NodeHostIPv4Address (..), + NodeIPv4Address) +import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultNodeDataDir, defaultNodeName, + defaultPortFile, defaultSocketPath, defaultUtxoSKeyPath) +import Cardano.TxGenerator.Setup.NixService (NixServiceOptions, NodeDescription (..)) + +import Cardano.Prelude ( unless, sort ) +import Data.Aeson ((.=), object) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KeyMap +import Data.Char (isDigit) +import Data.List (isPrefixOf) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (mapMaybe) +import Network.Socket (PortNumber) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) +import System.Exit (die) +import System.FilePath ((), takeDirectory) +import Text.Read (readMaybe) + +-- | Location of a @cardano-testnet@ output directory. +newtype TestnetConfig = TestnetConfig + { tcDir :: FilePath + } deriving (Show, Eq) + + +-- | Discover testnet infrastructure from a @cardano-testnet@ output directory +-- and merge it with user-provided JSON config. +-- +-- The 4 infrastructure fields (@localNodeSocketPath@, @sigKey@, +-- @nodeConfigFile@, @targetNodes@) are always populated from the testnet +-- directory and override any values in the user config. All other fields +-- must be supplied by the user. +discoverTestnetConfig :: TestnetConfig -> Aeson.Value -> IO NixServiceOptions +discoverTestnetConfig TestnetConfig{tcDir} userConfig = do + dirExists <- doesDirectoryExist tcDir + unless dirExists $ die $ "Testnet directory does not exist: " ++ tcDir + + targetNodes <- discoverNodes tcDir + let socketPath = tcDir defaultSocketPath 1 + sigKeyPath = tcDir defaultUtxoSKeyPath 1 + configPath = tcDir defaultConfigFile + + validateFileExists socketPath "socket" + validateFileExists sigKeyPath "signing key" + validateFileExists configPath "configuration" + + let infraJson = object + [ "localNodeSocketPath" .= socketPath + , "sigKey" .= sigKeyPath + , "nodeConfigFile" .= configPath + , "targetNodes" .= targetNodes + ] + + let merged = mergeValues userConfig infraJson + + case Aeson.fromJSON merged of + Aeson.Success opts -> pure opts + Aeson.Error err -> die $ "Failed to parse merged config: " ++ err + + +-- | Discover nodes by scanning for port files in the testnet directory. +-- cardano-testnet always starts nodes on localhost (see testnetDefaultIpv4Address +-- in Testnet.Types). If remote/container support is added in the future, +-- cardano-testnet should write node addresses to a metadata file. +discoverNodes :: FilePath -> IO (NonEmpty NodeDescription) +discoverNodes dir = do + let nodeDataDir = dir takeDirectory (defaultNodeDataDir 1) + exists <- doesDirectoryExist nodeDataDir + if not exists + then die $ "Node data directory does not exist: " ++ nodeDataDir + else do + entries <- listDirectory nodeDataDir + let nodeIndices = sort $ mapMaybe parseNodeIndex entries + nodes <- mapM (readNodeDescription dir) nodeIndices + case nodes of + [] -> die $ "No nodes found in: " ++ nodeDataDir + (n:ns) -> pure (n :| ns) + + +-- | Parse a node index from a directory name like "node1", "node2", etc. +parseNodeIndex :: String -> Maybe Int +parseNodeIndex name + | "node" `isPrefixOf` name = readMaybe (dropWhile (not . isDigit) name) + | otherwise = Nothing + + +-- | Read a node description from its port file. +readNodeDescription :: FilePath -> Int -> IO NodeDescription +readNodeDescription dir idx = do + let portPath = dir defaultPortFile idx + validateFileExists portPath ("port file for " ++ defaultNodeName idx) + portStr <- readFile portPath + case readMaybe portStr :: Maybe PortNumber of + Nothing -> die $ "Invalid port number in: " ++ portPath + Just port -> pure NodeDescription + { ndAddr = mkLocalhostAddr port + , ndName = defaultNodeName idx + } + +-- | Create a localhost NodeIPv4Address at the given port. +mkLocalhostAddr :: PortNumber -> NodeIPv4Address +mkLocalhostAddr port = NodeAddress + { naHostAddress = NodeHostIPv4Address + { unNodeHostIPv4Address = read "127.0.0.1" } + , naPort = port + } + + +-- | Deep merge two JSON values. Objects are merged recursively; +-- for all other types the override wins. +mergeValues :: Aeson.Value -> Aeson.Value -> Aeson.Value +mergeValues (Aeson.Object base) (Aeson.Object override) = + Aeson.Object (KeyMap.unionWith mergeValues base override) +mergeValues _ override = override + + +-- | Validate that a file exists, dying with a clear message if not. +validateFileExists :: FilePath -> String -> IO () +validateFileExists path description = do + exists <- doesFileExist path + unless exists $ die $ "Required " ++ description ++ " file not found: " ++ path diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 55757052548..cc6ee391ddf 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -86,6 +86,7 @@ library Cardano.TxGenerator.Script.Types Cardano.TxGenerator.Setup.NixService Cardano.TxGenerator.Setup.NodeConfig + Cardano.TxGenerator.Setup.TestnetDiscovery Cardano.TxGenerator.Setup.Plutus Cardano.TxGenerator.PlutusContext Cardano.TxGenerator.Setup.SigningKey @@ -127,6 +128,7 @@ library , cborg >= 0.2.2 && < 0.3 , containers , constraints-extras + , directory , dlist , extra , filepath From be656091a28e53c25d2b4b2612ea1499dbb31eba Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 24 Apr 2026 03:20:31 +0200 Subject: [PATCH 2/3] Add round-trip test for `discoverTestnetConfig` JSON serialisation --- bench/tx-generator/test/Main.hs | 2 + .../tx-generator/test/TestnetDiscoveryTest.hs | 117 ++++++++++++++++++ bench/tx-generator/tx-generator.cabal | 9 ++ 3 files changed, 128 insertions(+) create mode 100644 bench/tx-generator/test/TestnetDiscoveryTest.hs diff --git a/bench/tx-generator/test/Main.hs b/bench/tx-generator/test/Main.hs index 73fde7371f7..d387d1f2d07 100644 --- a/bench/tx-generator/test/Main.hs +++ b/bench/tx-generator/test/Main.hs @@ -8,6 +8,7 @@ import Test.Tasty import Test.Tasty.HUnit import Cardano.Benchmarking.GeneratorTx.SizedMetadata +import TestnetDiscoveryTest (testnetDiscoveryTests) main :: IO () main = defaultMain tests @@ -16,6 +17,7 @@ tests :: TestTree tests = testGroup "cardano-tx-generator" [ sizedMetadata + , testnetDiscoveryTests ] sizedMetadata :: TestTree diff --git a/bench/tx-generator/test/TestnetDiscoveryTest.hs b/bench/tx-generator/test/TestnetDiscoveryTest.hs new file mode 100644 index 00000000000..45740029b54 --- /dev/null +++ b/bench/tx-generator/test/TestnetDiscoveryTest.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-all-missed-specialisations #-} + +module TestnetDiscoveryTest + ( testnetDiscoveryTests + ) where + +import Prelude + +import Data.Aeson (Value (..), (.=), encode, fromJSON, object, toJSON) +import Data.Aeson.Types (Result (..)) +import Data.ByteString.Lazy as LBS (writeFile) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory, ()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Tasty +import Test.Tasty.HUnit + +import Cardano.Api (AnyCardanoEra (..), CardanoEra (..)) +import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultPortFile, + defaultSocketPath, defaultUtxoSKeyPath) +import Cardano.TxGenerator.Setup.NixService (NixServiceOptions (..)) +import Cardano.TxGenerator.Setup.TestnetDiscovery (TestnetConfig (..), + discoverTestnetConfig) + + +testnetDiscoveryTests :: TestTree +testnetDiscoveryTests = testGroup "TestnetDiscovery" + [ testCase "round-trip: JSON serialization" roundTripTest + ] + + +-- | A complete user config that provides all required non-infra fields. +completeUserConfig :: Value +completeUserConfig = object + [ "debugMode" .= False + , "era" .= AnyCardanoEra ConwayEra + , "tps" .= (10 :: Int) + , "tx_count" .= (100 :: Int) + , "inputs_per_tx" .= (2 :: Int) + , "outputs_per_tx" .= (2 :: Int) + , "tx_fee" .= (212345 :: Int) + , "min_utxo_value" .= (1000000 :: Int) + , "add_tx_size" .= (39 :: Int) + , "init_cooldown" .= (50 :: Double) + ] + + +-- | Verify that the discovered NixServiceOptions survives a JSON round-trip. +roundTripTest :: Assertion +roundTripTest = withMockTestnet $ \tmpDir -> do + opts <- discover tmpDir completeUserConfig + let json = toJSON opts + case fromJSON json of + Error err -> assertFailure $ "JSON round-trip failed: " ++ err ++ "\nJSON: " ++ show json + Success opts' -> opts @?= opts' + + +-- Helpers + +withMockTestnet :: (FilePath -> IO a) -> IO a +withMockTestnet action = withSystemTempDirectory "mock-testnet" $ \dir -> do + setupMockTestnetDir dir + action dir + +discover :: FilePath -> Value -> IO NixServiceOptions +discover dir = discoverTestnetConfig TestnetConfig { tcDir = dir } + + +-- | Set up a minimal mock testnet directory with all files that discoverTestnetConfig expects. +setupMockTestnetDir :: FilePath -> IO () +setupMockTestnetDir dir = do + mapM_ (setupNodeDir dir) [1..3] + + let socketPath = dir defaultSocketPath 1 + createDirectoryIfMissing True (takeDirectory socketPath) + Prelude.writeFile socketPath "" + + let sigKeyPath = dir defaultUtxoSKeyPath 1 + createDirectoryIfMissing True (takeDirectory sigKeyPath) + Prelude.writeFile sigKeyPath "{}" + + let configPath = dir defaultConfigFile + LBS.writeFile configPath $ encode minimalTestnetConfig + + +-- | Create a node data directory with a port file. +setupNodeDir :: FilePath -> Int -> IO () +setupNodeDir dir idx = do + let portPath = dir defaultPortFile idx + createDirectoryIfMissing True (takeDirectory portPath) + Prelude.writeFile portPath (show (30000 + idx)) + + +-- | Minimal configuration.yaml that will allow node-config parsing. +minimalTestnetConfig :: Value +minimalTestnetConfig = object + [ "Protocol" .= ("Cardano" :: String) + , "LastKnownBlockVersion-Major" .= (9 :: Int) + , "LastKnownBlockVersion-Minor" .= (0 :: Int) + , "LastKnownBlockVersion-Alt" .= (0 :: Int) + , "ByronGenesisFile" .= ("byron-genesis.json" :: String) + , "ShelleyGenesisFile" .= ("shelley-genesis.json" :: String) + , "AlonzoGenesisFile" .= ("alonzo-genesis.json" :: String) + , "ConwayGenesisFile" .= ("conway-genesis.json" :: String) + , "DijkstraGenesisFile" .= ("dijkstra-genesis.json" :: String) + , "RequiresNetworkMagic" .= ("RequiresMagic" :: String) + , "ExperimentalHardForksEnabled" .= True + , "ExperimentalProtocolsEnabled" .= True + , "TestShelleyHardForkAtEpoch" .= (0 :: Int) + , "TestAllegraHardForkAtEpoch" .= (0 :: Int) + , "TestMaryHardForkAtEpoch" .= (0 :: Int) + , "TestAlonzoHardForkAtEpoch" .= (0 :: Int) + , "TestBabbageHardForkAtEpoch" .= (0 :: Int) + , "TestConwayHardForkAtEpoch" .= (0 :: Int) + ] diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index cc6ee391ddf..04dc533c80e 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -252,10 +252,19 @@ test-suite tx-generator-test type: exitcode-stdio-1.0 build-depends: base + , aeson + , bytestring + , cardano-api + , cardano-node + , directory + , filepath , tasty , tasty-hunit + , temporary , tx-generator + other-modules: TestnetDiscoveryTest + ghc-options: -Weverything -fno-warn-missing-import-lists -fno-warn-safe From 0154393a1fb2670fb27e2887e7b1841de9f5b413 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 24 Apr 2026 03:20:59 +0200 Subject: [PATCH 3/3] Test that infrastructure fields always override user config --- .../tx-generator/test/TestnetDiscoveryTest.hs | 172 +++++++++++++++++- bench/tx-generator/tx-generator.cabal | 3 + 2 files changed, 173 insertions(+), 2 deletions(-) diff --git a/bench/tx-generator/test/TestnetDiscoveryTest.hs b/bench/tx-generator/test/TestnetDiscoveryTest.hs index 45740029b54..71155017394 100644 --- a/bench/tx-generator/test/TestnetDiscoveryTest.hs +++ b/bench/tx-generator/test/TestnetDiscoveryTest.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} @@ -8,14 +9,25 @@ module TestnetDiscoveryTest import Prelude -import Data.Aeson (Value (..), (.=), encode, fromJSON, object, toJSON) -import Data.Aeson.Types (Result (..)) +import Control.Exception (bracket, evaluate, try, SomeException) +import Data.Aeson (FromJSON, Value (..), (.=), (.:), encode, fromJSON, object, toJSON, + withObject) +import Data.Aeson.KeyMap qualified as KM (member) +import Data.Aeson.Key (Key, fromString) +import Data.Aeson.Types (Result (..), parseMaybe) import Data.ByteString.Lazy as LBS (writeFile) +import Data.Either (isLeft) +import Data.List (isSuffixOf) +import Data.Monoid.Extra (mwhen) +import GHC.IO.Handle (hDuplicate, hDuplicateTo) import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory, ()) +import System.IO (IOMode (..), hClose, openFile, stderr) import System.IO.Temp (withSystemTempDirectory) import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.QuickCheck (testProperty) +import Test.QuickCheck hiding (Success, expectFailure) import Cardano.Api (AnyCardanoEra (..), CardanoEra (..)) import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultPortFile, @@ -23,11 +35,14 @@ import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultPortFile, import Cardano.TxGenerator.Setup.NixService (NixServiceOptions (..)) import Cardano.TxGenerator.Setup.TestnetDiscovery (TestnetConfig (..), discoverTestnetConfig) +import Cardano.Node.Configuration.NodeAddress (unFile) +import Data.Maybe (fromMaybe) testnetDiscoveryTests :: TestTree testnetDiscoveryTests = testGroup "TestnetDiscovery" [ testCase "round-trip: JSON serialization" roundTripTest + , testProperty "infra fields always override user config" prop_infraOverride ] @@ -57,8 +72,161 @@ roundTripTest = withMockTestnet $ \tmpDir -> do Success opts' -> opts @?= opts' +-- Property test -- + +-- | Non-infra required field names. +requiredFieldNames :: [String] +requiredFieldNames = [ "debugMode", "era", "inputs_per_tx", "outputs_per_tx" + , "tx_fee", "min_utxo_value", "add_tx_size", "init_cooldown" + , "tps", "tx_count" ] + +-- | Required keys for NixServiceOptions parsing to succeed (non-infra only). +requiredKeys :: [Key] +requiredKeys = map fromString requiredFieldNames + + +-- | Generate a user config JSON with a biased random subset of required fields, +-- and optionally with user-provided infra fields that should be overridden. +genUserConfig :: Gen Value +genUserConfig = do + tpsVal <- choose (1 :: Int, 1000) + txCountVal <- choose (1 :: Int, 10000) + socketVal <- ("/test/socket/" ++) . show <$> choose (1 :: Int, 100) + keepaliveVal <- oneof [pure Nothing, Just <$> choose (1 :: Integer, 120)] + includeInfra <- arbitrary + + included <- frequency + [ (70, pure requiredFieldNames) + , (30, randomSubset requiredFieldNames) + ] + + let has :: String -> Bool + has n = n `elem` included + + let allFields :: [(String, Value)] + allFields = + [ ("debugMode", toJSON False) + , ("era", toJSON (AnyCardanoEra ConwayEra)) + , ("tps", toJSON tpsVal) + , ("tx_count", toJSON txCountVal) + , ("inputs_per_tx", toJSON (2 :: Int)) + , ("outputs_per_tx", toJSON (2 :: Int)) + , ("tx_fee", toJSON (212345 :: Int)) + , ("min_utxo_value", toJSON (1000000 :: Int)) + , ("add_tx_size", toJSON (39 :: Int)) + , ("init_cooldown", toJSON (50 :: Double)) + ] + + pure $ object + $ [ fromString k .= v | (k, v) <- allFields, has k ] + ++ [ "keepalive" .= v | Just v <- [keepaliveVal] ] + ++ [ "localNodeSocketPath" .= socketVal | includeInfra ] + + +-- | Pick a uniformly random number of elements from a list. +randomSubset :: [a] -> Gen [a] +randomSubset xs = do + n <- choose (0, length xs) + take n <$> shuffle xs + + +-- | Predict whether 'discoverTestnetConfig' will fail: all required +-- non-infra fields must be present in the user config. +expectFailure :: Value -> Bool +expectFailure (Object obj) = not $ all (`KM.member` obj) requiredKeys +expectFailure _ = True + + +-- | Extract a field from a JSON 'Value', returning 'Nothing' if absent. +jsonField :: FromJSON a => Key -> Value -> Maybe a +jsonField k = parseMaybe (withObject "config" (.: k)) + + +-- | Property: infrastructure fields always come from the testnet directory +-- regardless of what the user supplies; non-infra fields come from the user +-- config; missing required non-infra fields cause failure. +prop_infraOverride :: Property +prop_infraOverride = + forAll genUserConfig $ \userConfig -> + let fails = expectFailure userConfig + hasUserSocket = case jsonField "localNodeSocketPath" userConfig :: Maybe String of + Just _ -> True + Nothing -> False + in + cover 30 (not fails) "success" $ + cover 5 fails "failure (missing required)" $ + cover 5 (hasUserSocket && not fails) "user provides infra (should be overridden)" $ + ioProperty $ withMockTestnet $ \tmpDir -> do + let tryDiscover :: IO (Either SomeException NixServiceOptions) + tryDiscover = try (evaluate =<< discover tmpDir userConfig) + result <- if fails then withSilentStderr tryDiscover else tryDiscover + + pure $ conjoin + [ + counterexample + ("outcome: expected " ++ (if fails then "failure" else "success") + ++ ", got " ++ either (\e -> "failure (" ++ show e ++ ")") (const "success") result) + $ property (isLeft result == fails) + + , case result of + Left _ -> property fails + Right opts -> + let expectedTps :: Double + expectedTps = case jsonField "tps" userConfig :: Maybe Int of + Just v -> fromIntegral v + Nothing -> error "unreachable: expectFailure guards this" + + expectedTxCount :: Int + expectedTxCount = case jsonField "tx_count" userConfig :: Maybe Int of + Just v -> v + Nothing -> error "unreachable: expectFailure guards this" + + expectedKeepalive :: Maybe Integer + expectedKeepalive = jsonField "keepalive" userConfig + + in conjoin + [ assertSuffix "sigKey from discovery:" + (defaultUtxoSKeyPath 1) + (unFile (_nix_sigKey opts)) + , assertSuffix "socket path from discovery:" + (defaultSocketPath 1) + (_nix_localNodeSocketPath opts) + , assertSuffix "nodeConfigFile from discovery:" + defaultConfigFile + (fromMaybe "" (_nix_nodeConfigFile opts)) + , _nix_tps opts === expectedTps + , _nix_tx_count opts === expectedTxCount + , _nix_keepalive opts === expectedKeepalive + ] + ] + where + assertSuffix :: String -> String -> String -> Property + assertSuffix preface expectedSuffix actual = + if expectedSuffix `isSuffixOf` actual + then property True + else counterexample (munless (null preface) (preface ++ "\n") ++ + "expected string with suffix: " ++ show expectedSuffix ++ "\n but got: " ++ show actual) $ property False + where + munless :: Monoid m => Bool -> m -> m + munless b = mwhen (not b) + + -- Helpers +-- | Run an IO action with stderr silenced. +withSilentStderr :: IO a -> IO a +withSilentStderr action = bracket acquire release (const action) + where + acquire = do + saved <- hDuplicate stderr + devNull <- openFile "/dev/null" WriteMode + hDuplicateTo devNull stderr + pure (saved, devNull) + release (saved, devNull) = do + hDuplicateTo saved stderr + hClose saved + hClose devNull + withMockTestnet :: (FilePath -> IO a) -> IO a withMockTestnet action = withSystemTempDirectory "mock-testnet" $ \dir -> do setupMockTestnetDir dir diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 04dc533c80e..32600930f5a 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -257,9 +257,12 @@ test-suite tx-generator-test , cardano-api , cardano-node , directory + , extra , filepath + , QuickCheck , tasty , tasty-hunit + , tasty-quickcheck , temporary , tx-generator