tx-generator: add version cmd.

Add a version CLI command and log the tx-generator version and details
in the logs.

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

@@ -14,21 +14,25 @@ import           Prelude
 import           System.Exit
 
 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.NixOptions (NixServiceOptions, parseNixServiceOptions, setNodeConfigFile, _nix_nodeConfigFile)
-import           Cardano.Benchmarking.Script (runScript, parseScriptFileAeson)
+import           Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile,
+                   parseNixServiceOptions, setNodeConfigFile)
+import           Cardano.Benchmarking.Script (parseScriptFileAeson, runScript)
 import           Cardano.Benchmarking.Script.Aeson (prettyPrint)
 import           Cardano.Benchmarking.Script.Selftest (runSelftest)
+import           Cardano.Benchmarking.Version as Version
 
 data Command
   = Json FilePath
   | JsonHL FilePath (Maybe FilePath)
   | Compile FilePath
   | Selftest FilePath
+  | VersionCmd
 
 runCommand :: IO ()
 runCommand = withIOManager $ \iocp -> do
@@ -51,7 +55,8 @@ runCommand = withIOManager $ \iocp -> do
         Right script -> BSL.putStr $ prettyPrint script
         err -> handleError err
     Selftest outFile -> runSelftest iocp (Just outFile) >>= handleError
- where
+    VersionCmd -> runVersionCommand
+  where
   handleError :: Show a => Either a b -> IO ()
   handleError = \case
     Right _  -> exitSuccess
@@ -70,20 +75,25 @@ commandParser
     <> cmdParser "json_highlevel" jsonHLCmd "Run the tx-generator using a flat config."
     <> cmdParser "compile" compileCmd "Compile flat-options to benchmarking script."
     <> cmdParser "selftest" selfTestCmd "Run a build-in selftest."
+    <> cmdParser "version" versionCmd "Show the tx-generator version"
        )
  where
   cmdParser cmd parser description = command cmd $ info parser $ progDesc description
+
+  filePath :: String -> Parser String
+  filePath helpMsg = strArgument (metavar "FILEPATH" <> help helpMsg)
+
+  jsonCmd :: Parser Command
   jsonCmd = Json <$> filePath "low-level benchmarking script"
 
+  jsonHLCmd :: Parser Command
   jsonHLCmd = JsonHL <$> filePath "benchmarking options"
                      <*> nodeConfigOpt
-
+  compileCmd :: Parser Command
   compileCmd = Compile <$> filePath "benchmarking options"
 
   selfTestCmd = Selftest <$> filePath "output file"
 
-  filePath helpMsg = strArgument (metavar "FILEPATH" <> help helpMsg)
-
   nodeConfigOpt :: Parser (Maybe FilePath)
   nodeConfigOpt = option (Just <$> str)
     ( long "nodeConfig"
@@ -93,3 +103,8 @@ commandParser
       <> help "the node configfile"
     )
 
+  versionCmd :: Parser Command
+  versionCmd = pure VersionCmd
+
+runVersionCommand :: IO ()
+runVersionCommand = T.putStrLn $ multilineVersionMsg txGeneratorVersion

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

@@ -51,6 +51,7 @@ import           Ouroboros.Network.Protocol.Handshake.Type (Handshake)
 import           Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2)
 
 import           Cardano.Benchmarking.Types
+import           Cardano.Benchmarking.Version as Version
 
 data BenchTracers =
   BenchTracers
@@ -61,7 +62,8 @@ data BenchTracers =
   }
 
 data TraceBenchTxSubmit txid
-  = TraceBenchTxSubRecv [txid]
+  = TraceTxGeneratorVersion Version.Version
+  | TraceBenchTxSubRecv [txid]
   -- ^ Received from generator.
   | TraceBenchTxSubStart [txid]
   -- ^ The @txid@ has been submitted to `TxSubmission`

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

@@ -17,7 +17,7 @@ import           Ouroboros.Network.NodeToClient (IOManager)
 
 import           Cardano.Benchmarking.Script.Action
 import           Cardano.Benchmarking.Script.Aeson (parseScriptFileAeson)
-import           Cardano.Benchmarking.Script.Core (setProtocolParameters)
+import           Cardano.Benchmarking.Script.Core (setProtocolParameters, traceTxGeneratorVersion)
 import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.NodeConfig (shutDownLogging)
 import           Cardano.Benchmarking.Script.Store
@@ -40,5 +40,6 @@ runScript script iom = runActionM execScript iom >>= \case
   cleanup s a = void $ runActionMEnv s a iom
   execScript = do
     liftIO initDefaultTracers >>= set BenchTracers
