Skip to content

Commit 49dbad8

Browse files
iohk-bors[bot]deepfireMarcFontaineDenis Shevchenko
authored
4511: tx-generator trace forwarding r=denisshevchenko 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]>
2 parents 148238e + 00b004a commit 49dbad8

File tree

11 files changed

+124
-28
lines changed

11 files changed

+124
-28
lines changed

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

+20-6
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import Options.Applicative as Opt
2020
import Ouroboros.Network.NodeToClient (withIOManager)
2121

2222
import Cardano.Benchmarking.Compiler (compileOptions)
23-
import Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile,
23+
import Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile, _nix_cardanoTracerSocket,
2424
parseNixServiceOptions, setNodeConfigFile)
2525
import Cardano.Benchmarking.Script (parseScriptFileAeson, runScript)
2626
import Cardano.Benchmarking.Script.Aeson (prettyPrint)
@@ -29,7 +29,7 @@ import Cardano.Benchmarking.Version as Version
2929

3030
data Command
3131
= Json FilePath
32-
| JsonHL FilePath (Maybe FilePath)
32+
| JsonHL FilePath (Maybe FilePath) (Maybe FilePath)
3333
| Compile FilePath
3434
| Selftest FilePath
3535
| VersionCmd
@@ -43,9 +43,9 @@ runCommand = withIOManager $ \iocp -> do
4343
Json file -> do
4444
script <- parseScriptFileAeson file
4545
runScript script iocp >>= handleError
46-
JsonHL file nodeConfigOverwrite -> do
46+
JsonHL file nodeConfigOverwrite cardanoTracerOverwrite -> do
4747
opts <- parseNixServiceOptions file
48-
finalOpts <- mangleNodeConfig opts nodeConfigOverwrite
48+
finalOpts <- mangleTracerConfig cardanoTracerOverwrite <$> mangleNodeConfig nodeConfigOverwrite opts
4949
case compileOptions finalOpts of
5050
Right script -> runScript script iocp >>= handleError
5151
err -> handleError err
@@ -62,12 +62,16 @@ runCommand = withIOManager $ \iocp -> do
6262
Right _ -> exitSuccess
6363
Left err -> die $ show err
6464

65-
mangleNodeConfig :: NixServiceOptions -> Maybe FilePath -> IO NixServiceOptions
66-
mangleNodeConfig opts fp = case (_nix_nodeConfigFile opts, fp) of
65+
mangleNodeConfig :: Maybe FilePath -> NixServiceOptions -> IO NixServiceOptions
66+
mangleNodeConfig fp opts = case (_nix_nodeConfigFile opts, fp) of
6767
(_ , Just newFilePath) -> return $ setNodeConfigFile opts newFilePath
6868
(Just _ , Nothing) -> return opts
6969
(Nothing, Nothing) -> die "No node-configFile set"
7070

71+
mangleTracerConfig :: Maybe FilePath -> NixServiceOptions -> NixServiceOptions
72+
mangleTracerConfig traceSocket opts
73+
= opts { _nix_cardanoTracerSocket = traceSocket <> _nix_cardanoTracerSocket opts}
74+
7175
commandParser :: Parser Command
7276
commandParser
7377
= subparser (
@@ -89,6 +93,7 @@ commandParser
8993
jsonHLCmd :: Parser Command
9094
jsonHLCmd = JsonHL <$> filePath "benchmarking options"
9195
<*> nodeConfigOpt
96+
<*> tracerConfigOpt
9297
compileCmd :: Parser Command
9398
compileCmd = Compile <$> filePath "benchmarking options"
9499

@@ -103,6 +108,15 @@ commandParser
103108
<> help "the node configfile"
104109
)
105110

111+
tracerConfigOpt :: Parser (Maybe FilePath)
112+
tracerConfigOpt = option (Just <$> str)
113+
( long "cardano-tracer"
114+
<> short 'n'
115+
<> metavar "SOCKET"
116+
<> value Nothing
117+
<> help "the cardano-tracer socket"
118+
)
119+
106120
versionCmd :: Parser Command
107121
versionCmd = pure VersionCmd
108122

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ testCompiler o c = case runExcept $ runRWST c o 0 of
5151
compileToScript :: Compiler ()
5252
compileToScript = do
5353
initConstants
54-
emit . StartProtocol =<< askNixOption getNodeConfigFile
54+
StartProtocol <$> askNixOption getNodeConfigFile <*> askNixOption _nix_cardanoTracerSocket >>= emit
5555
genesisWallet <- importGenesisFunds
5656
collateralWallet <- addCollaterals genesisWallet
5757
splitWallet <- splittingPhase genesisWallet

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

