Remove unused ToObject/Transformable instances

Also simplify some HasTextFormatter instances
input-output-hk · Apr 8, 2021 · 3e50914 · 3e50914
1 parent 0f16414
commit 3e50914
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 105 deletions.
diff --git a/morpho-checkpoint-node/src/Morpho/Tracing/TracingOrphanInstances.hs b/morpho-checkpoint-node/src/Morpho/Tracing/TracingOrphanInstances.hs
@@ -12,21 +12,13 @@ module Morpho.Tracing.TracingOrphanInstances where
 
 import Cardano.BM.Data.Tracer
   ( HasTextFormatter (..),
-    contramap,
-    trStructured,
-    trStructuredText,
   )
 import Cardano.BM.Tracing
   ( HasPrivacyAnnotation (..),
     HasSeverityAnnotation (..),
     Severity (..),
-    ToObject (..),
     TracingVerbosity (..),
-    Transformable (..),
   )
--- We do need some consensus imports to provide useful trace messages for some
--- network protocols
-
 import Cardano.Crypto.DSIGN
 import Cardano.Prelude hiding (show)
 import Data.Text (pack)
@@ -42,15 +34,12 @@ import Morpho.Tracing.Types
 import Network.Mux (MuxTrace (..), WithMuxBearer (..))
 import qualified Network.Socket as Socket (SockAddr)
 import Ouroboros.Consensus.Block
-  ( BlockSupportsProtocol,
-    CannotForge,
-    ForgeStateUpdateError,
-    headerPoint,
+  ( headerPoint,
     realPointSlot,
   )
 import Ouroboros.Consensus.BlockchainTime
 import Ouroboros.Consensus.Ledger.Extended
-import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, HasTxId, txId)
+import Ouroboros.Consensus.Ledger.SupportsMempool (txId)
 import Ouroboros.Consensus.Ledger.SupportsProtocol
   ( LedgerSupportsProtocol,
   )
@@ -123,9 +112,6 @@ instance HasSeverityAnnotation a => HasSeverityAnnotation (TraceLabelCreds a) wh
 
 instance HasPrivacyAnnotation (TraceLabelCreds a)
 
-instance (ToObject a, HasTextFormatter a, Transformable Text IO a) => Transformable Text IO (TraceLabelCreds a) where
-  trTransformer _verb tr = contramap (\(TraceLabelCreds _ a) -> a) (trStructuredText _verb tr)
-
 instance (HashAlgorithm h, BftCrypto c) => HasTextFormatter (ExtractStateTrace h c) where
   formatText (MorphoStateTrace st) _ = pack $ "Current Ledger State: " ++ show st
   formatText (WontPushCheckpointTrace reason) _ =
@@ -151,9 +137,6 @@ instance HasSeverityAnnotation e => HasSeverityAnnotation (RpcTrace e i o) where
   getSeverityAnnotation (RpcTrace _ _ (RpcSuccess _)) = Info
   getSeverityAnnotation (RpcTrace _ _ (RpcEvent x)) = getSeverityAnnotation x
 
-instance (HashAlgorithm h, BftCrypto c) => Transformable Text IO (TimeTravelError (MorphoBlock h c)) where
-  trTransformer = trStructured
-
 instance HasPrivacyAnnotation (TimeTravelError blk)
 
 instance HasSeverityAnnotation (TimeTravelError blk) where
@@ -162,8 +145,6 @@ instance HasSeverityAnnotation (TimeTravelError blk) where
 
 instance (StandardHash blk) => HasTextFormatter (TimeTravelError blk)
 
-instance (HashAlgorithm h, BftCrypto c) => ToObject (TimeTravelError (MorphoBlock h c))
-
 instance HasPrivacyAnnotation (ChainDB.TraceEvent blk)
 
 instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where
@@ -231,9 +212,7 @@ instance HasSeverityAnnotation (TraceChainSyncClientEvent blk) where
   getSeverityAnnotation TraceException {} = Warning
   getSeverityAnnotation TraceTermination {} = Info
 
-instance
-  (BlockSupportsProtocol blk, Show (Header blk)) =>
-  HasTextFormatter (TraceChainSyncClientEvent blk)
+instance HasTextFormatter (TraceChainSyncClientEvent blk)
 
 instance HasPrivacyAnnotation (TraceChainSyncServerEvent blk)
 
@@ -313,50 +292,16 @@ instance
 instance HasTextFormatter (TraceBlockFetchServerEvent blk) where
   formatText _ = pack . show . toList
 
-instance (BftCrypto c, HashAlgorithm h) => Transformable Text IO (TraceChainSyncClientEvent (MorphoBlock h c)) where
-  trTransformer = trStructured
-
-instance (BftCrypto c, HashAlgorithm h) => Transformable Text IO (TraceChainSyncServerEvent (MorphoBlock h c)) where
-  trTransformer = trStructured
-
 condenseT :: Condense a => a -> Text
 condenseT = pack . condense
 
 showT :: Show a => a -> Text
 showT = pack . show
 
