Skip to content

Commit 4139153

Browse files
mgmeiermgmeier
authored
Merge pull request #5460 from input-output-hk/jutaro/deadlock-stdout-thread-tx-generator
Fix deadlock issue with stdout tracer in tx-generator
2 parents 7b5e194 + f4cbcb8 commit 4139153

File tree

11 files changed

+67
-65
lines changed

11 files changed

+67
-65
lines changed

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

+6-6
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE FlexibleContexts #-}
2-
{-# LANGUAGE PackageImports #-}
32
{-# LANGUAGE RankNTypes #-}
43
{-# LANGUAGE ScopedTypeVariables #-}
54
{-# LANGUAGE UndecidableInstances #-}
@@ -21,14 +20,15 @@ import Cardano.Prelude
2120
import Prelude (String)
2221

2322
import qualified Control.Concurrent.STM as STM
24-
import "contra-tracer" Control.Tracer (Tracer, traceWith)
2523
import qualified Data.Time.Clock as Clock
2624

2725
import qualified Data.List.NonEmpty as NE
2826
import Data.Text (pack)
2927
import Network.Socket (AddrInfo (..), AddrInfoFlag (..), Family (..), SocketType (Stream),
3028
addrFamily, addrFlags, addrSocketType, defaultHints, getAddrInfo)
3129

30+
import Cardano.Logging
31+
3232
import Cardano.Node.Configuration.NodeAddress
3333

3434
import Cardano.Api hiding (txFee)
@@ -45,7 +45,7 @@ import Cardano.TxGenerator.Types (NumberOfTxs, TPSRate, TxGenError (..
4545

4646
type AsyncBenchmarkControl = (Async (), [Async ()], IO SubmissionSummary, IO ())
4747

48-
waitBenchmark :: Tracer IO (TraceBenchTxSubmit TxId) -> AsyncBenchmarkControl -> ExceptT TxGenError IO ()
48+
waitBenchmark :: Trace IO (TraceBenchTxSubmit TxId) -> AsyncBenchmarkControl -> ExceptT TxGenError IO ()
4949
waitBenchmark traceSubmit (feeder, workers, mkSummary, _) = liftIO $ do
5050
mapM_ waitCatch (feeder : workers)
5151
traceWith traceSubmit . TraceBenchTxSubSummary =<< mkSummary
@@ -67,7 +67,7 @@ lookupNodeAddress node = do
6767
}
6868

6969
handleTxSubmissionClientError ::
70-
Tracer IO (TraceBenchTxSubmit TxId)
70+
Trace IO (TraceBenchTxSubmit TxId)
7171
-> Network.Socket.AddrInfo
7272
-> ReportRef
7373
-> SubmissionErrorPolicy
@@ -91,8 +91,8 @@ handleTxSubmissionClientError
9191
, show err]
9292

9393
walletBenchmark :: forall era. IsShelleyBasedEra era
94-
=> Tracer IO (TraceBenchTxSubmit TxId)
95-
-> Tracer IO NodeToNodeSubmissionTrace
94+
=> Trace IO (TraceBenchTxSubmit TxId)
95+
-> Trace IO NodeToNodeSubmissionTrace
9696
-> ConnectClient
9797
-> String
9898
-> NonEmpty NodeIPv4Address

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

+8-7
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,8 @@ module Cardano.Benchmarking.GeneratorTx.NodeToNode
1414
import Cardano.Prelude (forever, liftIO)
1515
import Prelude
1616

17+
import "contra-tracer" Control.Tracer (Tracer (..))
18+
1719
import Codec.Serialise (DeserialiseFailure)
1820
import Control.Concurrent.Class.MonadSTM.Strict (newTVarIO)
1921
import Control.Monad.Class.MonadTimer (MonadTimer, threadDelay)
@@ -23,7 +25,6 @@ import Data.Proxy (Proxy (..))
2325
import Network.Socket (AddrInfo (..))
2426
import System.Random (newStdGen)
2527

26-
import "contra-tracer" Control.Tracer (Tracer, nullTracer)
2728
import Ouroboros.Consensus.Block.Abstract
2829
import Ouroboros.Consensus.Byron.Ledger.Mempool (GenTx)
2930
import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock)
@@ -79,7 +80,7 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
7980
NtN.connectTo
8081
(socketSnocket ioManager)
8182
NetworkConnectTracers {
82-
nctMuxTracer = nullTracer,
83+
nctMuxTracer = mempty,
8384
nctHandshakeTracer = handshakeTracer
8485
}
8586
peerMultiplex
@@ -117,12 +118,12 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
117118
NtN.NodeToNodeProtocols
118119
{ NtN.chainSyncProtocol = InitiatorProtocolOnly $
119120
MuxPeer
120-
nullTracer
121+
mempty
121122
(cChainSyncCodec myCodecs)
122123
chainSyncPeerNull
123124
, NtN.blockFetchProtocol = InitiatorProtocolOnly $
124125
MuxPeer
125-
nullTracer
126+
mempty
126127
(cBlockFetchCodec myCodecs)
127128
(blockFetchClientPeer blockFetchClientNull)
128129
, NtN.keepAliveProtocol = InitiatorProtocolOnly $
@@ -135,7 +136,7 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
135136
(txSubmissionClientPeer myTxSubClient)
136137
, NtN.peerSharingProtocol = InitiatorProtocolOnly $
137138
MuxPeer
138-
nullTracer
139+
mempty
139140
(cPeerSharingCodec myCodecs)
140141
(peerSharingClientPeer peerSharingClientNull)
141142
} )
@@ -152,14 +153,14 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
152153
keepAliveRng <- newStdGen
153154
peerGSVMap <- liftIO . newTVarIO $ Map.singleton them defaultGSV
154155
runPeerWithLimits
155-
nullTracer
156+
mempty
156157
(cKeepAliveCodec myCodecs)
157158
(byteLimitsKeepAlive (const 0)) -- TODO: Real Bytelimits, see #1727
158159
timeLimitsKeepAlive
159160
channel
160161
$ keepAliveClientPeer
161162
$ keepAliveClient
162-
nullTracer
163+
mempty
163164
keepAliveRng
164165
(continueForever (Proxy :: Proxy IO)) them peerGSVMap
165166
(KeepAliveInterval 10)

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

+4-5
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@
99
{-# LANGUAGE MultiParamTypeClasses #-}
1010
{-# LANGUAGE NoMonomorphismRestriction #-}
1111
{-# LANGUAGE OverloadedStrings #-}
12-
{-# LANGUAGE PackageImports #-}
1312
{-# LANGUAGE RankNTypes #-}
1413
{-# LANGUAGE ScopedTypeVariables #-}
1514
{-# LANGUAGE TypeApplications #-}
@@ -39,8 +38,6 @@ import qualified Data.Text as T
3938
import Data.Type.Equality (type (~))
4039
#endif
4140

42-
import "contra-tracer" Control.Tracer (Tracer, traceWith)
43-
4441
import Cardano.Tracing.OrphanInstances.Byron ()
4542
import Cardano.Tracing.OrphanInstances.Common ()
4643
import Cardano.Tracing.OrphanInstances.Consensus ()
@@ -65,6 +62,8 @@ import Ouroboros.Network.Protocol.TxSubmission2.Type (BlockingReplyLis
6562
import Cardano.Api
6663
import Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx)
6764

65+
import Cardano.Logging
66+
6867
import Cardano.Benchmarking.LogTypes
6968
import Cardano.Benchmarking.Types
7069
type CardanoBlock = Consensus.CardanoBlock StandardCrypto
@@ -100,8 +99,8 @@ txSubmissionClient
10099
, IsShelleyBasedEra era
101100
, tx ~ Tx era
102101
)
103-
=> Tracer m NodeToNodeSubmissionTrace
104-
-> Tracer m (TraceBenchTxSubmit TxId)
102+
=> Trace m NodeToNodeSubmissionTrace
103+
-> Trace m (TraceBenchTxSubmit TxId)
105104
-> TxSource era
106105
-> EndOfProtocolCallback m
107106
-> TxSubmissionClient (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()

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

+6-7
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@
55
{-# LANGUAGE FlexibleInstances #-}
66
{-# LANGUAGE GADTs #-}
77
{-# LANGUAGE MultiParamTypeClasses #-}
8-
{-# LANGUAGE PackageImports #-}
98
{-# LANGUAGE ScopedTypeVariables #-}
109

1110
{-# OPTIONS_GHC -Wno-all-missed-specialisations #-}
@@ -32,10 +31,10 @@ import GHC.Generics
3231
import Cardano.Api
3332
import qualified Codec.CBOR.Term as CBOR
3433

35-
import "contra-tracer" Control.Tracer
36-
3734
import Network.Mux (WithMuxBearer (..))
3835

36+
import Cardano.Logging
37+
3938
import Cardano.Tracing.OrphanInstances.Byron ()
4039
import Cardano.Tracing.OrphanInstances.Common ()
4140
import Cardano.Tracing.OrphanInstances.Consensus ()
@@ -57,10 +56,10 @@ import Cardano.TxGenerator.Types (TPSRate)
5756

5857
data BenchTracers =
5958
BenchTracers
60-
{ btTxSubmit_ :: Tracer IO (TraceBenchTxSubmit TxId)
61-
, btConnect_ :: Tracer IO SendRecvConnect
62-
, btSubmission2_:: Tracer IO SendRecvTxSubmission2
63-
, btN2N_ :: Tracer IO NodeToNodeSubmissionTrace
59+
{ btTxSubmit_ :: Trace IO (TraceBenchTxSubmit TxId)
60+
, btConnect_ :: Trace IO SendRecvConnect
61+
, btSubmission2_:: Trace IO SendRecvTxSubmission2
62+
, btN2N_ :: Trace IO NodeToNodeSubmissionTrace
6463
}
6564

6665
data TraceBenchTxSubmit txid

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

+1-4
Original file line numberDiff line numberDiff line change
@@ -17,10 +17,9 @@ import Ouroboros.Network.NodeToClient (IOManager)
1717

1818
import Cardano.Benchmarking.Script.Action
1919
import Cardano.Benchmarking.Script.Aeson (parseScriptFileAeson)
20-
import Cardano.Benchmarking.Script.Core (setProtocolParameters, traceTxGeneratorVersion)
20+
import Cardano.Benchmarking.Script.Core (setProtocolParameters)
2121
import Cardano.Benchmarking.Script.Env
2222
import Cardano.Benchmarking.Script.Types
23-
import Cardano.Benchmarking.Tracer
2423

2524
type Script = [Action]
2625

@@ -37,8 +36,6 @@ runScript script iom = runActionM execScript iom >>= \case
3736
where
3837
cleanup s a = void $ runActionMEnv s a iom
3938
execScript = do
40-
liftIO (initTxGenTracers Nothing) >>= setBenchTracers
41-
traceTxGeneratorVersion
4239
setProtocolParameters QueryLocalNode
4340
forM_ script action
4441

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

+6-3
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,13 @@
1818
module Cardano.Benchmarking.Script.Core
1919
where
2020

21+
import "contra-tracer" Control.Tracer (Tracer (..))
22+
2123
import Control.Concurrent (threadDelay)
2224
import Control.Monad
2325
import Control.Monad.IO.Class
2426
import Control.Monad.Trans.Except
2527
import Control.Monad.Trans.Except.Extra
26-
import "contra-tracer" Control.Tracer (nullTracer)
2728
import Data.ByteString.Lazy.Char8 as BSL (writeFile)
2829
import Data.Ratio ((%))
2930

@@ -37,6 +38,8 @@ import Cardano.Api
3738
import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters,
3839
protocolParamMaxTxExUnits, protocolParamPrices)
3940

41+
import Cardano.Logging hiding(LocalSocket)
42+
4043
import Cardano.TxGenerator.Fund as Fund
4144
import qualified Cardano.TxGenerator.FundQueue as FundQueue
4245
import Cardano.TxGenerator.Setup.Plutus as Plutus
@@ -141,8 +144,8 @@ getConnectClient = do
141144
ioManager <- askIOManager
142145
return $ benchmarkConnectTxSubmit
143146
ioManager
144-
(btConnect_ tracers)
145-
nullTracer -- (btSubmission2_ tracers)
147+
(Tracer $ traceWith (btConnect_ tracers))
148+
mempty -- (btSubmission2_ tracers)
146149
(protocolToCodecConfig protocol)
147150
networkMagic
148151
waitBenchmark :: String -> ActionM ()

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
{-# LANGUAGE GADTs #-}
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE MultiParamTypeClasses #-}
6-
{-# LANGUAGE PackageImports #-}
76
{-# LANGUAGE RankNTypes #-}
87
{-# LANGUAGE ScopedTypeVariables #-}
98
{-# LANGUAGE StandaloneDeriving #-}
@@ -63,14 +62,15 @@ import Control.Monad.Trans.Class
6362
import Control.Monad.Trans.Except
6463
import Control.Monad.Trans.RWS.Strict (RWST)
6564
import qualified Control.Monad.Trans.RWS.Strict as RWS
66-
import "contra-tracer" Control.Tracer (traceWith)
6765
import Data.Map.Strict (Map)
6866
import qualified Data.Map.Strict as Map
6967
import qualified Data.Text as Text
7068
import Prelude
7169

7270
import Cardano.Api (File (..), SocketPath)
7371

72+
import Cardano.Logging
73+
7474
import Cardano.Benchmarking.GeneratorTx
7575
import qualified Cardano.Benchmarking.LogTypes as Tracer
7676
import Cardano.Benchmarking.OuroborosImports (NetworkId, PaymentKey, ShelleyGenesis,

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

+18-16
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@
88
{-# LANGUAGE LambdaCase #-}
99
{-# LANGUAGE MultiParamTypeClasses #-}
1010
{-# LANGUAGE NamedFieldPuns #-}
11-
{-# LANGUAGE PackageImports #-}
1211
{-# LANGUAGE RankNTypes #-}
1312
{-# LANGUAGE ScopedTypeVariables #-}
1413
{-# LANGUAGE TypeApplications #-}
@@ -25,7 +24,6 @@ module Cardano.Benchmarking.Tracer
2524
)
2625
where
2726

28-
import "contra-tracer" Control.Tracer (Tracer (..), nullTracer)
2927
import GHC.Generics
3028

3129
import Data.Aeson as A
@@ -72,10 +70,10 @@ generatorTracer tracerName mbTrStdout mbTrForward = do
7270

7371
initNullTracers :: BenchTracers
7472
initNullTracers = BenchTracers
75-
{ btTxSubmit_ = nullTracer
76-
, btConnect_ = nullTracer
77-
, btSubmission2_ = nullTracer
78-
, btN2N_ = nullTracer
73+
{ btTxSubmit_ = mempty
74+
, btConnect_ = mempty
75+
, btSubmission2_ = mempty
76+
, btN2N_ = mempty
7977
}
8078

8179
-- if the first argument isJust, we assume we have a socket path
@@ -87,20 +85,24 @@ initTxGenTracers mbForwarding = do
8785
confState <- emptyConfigReflection
8886

8987
let
90-
mkTracer :: (LogFormatting a, MetaTrace a) => Text -> IO (Tracer IO a)
91-
mkTracer namespace
92-
| isPrefixSilent namespace = pure nullTracer
88+
mkTracer :: (LogFormatting a, MetaTrace a)
89+
=> Text
90+
-> Maybe (Trace IO FormattedMessage)
91+
-> Maybe (Trace IO FormattedMessage)
92+
-> IO (Trace IO a)
93+
mkTracer namespace mbStdoutTracer' mbForwardingTracer'
94+
| isPrefixSilent namespace = pure mempty
9395
| otherwise = do
94-
tracer <- generatorTracer namespace mbStdoutTracer mbForwardingTracer
96+
tracer <- generatorTracer namespace mbStdoutTracer' mbForwardingTracer'
9597
configureTracers confState initialTraceConfig [tracer]
96-
pure $ Tracer (traceWith tracer)
98+
pure tracer
9799

98-
benchTracer@(Tracer traceBench) <- mkTracer "Benchmark"
99-
n2nSubmitTracer <- mkTracer "SubmitN2N"
100-
connectTracer <- mkTracer "Connect"
101-
submitTracer <- mkTracer "Submit"
100+
benchTracer <- mkTracer "Benchmark" mbStdoutTracer mbForwardingTracer
101+
n2nSubmitTracer <- mkTracer "SubmitN2N" mbStdoutTracer mbForwardingTracer
102+
connectTracer <- mkTracer "Connect" mbStdoutTracer mbForwardingTracer
103+
submitTracer <- mkTracer "Submit" mbStdoutTracer mbForwardingTracer
102104

103-
traceBench $ TraceTxGeneratorVersion Version.txGeneratorVersion
105+
traceWith benchTracer (TraceTxGeneratorVersion Version.txGeneratorVersion)
104106

105107
return $ BenchTracers
106108
{ btTxSubmit_ = benchTracer

‎cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs

+5-8
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,11 @@
44
{-# LANGUAGE OverloadedStrings #-}
55
{-# LANGUAGE PackageImports #-}
66

7-
module Cardano.Node.Tracing.Tracers.Peer where
8-
-- ( PeerT (..)
9-
-- , startPeerTracer
10-
-- , namesForPeers
11-
-- , severityPeers
12-
-- , docPeers
13-
-- , ppPeer
14-
-- ) where
7+
module Cardano.Node.Tracing.Tracers.Peer
8+
( PeerT (..)
9+
, startPeerTracer
10+
, ppPeer
11+
) where
1512

1613
import Cardano.Node.Orphans ()
1714

‎trace-dispatcher/src/Cardano/Logging/Tracer/Standard.hs

+8-4
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,16 @@ module Cardano.Logging.Tracer.Standard (
55
standardTracer
66
) where
77

8+
import Control.Concurrent (myThreadId)
89
import Control.Concurrent.Async
910
import Control.Concurrent.Chan.Unagi.Bounded
10-
import Control.Exception (BlockedIndefinitelyOnMVar, catch)
1111
import Control.Monad (forever, when)
1212
import Control.Monad.IO.Class
1313
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
1414
import Data.Maybe (isNothing)
1515
import Data.Text (Text)
1616
import qualified Data.Text.IO as TIO
17+
import GHC.Conc (labelThread)
1718
import System.IO (hFlush, stdout)
1819

1920
import Cardano.Logging.DocuGenerator
@@ -29,6 +30,8 @@ newtype StandardTracerState = StandardTracerState {
2930
emptyStandardTracerState :: StandardTracerState
3031
emptyStandardTracerState = StandardTracerState Nothing
3132

33+
-- | It is mandatory to construct only one standard tracer in any application!
34+
-- Throwing away a standard tracer and using a new one will result in an exception
3235
standardTracer :: forall m. (MonadIO m)
3336
=> m (Trace m FormattedMessage)
3437
standardTracer = do
@@ -66,9 +69,10 @@ standardTracer = do
6669
startStdoutThread :: IORef StandardTracerState -> IO ()
6770
startStdoutThread stateRef = do
6871
(inChan, outChan) <- newChan 2048
69-
as <- async (catch
70-
(stdoutThread outChan)
71-
(\(_ :: BlockedIndefinitelyOnMVar) -> pure ()))
72+
as <- async (do
73+
tid <- myThreadId
74+
labelThread tid "StdoutTrace"
75+
stdoutThread outChan)
7276
link as
7377
modifyIORef' stateRef (\ st ->
7478
st {stRunning = Just (inChan, outChan, as)})

0 commit comments

Comments
 (0)