leiosdemo202511: hacky special case for mux_tm

Author: nfrisby

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

@@ -19,19 +19,23 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ
 import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
 
+import           Control.Monad.Class.MonadTime.SI (Time (..))
 import           Data.Aeson (Value (String), (.=), (.?=))
 import           Data.Text (Text, pack)
 import qualified Network.TypedProtocol.Codec as Simple
 import qualified Network.TypedProtocol.Stateful.Codec as Stateful
 
 {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
 
+jsonTime :: Time -> Double
+jsonTime (Time x) = realToFrac x
+
 instance LogFormatting (Simple.AnyMessage ps)
       => LogFormatting (Simple.TraceSendRecv ps) where
   forMachine dtal (Simple.TraceSendMsg tm m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm)  ]
+    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm  ]
   forMachine dtal (Simple.TraceRecvMsg mbTm m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ]
+    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
 
   forHuman (Simple.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
   forHuman (Simple.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m
@@ -42,9 +46,9 @@ instance LogFormatting (Simple.AnyMessage ps)
 instance LogFormatting (Stateful.AnyMessage ps f)
       => LogFormatting (Stateful.TraceSendRecv ps f) where
   forMachine dtal (Stateful.TraceSendMsg tm m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm)  ]
+    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ]
   forMachine dtal (Stateful.TraceRecvMsg mbTm m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ]
+    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
 
   forHuman (Stateful.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
   forHuman (Stateful.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m

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

@@ -1445,18 +1445,20 @@ instance (ToJSON peer, ConvertRawHash header)
 instance ToObject (AnyMessage ps)
       => ToObject (TraceSendRecv ps) where
   toObject verb (TraceSendMsg tm m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm)  ]
+    [ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm  ]
   toObject verb (TraceRecvMsg mbTm m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ]
+    [ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ]
 
 
 instance ToObject (Stateful.AnyMessage ps f)
       => ToObject (Stateful.TraceSendRecv ps f) where
   toObject verb (Stateful.TraceSendMsg tm m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm)  ]
+    [ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm  ]
   toObject verb (Stateful.TraceRecvMsg mbTm m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ]
+    [ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ]
 
+jsonTime :: Time -> Double
+jsonTime (Time x) = realToFrac x
 
 instance ToObject (TraceTxSubmissionInbound txid tx) where
   toObject _verb (TraceTxSubmissionCollected count) =

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

@@ -26,17 +26,22 @@ import qualified Control.Tracer as T
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Encoding as AE
+import qualified Data.Aeson.KeyMap as AE
 import           Data.Functor.Contravariant
 import           Data.Maybe (fromMaybe)
 import           Data.Text as T (Text, intercalate, null, pack)
 import           Data.Text.Lazy (toStrict)
 import           Data.Text.Lazy.Builder as TB
 import           Data.Text.Lazy.Encoding (decodeUtf8)
-import           Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
+import           Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime)
+import           GHC.Clock (getMonotonicTime)
 import           Network.HostName
 import           System.IO.Unsafe (unsafePerformIO)
 
 
+data I a = I a
+instance Functor I where fmap f (I x) = I (f x)
+
 encodingToText :: AE.Encoding -> Text
 {-# INLINE encodingToText #-}
 encodingToText = toStrict . decodeUtf8 . AE.encodingToLazyByteString
@@ -45,6 +50,10 @@ timeFormatted :: UTCTime -> Text
 {-# INLINE timeFormatted #-}
 timeFormatted = pack . formatTime defaultTimeLocale "%F %H:%M:%S%4QZ"
 
+timeFormattedT :: UTCTime -> Text
+{-# INLINE timeFormattedT #-}
+timeFormattedT = pack . formatTime defaultTimeLocale "%FT%H:%M:%S%8QZ"
+
 -- If the hostname in the logs should be anything different from the system reported hostname,
 -- a new field would need to be added to PreFormatted to carry a new hostname argument to preFormatted.
 hostname :: Text
@@ -84,13 +93,21 @@ preFormatted withForHuman =
   flip contramapM
     (\case
       (lc, Right msg) -> do
+        tm       <- liftIO getMonotonicTime
         time     <- liftIO getCurrentTime
+        let tmf tm' = flip addUTCTime time $ fromRational $ tm' - toRational tm
         threadId <- liftIO myThreadId
         let ns' = lcNSPrefix lc ++ lcNSInner lc
             threadTextShortened = T.pack $ drop 9 $ show threadId       -- drop "ThreadId " prefix
             details = fromMaybe DNormal (lcDetails lc)
             condForHuman = let txt = forHuman msg in if T.null txt then Nothing else Just txt
-            machineFormatted = AE.toEncoding $ forMachine details msg
+            obj = forMachine details msg
+            -- nasty special case for a numeric "mux_tm" field
+            I obj' = (\f -> AE.alterF f "mux_at" obj) $ \case
+                Nothing -> I Nothing
+                Just (AE.Number tm') -> I $ Just $ AE.String $ timeFormattedT $ tmf $ toRational tm'
+                Just x -> I $ Just x
+            machineFormatted = AE.toEncoding $ obj'
 
         pure (lc, Right (PreFormatted
                           { pfForHuman = if withForHuman then condForHuman else Nothing