[tx-generator] Add --testnet-config-dir flag to json_highlevel

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"
     )

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

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