Added dnsSubscriptionTracer.

cardano-node/src/Cardano/TraceDispatcher/Network/Combinators.hs

@@ -32,8 +32,11 @@ module Cardano.TraceDispatcher.Network.Combinators
   , severityTxSubmission2Node
   , namesForTxSubmission2Node
 
-  , severityIpSubscription
-  , namesForIpSubscription
+  , severityIPSubscription
+  , namesForIPSubscription
+
+  , severityDNSSubscription
+  , namesForDNSSubscription
 
   ) where
 
@@ -57,6 +60,7 @@ import           Ouroboros.Network.Protocol.Trans.Hello.Type (Hello,
                      Message (..))
 import qualified Ouroboros.Network.Protocol.TxSubmission.Type as TXS
 import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as TXS
+import           Ouroboros.Network.Subscription.Dns (WithDomainName (..))
 import           Ouroboros.Network.Subscription.Ip (WithIPList (..))
 import           Ouroboros.Network.Subscription.Worker (ConnectResult (..),
                      SubscriberError, SubscriptionTrace (..))
@@ -446,10 +450,10 @@ namesForTxSubmission2Node (BlockFetch.TraceLabelPeer _ v) =
     namesTxSubNode'' (MsgTalk _)                      = ["KThxBye"]
     -- TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet.
 
-severityIpSubscription ::
+severityIPSubscription ::
      WithIPList (SubscriptionTrace Socket.SockAddr)
   -> SeverityS
-severityIpSubscription WithIPList {..} = case wilEvent of
+severityIPSubscription WithIPList {..} = case wilEvent of
     SubscriptionTraceConnectStart _ -> Info
     SubscriptionTraceConnectEnd _ connectResult -> case connectResult of
       ConnectSuccess         -> Info
@@ -478,25 +482,63 @@ severityIpSubscription WithIPList {..} = case wilEvent of
     SubscriptionTraceAllocateSocket {} -> Debug
     SubscriptionTraceCloseSocket {} -> Info
 
-namesForIpSubscription ::
+namesForSubscription ::
+     SubscriptionTrace Socket.SockAddr
+  -> [Text]
+namesForSubscription SubscriptionTraceConnectStart {} = ["ConnectStart"]
+namesForSubscription SubscriptionTraceConnectEnd {} = ["ConnectEnd"]
+namesForSubscription SubscriptionTraceConnectException {} = ["ConnectException"]
+namesForSubscription SubscriptionTraceSocketAllocationException {} = ["SocketAllocationException"]
+namesForSubscription SubscriptionTraceTryConnectToPeer {}  = ["TryConnectToPeer"]
+namesForSubscription SubscriptionTraceSkippingPeer {} = ["SkippingPeer"]
+namesForSubscription SubscriptionTraceSubscriptionRunning = ["SubscriptionRunning"]
+namesForSubscription SubscriptionTraceSubscriptionWaiting {} = ["SubscriptionWaiting"]
+namesForSubscription SubscriptionTraceSubscriptionFailed = ["SubscriptionFailed"]
+namesForSubscription SubscriptionTraceSubscriptionWaitingNewConnection {} = ["SubscriptionWaitingNewConnection"]
+namesForSubscription SubscriptionTraceStart {} = ["Start"]
+namesForSubscription SubscriptionTraceRestart {} = ["Restart"]
+namesForSubscription SubscriptionTraceConnectionExist {} = ["ConnectionExist"]
+namesForSubscription SubscriptionTraceUnsupportedRemoteAddr {} = ["UnsupportedRemoteAddr"]
+namesForSubscription SubscriptionTraceMissingLocalAddress = ["MissingLocalAddress"]
+namesForSubscription SubscriptionTraceApplicationException {} = ["ApplicationException"]
+namesForSubscription SubscriptionTraceAllocateSocket {} = ["AllocateSocket"]
+namesForSubscription SubscriptionTraceCloseSocket {} = ["CloseSocket"]
+
+namesForIPSubscription ::
      WithIPList (SubscriptionTrace Socket.SockAddr)
   -> [Text]