+    traceTxGeneratorVersion
     setProtocolParameters QueryLocalNode
     forM_ script action

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

@@ -47,8 +47,9 @@ import           Cardano.Benchmarking.ListBufferedSelector
 import           Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile,
                    makeLocalConnectInfo, protocolToCodecConfig)
 import           Cardano.Benchmarking.PlutusExample as PlutusExample
-import           Cardano.Benchmarking.LogTypes as Core (btConnect_, btN2N_, btSubmission2_,
-                   btTxSubmit_)
+
+import           Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_,
+                   btSubmission2_, btTxSubmit_)
 import           Cardano.Benchmarking.Types as Core (NumberOfInputsPerTx (..),
                    NumberOfOutputsPerTx (..), NumberOfTxs (..), SubmissionErrorPolicy (..), TPSRate,
                    TxAdditionalSize (..))
@@ -59,6 +60,7 @@ import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.Setters
 import           Cardano.Benchmarking.Script.Store as Store
 import           Cardano.Benchmarking.Script.Types
+import           Cardano.Benchmarking.Version as Version
 
 liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x)
 liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall)
@@ -648,6 +650,9 @@ spendAutoScript sourceWallet submitMode loopScriptFile threadName txCount tps er
              test <- f m
              if test then search f m b else search f a m
 