-instance
-  (MorphoStateDefaultConstraints h c, Signable (BftDSIGN c) (MorphoStdHeader h c)) =>
-  Transformable Text IO (TraceForgeEvent (MorphoBlock h c))
-  where
-  trTransformer = trStructuredText
-
-instance
-  ( tx ~ GenTx blk,
-    Condense (HeaderHash blk),
-    HasTxId tx,
-    LedgerSupportsProtocol blk,
-    Show (TxId tx),
-    Show blk,
-    Show (CannotForge blk),
-    Show (ForgeStateUpdateError blk)
-  ) =>
-  HasTextFormatter (TraceLabelCreds (TraceForgeEvent blk))
-  where
+instance (Signable (BftDSIGN c) (MorphoStdHeader h c), MorphoStateDefaultConstraints h c) => HasTextFormatter (TraceLabelCreds (TraceForgeEvent (MorphoBlock h c))) where
   formatText (TraceLabelCreds _ t) = formatText t
 
-instance
-  ( tx ~ GenTx blk,
-    Condense (HeaderHash blk),
-    HasTxId tx,
-    LedgerSupportsProtocol blk,
-    Show (TxId tx),
-    Show blk,
-    Show (CannotForge blk),
-    Show (ForgeStateUpdateError blk)
-  ) =>
-  HasTextFormatter (TraceForgeEvent blk)
-  where
+instance (Signable (BftDSIGN c) (MorphoStdHeader h c), MorphoStateDefaultConstraints h c) => HasTextFormatter (TraceForgeEvent (MorphoBlock h c)) where
   formatText = \case
     TraceAdoptedBlock slotNo blk txs ->
       const $
@@ -433,13 +378,7 @@ instance
           <> " failed with "
           <> showT err
 
-instance Transformable Text IO (TraceLocalTxSubmissionServerEvent (MorphoBlock h c)) where
-  trTransformer = trStructured
-
-instance
-  (Condense (HeaderHash blk), LedgerSupportsProtocol blk) =>
-  HasTextFormatter (ChainDB.TraceEvent blk)
-  where
+instance (Signable (BftDSIGN c) (MorphoStdHeader h c), MorphoStateDefaultConstraints h c) => HasTextFormatter (ChainDB.TraceEvent (MorphoBlock h c)) where
   formatText = \case
     ChainDB.TraceAddBlockEvent ev -> case ev of
       ChainDB.IgnoreBlockOlderThanK pt ->
@@ -545,23 +484,12 @@ instance
     ChainDB.TraceImmutableDBEvent ev -> \_o -> Text.append "TraceImmDBEvent" (showT ev)
     ChainDB.TraceVolatileDBEvent ev -> \_o -> Text.append "TraceVolDBEvent " (showT ev)
 
-instance (BftCrypto c, HashAlgorithm h) => ToObject (TraceChainSyncClientEvent (MorphoBlock h c))
-
-instance (BftCrypto c, HashAlgorithm h) => ToObject (TraceChainSyncServerEvent (MorphoBlock h c))
-
-instance
-  (Show (GenTxId blk), Show (ApplyTxErr blk), Show (GenTx blk)) =>
+instance-- (Show (GenTxId blk), Show (ApplyTxErr blk), Show (GenTx blk)) =>
   HasTextFormatter (TraceEventMempool blk)
 
 instance HasTextFormatter () where
   formatText _ = pack . show . toList
 
-instance
-  (MorphoStateDefaultConstraints h c, Signable (BftDSIGN c) (MorphoStdHeader h c)) =>
-  ToObject (TraceForgeEvent (MorphoBlock h c))
-
-instance ToObject (TraceLocalTxSubmissionServerEvent (MorphoBlock h c))
-
 -- | Tracing wrapper which includes current tip in the logs (thus it requires
 -- it from the context).
 showTip ::

diff --git a/morpho-checkpoint-node/src/Morpho/Tracing/Types.hs b/morpho-checkpoint-node/src/Morpho/Tracing/Types.hs
@@ -10,7 +10,6 @@ where
 import Cardano.BM.Data.Severity
 import Cardano.BM.Data.Tracer
 import Cardano.Prelude
-import Data.Aeson hiding (Error)
 import Morpho.Config.Topology
 import Morpho.Ledger.Block
 import Morpho.Ledger.State
@@ -32,31 +31,6 @@ instance HasSeverityAnnotation MorphoInitTrace where
 
 instance HasPrivacyAnnotation MorphoInitTrace
 
-instance Transformable Text IO MorphoInitTrace where
-  trTransformer = trStructuredText
-
-instance ToObject MorphoInitTrace where
-  toObject _ (NotFoundInTopology nid) =
-    mkObject
-      [ "kind" .= String "NotFoundInTopology",
-        "nodeId" .= String (show nid)
-      ]
-  toObject _ (ProducerList nid prods) =
-    mkObject
-      [ "kind" .= String "ProducerList",
-        "nodeId" .= String (show nid),
-        "producers" .= String (show prods)
-      ]
-  toObject _ PerformingDBValidation =
-    mkObject
-      [ "kind" .= String "PerformingDBValidation"
-      ]
-  toObject _ (PrometheusException err) =
-    mkObject
-      [ "kind" .= String "PrometheusException",
-        "error" .= String (show err)
-      ]
-
 instance HasTextFormatter MorphoInitTrace where
   formatText (NotFoundInTopology nid) _ = "Own node id " <> show nid <> " not found in topology"
   formatText (ProducerList nid prods) _ = "I am node id " <> show nid <> ". My producers are " <> show prods