cardano-node: Change fallback node name for trace-forwarding.

cardano-node/src/Cardano/Node/Startup.hs

@@ -247,13 +247,12 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do
       Just aName -> return aName
       Nothing -> do
         -- The user didn't specify node's name in the configuration.
-        -- In this case we should form node's name as "host:port", where 'host' and 'port'
-        -- are taken from '--host-addr' and '--port' CLI-parameters correspondingly.
-        let SocketConfig hostIPv4 hostIPv6 port _ = ncSocketConfig nc
-        hostName <- case (show <$> hostIPv6) <> (show <$> hostIPv4) of
-          Last (Just addr) -> return addr
-          Last  Nothing    -> getHostName
-        return . pack $ hostName <> maybe "" ((":" ++) . show) (getLast port)
+        -- In this case we should form node's name as "host_port",
+        -- where 'host' is the machine's host name and 'port' is taken
+        -- from the '--port' CLI-parameter.
+        let SocketConfig{ncNodePortNumber = port} = ncSocketConfig nc
+        hostName <- getHostName
+        return . pack $ hostName <> "_" <> show (getLast port)
 
 -- | This information is taken from 'BasicInfoShelleyBased'. It is required for
 --   'cardano-tracer' service (particularly, for RTView).

cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs

@@ -4,7 +4,8 @@ module Cardano.Tracer.Handlers.Notifications.Send
   ( makeAndSendNotification
   ) where
 
-import           Cardano.Logging (showT)
+import           Cardano.Logging (Trace, showT)
+import           Cardano.Tracer.MetaTrace (TracerTrace(..))
 import           Cardano.Tracer.Handlers.Notifications.Email
 import           Cardano.Tracer.Handlers.Notifications.Types
 import           Cardano.Tracer.Types
@@ -23,20 +24,21 @@ import           Data.Time.Clock (UTCTime)
 import           Data.Time.Format (defaultTimeLocale, formatTime)
 
 makeAndSendNotification
-  :: EmailSettings
+  :: Trace IO TracerTrace
+  -> EmailSettings
   -> ConnectedNodesNames
   -> DataPointRequestors
   -> Lock
   -> TVar UTCTime
   -> EventsQueue
   -> IO ()
-makeAndSendNotification emailSettings connectedNodesNames dpRequestors
+makeAndSendNotification tracer emailSettings connectedNodesNames dpRequestors
                         currentDPLock lastTime eventsQueue = do
   events <- atomically $ nub <$> flushTBQueue eventsQueue
   let (nodeIds, tss) = unzip $ nub [(nodeId, ts) | Event nodeId ts _ _ <- events]
   unless (null nodeIds) $ do
     nodeNames <-
-      forM nodeIds $ askNodeNameRaw connectedNodesNames dpRequestors currentDPLock
+      forM nodeIds $ askNodeNameRaw tracer connectedNodesNames dpRequestors currentDPLock
     lastEventTime <- readTVarIO lastTime
     let onlyNewEvents = filter (\(Event _ ts _ _) -> ts > lastEventTime) events
     sendNotification emailSettings onlyNewEvents $ zip nodeIds nodeNames

cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs

@@ -7,11 +7,13 @@ module Cardano.Tracer.Handlers.Notifications.Utils
   , updateNotificationsPeriods
   ) where
 
+import           Cardano.Logging (Trace)
 import           Cardano.Tracer.Handlers.Notifications.Send
 import           Cardano.Tracer.Handlers.Notifications.Settings
 import           Cardano.Tracer.Handlers.Notifications.Timer
 import           Cardano.Tracer.Handlers.Notifications.Types
 import           Cardano.Tracer.Handlers.Utils
+import           Cardano.Tracer.MetaTrace (TracerTrace(..))
 import           Cardano.Tracer.Types
 
 import           Control.Concurrent.Extra (Lock)
@@ -23,12 +25,13 @@ import           Control.Monad.Extra (unlessM, whenJust)
 import qualified Data.Map.Strict as M
 
 initEventsQueues
-  :: Maybe FilePath
+  :: Trace IO TracerTrace
+  -> Maybe FilePath
   -> ConnectedNodesNames
   -> DataPointRequestors
   -> Lock
   -> IO EventsQueues
-initEventsQueues rtvSD nodesNames dpReqs curDPLock = do
+initEventsQueues tracer rtvSD nodesNames dpReqs curDPLock = do
   emailSettings <- readSavedEmailSettings rtvSD
 
   newTVarIO . M.fromList =<<
@@ -39,7 +42,7 @@ initEventsQueues rtvSD nodesNames dpReqs curDPLock = do
       let mkEventQueue ident (evsS, evsP) = do
             evsQ <- newTBQueueIO 2000
             evsT <- mkTimer
