Skip to content

Commit 202d6bf

Browse files
bladyjokerbladyjoker
committed
Merge remote-tracking branch 'origin/nfrisby/leios-202511-demo' into leios-prototype
2 parents b1dc13a + 93d2c84 commit 202d6bf

File tree

3 files changed

+66
-43
lines changed

3 files changed

+66
-43
lines changed

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

Lines changed: 37 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -19,71 +19,75 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ
1919
import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM
2020
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
2121

22-
import Data.Aeson (Value (String), (.=))
22+
import Control.Monad.Class.MonadTime.SI (Time (..))
23+
import Data.Aeson (Value (String), (.=), (.?=))
2324
import Data.Text (Text, pack)
2425
import qualified Network.TypedProtocol.Codec as Simple
2526
import qualified Network.TypedProtocol.Stateful.Codec as Stateful
2627

2728
{-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
2829

30+
jsonTime :: Time -> Double
31+
jsonTime (Time x) = realToFrac x
32+
2933
instance LogFormatting (Simple.AnyMessage ps)
3034
=> LogFormatting (Simple.TraceSendRecv ps) where
31-
forMachine dtal (Simple.TraceSendMsg m) = mconcat
32-
[ "kind" .= String "Send" , "msg" .= forMachine dtal m ]
33-
forMachine dtal (Simple.TraceRecvMsg m) = mconcat
34-
[ "kind" .= String "Recv" , "msg" .= forMachine dtal m ]
35+
forMachine dtal (Simple.TraceSendMsg tm m) = mconcat
36+
[ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ]
37+
forMachine dtal (Simple.TraceRecvMsg mbTm m) = mconcat
38+
[ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
3539

36-
forHuman (Simple.TraceSendMsg m) = "Send: " <> forHumanOrMachine m
37-
forHuman (Simple.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m
40+
forHuman (Simple.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
41+
forHuman (Simple.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m
3842

39-
asMetrics (Simple.TraceSendMsg m) = asMetrics m
40-
asMetrics (Simple.TraceRecvMsg m) = asMetrics m
43+
asMetrics (Simple.TraceSendMsg _tm m) = asMetrics m
44+
asMetrics (Simple.TraceRecvMsg _mbTm m) = asMetrics m
4145

4246
instance LogFormatting (Stateful.AnyMessage ps f)
4347
=> LogFormatting (Stateful.TraceSendRecv ps f) where
44-
forMachine dtal (Stateful.TraceSendMsg m) = mconcat
45-
[ "kind" .= String "Send" , "msg" .= forMachine dtal m ]
46-
forMachine dtal (Stateful.TraceRecvMsg m) = mconcat
47-
[ "kind" .= String "Recv" , "msg" .= forMachine dtal m ]
48+
forMachine dtal (Stateful.TraceSendMsg tm m) = mconcat
49+
[ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ]
50+
forMachine dtal (Stateful.TraceRecvMsg mbTm m) = mconcat
51+
[ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
4852

49-
forHuman (Stateful.TraceSendMsg m) = "Send: " <> forHumanOrMachine m
50-
forHuman (Stateful.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m
53+
forHuman (Stateful.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
54+
forHuman (Stateful.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m
5155

52-
asMetrics (Stateful.TraceSendMsg m) = asMetrics m
53-
asMetrics (Stateful.TraceRecvMsg m) = asMetrics m
56+
asMetrics (Stateful.TraceSendMsg _tm m) = asMetrics m
57+
asMetrics (Stateful.TraceRecvMsg _mbTm m) = asMetrics m
5458

5559
instance MetaTrace (Simple.AnyMessage ps) =>
5660
MetaTrace (Simple.TraceSendRecv ps) where
57-
namespaceFor (Simple.TraceSendMsg msg) =
61+
namespaceFor (Simple.TraceSendMsg _tm msg) =
5862
nsPrependInner "Send" (namespaceFor msg)
59-
namespaceFor (Simple.TraceRecvMsg msg) =
63+
namespaceFor (Simple.TraceRecvMsg _mbTm msg) =
6064
nsPrependInner "Receive" (namespaceFor msg)
6165

62-
severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
66+
severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
6367
severityFor (Namespace out tl) (Just msg)
6468
severityFor (Namespace out ("Send" : tl)) Nothing =
6569
severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
66-
severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
70+
severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
6771
severityFor (Namespace out tl) (Just msg)
6872
severityFor (Namespace out ("Receive" : tl)) Nothing =
6973
severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
7074
severityFor _ _ = Nothing
7175

72-
privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
76+
privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
7377
privacyFor (Namespace out tl) (Just msg)
7478
privacyFor (Namespace out ("Send" : tl)) Nothing =
7579
privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
76-
privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
80+
privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
7781
privacyFor (Namespace out tl) (Just msg)
7882
privacyFor (Namespace out ("Receive" : tl)) Nothing =
7983
privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
8084
privacyFor _ _ = Nothing
8185

82-
detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
86+
detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
8387
detailsFor (Namespace out tl) (Just msg)
8488
detailsFor (Namespace out ("Send" : tl)) Nothing =
8589
detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
86-
detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
90+
detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
8791
detailsFor (Namespace out tl) (Just msg)
8892
detailsFor (Namespace out ("Receive" : tl)) Nothing =
8993
detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
@@ -107,36 +111,36 @@ instance MetaTrace (Simple.AnyMessage ps) =>
107111

108112
instance MetaTrace (Stateful.AnyMessage ps f) =>
109113
MetaTrace (Stateful.TraceSendRecv ps f) where
110-
namespaceFor (Stateful.TraceSendMsg msg) =
114+
namespaceFor (Stateful.TraceSendMsg _tm msg) =
111115
nsPrependInner "Send" (namespaceFor msg)
112-
namespaceFor (Stateful.TraceRecvMsg msg) =
116+
namespaceFor (Stateful.TraceRecvMsg _mbTm msg) =
113117
nsPrependInner "Receive" (namespaceFor msg)
114118

115-
severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
119+
severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
116120
severityFor (Namespace out tl) (Just msg)
117121
severityFor (Namespace out ("Send" : tl)) Nothing =
118122
severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
119-
severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
123+
severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
120124
severityFor (Namespace out tl) (Just msg)
121125
severityFor (Namespace out ("Receive" : tl)) Nothing =
122126
severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
123127
severityFor _ _ = Nothing
124128

125-
privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
129+
privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
126130
privacyFor (Namespace out tl) (Just msg)
127131
privacyFor (Namespace out ("Send" : tl)) Nothing =
128132
privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
129-
privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
133+
privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
130134
privacyFor (Namespace out tl) (Just msg)
131135
privacyFor (Namespace out ("Receive" : tl)) Nothing =
132136
privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
133137
privacyFor _ _ = Nothing
134138

135-
detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
139+
detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
136140
detailsFor (Namespace out tl) (Just msg)
137141
detailsFor (Namespace out ("Send" : tl)) Nothing =
138142
detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
139-
detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
143+
detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
140144
detailsFor (Namespace out tl) (Just msg)
141145
detailsFor (Namespace out ("Receive" : tl)) Nothing =
142146
detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing

‎cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs‎

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1444,19 +1444,21 @@ instance (ToJSON peer, ConvertRawHash header)
14441444

14451445
instance ToObject (AnyMessage ps)
14461446
=> ToObject (TraceSendRecv ps) where
1447-
toObject verb (TraceSendMsg m) = mconcat
1448-
[ "kind" .= String "Send" , "msg" .= toObject verb m ]
1449-
toObject verb (TraceRecvMsg m) = mconcat
1450-
[ "kind" .= String "Recv" , "msg" .= toObject verb m ]
1447+
toObject verb (TraceSendMsg tm m) = mconcat
1448+
[ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm ]
1449+
toObject verb (TraceRecvMsg mbTm m) = mconcat
1450+
[ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ]
14511451

14521452

14531453
instance ToObject (Stateful.AnyMessage ps f)
14541454
=> ToObject (Stateful.TraceSendRecv ps f) where
1455-
toObject verb (Stateful.TraceSendMsg m) = mconcat
1456-
[ "kind" .= String "Send" , "msg" .= toObject verb m ]
1457-
toObject verb (Stateful.TraceRecvMsg m) = mconcat
1458-
[ "kind" .= String "Recv" , "msg" .= toObject verb m ]
1455+
toObject verb (Stateful.TraceSendMsg tm m) = mconcat
1456+
[ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm ]
1457+
toObject verb (Stateful.TraceRecvMsg mbTm m) = mconcat
1458+
[ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ]
14591459

1460+
jsonTime :: Time -> Double
1461+
jsonTime (Time x) = realToFrac x
14601462

14611463
instance ToObject (TraceTxSubmissionInbound txid tx) where
14621464
toObject _verb (TraceTxSubmissionCollected count) =

‎trace-dispatcher/src/Cardano/Logging/Formatter.hs‎

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,17 +26,22 @@ import qualified Control.Tracer as T
2626
import Data.Aeson ((.=))
2727
import qualified Data.Aeson as AE
2828
import qualified Data.Aeson.Encoding as AE
29+
import qualified Data.Aeson.KeyMap as AE
2930
import Data.Functor.Contravariant
3031
import Data.Maybe (fromMaybe)
3132
import Data.Text as T (Text, intercalate, null, pack)
3233
import Data.Text.Lazy (toStrict)
3334
import Data.Text.Lazy.Builder as TB
3435
import Data.Text.Lazy.Encoding (decodeUtf8)
35-
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
36+
import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime)
37+
import GHC.Clock (getMonotonicTime)
3638
import Network.HostName
3739
import System.IO.Unsafe (unsafePerformIO)
3840

3941

42+
data I a = I a
43+
instance Functor I where fmap f (I x) = I (f x)
44+
4045
encodingToText :: AE.Encoding -> Text
4146
{-# INLINE encodingToText #-}
4247
encodingToText = toStrict . decodeUtf8 . AE.encodingToLazyByteString
@@ -45,6 +50,10 @@ timeFormatted :: UTCTime -> Text
4550
{-# INLINE timeFormatted #-}
4651
timeFormatted = pack . formatTime defaultTimeLocale "%F %H:%M:%S%4QZ"
4752

53+
timeFormattedT :: UTCTime -> Text
54+
{-# INLINE timeFormattedT #-}
55+
timeFormattedT = pack . formatTime defaultTimeLocale "%FT%H:%M:%S%8QZ"
56+
4857
-- If the hostname in the logs should be anything different from the system reported hostname,
4958
-- a new field would need to be added to PreFormatted to carry a new hostname argument to preFormatted.
5059
hostname :: Text
@@ -84,13 +93,21 @@ preFormatted withForHuman =
8493
flip contramapM
8594
(\case
8695
(lc, Right msg) -> do
96+
tm <- liftIO getMonotonicTime
8797
time <- liftIO getCurrentTime
98+
let tmf tm' = flip addUTCTime time $ fromRational $ tm' - toRational tm
8899
threadId <- liftIO myThreadId
89100
let ns' = lcNSPrefix lc ++ lcNSInner lc
90101
threadTextShortened = T.pack $ drop 9 $ show threadId -- drop "ThreadId " prefix
91102
details = fromMaybe DNormal (lcDetails lc)
92103
condForHuman = let txt = forHuman msg in if T.null txt then Nothing else Just txt
93-
machineFormatted = AE.toEncoding $ forMachine details msg
104+
obj = forMachine details msg
105+
-- nasty special case for a numeric "mux_tm" field
106+
I obj' = (\f -> AE.alterF f "mux_at" obj) $ \case
107+
Nothing -> I Nothing
108+
Just (AE.Number tm') -> I $ Just $ AE.String $ timeFormattedT $ tmf $ toRational tm'
109+
Just x -> I $ Just x
110+
machineFormatted = AE.toEncoding $ obj'
94111

95112
pure (lc, Right (PreFormatted
96113
{ pfForHuman = if withForHuman then condForHuman else Nothing

0 commit comments

Comments
 (0)