txgen-mvar: experimental NixServiceOptions change

bench/tx-generator/src/Cardano/Benchmarking/Command.hs

@@ -10,22 +10,21 @@ module Cardano.Benchmarking.Command
 )
 where
 
-import           Prelude
-import           System.Exit
-
-import           Data.Aeson (fromJSON)
-import           Data.ByteString.Lazy as BSL
-import           Data.Text.IO as T
-import           Options.Applicative as Opt
-
-import           Ouroboros.Network.NodeToClient (withIOManager)
-
 import           Cardano.Benchmarking.Compiler (compileOptions)
 import           Cardano.Benchmarking.Script (parseScriptFileAeson, runScript)
 import           Cardano.Benchmarking.Script.Aeson (parseJSONFile, prettyPrint)
 import           Cardano.Benchmarking.Script.Selftest (runSelftest)
 import           Cardano.Benchmarking.Version as Version
 import           Cardano.TxGenerator.Setup.NixService
+import           Ouroboros.Network.NodeToClient (withIOManager)
+
+import           Prelude
+
+import           Data.Aeson (fromJSON)
+import           Data.ByteString.Lazy as BSL
+import           Data.Text.IO as T
+import           Options.Applicative as Opt
+import           System.Exit
 
 
 data Command

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -50,8 +51,7 @@ waitBenchmark traceSubmit (feeder, workers, mkSummary, _) = liftIO $ do
   mapM_ waitCatch (feeder : workers)
   traceWith traceSubmit . TraceBenchTxSubSummary =<< mkSummary
 
-lookupNodeAddress ::
-  NodeAddress' NodeHostIPv4Address -> IO AddrInfo
+lookupNodeAddress :: NodeIPv4Address -> IO AddrInfo
 lookupNodeAddress node = do
   (remoteAddr:_) <- getAddrInfo (Just hints) (Just targetNodeHost) (Just targetNodePort)
   return remoteAddr
@@ -96,7 +96,7 @@ walletBenchmark :: forall era. IsShelleyBasedEra era
   -> Trace IO NodeToNodeSubmissionTrace
   -> ConnectClient
   -> String
-  -> NonEmpty (WithAlias NodeIPv4Address)
+  -> NonEmpty NodeDescription
   -> TPSRate
   -> SubmissionErrorPolicy
   -> AsType era
@@ -123,7 +123,7 @@ walletBenchmark
   = liftIO $ do
   traceDebug "******* Tx generator, phase 2: pay to recipients *******"
 
-  remoteAddresses <- forM targets (\(WithAlias name addr) -> secondM lookupNodeAddress (name, addr))
+  remoteAddresses <- forM targets (\(NodeDescription {..}) -> secondM lookupNodeAddress (ndName, NodeAddress { naHostAddress = NodeHostIPv4Address ndAddr, naPort = toEnum ndPort }))
   let numTargets :: Natural = fromIntegral $ NE.length targets
 
   traceDebug $ "******* Tx generator, launching Tx peers:  " ++ show (NE.length remoteAddresses) ++ " of them"

bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs

@@ -44,7 +44,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.Benchmarking.OuroborosImports (SigningKeyFile)
 import           Cardano.Node.Configuration.NodeAddress (NodeIPv4Address)
-import           Cardano.TxGenerator.Setup.NixService (WithAlias)
+import           Cardano.TxGenerator.Setup.NixService (NodeDescription)
 import           Cardano.TxGenerator.Types
 
 import           Prelude
@@ -178,7 +178,7 @@ data ProtocolParametersSource where
   deriving (Show, Eq)
 deriving instance Generic ProtocolParametersSource
 
-type TargetNodes = NonEmpty (WithAlias NodeIPv4Address)
+type TargetNodes = NonEmpty NodeDescription
 
 data SubmitMode where
   LocalSocket :: SubmitMode

bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs

