Merge #2694

2694: Generate valid json for TraceLabelPeer r=karknu a=karknu Co-authored-by: Karl Knutsson <karl.knutsson@iohk.io>
IntersectMBO · May 12, 2021 · 695441f · 695441f
2 parents 7821d2b + ac7cf19
commit 695441f
Show file tree

Hide file tree

Showing 2 changed files with 56 additions and 19 deletions.
diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
@@ -16,10 +16,11 @@ import           Cardano.Prelude hiding (show)
 import           Prelude (String, show)
 
 import           Control.Monad.Class.MonadTime (DiffTime, Time (..))
+import qualified Data.IP as IP
 import           Data.Text (pack)
 
 import           Network.Mux (MuxTrace (..), WithMuxBearer (..))
-import qualified Network.Socket as Socket (SockAddr)
+import           Network.Socket (SockAddr (..))
 
 import           Cardano.Tracing.ConvertTxId (ConvertTxId)
 import           Cardano.Tracing.OrphanInstances.Common
@@ -175,8 +176,8 @@ instance HasSeverityAnnotation (WithDomainName DnsTrace) where
     DnsTraceLookupAAAAResult {} -> Debug
 
 
-instance HasPrivacyAnnotation (WithDomainName (SubscriptionTrace Socket.SockAddr))
-instance HasSeverityAnnotation (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
+instance HasPrivacyAnnotation (WithDomainName (SubscriptionTrace SockAddr))
+instance HasSeverityAnnotation (WithDomainName (SubscriptionTrace SockAddr)) where
   getSeverityAnnotation (WithDomainName _ ev) = case ev of
     SubscriptionTraceConnectStart {} -> Notice
     SubscriptionTraceConnectEnd {} -> Notice
@@ -204,8 +205,8 @@ instance HasSeverityAnnotation (WithDomainName (SubscriptionTrace Socket.SockAdd
     SubscriptionTraceCloseSocket {} -> Debug
 
 
-instance HasPrivacyAnnotation (WithIPList (SubscriptionTrace Socket.SockAddr))
-instance HasSeverityAnnotation (WithIPList (SubscriptionTrace Socket.SockAddr)) where
+instance HasPrivacyAnnotation (WithIPList (SubscriptionTrace SockAddr))
+instance HasSeverityAnnotation (WithIPList (SubscriptionTrace SockAddr)) where
   getSeverityAnnotation (WithIPList _ _ ev) = case ev of
     SubscriptionTraceConnectStart _ -> Info
     SubscriptionTraceConnectEnd _ connectResult -> case connectResult of
@@ -331,15 +332,16 @@ instance HasTextFormatter NtN.AcceptConnectionsPolicyTrace where
   formatText a _ = pack (show a)
 
 
-instance (StandardHash header, Show peer)
+instance (StandardHash header, Show peer, ToObject peer)
       => Transformable Text IO [TraceLabelPeer peer (FetchDecision [Point header])] where
   trTransformer = trStructuredText
 instance (StandardHash header, Show peer)
       => HasTextFormatter [TraceLabelPeer peer (FetchDecision [Point header])] where
   formatText a _ = pack (show a)
 
 
-instance (Show peer, Show a, HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a)
+instance ( Show peer, ToObject peer, Show a, HasPrivacyAnnotation a
+         , HasSeverityAnnotation a, ToObject a)
       => Transformable Text IO (TraceLabelPeer peer a) where
   trTransformer = trStructuredText
 instance (Show peer, Show a)
@@ -374,9 +376,9 @@ instance Show addr => HasTextFormatter (WithAddr addr ErrorPolicyTrace) where
   formatText a _ = pack (show a)
 
 
-instance Transformable Text IO (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
+instance Transformable Text IO (WithDomainName (SubscriptionTrace SockAddr)) where
   trTransformer = trStructuredText
-instance HasTextFormatter (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
+instance HasTextFormatter (WithDomainName (SubscriptionTrace SockAddr)) where
   formatText a _ = pack (show a)
 
 
@@ -386,9 +388,9 @@ instance HasTextFormatter (WithDomainName DnsTrace) where
   formatText a _ = pack (show a)
 
 
-instance Transformable Text IO (WithIPList (SubscriptionTrace Socket.SockAddr)) where
+instance Transformable Text IO (WithIPList (SubscriptionTrace SockAddr)) where
   trTransformer = trStructuredText
-instance HasTextFormatter (WithIPList (SubscriptionTrace Socket.SockAddr)) where
+instance HasTextFormatter (WithIPList (SubscriptionTrace SockAddr)) where
   formatText a _ = pack (show a)
 
 
@@ -727,7 +729,7 @@ instance ToObject (TraceFetchClientState header) where
     mkObject [ "kind" .= String "ClientTerminating" ]
 
 
-instance Show peer
+instance (ToObject peer)
       => ToObject [TraceLabelPeer peer (FetchDecision [Point header])] where
   toObject MinimalVerbosity _ = emptyObject
   toObject _ [] = emptyObject
@@ -736,10 +738,9 @@ instance Show peer
     , "peers" .= toJSON
       (foldl' (\acc x -> toObject MaximalVerbosity x : acc) [] xs) ]
 
-
-instance (Show peer, ToObject a) => ToObject (TraceLabelPeer peer a) where
+instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where
   toObject verb (TraceLabelPeer peerid a) =
-    mkObject [ "peer" .= show peerid ] <> toObject verb a
+    mkObject [ "peer" .= toObject verb peerid ] <> toObject verb a
 
 
 instance ToObject (AnyMessageAndAgency ps)
@@ -828,7 +829,7 @@ instance Show addr => ToObject (WithAddr addr ErrorPolicyTrace) where
              , "event" .= show ev ]
 
 
-instance ToObject (WithIPList (SubscriptionTrace Socket.SockAddr)) where
+instance ToObject (WithIPList (SubscriptionTrace SockAddr)) where
   toObject _verb (WithIPList localAddresses dests ev) =
     mkObject [ "kind" .= String "WithIPList SubscriptionTrace"
              , "localAddresses" .= show localAddresses
@@ -843,7 +844,7 @@ instance ToObject (WithDomainName DnsTrace) where
              , "event" .= show ev ]
 
 
-instance ToObject (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
+instance ToObject (WithDomainName (SubscriptionTrace SockAddr)) where
   toObject _verb (WithDomainName dom ev) =
     mkObject [ "kind" .= String "SubscriptionTrace"
              , "domain" .= show dom
@@ -855,3 +856,34 @@ instance (Show peer) => ToObject (WithMuxBearer peer MuxTrace) where
     mkObject [ "kind" .= String "MuxTrace"
              , "bearer" .= show b
              , "event" .= show ev ]
+
+instance ToObject NtN.RemoteAddress where
+    toObject _verb (SockAddrInet port addr) =
+        let ip = IP.fromHostAddress addr in
+        mkObject [ "addr" .= show ip
+                 , "port" .= show port
+                 ]
+    toObject _verb (SockAddrInet6 port _ addr _) =
+        let ip = IP.fromHostAddress6 addr in
+        mkObject [ "addr" .= show ip
+                 , "port" .= show port
+                 ]
+    toObject _verb (SockAddrUnix path) =
+        mkObject [ "path" .= show path ]
+
+
+instance ToObject NtN.RemoteConnectionId where
+    toObject verb (NtN.ConnectionId l r) =
+        mkObject [ "local" .= toObject verb l
+                 , "remote" .= toObject verb r
+                 ]
+
+instance ToObject LocalAddress where
+    toObject _verb (LocalAddress path) =
+        mkObject ["path" .= path]
+
+instance ToObject NtC.LocalConnectionId where
+    toObject verb (NtC.ConnectionId l r) =
+        mkObject [ "local" .= toObject verb l
+                 , "remote" .= toObject verb r
+                 ]
diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -279,8 +279,8 @@ mkTracers
      , HasKESMetricsData blk
      , HasKESInfo blk
      , TraceConstraints blk
-     , Show peer, Eq peer
-     , Show localPeer
+     , Show peer, Eq peer, ToObject peer
+     , Show localPeer, ToObject localPeer
      )
   => BlockConfig blk
   -> TraceOptions
@@ -510,6 +510,7 @@ mkConsensusTracers
      , ToObject (OtherHeaderEnvelopeError blk)
      , ToObject (ValidationErr (BlockProtocol blk))
      , ToObject (ForgeStateUpdateError blk)
+     , ToObject peer
      , Consensus.RunNode blk
      , HasKESMetricsData blk
      , HasKESInfo blk
@@ -964,6 +965,7 @@ nodeToClientTracers'
      , Show (ApplyTxErr blk)
      , Show (GenTx blk)
      , Show localPeer
+     , ToObject localPeer
      , ShowQuery (Query blk)
      )
   => TraceSelection
@@ -991,6 +993,7 @@ nodeToNodeTracers'
      , Show blk
      , Show (Header blk)
      , Show peer
+     , ToObject peer
      )
   => TraceSelection
   -> TracingVerbosity
@@ -1010,6 +1013,7 @@ teeTraceBlockFetchDecision
     :: ( Eq peer
        , HasHeader blk
        , Show peer
+       , ToObject peer
        )
     => TracingVerbosity
     -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer)
@@ -1035,6 +1039,7 @@ teeTraceBlockFetchDecisionElide
     :: ( Eq peer
        , HasHeader blk
        , Show peer
+       , ToObject peer
        )
     => TracingVerbosity
     -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer)