diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs index cf6df4feb6c..f4a2cb33657 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs @@ -123,8 +123,10 @@ walletBenchmark = liftIO $ do traceDebug "******* Tx generator, phase 2: pay to recipients *******" - remoteAddresses <- forM targets (\(NodeDescription {..}) -> secondM lookupNodeAddress (ndName, NodeAddress { naHostAddress = NodeHostIPv4Address ndAddr, naPort = toEnum ndPort })) let numTargets :: Natural = fromIntegral $ NE.length targets + lookupTarget :: NodeDescription -> IO (String, AddrInfo) + lookupTarget NodeDescription {..} = secondM lookupNodeAddress (ndName, ndAddr) + remoteAddresses <- forM targets lookupTarget traceDebug $ "******* Tx generator, launching Tx peers: " ++ show (NE.length remoteAddresses) ++ " of them" diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs index 0ace51b37cd..759666ae205 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs @@ -12,7 +12,6 @@ module Cardano.TxGenerator.Setup.NixService , NodeDescription (..) , getKeepaliveTimeout , getNodeAlias - , setNodeAlias , getNodeConfigFile , setNodeConfigFile , txGenTxParams @@ -25,6 +24,7 @@ import Cardano.Api (AnyCardanoEra, mapFile) import Cardano.CLI.Types.Common (FileDirection (..), SigningKeyFile) import qualified Cardano.Ledger.Coin as L +import Cardano.Node.Configuration.NodeAddress (NodeAddress' (..), NodeHostIPv4Address (..), NodeIPv4Address) import Cardano.Node.Types (AdjustFilePaths (..)) import Cardano.TxGenerator.Internal.Orphans () import Cardano.TxGenerator.Types @@ -32,8 +32,8 @@ import Cardano.TxGenerator.Types import Data.Aeson as Aeson import Data.Aeson.Types as Aeson import Data.Foldable (find) -import Data.IP as IP -import Data.List.NonEmpty (NonEmpty (..), partition) +import Data.Function (on) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import qualified Data.Time.Clock as Clock (DiffTime, secondsToDiffTime) import GHC.Generics (Generic) @@ -64,24 +64,31 @@ deriving instance Generic NixServiceOptions -- only works on JSON Object types data NodeDescription = NodeDescription { - ndAddr :: IPv4 + -- NodeIPAddress would be agnostic to IPv4 vs. IPv6 and likely + -- a small investment here. + ndAddr :: NodeIPv4Address , ndName :: String - , ndPort :: Int } deriving (Eq, Show, Generic) -- { "alias": "foo", "addr": ..., "port": ... } instance FromJSON NodeDescription where parseJSON = withObject "NodeDescription" \v -> do - ndAddr <- v .: "addr" Key "addr" - ndPort <- v .: "port" Key "port" - ndName <- v .:? "name" Key "name" .!= show ndAddr + unNodeHostIPv4Address + <- v .: "addr" Key "addr" + naPort <- fmap toEnum $ + v .: "port" Key "port" + let naHostAddress = NodeHostIPv4Address {..} + ndAddr = NodeAddress {..} + ndName <- v .:? "name" Key "name" .!= show ndAddr pure $ NodeDescription {..} instance ToJSON NodeDescription where toJSON NodeDescription {..} = object [ "name" .= ndName - , "addr" .= ndAddr - , "port" .= ndPort ] + , "addr" .= unNodeHostIPv4Address + , "port" .= fromEnum naPort ] where + _addr@(NodeAddress {..}) = ndAddr + _hostAddr@(NodeHostIPv4Address {..}) = naHostAddress -- Long GC pauses on target nodes can trigger spurious MVar deadlock @@ -89,15 +96,10 @@ instance ToJSON NodeDescription where getKeepaliveTimeout :: NixServiceOptions -> Clock.DiffTime getKeepaliveTimeout = maybe 10 Clock.secondsToDiffTime . _nix_keepalive -getNodeAlias :: NixServiceOptions -> IPv4 -> Maybe String +getNodeAlias :: NixServiceOptions -> NodeIPv4Address -> Maybe String getNodeAlias NixServiceOptions {..} ip = fmap ndName $ - flip find _nix_targetNodes \(NodeDescription {..}) -> ndAddr == ip - -setNodeAlias :: NixServiceOptions -> IPv4 -> String -> Maybe NixServiceOptions -setNodeAlias opts@(NixServiceOptions { _nix_targetNodes = targets }) ip name - | ([match], nonMatches) <- flip partition targets \(NodeDescription {..}) -> ndAddr == ip - = Just $ opts { _nix_targetNodes = match { ndName = name } :| nonMatches } - | otherwise = Nothing + find ((=:=:= ip) . ndAddr) _nix_targetNodes where + (=:=:=) = (==) `on` naHostAddress getNodeConfigFile :: NixServiceOptions -> Maybe FilePath getNodeConfigFile = _nix_nodeConfigFile diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 7ce663883b5..1a0424aad5c 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -123,7 +123,6 @@ library , generic-monoid , ghc-prim , io-classes - , iproute , mtl , network , network-mux