@@ -1,15 +1,18 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Cardano.TxGenerator.Setup.NixService
        ( NixServiceOptions (..)
-       , WithAlias(..)
+       , NodeDescription (..)
        , getKeepaliveTimeout
-       , getAliasPayload
+       , getNodeAlias
+       , setNodeAlias
        , getNodeConfigFile
        , setNodeConfigFile
        , txGenTxParams
@@ -22,13 +25,15 @@ import           Cardano.Api (AnyCardanoEra, mapFile)
 
 import           Cardano.CLI.Types.Common (FileDirection (..), SigningKeyFile)
 import qualified Cardano.Ledger.Coin as L
-import           Cardano.Node.Configuration.NodeAddress (NodeIPv4Address)
 import           Cardano.Node.Types (AdjustFilePaths (..))
 import           Cardano.TxGenerator.Internal.Orphans ()
 import           Cardano.TxGenerator.Types
 
 import           Data.Aeson as Aeson
-import           Data.List.NonEmpty (NonEmpty)
+import           Data.Aeson.Types as Aeson
+import           Data.Foldable (find)
+import           Data.IP as IP
+import           Data.List.NonEmpty (NonEmpty (..), partition)
 import           Data.Maybe (fromMaybe)
 import qualified Data.Time.Clock as Clock (DiffTime, secondsToDiffTime)
 import           GHC.Generics (Generic)
@@ -51,39 +56,48 @@ data NixServiceOptions = NixServiceOptions {
   , _nix_cardanoTracerSocket  :: Maybe FilePath
   , _nix_sigKey               :: SigningKeyFile In
   , _nix_localNodeSocketPath  :: String
-  , _nix_targetNodes          :: NonEmpty (WithAlias NodeIPv4Address)
+  , _nix_targetNodes          :: NonEmpty NodeDescription
   } deriving (Show, Eq)
 
 deriving instance Generic NixServiceOptions
 
 -- only works on JSON Object types
-data WithAlias a =
-  WithAlias String a
-
-deriving instance Show a    => Show    (WithAlias a)
-deriving instance Eq   a    => Eq      (WithAlias a)
--- deriving instance Generic a => Generic (WithAlias a)
+data NodeDescription =
+  NodeDescription {
+      ndAddr    :: IPv4
+    , ndName    :: String
+    , ndPort    :: Int
+    } deriving (Eq, Show, Generic)
 
 -- { "alias": "foo", "addr": ..., "port": ... }
-instance (Show a, FromJSON a) => FromJSON (WithAlias a) where
-  parseJSON val = case fromJSON val of
-      Error e          -> fail e
-      Success payload  -> withObject "WithAlias" (\o' -> do
-        alias <- o' .:? "name" .!= show payload
-        pure $ WithAlias alias payload
-        ) val
+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
+    pure $ NodeDescription {..}
 
-instance ToJSON a => ToJSON (WithAlias a) where
-  toJSON (WithAlias _ val) = toJSON val
+instance ToJSON NodeDescription where
+  toJSON NodeDescription {..} = object
+       [ "name" .= ndName
+       , "addr" .= ndAddr
+       , "port" .= ndPort ]
 
 
 -- Long GC pauses on target nodes can trigger spurious MVar deadlock
 -- detection. Increasing this timeout can help mitigate those errors.
 getKeepaliveTimeout :: NixServiceOptions -> Clock.DiffTime
 getKeepaliveTimeout = maybe 10 Clock.secondsToDiffTime . _nix_keepalive
 
-getAliasPayload :: WithAlias a -> a
-getAliasPayload (WithAlias _ val) = val
+getNodeAlias :: NixServiceOptions -> IPv4 -> 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
 
 getNodeConfigFile :: NixServiceOptions -> Maybe FilePath
 getNodeConfigFile = _nix_nodeConfigFile

bench/tx-generator/tx-generator.cabal

@@ -123,6 +123,7 @@ library
                       , generic-monoid
                       , ghc-prim
                       , io-classes
+                      , iproute
                       , mtl
                       , network
                       , network-mux