Merge #4511

4511: tx-generator trace forwarding r=deepfire a=MarcFontaine

Extend the `tx-generator` such that it forwards traces to `cardano-tracer`.

Co-authored-by: Kosyrev Serge <[email protected]>
Co-authored-by: MarcFontaine <[email protected]>
Co-authored-by: Denis Shevchenko <[email protected]>

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

@@ -20,7 +20,7 @@ import           Options.Applicative as Opt
 import           Ouroboros.Network.NodeToClient (withIOManager)
 
 import           Cardano.Benchmarking.Compiler (compileOptions)
-import           Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile,
+import           Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile, _nix_cardanoTracerSocket,
                    parseNixServiceOptions, setNodeConfigFile)
 import           Cardano.Benchmarking.Script (parseScriptFileAeson, runScript)
 import           Cardano.Benchmarking.Script.Aeson (prettyPrint)
@@ -29,7 +29,7 @@ import           Cardano.Benchmarking.Version as Version
 
 data Command
   = Json FilePath
-  | JsonHL FilePath (Maybe FilePath)
+  | JsonHL FilePath (Maybe FilePath) (Maybe FilePath)
   | Compile FilePath
   | Selftest FilePath
   | VersionCmd
@@ -43,9 +43,9 @@ runCommand = withIOManager $ \iocp -> do
     Json file -> do
       script <- parseScriptFileAeson file
       runScript script iocp >>= handleError
-    JsonHL file nodeConfigOverwrite -> do
+    JsonHL file nodeConfigOverwrite cardanoTracerOverwrite -> do
       opts <- parseNixServiceOptions file
-      finalOpts <- mangleNodeConfig opts nodeConfigOverwrite
+      finalOpts <- mangleTracerConfig cardanoTracerOverwrite <$> mangleNodeConfig nodeConfigOverwrite opts
       case compileOptions finalOpts of
         Right script -> runScript script iocp >>= handleError
         err -> handleError err
@@ -62,12 +62,16 @@ runCommand = withIOManager $ \iocp -> do
     Right _  -> exitSuccess
     Left err -> die $ show err
 
-  mangleNodeConfig :: NixServiceOptions -> Maybe FilePath -> IO NixServiceOptions
-  mangleNodeConfig opts fp = case (_nix_nodeConfigFile opts, fp) of
+  mangleNodeConfig :: Maybe FilePath -> NixServiceOptions -> IO NixServiceOptions
+  mangleNodeConfig fp opts = case (_nix_nodeConfigFile opts, fp) of
     (_      , Just newFilePath) -> return $ setNodeConfigFile opts newFilePath
     (Just _ , Nothing) -> return opts
     (Nothing, Nothing) -> die "No node-configFile set"
 
+  mangleTracerConfig ::  Maybe FilePath -> NixServiceOptions -> NixServiceOptions
+  mangleTracerConfig traceSocket opts
+    = opts { _nix_cardanoTracerSocket = traceSocket <> _nix_cardanoTracerSocket opts}
+
 commandParser :: Parser Command
 commandParser
   = subparser (
@@ -89,6 +93,7 @@ commandParser
   jsonHLCmd :: Parser Command
   jsonHLCmd = JsonHL <$> filePath "benchmarking options"
                      <*> nodeConfigOpt
+                     <*> tracerConfigOpt
   compileCmd :: Parser Command
   compileCmd = Compile <$> filePath "benchmarking options"
 
@@ -103,6 +108,15 @@ commandParser
       <> help "the node configfile"
     )
 
+  tracerConfigOpt :: Parser (Maybe FilePath)
+  tracerConfigOpt = option (Just <$> str)
+    ( long "cardano-tracer"
+      <> short 'n'
+      <> metavar "SOCKET"
+      <> value Nothing
+      <> help "the cardano-tracer socket"
+    )
+
   versionCmd :: Parser Command
   versionCmd = pure VersionCmd
 

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