-namesForIpSubscription WithIPList {..} = case wilEvent of
-    SubscriptionTraceConnectStart _ -> ["ConnectStart"]
-    SubscriptionTraceConnectEnd _ _connectResult -> ["ConnectEnd"]
-    SubscriptionTraceConnectException _ _e -> ["ConnectException"]
-    SubscriptionTraceSocketAllocationException {} -> ["SocketAllocationException"]
-    SubscriptionTraceTryConnectToPeer {}  -> ["TryConnectToPeer"]
-    SubscriptionTraceSkippingPeer {} -> ["SkippingPeer"]
-    SubscriptionTraceSubscriptionRunning -> ["SubscriptionRunning"]
-    SubscriptionTraceSubscriptionWaiting {} -> ["SubscriptionWaiting"]
-    SubscriptionTraceSubscriptionFailed -> ["SubscriptionFailed"]
-    SubscriptionTraceSubscriptionWaitingNewConnection {} -> ["SubscriptionWaitingNewConnection"]
-    SubscriptionTraceStart {} -> ["Start"]
-    SubscriptionTraceRestart {} -> ["Restart"]
-    SubscriptionTraceConnectionExist {} -> ["ConnectionExist"]
-    SubscriptionTraceUnsupportedRemoteAddr {} -> ["UnsupportedRemoteAddr"]
-    SubscriptionTraceMissingLocalAddress -> ["MissingLocalAddress"]
-    SubscriptionTraceApplicationException _ _e -> ["ApplicationException"]
-    SubscriptionTraceAllocateSocket {} -> ["AllocateSocket"]
-    SubscriptionTraceCloseSocket {} -> ["CloseSocket"]
+namesForIPSubscription(WithIPList _ _ e) = "IP" : namesForSubscription e
+
+namesForDNSSubscription ::
+     WithDomainName (SubscriptionTrace Socket.SockAddr)
+  -> [Text]
+namesForDNSSubscription(WithDomainName _ e) = "DNS" : namesForSubscription e
+
+severityDNSSubscription ::
+     WithDomainName (SubscriptionTrace Socket.SockAddr)
+  -> SeverityS
+severityDNSSubscription WithDomainName {..} = case wdnEvent of
+    SubscriptionTraceConnectStart {} -> Notice
+    SubscriptionTraceConnectEnd {} -> Notice
+    SubscriptionTraceConnectException _ e ->
+        case fromException $ SomeException e of
+             Just (_::SubscriberError) -> Debug
+             Nothing                   -> Error
+    SubscriptionTraceSocketAllocationException {} -> Error
+    SubscriptionTraceTryConnectToPeer {} -> Info
+    SubscriptionTraceSkippingPeer {} -> Info
+    SubscriptionTraceSubscriptionRunning -> Debug
+    SubscriptionTraceSubscriptionWaiting {} -> Debug
+    SubscriptionTraceSubscriptionFailed -> Warning
+    SubscriptionTraceSubscriptionWaitingNewConnection {} -> Debug
+    SubscriptionTraceStart {} -> Debug
+    SubscriptionTraceRestart {} -> Debug
+    SubscriptionTraceConnectionExist {} -> Info
+    SubscriptionTraceUnsupportedRemoteAddr {} -> Warning
+    SubscriptionTraceMissingLocalAddress -> Warning
+    SubscriptionTraceApplicationException _ e ->
+        case fromException $ SomeException e of
+             Just (_::SubscriberError) -> Debug
+             Nothing                   -> Error
+    SubscriptionTraceAllocateSocket {} -> Debug
+    SubscriptionTraceCloseSocket {} -> Debug

cardano-node/src/Cardano/TraceDispatcher/Network/Docu.hs

@@ -12,18 +12,19 @@ module Cardano.TraceDispatcher.Network.Docu
   , docTBlockFetch
   , docTTxSubmissionNode
   , docTTxSubmission2Node
-  , docIpSubscriptionTracer
+  , docIPSubscriptionTracer
+  , docDNSSubscriptionTracer
   ) where
 
 import           Cardano.Logging
 import           Cardano.Prelude
-import qualified Network.Socket as Socket
 import           Data.Time.Clock (DiffTime)
-
+import qualified Network.Socket as Socket
+import qualified Network.DNS as DNS
 
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx,
                      GenTxId)
-
+                     
 import           Ouroboros.Network.Block (Point, Tip)
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
 import           Ouroboros.Network.Codec (AnyMessageAndAgency (..))
@@ -36,6 +37,7 @@ import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
 import           Ouroboros.Network.Protocol.Trans.Hello.Type (Message (..))
 import qualified Ouroboros.Network.Protocol.TxSubmission.Type as TXS
 import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as TXS
+import           Ouroboros.Network.Subscription.Dns (WithDomainName (..))
 import           Ouroboros.Network.Subscription.Ip (WithIPList (..))
 import           Ouroboros.Network.Subscription.Worker (ConnectResult (..),
                      LocalAddresses, SubscriptionTrace (..))
@@ -89,6 +91,8 @@ protoDiffTime = undefined
 protoException :: NoMethodError
 protoException = undefined
 
+protoDomain :: DNS.Domain
+protoDomain = undefined
 
 ------------------------------------
 
@@ -560,11 +564,17 @@ docTTxSubmission2Node = Documented [
   --TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet.
   ]
 
-docIpSubscriptionTracer :: Documented (WithIPList (SubscriptionTrace Socket.SockAddr))
-docIpSubscriptionTracer = Documented $ map withIPList (undoc docSubscriptionTracer)
+docIPSubscriptionTracer :: Documented (WithIPList (SubscriptionTrace Socket.SockAddr))
+docIPSubscriptionTracer = Documented $ map withIPList (undoc docSubscriptionTracer)
   where
     withIPList (DocMsg v nl comment) =
