Skip to content

Commit dd72950

Browse files
jutarojutaro
committed
cardano-node: forMachine MuxTrace
1 parent ce3e2e0 commit dd72950

File tree

1 file changed

+196
-5
lines changed

1 file changed

+196
-5
lines changed

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

Lines changed: 196 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,12 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE CPP #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE GADTs #-}
6+
{-# LANGUAGE NamedFieldPuns #-}
57
{-# LANGUAGE ScopedTypeVariables #-}
68

9+
710
{-# OPTIONS_GHC -Wno-orphans #-}
811

912
module Cardano.Node.Tracing.Tracers.Diffusion
@@ -13,6 +16,7 @@ import Cardano.Logging
1316
import Data.Aeson (Value (String), (.=))
1417
import Data.Text (pack)
1518
import Network.Mux (MuxTrace (..), WithMuxBearer (..))
19+
import Network.Mux.Types
1620
import Network.TypedProtocol.Codec (AnyMessageAndAgency (..))
1721

1822
import Cardano.Node.Types (UseLedger (..))
@@ -29,14 +33,14 @@ import qualified Ouroboros.Network.Protocol.Handshake.Type as HS
2933
-- Mux Tracer
3034
--------------------------------------------------------------------------------
3135

32-
instance (LogFormatting peer, Show peer) =>
36+
instance (LogFormatting peer, LogFormatting MuxTrace) =>
3337
LogFormatting (WithMuxBearer peer MuxTrace) where
3438
forMachine dtal (WithMuxBearer b ev) =
35-
mconcat [ "kind" .= String "MuxTrace"
39+
mconcat [ "kind" .= String "MuxTrace"
3640
, "bearer" .= forMachine dtal b
37-
, "event" .= showT ev ]
38-
forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b
39-
<> ". " <> showT ev
41+
, "event" .= forMachine dtal ev ]
42+
forHuman (WithMuxBearer b ev) = "With mux bearer " <> forHuman b
43+
<> ". " <> forHuman ev
4044

4145
instance MetaTrace tr => MetaTrace (WithMuxBearer peer tr) where
4246
namespaceFor (WithMuxBearer _peer obj) = (nsCast . namespaceFor) obj
@@ -53,6 +57,193 @@ instance MetaTrace tr => MetaTrace (WithMuxBearer peer tr) where
5357
metricsDocFor ns = metricsDocFor (nsCast ns :: Namespace tr)
5458
allNamespaces = map nsCast (allNamespaces :: [Namespace tr])
5559

60+
instance LogFormatting MuxTrace where
61+
forMachine _dtal MuxTraceRecvHeaderStart = mconcat
62+
[ "kind" .= String "MuxTraceRecvHeaderStart"
63+
, "msg" .= String "Bearer Receive Header Start"
64+
]
65+
forMachine _dtal (MuxTraceRecvHeaderEnd MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat
66+
[ "kind" .= String "MuxTraceRecvHeaderStart"
67+
, "msg" .= String "Bearer Receive Header End"
68+
, "timestamp" .= String (showT (unRemoteClockModel mhTimestamp))
69+
, "miniProtocolNum" .= String (showT mhNum)
70+
, "miniProtocolDir" .= String (showT mhDir)
71+
, "length" .= String (showT mhLength)
72+
]
73+
forMachine _dtal (MuxTraceRecvDeltaQObservation MuxSDUHeader { mhTimestamp, mhLength } ts) = mconcat
74+
[ "kind" .= String "MuxTraceRecvDeltaQObservation"
75+
, "msg" .= String "Bearer DeltaQ observation"
76+
, "timeRemote" .= String (showT ts)
77+
, "timeLocal" .= String (showT (unRemoteClockModel mhTimestamp))
78+
, "length" .= String (showT mhLength)
79+
]
80+
forMachine _dtal (MuxTraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = mconcat
81+
[ "kind" .= String "MuxTraceRecvDeltaQSample"
82+
, "msg" .= String "Bearer DeltaQ Sample"
83+
, "duration" .= String (showT d)
84+
, "packets" .= String (showT sp)
85+
, "sumBytes" .= String (showT so)
86+
, "DeltaQ_S" .= String (showT dqs)
87+
, "DeltaQ_VMean" .= String (showT dqvm)
88+
, "DeltaQ_VVar" .= String (showT dqvs)
89+
, "DeltaQ_estR" .= String (showT estR)
90+
, "sizeDist" .= String (showT sdud)
91+
]
92+
forMachine _dtal (MuxTraceRecvStart len) = mconcat
93+
[ "kind" .= String "MuxTraceRecvStart"
94+
, "msg" .= String "Bearer Receive Start"
95+
, "length" .= String (showT len)
96+
]
97+
forMachine _dtal (MuxTraceRecvEnd len) = mconcat
98+
[ "kind" .= String "MuxTraceRecvEnd"
99+
, "msg" .= String "Bearer Receive End"
100+
, "length" .= String (showT len)
101+
]
102+
forMachine _dtal (MuxTraceSendStart MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat
103+
[ "kind" .= String "MuxTraceSendStart"
104+
, "msg" .= String "Bearer Send Start"
105+
, "timestamp" .= String (showT (unRemoteClockModel mhTimestamp))
106+
, "miniProtocolNum" .= String (showT mhNum)
107+
, "miniProtocolDir" .= String (showT mhDir)
108+
, "length" .= String (showT mhLength)
109+
]
110+
forMachine _dtal MuxTraceSendEnd = mconcat
111+
[ "kind" .= String "MuxTraceSendEnd"
112+
, "msg" .= String "Bearer Send End"
113+
]
114+
forMachine _dtal (MuxTraceState new) = mconcat
115+
[ "kind" .= String "MuxTraceState"
116+
, "msg" .= String "MuxState"
117+
, "state" .= String (showT new)
118+
]
119+
forMachine _dtal (MuxTraceCleanExit mid dir) = mconcat
120+
[ "kind" .= String "MuxTraceCleanExit"
121+
, "msg" .= String "Miniprotocol terminated cleanly"
122+
, "miniProtocolNum" .= String (showT mid)
123+
, "miniProtocolDir" .= String (showT dir)
124+
]
125+
forMachine _dtal (MuxTraceExceptionExit mid dir exc) = mconcat
126+
[ "kind" .= String "MuxTraceExceptionExit"
127+
, "msg" .= String "Miniprotocol terminated with exception"
128+
, "miniProtocolNum" .= String (showT mid)
129+
, "miniProtocolDir" .= String (showT dir)
130+
, "exception" .= String (showT exc)
131+
]
132+
forMachine _dtal (MuxTraceChannelRecvStart mid) = mconcat
133+
[ "kind" .= String "MuxTraceChannelRecvStart"
134+
, "msg" .= String "Channel Receive Start"
135+
, "miniProtocolNum" .= String (showT mid)
136+
]
137+
forMachine _dtal (MuxTraceChannelRecvEnd mid len) = mconcat
138+
[ "kind" .= String "MuxTraceChannelRecvEnd"
139+
, "msg" .= String "Channel Receive End"
140+
, "miniProtocolNum" .= String (showT mid)
141+
, "length" .= String (showT len)
142+
]
143+
forMachine _dtal (MuxTraceChannelSendStart mid len) = mconcat
144+
[ "kind" .= String "MuxTraceChannelSendStart"
145+
, "msg" .= String "Channel Send Start"
146+
, "miniProtocolNum" .= String (showT mid)
147+
, "length" .= String (showT len)
148+
]
149+
forMachine _dtal (MuxTraceChannelSendEnd mid) = mconcat
150+
[ "kind" .= String "MuxTraceChannelSendEnd"
151+
, "msg" .= String "Channel Send End"
152+
, "miniProtocolNum" .= String (showT mid)
153+
]
154+
forMachine _dtal MuxTraceHandshakeStart = mconcat
155+
[ "kind" .= String "MuxTraceHandshakeStart"
156+
, "msg" .= String "Handshake start"
157+
]
158+
forMachine _dtal (MuxTraceHandshakeClientEnd duration) = mconcat
159+
[ "kind" .= String "MuxTraceHandshakeClientEnd"
160+
, "msg" .= String "Handshake Client end"
161+
, "duration" .= String (showT duration)
162+
]
163+
forMachine _dtal MuxTraceHandshakeServerEnd = mconcat
164+
[ "kind" .= String "MuxTraceHandshakeServerEnd"
165+
, "msg" .= String "Handshake Server end"
166+
]
167+
forMachine dtal (MuxTraceHandshakeClientError e duration) = mconcat
168+
[ "kind" .= String "MuxTraceHandshakeClientError"
169+
, "msg" .= String "Handshake Client Error"
170+
, "duration" .= String (showT duration)
171+
-- Client Error can include an error string from the peer which could be very large.
172+
, "error" .= if dtal >= DDetailed
173+
then show e
174+
else take 256 $ show e
175+
]
176+
forMachine dtal (MuxTraceHandshakeServerError e) = mconcat
177+
[ "kind" .= String "MuxTraceHandshakeServerError"
178+
, "msg" .= String "Handshake Server Error"
179+
, "error" .= if dtal >= DDetailed
180+
then show e
181+
else take 256 $ show e
182+
]
183+
forMachine _dtal MuxTraceSDUReadTimeoutException = mconcat
184+
[ "kind" .= String "MuxTraceSDUReadTimeoutException"
185+
, "msg" .= String "Timed out reading SDU"
186+
]
187+
forMachine _dtal MuxTraceSDUWriteTimeoutException = mconcat
188+
[ "kind" .= String "MuxTraceSDUWriteTimeoutException"
189+
, "msg" .= String "Timed out writing SDU"
190+
]
191+
forMachine _dtal (MuxTraceStartEagerly mid dir) = mconcat
192+
[ "kind" .= String "MuxTraceStartEagerly"
193+
, "msg" .= String "Eagerly started"
194+
, "miniProtocolNum" .= String (showT mid)
195+
, "miniProtocolDir" .= String (showT dir)
196+
]
197+
forMachine _dtal (MuxTraceStartOnDemand mid dir) = mconcat
198+
[ "kind" .= String "MuxTraceStartOnDemand"
199+
, "msg" .= String "Preparing to start"
200+
, "miniProtocolNum" .= String (showT mid)
201+
, "miniProtocolDir" .= String (showT dir)
202+
]
203+
forMachine _dtal (MuxTraceStartedOnDemand mid dir) = mconcat
204+
[ "kind" .= String "MuxTraceStartedOnDemand"
205+
, "msg" .= String "Started on demand"
206+
, "miniProtocolNum" .= String (showT mid)
207+
, "miniProtocolDir" .= String (showT dir)
208+
]
209+
forMachine _dtal (MuxTraceTerminating mid dir) = mconcat
210+
[ "kind" .= String "MuxTraceTerminating"
211+
, "msg" .= String "Terminating"
212+
, "miniProtocolNum" .= String (showT mid)
213+
, "miniProtocolDir" .= String (showT dir)
214+
]
215+
forMachine _dtal MuxTraceStopping = mconcat
216+
[ "kind" .= String "MuxTraceStopping"
217+
, "msg" .= String "Mux stopping"
218+
]
219+
forMachine _dtal MuxTraceStopped = mconcat
220+
[ "kind" .= String "MuxTraceStopped"
221+
, "msg" .= String "Mux stoppped"
222+
]
223+
#ifdef os_HOST_linux
224+
forMachine _dtal (MuxTraceTCPInfo StructTCPInfo
225+
{ tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans
226+
, tcpi_rtt, tcpi_rttvar, tcpi_snd_cwnd }
227+
len) =
228+
[ "kind" .= String "MuxTraceTCPInfo"
229+
, "msg" .= String "TCPInfo"
230+
, "rtt" .= String (show (fromIntegral tcpi_rtt :: Word))
231+
, "rttvar" .= String (show (fromIntegral tcpi_rttvar :: Word))
232+
, "snd_cwnd" .= String (show (fromIntegral tcpi_snd_cwnd :: Word))
233+
, "snd_mss" .= String (show (fromIntegral tcpi_snd_mss :: Word))
234+
, "rcv_mss" .= String (show (fromIntegral tcpi_rcv_mss :: Word))
235+
, "lost" .= String (show (fromIntegral tcpi_lost :: Word))
236+
, "retrans" .= String (show (fromIntegral tcpi_retrans :: Word))
237+
, "length" .= String (showT len)
238+
]
239+
#else
240+
forMachine _dtal (MuxTraceTCPInfo _ len) = mconcat
241+
[ "kind" .= String "MuxTraceTCPInfo"
242+
, "msg" .= String "TCPInfo"
243+
, "len" .= String (showT len)
244+
]
245+
#endif
246+
56247
instance MetaTrace MuxTrace where
57248
namespaceFor MuxTraceRecvHeaderStart {} =
58249
Namespace [] ["RecvHeaderStart"]

0 commit comments

Comments
 (0)