@@ -51,7 +51,7 @@ testCompiler o c = case runExcept $ runRWST c o 0 of
 compileToScript :: Compiler ()
 compileToScript = do
   initConstants
-  emit . StartProtocol =<< askNixOption getNodeConfigFile
+  StartProtocol <$> askNixOption getNodeConfigFile <*> askNixOption _nix_cardanoTracerSocket >>= emit
   genesisWallet <- importGenesisFunds
   collateralWallet <- addCollaterals genesisWallet
   splitWallet <- splittingPhase genesisWallet

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

@@ -39,6 +39,7 @@ data NixServiceOptions = NixServiceOptions {
   , _nix_executionMemory  :: Natural
   , _nix_executionSteps   :: Natural
   , _nix_nodeConfigFile       :: Maybe FilePath
+  , _nix_cardanoTracerSocket  :: Maybe FilePath
   , _nix_sigKey               :: SigningKeyFile
   , _nix_localNodeSocketPath  :: String
   , _nix_targetNodes          :: NonEmpty NodeIPv4Address

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

@@ -16,7 +16,7 @@ action a = case a of
   Set (key :=> (Identity val)) -> set (User key) val
   InitWallet name -> initWallet name
   SetProtocolParameters p -> setProtocolParameters p
-  StartProtocol filePath -> startProtocol filePath
+  StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket
   ReadSigningKey name filePath -> readSigningKey name filePath
   DefineSigningKey name descr -> defineSigningKey name descr
   AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName

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

@@ -62,14 +62,20 @@ makeNodeConfig logConfig = liftToAction $ ExceptT $ do
     Left err -> return $ Left $ MkNodeConfigError err
     Right nc' -> return $ Right nc'
 
-startProtocol :: FilePath -> ActionM ()
-startProtocol filePath = do
-  nodeConfig <- makeNodeConfig filePath
+startProtocol :: FilePath -> Maybe FilePath -> ActionM ()
+startProtocol configFile tracerSocket = do
+  nodeConfig <- makeNodeConfig configFile
   protocol <- makeConsensusProtocol nodeConfig
   set Protocol protocol
   set Genesis $ Core.getGenesis protocol
-  set (User TNetworkId) $ protocolToNetworkId protocol
-  liftIO initDefaultTracers >>= set Store.BenchTracers
+  let networkId = protocolToNetworkId protocol
+  set (User TNetworkId) networkId
+  tracers <- case tracerSocket of
+    Nothing -> liftIO initDefaultTracers
+    Just socket -> do
+      iomgr <- askIOManager
+      liftIO $ initTracers iomgr networkId socket
+  set Store.BenchTracers tracers
 
 shutDownLogging :: ActionM ()
 shutDownLogging = do

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

@@ -31,7 +31,7 @@ data Action where
   Set                :: !SetKeyVal -> Action
 --  Declare            :: SetKeyVal   -> Action --declare (once): error if key was set before
   InitWallet         :: !WalletName -> Action
-  StartProtocol      :: !FilePath -> Action
+  StartProtocol      :: !FilePath -> !(Maybe FilePath) -> Action
   Delay              :: !Double -> Action
   ReadSigningKey     :: !KeyName -> !SigningKeyFile -> Action
   DefineSigningKey   :: !KeyName -> !TextEnvelope -> Action

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

@@ -7,6 +7,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -19,7 +20,8 @@
 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 module Cardano.Benchmarking.Tracer
-  ( initDefaultTracers
+  ( initTracers
+  , initDefaultTracers
   , initNullTracers
   )
 where
@@ -35,21 +37,39 @@ import qualified Data.Map as Map
 import           Data.Proxy
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           Data.Time.Clock
+
+import           Trace.Forward.Utils.DataPoint
+import           Trace.Forward.Utils.TraceObject
+import           Ouroboros.Network.IOManager (IOManager)
 
 import           Cardano.Api
 import           Cardano.Logging
+import           Cardano.Node.Startup
 
 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
-  tr'   <- machineFormatter Nothing tr
-  tr''  <- withDetailsFromConfig tr'
+generatorTracer ::
+     LogFormatting a
+  => (a -> Namespace)
+  -> Text
+  -> Maybe (Trace IO FormattedMessage)
+  -> Maybe (Trace IO FormattedMessage)
+  -> IO (Trace IO a)
+generatorTracer namesFor tracerName mbTrStdout mbTrForward = do
+  forwardTrace <- case mbTrForward of
+                        Nothing -> mempty
+                        Just trForward -> forwardFormatter Nothing trForward
+  stdoutTrace  <- case mbTrStdout of
+                        Nothing -> mempty
+                        Just trForward -> machineFormatter Nothing trForward
+  let tr = forwardTrace <> stdoutTrace
+  tr'  <- withDetailsFromConfig tr
   pure $ withNamesAppended namesFor
           $ appendName tracerName
-              tr''
+              tr'
 
 initNullTracers :: BenchTracers
 initNullTracers = BenchTracers
@@ -62,22 +82,70 @@ initNullTracers = BenchTracers
 
 initDefaultTracers :: IO BenchTracers
 initDefaultTracers = do
-  st <-  standardTracer
-  benchTracer <-  generatorTracer singletonName "benchmark" st
+  mbStdoutTracer <- fmap Just standardTracer
+  let mbForwardingTracer = Nothing
+  benchTracer <-  generatorTracer singletonName "benchmark"  mbStdoutTracer mbForwardingTracer
+  configureTracers initialTraceConfig benchTracerDocumented [benchTracer]
+  n2nSubmitTracer <- generatorTracer singletonName "submitN2N"  mbStdoutTracer mbForwardingTracer
+  configureTracers initialTraceConfig nodeToNodeSubmissionTraceDocumented [n2nSubmitTracer]
+  connectTracer <- generatorTracer singletonName "connect"  mbStdoutTracer mbForwardingTracer
+  configureTracers initialTraceConfig sendRecvConnectDocumented [connectTracer]
+  submitTracer <- generatorTracer namesForSubmission2 "submit"  mbStdoutTracer mbForwardingTracer
+  configureTracers initialTraceConfig submission2Documented [submitTracer]
+
+  return $ BenchTracers
+    { btTxSubmit_    = Tracer (traceWith benchTracer)
+    , btConnect_     = Tracer (traceWith connectTracer)
+    , btSubmission2_ = Tracer (traceWith submitTracer)
+    , btN2N_         = Tracer (traceWith n2nSubmitTracer)
+    }
+
+
+initTracers ::
+     IOManager
+  -> NetworkId
+  -> FilePath
+  -> IO BenchTracers
+initTracers iomgr networkId tracerSocket = do
+  (forwardingTracer :: Trace IO FormattedMessage, dpTracer :: Trace IO DataPoint) <- do
+          (forwardSink :: ForwardSink TraceObject, dpStore) <- initForwarding iomgr initialTraceConfig (toNetworkMagic networkId)
+                                                                 Nothing $ Just (tracerSocket, Initiator)
+          pure (forwardTracer forwardSink, dataPointTracer dpStore)
+  mbStdoutTracer <- fmap Just standardTracer
+  let mbForwardingTracer = Just forwardingTracer
+  benchTracer <-  generatorTracer singletonName "benchmark" mbStdoutTracer mbForwardingTracer
   configureTracers initialTraceConfig benchTracerDocumented [benchTracer]
-  n2nSubmitTracer <- generatorTracer singletonName "submitN2N" st
+  n2nSubmitTracer <- generatorTracer singletonName "submitN2N" mbStdoutTracer mbForwardingTracer
   configureTracers initialTraceConfig nodeToNodeSubmissionTraceDocumented [n2nSubmitTracer]
-  connectTracer <- generatorTracer singletonName "connect" st
+  connectTracer <- generatorTracer singletonName "connect" mbStdoutTracer mbForwardingTracer
   configureTracers initialTraceConfig sendRecvConnectDocumented [connectTracer]
-  submitTracer <- generatorTracer namesForSubmission2 "submit" st
+  submitTracer <- generatorTracer namesForSubmission2 "submit" mbStdoutTracer mbForwardingTracer
   configureTracers initialTraceConfig submission2Documented [submitTracer]
+  -- Now we need to provide "Nodeinfo" DataPoint, to forward generator's name
+  -- to the acceptor application (for example, 'cardano-tracer').
+  nodeInfoTracer <- mkDataPointTracer dpTracer (const ["NodeInfo"])
+  prepareGenInfo >>= traceWith nodeInfoTracer
 
+  traceWith benchTracer $ TraceTxGeneratorVersion Version.txGeneratorVersion
+--  traceWith st $ show $ TraceTxGeneratorVersion Version.txGeneratorVersion
   return $ BenchTracers
     { btTxSubmit_    = Tracer (traceWith benchTracer)
     , btConnect_     = Tracer (traceWith connectTracer)
     , btSubmission2_ = Tracer (traceWith submitTracer)
     , btN2N_         = Tracer (traceWith n2nSubmitTracer)
     }
+ where
+  prepareGenInfo = do
+    now <- getCurrentTime
+    return $ NodeInfo
+      { niName            = "TxGenerator"
+      , niProtocol        = "N/A"
+      , niVersion         = _compilerVersion
+      , niCommit          = _gitRev
+      , niStartTime       = now
+      , niSystemStartTime = now
+      }
+  Version{_compilerVersion, _gitRev} = Version.txGeneratorVersion
 
 initialTraceConfig :: TraceConfig
 initialTraceConfig = TraceConfig {

bench/tx-generator/tx-generator.cabal

@@ -116,6 +116,7 @@ library
                      , text
                      , time
                      , trace-dispatcher
+                     , trace-forward
                      , transformers
                      , transformers-except
                      , unordered-containers

nix/nixos/tx-generator-service.nix

@@ -96,6 +96,8 @@ in pkgs.commonLib.defServiceModule
 
         sigKey          = mayOpt str         "Key with funds";
 
+        tracerSocketPath =
+                          mayOpt str         "Socket path of cardano-tracer";
         localNodeSocketPath =
                            mayOpt str        "Local node socket path";
         localNodeConf   = mayOpt attrs       "Config of the local node";
@@ -119,7 +121,9 @@ in pkgs.commonLib.defServiceModule
       configExeArgsFn = cfg: [
           "json_highlevel"
           "${pkgs.writeText "tx-gen-config.json" (cfg.decideRunScript cfg)}"
-        ];
+      ] ++ optionals (cfg.tracerSocketPath != null) [
+          "--cardano-tracer" cfg.tracerSocketPath
+      ];
 
       configSystemdExtraConfig = _: {};
 

nix/workbench/backend/services-config.nix

@@ -84,13 +84,15 @@ with lib;
         profile: nodeSpec: args: args;
 
       finaliseGeneratorService =
-        svc: recursiveUpdate svc
+        profile: svc: recursiveUpdate svc
           ({
             sigKey         = "./genesis/utxo-keys/utxo1.skey";
             runScriptFile  = "run-script.json";
             ## path to the config and socket of the locally running node.
             nodeConfigFile = "./node-0/config.json";
             localNodeSocketPath = "./node-0/node.socket";
+          } // optionalAttrs profile.node.tracer {
+            tracerSocketPath = "../tracer/tracer.socket";
           } // optionalAttrs useCabalRun {
             executable     = "cabal run exe:tx-generator --";
           });

nix/workbench/profiles/generator-service.nix

@@ -26,7 +26,7 @@ let
                ShelleyGenesisFile ByronGenesisFile;
            };
     in
-        services-config.finaliseGeneratorService
+        services-config.finaliseGeneratorService profile.value
         {
           inherit (profile.value) era;