-      DocMsg (WithIPList protoLocalAdresses [] v) nl comment
+      DocMsg (WithIPList protoLocalAdresses [] v) nl ("IP Subscription: " <> comment)
+
+docDNSSubscriptionTracer :: Documented (WithDomainName (SubscriptionTrace Socket.SockAddr))
+docDNSSubscriptionTracer = Documented $ map withDomainName (undoc docSubscriptionTracer)
+  where
+    withDomainName (DocMsg v nl comment) =
+      DocMsg (WithDomainName protoDomain v) nl ("DNS Subscription: " <> comment)
 
 docSubscriptionTracer :: Documented (SubscriptionTrace Socket.SockAddr)
 docSubscriptionTracer = Documented [

cardano-node/src/Cardano/TraceDispatcher/Network/Formatting.hs

@@ -47,6 +47,7 @@ import           Ouroboros.Network.Protocol.Trans.Hello.Type
                      (ClientHasAgency (..), Message (..), ServerHasAgency (..))
 import qualified Ouroboros.Network.Protocol.TxSubmission.Type as STX
 import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as TXS
+import           Ouroboros.Network.Subscription.Dns (WithDomainName (..))
 import           Ouroboros.Network.Subscription.Ip (SubscriptionTrace,
                      WithIPList (..))
 
@@ -308,8 +309,25 @@ instance (Show txid, Show tx)
 
 instance LogFormatting (WithIPList (SubscriptionTrace Socket.SockAddr)) where
   forMachine _dtal (WithIPList localAddresses dests ev) =
-    mkObject [ "kind" .= String "WithIPList SubscriptionTrace"
+    mkObject [ "kind" .= String "IP SubscriptionTrace"
              , "localAddresses" .= String (pack $ show localAddresses)
              , "dests" .= String (pack $ show dests)
              , "event" .= String (pack $ show ev)]
-  forHuman  obj = pack $ show obj
+  forHuman (WithIPList localAddresses dests ev) =
+                     pack (show ev)
+                  <> ". Local addresses are "
+                  <> (pack $ show localAddresses)
+                  <> ". Destinations are "
+                  <> (pack $ show dests)
+                  <> "."
+
+instance LogFormatting (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
+  forMachine _dtal (WithDomainName dom ev) =
+    mkObject [ "kind" .= String "DNS SubscriptionTrace"
+             , "domain" .= String (pack $ show dom)
+             , "event" .= String (pack $ show ev)]
+  forHuman (WithDomainName dom ev) =
+                     pack (show ev)
+                  <> ". Domain is "
+                  <> pack (show dom)
+                  <> "."

cardano-node/src/Cardano/TraceDispatcher/Tracers.hs

@@ -269,8 +269,13 @@ mkDispatchTracers' trBase = do
                 trBase
     ipsTr   <-  mkStandardTracer
                 "IpSubscription"
-                namesForIpSubscription
-                severityIpSubscription
+                namesForIPSubscription
+                severityIPSubscription
+                trBase
+    dnssTr  <-  mkStandardTracer
+                "DnsSubscription"
+                namesForDNSSubscription
+                severityDNSSubscription
                 trBase
     pure Tracers
       { chainDBTracer = T.Tracer (traceWith cdbmTr)
@@ -305,7 +310,7 @@ mkDispatchTracers' trBase = do
         , NodeToNode.tTxSubmission2Tracer = T.Tracer (traceWith ts2nTr)
         }
       , ipSubscriptionTracer = T.Tracer (traceWith ipsTr)
-      , dnsSubscriptionTracer= T.nullTracer
+      , dnsSubscriptionTracer = T.Tracer (traceWith dnssTr)
       , dnsResolverTracer = T.nullTracer
       , errorPolicyTracer = T.nullTracer
       , localErrorPolicyTracer = T.nullTracer
@@ -381,8 +386,10 @@ configTracers config Tracers {..} = do
       [traceTrans (NodeToNode.tTxSubmissionTracer nodeToNodeTracers)]
     configureTracers config docTTxSubmission2Node
       [traceTrans (NodeToNode.tTxSubmission2Tracer nodeToNodeTracers)]
-    configureTracers config docIpSubscriptionTracer
-      [traceTrans ipSubscriptionTracer]      
+    configureTracers config docIPSubscriptionTracer
+      [traceTrans ipSubscriptionTracer]
+    configureTracers config docDNSSubscriptionTracer
+        [traceTrans dnsSubscriptionTracer]
     pure ()
 
 docTracers :: forall peer localPeer blk.
@@ -478,6 +485,12 @@ docTracers' _ Tracers {..} = do
   ts2nTrDoc  <-  documentMarkdown
                   docTTxSubmission2Node
                   [traceTrans (NodeToNode.tTxSubmission2Tracer nodeToNodeTracers)]
+  ipsTrDoc   <-  documentMarkdown
+                  docIPSubscriptionTracer
+                  [traceTrans ipSubscriptionTracer]
+  dnssTrDoc  <-  documentMarkdown
+                    docDNSSubscriptionTracer
+                    [traceTrans dnsSubscriptionTracer]
 
   let bl = cdbmTrDoc
           ++ cscTrDoc
@@ -503,6 +516,8 @@ docTracers' _ Tracers {..} = do
           ++ tbfsTrDoc
           ++ tsnTrDoc
           ++ ts2nTrDoc
+          ++ ipsTrDoc
+          ++ dnssTrDoc
 
   res <- buildersToText bl
   T.writeFile "/home/yupanqui/IOHK/CardanoLogging.md" res