+traceTxGeneratorVersion :: ActionM ()
+traceTxGeneratorVersion = traceBenchTxSubmit TraceTxGeneratorVersion Version.txGeneratorVersion
+
 {-
 This is for dirty hacking and testing and quick-fixes.
 Its a function that can be called from the JSON scripts
@@ -656,3 +661,4 @@ and for which the JSON encoding is "reserved".
 reserved :: [String] -> ActionM ()
 reserved _ = do
   throwE $ UserError "no dirty hack is implemented"
+

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

@@ -71,7 +71,6 @@ startProtocol filePath = do
   set (User TNetworkId) $ protocolToNetworkId protocol
   liftIO initDefaultTracers >>= set Store.BenchTracers
 
-
 shutDownLogging :: ActionM ()
 shutDownLogging = do
   traceError "QRT Last Message. LoggingLayer going to shutdown. 73 . . . ."

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

@@ -10,11 +10,13 @@
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 {-# OPTIONS_GHC -Wno-all-missed-specialisations #-}
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 module Cardano.Benchmarking.Tracer
   ( initDefaultTracers
@@ -25,8 +27,10 @@ import           GHC.Generics
 
 import           Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KeyMap
+import           Data.Kind
 import qualified Data.Map as Map
 
+import           Data.Proxy
 import           Data.Text (Text)
 import qualified Data.Text as Text
 
@@ -35,6 +39,7 @@ import           Cardano.Logging
 
 import           Cardano.Benchmarking.LogTypes
 import           Cardano.Benchmarking.Types
+import           Cardano.Benchmarking.Version as Version
 
 generatorTracer :: LogFormatting a => (a -> Namespace) -> Text -> Trace IO FormattedMessage -> IO (Trace IO a)
 generatorTracer namesFor tracerName tr = do
@@ -47,11 +52,11 @@ generatorTracer namesFor tracerName tr = do
 initDefaultTracers :: IO BenchTracers
 initDefaultTracers = do
   st <-  standardTracer
-  benchTracer <-  generatorTracer genericNames "benchmark" st
+  benchTracer <-  generatorTracer singletonName "benchmark" st
   configureTracers initialTraceConfig benchTracerDocumented [benchTracer]
-  n2nSubmitTracer <- generatorTracer genericNames "submitN2N" st
+  n2nSubmitTracer <- generatorTracer singletonName "submitN2N" st
   configureTracers initialTraceConfig nodeToNodeSubmissionTraceDocumented [n2nSubmitTracer]
-  connectTracer <- generatorTracer genericNames "connect" st
+  connectTracer <- generatorTracer singletonName "connect" st
   configureTracers initialTraceConfig sendRecvConnectDocumented [connectTracer]
   submitTracer <- generatorTracer namesForSubmission2 "submit" st
   configureTracers initialTraceConfig submission2Documented [submitTracer]
@@ -82,8 +87,11 @@ initialTraceConfig = TraceConfig {
     initConf :: Text -> (Namespace, [ConfigOption])
     initConf tr = ([tr], [ConfDetail DMaximum])
 
-genericNames :: (ConstructorName f, Generic a, Rep a ~ D1 c f) => a ->  [Text]
-genericNames x = [ Text.pack $ constructorName $ unM1 $ from x ]
+singletonName :: (ConstructorName f, Generic a, Rep a ~ D1 c f) => a -> [Text]
+singletonName a = [ genericName a ]
+
+genericName :: (ConstructorName f, Generic a, Rep a ~ D1 c f) => a -> Text
+genericName x = Text.pack $ constructorName $ unM1 $ from x
 
 class ConstructorName f where
   constructorName :: f p -> String
@@ -94,27 +102,25 @@ instance (ConstructorName f, ConstructorName g) => ConstructorName (f :+: g) whe
 instance (Constructor ('MetaCons n f r)) => ConstructorName (C1 ('MetaCons n f r) x) where
   constructorName = conName
 
+genericConstructorsOf :: forall a c f. (Rep a ~ D1 c f, ConstructorsOf f) => Proxy a -> [Text]
+genericConstructorsOf _ = map Text.pack $ constructorsOf (Proxy :: Proxy f)
+
+class ConstructorsOf (f :: Type -> Type ) where
+  constructorsOf :: Proxy f -> [String]
+
+instance (ConstructorsOf f, ConstructorsOf g) => ConstructorsOf (f :+: g) where
+  constructorsOf _ = constructorsOf (Proxy :: Proxy f) ++ constructorsOf (Proxy :: Proxy g)
+
+instance (Constructor ('MetaCons n f r)) => ConstructorsOf (C1 ('MetaCons n f r) x) where
+  constructorsOf _ = [ conName @('MetaCons n f r) undefined ]
+
 instance LogFormatting (TraceBenchTxSubmit TxId) where
   forHuman = Text.pack . show
   forMachine DMinimal _ = mempty
-  forMachine DNormal t = case t of
-    TraceBenchTxSubRecv _      -> mconcat ["kind" .= A.String "TraceBenchTxSubRecv"]
-    TraceBenchTxSubStart _     -> mconcat ["kind" .= A.String "TraceBenchTxSubStart"]
-    TraceBenchTxSubServAnn _   -> mconcat ["kind" .= A.String "TraceBenchTxSubServAnn"]
-    TraceBenchTxSubServReq _   -> mconcat ["kind" .= A.String "TraceBenchTxSubServReq"]
-    TraceBenchTxSubServAck _   -> mconcat ["kind" .= A.String "TraceBenchTxSubServAck"]
-    TraceBenchTxSubServDrop _  -> mconcat ["kind" .= A.String "TraceBenchTxSubServDrop"]
-    TraceBenchTxSubServOuts _  -> mconcat ["kind" .= A.String "TraceBenchTxSubServOuts"]
-    TraceBenchTxSubServUnav _  -> mconcat ["kind" .= A.String "TraceBenchTxSubServUnav"]
-    TraceBenchTxSubServFed _ _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServFed"]
-    TraceBenchTxSubServCons _  -> mconcat ["kind" .= A.String "TraceBenchTxSubServCons"]
-    TraceBenchTxSubIdle        -> mconcat ["kind" .= A.String "TraceBenchTxSubIdle"]
-    TraceBenchTxSubRateLimit _ -> mconcat ["kind" .= A.String "TraceBenchTxSubRateLimit"]
-    TraceBenchTxSubSummary _   -> mconcat ["kind" .= A.String "TraceBenchTxSubSummary"]
-    TraceBenchTxSubDebug _     -> mconcat ["kind" .= A.String "TraceBenchTxSubDebug"]
-    TraceBenchTxSubError _     -> mconcat ["kind" .= A.String "TraceBenchTxSubError"]
+  forMachine DNormal t = mconcat [ "kind" .= A.String (genericName t) ]
   forMachine DDetailed t = forMachine DMaximum t
   forMachine DMaximum t = case t of
+    TraceTxGeneratorVersion v -> mconcat [ "kind" .= A.String "TraceTxGeneratorVersion" ] <> Version.toJsonLogMsg v
     TraceBenchTxSubRecv txIds ->
       mconcat [ "kind"  .= A.String "TraceBenchTxSubRecv"
               , "txIds" .= toJSON txIds
@@ -177,27 +183,8 @@ instance LogFormatting (TraceBenchTxSubmit TxId) where
               ]
 
 benchTracerDocumented :: Documented (TraceBenchTxSubmit TxId)
-benchTracerDocumented = Documented
-  [ emptyDoc ["benchmark", "TraceBenchTxSubRecv"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubStart"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServAnn"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServReq"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServAck"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServDrop"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServOuts"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServUnav"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServFed"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServCons"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubIdle"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubRateLimit"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubServCons"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubIdle"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubRateLimit"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubSummary"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubDebug"]
-  , emptyDoc ["benchmark", "TraceBenchTxSubError"]
-  ]
-
+benchTracerDocumented
+  = Documented $ map (emptyDoc2 "benchmark") $ genericConstructorsOf (Proxy :: Proxy (TraceBenchTxSubmit x))
 
 instance LogFormatting NodeToNodeSubmissionTrace where
   forHuman = Text.pack . show
@@ -225,20 +212,13 @@ instance LogFormatting NodeToNodeSubmissionTrace where
        , "sent" .= A.toJSON sent ]
 
 nodeToNodeSubmissionTraceDocumented :: Documented NodeToNodeSubmissionTrace
-nodeToNodeSubmissionTraceDocumented = Documented
-  [ emptyDoc ["submitN2N", "ReqIdsBlocking"]
-  , emptyDoc ["submitN2N", "IdsListBlocking"]
-  , emptyDoc ["submitN2N", "ReqIdsPrompt"]
-  , emptyDoc ["submitN2N", "IdsListPrompt"]
-  , emptyDoc ["submitN2N", "ReqTxs"]
-  , emptyDoc ["submitN2N", "TxList"]
-  ]
+nodeToNodeSubmissionTraceDocumented
+  = Documented $ map (emptyDoc2 "submitN2N") $ genericConstructorsOf (Proxy :: Proxy NodeToNodeSubmissionTrace)
 
 instance LogFormatting SendRecvConnect where
   forHuman = Text.pack . show
   forMachine _ _ = KeyMap.fromList [ "kind" .= A.String "SendRecvConnect" ]
 
-
 sendRecvConnectDocumented :: Documented SendRecvConnect
 sendRecvConnectDocumented = Documented
   [ emptyDoc ["connect"]
@@ -258,3 +238,6 @@ submission2Documented = Documented
 
 emptyDoc :: Namespace -> DocMsg a
 emptyDoc ns = DocMsg ns [] "ToDo: write benchmark tracer docs"
+
+emptyDoc2 :: Text -> Text -> DocMsg a
+emptyDoc2 n1 n2 = DocMsg [n1, n2] [] "ToDo: write benchmark tracer docs"

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

@@ -0,0 +1,51 @@
+module Cardano.Benchmarking.Version
+where
+
+import           Data.Aeson as A
+import           Data.Text as Text
+import           Data.Version (showVersion)
+import           Paths_tx_generator (version)
+import           System.Info (arch, compilerName, compilerVersion, os)
+
+import           Cardano.Git.Rev (gitRev)
+
+data Version = Version
+  { _package :: !Text
+  , _os      :: !Text
+  , _arch    :: !Text
+  , _compilerName :: !Text
+  , _compilerVersion :: !Text
+  , _gitRev :: !Text
+  }
+  deriving (Show)
+
+txGeneratorVersion :: Version
+txGeneratorVersion = Version
+  { _package = renderVersion version
+  , _os      = Text.pack os
+  , _arch    = Text.pack arch
+  , _compilerName    = Text.pack compilerName
+  , _compilerVersion = renderVersion compilerVersion
+  , _gitRev = gitRev
+  }
+  where
+    renderVersion = Text.pack . showVersion
+
+multilineVersionMsg :: Version -> Text
+multilineVersionMsg v
+  = mconcat
+    [ "tx-generator ", _package v
+    , " - ", _os v, "-", _arch v
+    , " - ", _compilerName v, "-", _compilerVersion v
+    , "\ngit rev ", _gitRev v
+    ]
+
+toJsonLogMsg :: Version -> A.Object
+toJsonLogMsg v = mconcat
+  [ "package"    .= A.String ( _package v)
+  , "os"         .= A.String ( _os v)
+  , "arch"       .= A.String ( _arch v)
+  , "compilerName"    .= A.String ( _compilerName v)
+  , "compilerVersion" .= A.String ( _compilerVersion v)
+  , "gitRev"          .= A.String ( _gitRev v)
+  ]

bench/tx-generator/tx-generator.cabal

@@ -53,6 +53,7 @@ library
                        Cardano.Benchmarking.TpsThrottle
                        Cardano.Benchmarking.Tracer
                        Cardano.Benchmarking.Types
+                       Cardano.Benchmarking.Version
                        Cardano.Benchmarking.Wallet
                        Cardano.Benchmarking.ListBufferedSelector
                        Cardano.Benchmarking.PlutusExample
@@ -72,6 +73,7 @@ library
                      , cardano-cli
                      , cardano-crypto-class
                      , cardano-crypto-wrapper
+                     , cardano-git-rev
                      , cardano-ledger-alonzo
                      , cardano-ledger-byron
                      , cardano-node