diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs index 7bdfa720d0e..2e7517bf31e 100644 --- a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs +++ b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} @@ -28,7 +29,6 @@ import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Configuration.Topology (TopologyError (..)) import Cardano.Node.Startup (StartupTrace (..)) import Cardano.Node.Types -import Cardano.Logging (traceWith) import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Network.ConsensusMode import Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..)) @@ -45,6 +45,7 @@ import Control.Exception (IOException) import qualified Control.Exception as Exception import Control.Exception.Base (Exception (..)) import Control.Monad.Trans.Except.Extra +import qualified "contra-tracer" Control.Tracer as CT import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -213,26 +214,26 @@ instance ToJSON NetworkTopology where -- | Read the `NetworkTopology` configuration from the specified file. -- -readTopologyFile :: NodeConfiguration -> IO (Either Text NetworkTopology) -readTopologyFile nc = do +readTopologyFile :: NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text NetworkTopology) +readTopologyFile nc tr = do eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc) case eBs of Left e -> return . Left $ handler e Right bs -> let bs' = LBS.fromStrict bs in - return $ case eitherDecode bs' of - Left err -> Left (handlerJSON err) + case eitherDecode bs' of + Left err -> return $ Left (handlerJSON err) Right t | isValidTrustedPeerConfiguration t -> if isGenesisCompatible (ncConsensusMode nc) (ntUseBootstrapPeers t) then return (Right t) else do - traceWith (ncTraceConfig nc) $ + CT.traceWith tr $ NetworkConfigUpdateError genesisIncompatible return . Right $ t { ntUseBootstrapPeers = DontUseBootstrapPeers } | otherwise -> - Left handlerBootstrap + pure $ Left handlerBootstrap where handler :: IOException -> Text handler e = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: " @@ -260,9 +261,9 @@ readTopologyFile nc = do isGenesisCompatible GenesisMode (UseBootstrapPeers{}) = False isGenesisCompatible _ _ = True -readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology -readTopologyFileOrError nc = - readTopologyFile nc +readTopologyFileOrError :: NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO NetworkTopology +readTopologyFileOrError nc tr = + readTopologyFile nc tr >>= either (\err -> error $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: " <> Text.unpack err) pure diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 5a022274bda..742ed589c02 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -437,7 +437,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do { ntUseLedgerPeers , ntUseBootstrapPeers , ntPeerSnapshotPath - } <- TopologyP2P.readTopologyFileOrError nc + } <- TopologyP2P.readTopologyFileOrError nc (startupTracer tracers) let (localRoots, publicRoots) = producerAddresses nt traceWith (startupTracer tracers) $ NetworkConfig localRoots @@ -922,8 +922,6 @@ mkP2PArguments NodeConfiguration { , P2P.daReadUseLedgerPeers , P2P.daReadUseBootstrapPeers , P2P.daReadLedgerPeerSnapshot - , P2P.daConsensusMode = ncConsensusMode - , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout , P2P.daTimeWaitTimeout = ncTimeWaitTimeout , P2P.daDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 69be0437edb..408270ab20a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -65,6 +65,7 @@ import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision +import Ouroboros.Network.BlockFetch.Decision.Trace import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) @@ -698,6 +699,36 @@ calculateBlockFetchClientMetrics cm _lc _ = pure cm -- BlockFetchDecision Tracer -------------------------------------------------------------------------------- +-- TODO @ouroboros-network +instance MetaTrace (TraceDecisionEvent peer (Header blk)) where + namespaceFor PeersFetch{} = Namespace [] ["PeersFetch"] + namespaceFor PeerStarvedUs{} = Namespace [] ["PeerStarvedUs"] + + severityFor (Namespace _ ["PeersFetch"]) _ = Just Debug + severityFor (Namespace _ ["PeerStarvedUs"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace [] ["PeersFetch"]) = + Just "TODO: @ouroboros-network" + documentFor (Namespace [] ["PeerStarvedUs"]) = + Just "TODO: @ouroboros-network" + documentFor _ = Nothing + + allNamespaces = + [ Namespace [] ["PeersFetch"], Namespace [] ["PeerStarvedUs"] ] + +-- TODO @ouroboros-network +instance LogFormatting (TraceDecisionEvent peer (Header blk)) where + forHuman (PeersFetch _traces) = + "TODO: @ouroboros-network" + forHuman (PeerStarvedUs _traces) = + "TODO: @ouroboros-network" + + forMachine _dtal (PeersFetch _traces) = + mconcat [ "kind" .= String "TODO: @ouroboros-network" ] + forMachine _dtal (PeerStarvedUs _traces) = + mconcat [ "kind" .= String "TODO: @ouroboros-network" ] + instance (LogFormatting peer, Show peer) => LogFormatting [TraceLabelPeer peer (FetchDecision [Point header])] where forMachine DMinimal _ = mempty diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 1a13f2659d1..7a548bbb2f4 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -559,9 +559,6 @@ instance LogFormatting (TracePeerSelection SockAddr) where , "upstreamyness" .= dpssUpstreamyness ds , "fetchynessBlocks" .= dpssFetchynessBlocks ds ] - forMachine _dtal (TraceVerifyPeerSnapshot result) = - mconcat [ "kind" .= String "VerifyPeerSnapshot" - , "result" .= result] forHuman = pack . show @@ -688,8 +685,6 @@ instance MetaTrace (TracePeerSelection SockAddr) where Namespace [] ["ChurnTimeout"] namespaceFor TraceDebugState {} = Namespace [] ["DebugState"] - namespaceFor TraceVerifyPeerSnapshot {} = - Namespace [] ["VerifyPeerSnapshot"] severityFor (Namespace [] ["LocalRootPeersChanged"]) _ = Just Notice severityFor (Namespace [] ["TargetsChanged"]) _ = Just Notice @@ -1206,7 +1201,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] - forMachine dtal (TrReleaseConnection prov connId) = + forMachine _dtal (TrReleaseConnection prov connId) = mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= toJSON connId @@ -1323,7 +1318,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, listValue (\(localAddr, connState) -> object [ "localAddress" .= localAddr - , "state" .= toJSON connState + , "state" .= toJSON connState ] ) (Map.toList inner) @@ -1537,7 +1532,7 @@ instance MetaTrace (ConnectionManager.AbstractTransitionTrace peerAddr) where instance (Show addr, LogFormatting addr, ToJSON addr) => LogFormatting (Server.Trace addr) where - forMachine dtal (TrAcceptConnection connId) = + forMachine _dtal (TrAcceptConnection connId) = mconcat [ "kind" .= String "AcceptConnection" , "address" .= toJSON connId ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index cb223c32450..2ac74d7fb2a 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -93,6 +93,7 @@ import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), HasHea import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..), TraceLabelPeer (..)) import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) +import Ouroboros.Network.BlockFetch.Decision.Trace import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..)) @@ -1455,6 +1456,7 @@ nodeToNodeTracers' trSel verb tr = verb "KeepAliveProtocol" tr } +-- TODO @ouroboros-network teeTraceBlockFetchDecision :: ( Eq peer , HasHeader blk @@ -1464,11 +1466,14 @@ teeTraceBlockFetchDecision => TracingVerbosity -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) -> Trace IO Text - -> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]) + -> Tracer IO (WithSeverity (TraceDecisionEvent peer (Header blk))) teeTraceBlockFetchDecision verb eliding tr = - Tracer $ \ev -> do - traceWith (teeTraceBlockFetchDecision' meTr) ev - traceWith (teeTraceBlockFetchDecisionElide verb eliding bfdTr) ev + Tracer $ \(WithSeverity s ev) -> case ev of + PeerStarvedUs {} -> do + traceWith (toLogObject' verb meTr) ev + PeersFetch ev' -> do + traceWith (teeTraceBlockFetchDecision' meTr) (WithSeverity s ev') + traceWith (teeTraceBlockFetchDecisionElide verb eliding bfdTr) (WithSeverity s ev') where meTr = appendName "metrics" tr bfdTr = appendName "BlockFetchDecision" tr