Use toGenericObject for final traces

morpho-checkpoint-node/src/Morpho/Tracing/Tracers.hs

@@ -17,15 +17,14 @@ module Morpho.Tracing.Tracers
 where
 
 import Cardano.BM.Data.LogItem
-import Cardano.BM.Data.Tracer (HasTextFormatter (formatText), WithSeverity (..), showTracing)
+import Cardano.BM.Data.Tracer (HasTextFormatter (formatText))
 import Cardano.BM.Trace
 import Cardano.BM.Tracing
 import Cardano.Crypto.DSIGN.Class
 import Cardano.Prelude hiding (show)
 import Codec.CBOR.Read (DeserialiseFailure)
 import Data.Aeson
 import qualified Data.HashMap.Strict as HM
-import qualified Data.Text as Text
 import GHC.Exts (fromList)
 import Morpho.Config.Types
 import Morpho.Ledger.Block
@@ -50,7 +49,6 @@ import Ouroboros.Network.NodeToNode
 import qualified Ouroboros.Network.NodeToNode as NtN
 import Ouroboros.Network.PeerSelection.LedgerPeers
 import Ouroboros.Network.Snocket (LocalAddress)
-import Prelude (String, show)
 
 data Tracers peer localPeer h c = Tracers
   { -- | Used for top-level morpho traces during initialization
@@ -233,8 +231,8 @@ mkTracers nc tracer = do
             toGenericObject nc $
               appendName "forge" ctracer,
           Consensus.blockchainTimeTracer =
-            showTracing $
-              withName nc "blockchain-time" ctracer,
+            toGenericObject nc $
+              appendName "blockchain-time" ctracer,
           -- TODO: trace the forge state if we add any.
           Consensus.forgeStateInfoTracer = Tracer $ const mempty,
           -- TODO: Trace this
@@ -246,8 +244,7 @@ mkTracers nc tracer = do
 --------------------------------------------------------------------------------
 
 nodeToNodeTracers' ::
-  ( Show peer,
-    ToJSON peer,
+  ( ToJSON peer,
     MorphoStateDefaultConstraints h c,
     blk ~ MorphoBlock h c
   ) =>
@@ -266,8 +263,8 @@ nodeToNodeTracers' nc tracer =
         toGenericObject nc $
           appendName "block-fetch-protocol" tracer,
       NodeToNode.tBlockFetchSerialisedTracer =
-        showTracing $
-          withName nc "block-fetch-protocol-serialized" tracer,
+        toGenericObject nc $
+          appendName "block-fetch-protocol-serialized" tracer,
       NodeToNode.tTxSubmissionTracer =
         toGenericObject nc $
           appendName "tx-submission-protocol" tracer,
@@ -297,9 +294,3 @@ nodeToClientTracers' nc tracer =
         toGenericObject nc $
           appendName "local-state-query-protocol" tracer
     }
-
-instance Show a => Show (WithSeverity a) where
-  show (WithSeverity _sev a) = show a
-
-withName :: NodeConfiguration -> Text -> Trace IO Text -> Tracer IO String
-withName nc name tr = contramap Text.pack $ toGenericObject nc $ appendName name tr

morpho-checkpoint-node/src/Morpho/Tracing/TracingOrphanInstances.hs

@@ -99,14 +99,20 @@ import Ouroboros.Network.TxSubmission.Outbound
   )
 import Prelude (String, id, show)
 
-instance HasTextFormatter Text where
-  formatText t _ = t
+instance HasPrivacyAnnotation (TraceBlockchainTimeEvent t)
 
 instance HasSeverityAnnotation (TraceBlockchainTimeEvent t) where
   getSeverityAnnotation (TraceStartTimeInTheFuture _ _) = Debug
   getSeverityAnnotation (TraceCurrentSlotUnknown _ _) = Debug
   getSeverityAnnotation (TraceSystemClockMovedBack _ _) = Warning
 
+instance HasTextFormatter (TraceBlockchainTimeEvent t) where
+  formatText ev _ = case ev of
+    TraceStartTimeInTheFuture (SystemStart start) toWait ->
+      "Waiting " <> showT toWait <> " until genesis start time at " <> showT start
+    TraceSystemClockMovedBack _ _ -> "System clock moved back an acceptable time span"
+    TraceCurrentSlotUnknown _ _ -> "Current slot is not yet known"
+
 instance HasSeverityAnnotation a => HasSeverityAnnotation (TraceLabelCreds a) where
   getSeverityAnnotation (TraceLabelCreds _ a) = getSeverityAnnotation a