+1
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ data NixServiceOptions = NixServiceOptions {
3939
, _nix_executionMemory :: Natural
4040
, _nix_executionSteps :: Natural
4141
, _nix_nodeConfigFile :: Maybe FilePath
42+
, _nix_cardanoTracerSocket :: Maybe FilePath
4243
, _nix_sigKey :: SigningKeyFile
4344
, _nix_localNodeSocketPath :: String
4445
, _nix_targetNodes :: NonEmpty NodeIPv4Address

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ action a = case a of
1616
Set (key :=> (Identity val)) -> set (User key) val
1717
InitWallet name -> initWallet name
1818
SetProtocolParameters p -> setProtocolParameters p
19-
StartProtocol filePath -> startProtocol filePath
19+
StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket
2020
ReadSigningKey name filePath -> readSigningKey name filePath
2121
DefineSigningKey name descr -> defineSigningKey name descr
2222
AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName

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

+11-5
Original file line numberDiff line numberDiff line change
@@ -62,14 +62,20 @@ makeNodeConfig logConfig = liftToAction $ ExceptT $ do
6262
Left err -> return $ Left $ MkNodeConfigError err
6363
Right nc' -> return $ Right nc'
6464

65-
startProtocol :: FilePath -> ActionM ()
66-
startProtocol filePath = do
67-
nodeConfig <- makeNodeConfig filePath
65+
startProtocol :: FilePath -> Maybe FilePath -> ActionM ()
66+
startProtocol configFile tracerSocket = do
67+
nodeConfig <- makeNodeConfig configFile
6868
protocol <- makeConsensusProtocol nodeConfig
6969
set Protocol protocol
7070
set Genesis $ Core.getGenesis protocol
71-
set (User TNetworkId) $ protocolToNetworkId protocol
72-
liftIO initDefaultTracers >>= set Store.BenchTracers
71+
let networkId = protocolToNetworkId protocol
72+
set (User TNetworkId) networkId
73+
tracers <- case tracerSocket of
74+
Nothing -> liftIO initDefaultTracers
75+
Just socket -> do
76+
iomgr <- askIOManager
77+
liftIO $ initTracers iomgr networkId socket
78+
set Store.BenchTracers tracers
7379

7480
shutDownLogging :: ActionM ()
7581
shutDownLogging = do

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ data Action where
3131
Set :: !SetKeyVal -> Action
3232
-- Declare :: SetKeyVal -> Action --declare (once): error if key was set before
3333
InitWallet :: !WalletName -> Action
34-
StartProtocol :: !FilePath -> Action
34+
StartProtocol :: !FilePath -> !(Maybe FilePath) -> Action
3535
Delay :: !Double -> Action
3636
ReadSigningKey :: !KeyName -> !SigningKeyFile -> Action
3737
DefineSigningKey :: !KeyName -> !TextEnvelope -> Action

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

+79-11
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
{-# LANGUAGE KindSignatures #-}
88
{-# LANGUAGE LambdaCase #-}
99
{-# LANGUAGE MultiParamTypeClasses #-}
10+
{-# LANGUAGE NamedFieldPuns #-}
1011
{-# LANGUAGE PackageImports #-}
1112
{-# LANGUAGE RankNTypes #-}
1213
{-# LANGUAGE ScopedTypeVariables #-}
@@ -19,7 +20,8 @@
1920
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
2021

2122
module Cardano.Benchmarking.Tracer
22-
( initDefaultTracers
23+
( initTracers
24+
, initDefaultTracers
2325
, initNullTracers
2426
)
2527
where
@@ -35,21 +37,39 @@ import qualified Data.Map as Map
3537
import Data.Proxy
3638
import Data.Text (Text)
3739
import qualified Data.Text as Text
40+
import Data.Time.Clock
41+
42+
import Trace.Forward.Utils.DataPoint
43+
import Trace.Forward.Utils.TraceObject
44+
import Ouroboros.Network.IOManager (IOManager)
3845

3946
import Cardano.Api
4047
import Cardano.Logging
48+
import Cardano.Node.Startup
4149

4250
import Cardano.Benchmarking.LogTypes
4351
import Cardano.Benchmarking.Types
4452
import Cardano.Benchmarking.Version as Version
4553

46-
generatorTracer :: LogFormatting a => (a -> Namespace) -> Text -> Trace IO FormattedMessage -> IO (Trace IO a)
47-
generatorTracer namesFor tracerName tr = do
48-
tr' <- machineFormatter Nothing tr
49-
tr'' <- withDetailsFromConfig tr'
54+
generatorTracer ::
55+
LogFormatting a
56+
=> (a -> Namespace)
57+
-> Text
58+
-> Maybe (Trace IO FormattedMessage)
59+
-> Maybe (Trace IO FormattedMessage)
60+
-> IO (Trace IO a)
61+
generatorTracer namesFor tracerName mbTrStdout mbTrForward = do
62+
forwardTrace <- case mbTrForward of
63+
Nothing -> mempty
64+
Just trForward -> forwardFormatter Nothing trForward
65+
stdoutTrace <- case mbTrStdout of
66+
Nothing -> mempty
67+
Just trForward -> machineFormatter Nothing trForward
68+
let tr = forwardTrace <> stdoutTrace
69+
tr' <- withDetailsFromConfig tr
5070
pure $ withNamesAppended namesFor
5171
$ appendName tracerName
52-
tr''
72+
tr'
5373

5474
initNullTracers :: BenchTracers
5575
initNullTracers = BenchTracers
@@ -62,22 +82,70 @@ initNullTracers = BenchTracers
6282

6383
initDefaultTracers :: IO BenchTracers
6484
initDefaultTracers = do
65-
st <- standardTracer
66-
benchTracer <- generatorTracer singletonName "benchmark" st
85+
mbStdoutTracer <- fmap Just standardTracer
86+
let mbForwardingTracer = Nothing
87+
benchTracer <- generatorTracer singletonName "benchmark" mbStdoutTracer mbForwardingTracer
88+
configureTracers initialTraceConfig benchTracerDocumented [benchTracer]
89+
n2nSubmitTracer <- generatorTracer singletonName "submitN2N" mbStdoutTracer mbForwardingTracer
90+
configureTracers initialTraceConfig nodeToNodeSubmissionTraceDocumented [n2nSubmitTracer]
91+
connectTracer <- generatorTracer singletonName "connect" mbStdoutTracer mbForwardingTracer
92+
configureTracers initialTraceConfig sendRecvConnectDocumented [connectTracer]
93+
submitTracer <- generatorTracer namesForSubmission2 "submit" mbStdoutTracer mbForwardingTracer
94+
configureTracers initialTraceConfig submission2Documented [submitTracer]
95+
96+
return $ BenchTracers
97+
{ btTxSubmit_ = Tracer (traceWith benchTracer)
98+
, btConnect_ = Tracer (traceWith connectTracer)
99+
, btSubmission2_ = Tracer (traceWith submitTracer)
100+
, btN2N_ = Tracer (traceWith n2nSubmitTracer)
101+
}
102+
103+
104+
initTracers ::
105+
IOManager
106+
-> NetworkId
107+
-> FilePath
108+
-> IO BenchTracers
109+
initTracers iomgr networkId tracerSocket = do
110+
(forwardingTracer :: Trace IO FormattedMessage, dpTracer :: Trace IO DataPoint) <- do
111+
(forwardSink :: ForwardSink TraceObject, dpStore) <- initForwarding iomgr initialTraceConfig (toNetworkMagic networkId)
112+
Nothing $ Just (tracerSocket, Initiator)
113+
pure (forwardTracer forwardSink, dataPointTracer dpStore)
114+
mbStdoutTracer <- fmap Just standardTracer
115+
let mbForwardingTracer = Just forwardingTracer
116+
benchTracer <- generatorTracer singletonName "benchmark" mbStdoutTracer mbForwardingTracer
67117
configureTracers initialTraceConfig benchTracerDocumented [benchTracer]
68-
n2nSubmitTracer <- generatorTracer singletonName "submitN2N" st
118+
n2nSubmitTracer <- generatorTracer singletonName "submitN2N" mbStdoutTracer mbForwardingTracer
69119
configureTracers initialTraceConfig nodeToNodeSubmissionTraceDocumented [n2nSubmitTracer]
70-
connectTracer <- generatorTracer singletonName "connect" st
120+
connectTracer <- generatorTracer singletonName "connect" mbStdoutTracer mbForwardingTracer
71121
configureTracers initialTraceConfig sendRecvConnectDocumented [connectTracer]
72-
submitTracer <- generatorTracer namesForSubmission2 "submit" st
122+
submitTracer <- generatorTracer namesForSubmission2 "submit" mbStdoutTracer mbForwardingTracer
73123
configureTracers initialTraceConfig submission2Documented [submitTracer]
124+
-- Now we need to provide "Nodeinfo" DataPoint, to forward generator's name
125+
-- to the acceptor application (for example, 'cardano-tracer').
126+
nodeInfoTracer <- mkDataPointTracer dpTracer (const ["NodeInfo"])
127+
prepareGenInfo >>= traceWith nodeInfoTracer
74128

129+
traceWith benchTracer $ TraceTxGeneratorVersion Version.txGeneratorVersion
130+
-- traceWith st $ show $ TraceTxGeneratorVersion Version.txGeneratorVersion
75131
return $ BenchTracers
76132
{ btTxSubmit_ = Tracer (traceWith benchTracer)
77133
, btConnect_ = Tracer (traceWith connectTracer)
78134
, btSubmission2_ = Tracer (traceWith submitTracer)
79135
, btN2N_ = Tracer (traceWith n2nSubmitTracer)
80136
}
137+
where
138+
prepareGenInfo = do
139+
now <- getCurrentTime
140+
return $ NodeInfo
141+
{ niName = "TxGenerator"
142+
, niProtocol = "N/A"
143+
, niVersion = _compilerVersion
144+
, niCommit = _gitRev
145+
, niStartTime = now
146+
, niSystemStartTime = now
147+
}
148+
Version{_compilerVersion, _gitRev} = Version.txGeneratorVersion
81149

82150
initialTraceConfig :: TraceConfig
83151
initialTraceConfig = TraceConfig {

‎bench/tx-generator/tx-generator.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -116,6 +116,7 @@ library
116116
, text
117117
, time
118118
, trace-dispatcher
119+
, trace-forward
119120
, transformers
120121
, transformers-except
121122
, unordered-containers

‎nix/nixos/tx-generator-service.nix

+5-1
Original file line numberDiff line numberDiff line change
@@ -96,6 +96,8 @@ in pkgs.commonLib.defServiceModule
9696

9797
sigKey = mayOpt str "Key with funds";
9898

99+
tracerSocketPath =
100+
mayOpt str "Socket path of cardano-tracer";
99101
localNodeSocketPath =
100102
mayOpt str "Local node socket path";
101103
localNodeConf = mayOpt attrs "Config of the local node";
@@ -119,7 +121,9 @@ in pkgs.commonLib.defServiceModule
119121
configExeArgsFn = cfg: [
120122
"json_highlevel"
121123
"${pkgs.writeText "tx-gen-config.json" (cfg.decideRunScript cfg)}"
122-
];
124+
] ++ optionals (cfg.tracerSocketPath != null) [
125+
"--cardano-tracer" cfg.tracerSocketPath
126+
];
123127

124128
configSystemdExtraConfig = _: {};
125129

‎nix/workbench/backend/services-config.nix

+3-1
Original file line numberDiff line numberDiff line change
@@ -84,13 +84,15 @@ with lib;
8484
profile: nodeSpec: args: args;
8585

8686
finaliseGeneratorService =
87-
svc: recursiveUpdate svc
87+
profile: svc: recursiveUpdate svc
8888
({
8989
sigKey = "./genesis/utxo-keys/utxo1.skey";
9090
runScriptFile = "run-script.json";
9191
## path to the config and socket of the locally running node.
9292
nodeConfigFile = "./node-0/config.json";
9393
localNodeSocketPath = "./node-0/node.socket";
94+
} // optionalAttrs profile.node.tracer {
95+
tracerSocketPath = "../tracer/tracer.socket";
9496
} // optionalAttrs useCabalRun {
9597
executable = "cabal run exe:tx-generator --";
9698
});

‎nix/workbench/profiles/generator-service.nix

+1-1
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ let
2626
ShelleyGenesisFile ByronGenesisFile;
2727
};
2828
in
29-
services-config.finaliseGeneratorService
29+
services-config.finaliseGeneratorService profile.value
3030
{
3131
inherit (profile.value) era;
3232

0 commit comments

Comments
 (0)