-              (makeAndSendNotification emailSettings nodesNames dpReqs curDPLock lastTime evsQ) evsS evsP
+              (makeAndSendNotification tracer emailSettings nodesNames dpReqs curDPLock lastTime evsQ) evsS evsP
             pure (ident, (evsQ, evsT))
 
       settings <- readSavedEventsSettings rtvSD

cardano-tracer/src/Cardano/Tracer/MetaTrace.hs

@@ -23,6 +23,7 @@ module Cardano.Tracer.MetaTrace
 import           Cardano.Logging
 import           Cardano.Logging.Resources
 import           Cardano.Tracer.Configuration
+import           Cardano.Tracer.Types (NodeId(..), NodeName)
 
 import           Data.Aeson hiding (Error)
 import qualified Data.Aeson as AE
@@ -49,6 +50,9 @@ data TracerTrace
   | TracerInitStarted
   | TracerInitEventQueues
   | TracerInitDone
+  | TracerAddNewNodeIdMapping
+    { ttBimapping :: !(NodeId, NodeName)
+    }
   | TracerStartedLogRotator
   | TracerStartedPrometheus
     { ttPrometheusEndpoint   :: !Endpoint
@@ -107,6 +111,11 @@ instance ToJSON TracerTrace where
     TracerInitDone -> concatPairs
       [ "kind" .= txt "TracerInitDone"
       ]
+    TracerAddNewNodeIdMapping (NodeId nodeId, nodeName) -> concatPairs
+      [ "kind"     .= txt "TracerAddNewNodeIdMapping"
+      , "nodeId"   .= txt nodeId
+      , "nodeName" .= txt nodeName
+      ]
     TracerStartedLogRotator -> concatPairs
       [ "kind" .= txt "TracerStartedLogRotator"
       ]
@@ -204,6 +213,7 @@ instance MetaTrace TracerTrace where
     namespaceFor TracerInitStarted = Namespace [] ["InitStart"]
     namespaceFor TracerInitEventQueues = Namespace [] ["EventQueues"]
     namespaceFor TracerInitDone = Namespace [] ["InitDone"]
+    namespaceFor TracerAddNewNodeIdMapping {} = Namespace [] ["AddNewNodeIdMapping"]
     namespaceFor TracerStartedLogRotator = Namespace [] ["StartedLogRotator"]
     namespaceFor TracerStartedPrometheus{} = Namespace [] ["StartedPrometheus"]
     namespaceFor TracerStartedMonitoring{} = Namespace [] ["StartedMonitoring"]
@@ -225,6 +235,7 @@ instance MetaTrace TracerTrace where
     severityFor (Namespace _ ["InitStart"]) _ = Just Info
     severityFor (Namespace _ ["EventQueues"]) _ = Just Info
     severityFor (Namespace _ ["InitDone"]) _ = Just Info
+    severityFor (Namespace _ ["AddNewNodeIdMapping"]) _ = Just Info
     severityFor (Namespace _ ["StartedLogRotator"]) _ = Just Info
     severityFor (Namespace _ ["StartedPrometheus"]) _ = Just Info
     severityFor (Namespace _ ["StartedMonitoring"]) _ = Just Info
@@ -250,6 +261,7 @@ instance MetaTrace TracerTrace where
       , Namespace [] ["InitStart"]
       , Namespace [] ["EventQueues"]
       , Namespace [] ["InitDone"]
+      , Namespace [] ["AddNewNodeIdMapping"]
       , Namespace [] ["StartedLogRotator"]
       , Namespace [] ["StartedPrometheus"]
       , Namespace [] ["StartedMonitoring"]

cardano-tracer/src/Cardano/Tracer/Types.hs

@@ -16,8 +16,10 @@ module Cardano.Tracer.Types
 
 import           Cardano.Tracer.Configuration
 
+
 import           Control.Concurrent.MVar (MVar)
 import           Control.Concurrent.STM.TVar (TVar)
+import           Data.Aeson (ToJSON)
 import           Data.Bimap (Bimap)
 import           Data.Kind
 import           Data.Map.Strict (Map)
@@ -32,7 +34,8 @@ import           Trace.Forward.Utils.DataPoint (DataPointRequestor)
 -- | Unique identifier of connected node, based on 'remoteAddress' from
 --   'ConnectionId', please see 'ouroboros-network'.
 newtype NodeId = NodeId Text
-  deriving (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show)
+  deriving newtype (ToJSON)
 
 type NodeName = Text
 

cardano-tracer/src/Cardano/Tracer/Utils.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 #if !defined(mingw32_HOST_OS)
 #define UNIX
@@ -45,9 +46,12 @@ import           Cardano.Node.Startup (NodeInfo (..))
 import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.Utils
+import qualified Cardano.Logging as Tracer (traceWith)
+import           Cardano.Tracer.MetaTrace hiding (traceWith)
 import           Cardano.Tracer.Types
 import           Ouroboros.Network.Socket (ConnectionId (..))
 
+
 #if MIN_VERSION_base(4,18,0)
 -- Do not know why.
 import           Control.Applicative (liftA3)
@@ -59,15 +63,16 @@ import           Control.Concurrent.Async (Concurrently(..))
 import           Control.Concurrent.Extra (Lock)
 import           Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_)
 import           Control.Concurrent.STM (atomically)
