@@ -70,13 +70,13 @@ data LeiosEvent
70
70
LeiosEventTcp (LabelLink (TcpEvent LeiosMessage ))
71
71
deriving (Show )
72
72
73
- logLeiosTraceEvent :: Map NodeId T. Text -> Bool -> DiffTime -> LeiosEvent -> Maybe Encoding
74
- logLeiosTraceEvent m emitControl t e = do
75
- x <- logLeiosEvent m emitControl e
73
+ logLeiosTraceEvent :: Map NodeId T. Text -> Int -> DiffTime -> LeiosEvent -> Maybe Encoding
74
+ logLeiosTraceEvent m loudness t e = do
75
+ x <- logLeiosEvent m loudness e
76
76
pure $ (pairs $ " time_s" .= t <> pair " event" x)
77
77
78
- logLeiosEvent :: Map NodeId T. Text -> Bool -> LeiosEvent -> Maybe Encoding
79
- logLeiosEvent nodeNames emitControl e = case e of
78
+ logLeiosEvent :: Map NodeId T. Text -> Int -> LeiosEvent -> Maybe Encoding
79
+ logLeiosEvent nodeNames loudness e = case e of
80
80
LeiosEventSetup {} -> Nothing
81
81
LeiosEventNode (LabelNode nid x) -> do
82
82
pairs <$> logNode nid x
@@ -87,14 +87,19 @@ logLeiosEvent nodeNames emitControl e = case e of
87
87
" tag" .= asString " Sent"
88
88
<> " sender" .= from
89
89
<> " receipient" .= to
90
- <> " fragments" .= length fcs
91
- <> " forecast" .= forecast
92
- -- <> "forecasts" .= fcs
90
+ <> mconcat
91
+ [ " fragments" .= length fcs
92
+ <> " forecast" .= forecast
93
+ | emitDebug
94
+ ]
95
+ <> mconcat [" forecasts" .= fcs | emitControl]
93
96
<> " msg_size_bytes" .= fromBytes (messageSizeBytes msg)
94
97
<> " time_to_received_s" .= (coerce forecast. msgRecvTrailingEdge - coerce forecast. msgSendLeadingEdge :: DiffTime )
95
98
<> " sending_s" .= (coerce forecast. msgSendTrailingEdge - coerce forecast. msgSendLeadingEdge :: DiffTime )
96
99
<> ps
97
100
where
101
+ emitControl = loudness >= 3
102
+ emitDebug = loudness >= 2
98
103
node nid = " node" .= nid <> " node_name" .= nodeNames Map. ! nid
99
104
ibKind = " kind" .= asString " IB"
100
105
ebKind = " kind" .= asString " EB"
@@ -177,26 +182,34 @@ logLeiosEvent nodeNames emitControl e = case e of
177
182
logMsg (PraosMsg (PraosMessage (Right (ProtocolMessage (SomeMessage (MsgBlock hash _body)))))) =
178
183
Just $ rbKind <> " id" .= show (coerce @ _ @ Int hash)
179
184
logMsg (PraosMsg msg)
180
- | emitControl = Just $ mconcat [" id" .= asString " control" , " label " .= praosMessageLabel msg]
185
+ | emitControl = Just $ mconcat [rbKind <> " id" .= asString " control" , " msg_label " .= praosMessageLabel msg]
181
186
| otherwise = Nothing
182
187
logRelay :: (HasField " node" id NodeId , HasField " num" id Int ) => (h -> id ) -> RelayMessage id h b -> Maybe Series
183
- logRelay _getId (ProtocolMessage (SomeMessage (MsgRespondBodies xs))) =
184
- Just $ " ids" .= map (mkStringId . fst ) xs <> " msg_label" .= asString " respond-bodies"
185
- logRelay _getId (ProtocolMessage (SomeMessage (MsgRequestBodies xs))) =
188
+ logRelay _getId (ProtocolMessage (SomeMessage msg@ (MsgRespondBodies xs))) =
186
189
Just $
187
- " ids" .= map mkStringId xs
188
- <> " msg_label" .= asString " request-bodies"
189
- logRelay getId (ProtocolMessage (SomeMessage (MsgRespondHeaders xs))) =
190
- Just $
191
- " ids" .= map (mkStringId . getId) (toList xs)
192
- <> " msg_label" .= asString " respond-headers"
193
- logRelay _getId (ProtocolMessage (SomeMessage (MsgRequestHeaders _ ws we))) =
194
- Just $
195
- " shrink" .= ws. value
196
- <> " expand" .= we. value
197
- <> " msg_label" .= asString " request-headers"
190
+ " ids" .= map (mkStringId . fst ) xs
191
+ <> " msg_label" .= relayMessageLabel msg
192
+ logRelay _getId (ProtocolMessage (SomeMessage msg@ (MsgRequestBodies xs)))
193
+ | emitDebug =
194
+ Just $
195
+ " ids" .= map mkStringId xs
196
+ <> " msg_label" .= relayMessageLabel msg
197
+ logRelay getId (ProtocolMessage (SomeMessage msg@ (MsgRespondHeaders xs)))
198
+ | emitDebug =
199
+ Just $
200
+ " ids" .= map (mkStringId . getId) (toList xs)
201
+ <> " msg_label" .= relayMessageLabel msg
202
+ logRelay _getId (ProtocolMessage (SomeMessage msg@ (MsgRequestHeaders _ ws we)))
203
+ | emitDebug =
204
+ Just $
205
+ " shrink" .= ws. value
206
+ <> " expand" .= we. value
207
+ <> " msg_label" .= relayMessageLabel msg
198
208
logRelay _ (ProtocolMessage (SomeMessage msg))
199
- | emitControl = Just $ " id" .= asString " control" <> " label" .= relayMessageLabel msg
209
+ | emitControl =
210
+ Just $
211
+ " id" .= asString " control"
212
+ <> " msg_label" .= relayMessageLabel msg
200
213
| otherwise = Nothing
201
214
asString x = x :: String
202
215
0 commit comments