-import           Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVarIO)
+import           Control.Concurrent.STM.TVar (modifyTVar', stateTVar, readTVarIO, newTVarIO)
 import           Control.Exception (SomeAsyncException (..), SomeException, finally, fromException,
                    try, tryJust)
 import           Control.Monad (forM_)
 import           Control.Monad.Extra (whenJustM)
 import           "contra-tracer" Control.Tracer (stdoutTracer, traceWith)
 import           Data.Word (Word32)
 import qualified Data.Bimap as BM
-import           Data.Foldable (traverse_)
+import           Data.Bimap (Bimap)
+import           Data.Foldable (for_, traverse_)
 import           Data.Functor ((<&>), void)
 import           Data.List.Extra (dropPrefix, dropSuffix, replace)
 import qualified Data.Map.Strict as Map
@@ -167,16 +172,17 @@ askNodeName
   :: TracerEnv
   -> NodeId
   -> IO NodeName
-askNodeName TracerEnv{teConnectedNodesNames, teDPRequestors, teCurrentDPLock} =
-  askNodeNameRaw teConnectedNodesNames teDPRequestors teCurrentDPLock
+askNodeName TracerEnv{teTracer, teConnectedNodesNames, teDPRequestors, teCurrentDPLock} =
+  askNodeNameRaw teTracer teConnectedNodesNames teDPRequestors teCurrentDPLock
 
 askNodeNameRaw
-  :: ConnectedNodesNames
+  :: Trace IO TracerTrace
+  -> ConnectedNodesNames
   -> DataPointRequestors
   -> Lock
   -> NodeId
   -> IO NodeName
-askNodeNameRaw connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anId) = do
+askNodeNameRaw tracer connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anId) = do
   nodesNames <- readTVarIO connectedNodesNames
   case BM.lookup nodeId nodesNames of
     Just nodeName -> return nodeName
@@ -186,8 +192,32 @@ askNodeNameRaw connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anI
         askDataPoint dpRequestors currentDPLock nodeId "NodeInfo" >>= \case
           Nothing -> return anId
           Just NodeInfo{niName} -> return $ if T.null niName then anId else niName
-      -- Store it in for the future using.
-      atomically . modifyTVar' connectedNodesNames $ BM.insert nodeId nodeName
+
+      -- Overlapping node names are considered a misconfiguration.
+      -- However using the unique node ID as a fallback still ensures no
+      -- trace messages or metrics get lost.
+      maybePair <- atomically do
+        stateTVar connectedNodesNames \oldBimap ->
+          let
+             maybePair :: Maybe (NodeId, T.Text)
+             maybePair
+               | BM.member nodeId oldBimap
+               = Nothing
+               | BM.memberR nodeName oldBimap
+               = Just (nodeId, anId)
+               | otherwise
+               = Just (nodeId, nodeName)
+
+             newBimap :: Bimap NodeId NodeName
+             newBimap = maybe oldBimap (\(k, v) -> BM.insert k v oldBimap) maybePair
+
+          in (maybePair, newBimap)
+
+      for_ @Maybe maybePair \pair ->
+        Tracer.traceWith tracer TracerAddNewNodeIdMapping
+          { ttBimapping = pair
+          }
+
       return nodeName
 
 askNodeId

cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs

@@ -51,8 +51,11 @@ launchAcceptorsSimple mode localSock dpName = do
 #endif
   currentLogLock <- newLock
   currentDPLock <- newLock
+
+  tr <- mkTracerTracer $ SeverityF $ Just Warning
+
 #if RTVIEW
-  eventsQueues <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock
+  eventsQueues <- initEventsQueues tr Nothing connectedNodesNames dpRequestors currentDPLock
 
   chainHistory <- initBlockchainHistory
   resourcesHistory <- initResourcesHistory
@@ -61,8 +64,6 @@ launchAcceptorsSimple mode localSock dpName = do
   rtViewPageOpened <- newTVarIO False
 #endif
 
-  tr <- mkTracerTracer $ SeverityF $ Just Warning
-
   registry <- newRegistry
 
   let tracerEnv :: TracerEnv