diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 336d0186b4d..46c7cbafa8f 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -126,7 +126,7 @@ library , hashable , optparse-applicative-fork >= 0.18.1 , ouroboros-consensus - , ouroboros-network-api ^>= 0.14 + , ouroboros-network-api ^>= 0.16 , sop-core , split , sqlite-easy >= 1.1.0.1 @@ -212,7 +212,7 @@ test-suite test-locli build-depends: cardano-prelude , containers , hedgehog - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , locli , text diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 0ba33110946..5854af24479 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -83,9 +83,9 @@ library -------------------------- build-depends: , cardano-api ^>=10.17 - , plutus-ledger-api ^>=1.45 - , plutus-tx ^>=1.45 - , plutus-tx-plugin ^>=1.45 + , plutus-ledger-api ^>=1.50 + , plutus-tx ^>=1.50 + , plutus-tx-plugin ^>=1.50 ------------------------ -- Non-IOG dependencies diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index b9da17c9869..92e69d15730 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -19,6 +19,7 @@ import Data.ByteString.Short (ShortByteString) import Data.Int (Int64) import Data.Map.Strict as Map (lookup) +import Control.Exception (displayException) import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra import Control.Monad.Writer (runWriter) @@ -71,8 +72,8 @@ readPlutusScript (Left s) doLoad fp = second (second (const $ ResolvedToFallback asFileName)) <$> readPlutusScript (Right fp) readPlutusScript (Right fp) = runExceptT $ do - script <- firstExceptT ApiError $ - readFileScriptInAnyLang fp + script <- + handleExceptT (\(e :: SomeException) -> ApiError $ displayException e) (readFileScriptInAnyLang fp) case script of ScriptInAnyLang (PlutusScriptLanguage _) _ -> pure (script, ResolvedToFileName fp) ScriptInAnyLang lang _ -> throwE $ TxGenError $ "readPlutusScript: only PlutusScript supported, found: " ++ show lang diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index f4a5391ee62..d619749983e 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -113,9 +113,9 @@ library , attoparsec-aeson , base16-bytestring , bytestring - , cardano-api ^>= 10.17 + , cardano-api ^>= 10.18 , cardano-binary - , cardano-cli ^>= 10.11 + , cardano-cli ^>= 10.12 , cardano-crypto-class , cardano-crypto-wrapper , cardano-data @@ -154,7 +154,6 @@ library , random , serialise , streaming - , strict-stm , cardano-ledger-shelley , prettyprinter , stm diff --git a/cabal.project b/cabal.project index 509e7bfbb6f..19155923773 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2025-06-24T21:06:59Z - , cardano-haskell-packages 2025-07-01T09:22:51Z + , hackage.haskell.org 2025-09-24T20:00:55Z + , cardano-haskell-packages 2025-09-24T15:29:30Z packages: cardano-node @@ -61,6 +61,13 @@ package plutus-scripts-bench allow-newer: , katip:Win32 +allow-newer: + , cardano-ledger-byron + -- https://github.com/phadej/vec/issues/121 + , ral:QuickCheck + , fin:QuickCheck + , bin:QuickCheck + if impl (ghc >= 9.12) allow-newer: -- https://github.com/kapralVV/Unique/issues/11 @@ -72,3 +79,41 @@ if impl (ghc >= 9.12) -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. + +source-repository-package + type: git + location: https://github.com/intersectmbo/cardano-cli.git + tag: 801b1d7cce99c6d5afbe6af7d7ad1d7a2cde087c + --sha256: sha256-s6SvoDHCFXfMC5bNBFoDgxMDZuMhnE1ZZwx1L15yjL0= + subdir: cardano-cli + + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api + tag: 7388805c2a56e2f628ca46924c648268cc61bbd2 + --sha256: sha256-YdFyulwmlwLDjVd6Bk+8IxQAdBSRCpacL5HzW3aCb7c= + subdir: + cardano-api + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + -- latest master + tag: 71b02607c8a39ed4d8c983b281b05452ed8c01ce + --sha256: sha256-/vnZnAPsEuqQMzG5NGHaWk9vyefBWMft7/rKQ+yyYTQ= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core + +source-repository-package + type: git + location: https://github.com/input-output-hk/kes-agent + tag: bf203c4e7f7e6aab947b077e178baac3ecb2541d + --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= + subdir: + kes-agent diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 3ee509f4c65..0d523a5ba2c 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -44,7 +44,7 @@ executable cardano-node-chairman build-depends: cardano-api , cardano-crypto-class , cardano-git-rev ^>= 0.2.2 - , cardano-ledger-core ^>= 1.17 + , cardano-ledger-core >= 1.17 , cardano-node ^>= 10.5 , cardano-prelude , containers @@ -55,8 +55,7 @@ executable cardano-node-chairman , ouroboros-consensus-cardano , ouroboros-network-api , ouroboros-network-protocols - , strict-stm - , si-timers + , io-classes , text , time @@ -75,7 +74,7 @@ test-suite chairman-tests , data-default-class , filepath , hedgehog - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , network , process , random @@ -90,5 +89,5 @@ test-suite chairman-tests ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" build-tool-depends: cardano-node:cardano-node - , cardano-cli:cardano-cli ^>= 10.11 + , cardano-cli:cardano-cli ^>= 10.12 , cardano-node-chairman:cardano-node-chairman diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index c0874d28f06..58f6d333c7c 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -112,7 +112,6 @@ library Cardano.Node.Tracing.Tracers.NodeToClient Cardano.Node.Tracing.Tracers.NodeToNode Cardano.Node.Tracing.Tracers.NodeVersion - Cardano.Node.Tracing.Tracers.NonP2P Cardano.Node.Tracing.Tracers.P2P Cardano.Node.Tracing.Tracers.Peer Cardano.Node.Tracing.Tracers.Resources @@ -142,7 +141,7 @@ library , async , base16-bytestring , bytestring - , cardano-api ^>= 10.17.1 + , cardano-api ^>= 10.18 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>=0.2.2 @@ -172,7 +171,7 @@ library , generic-data , hashable , hostname - , io-classes >= 1.5 + , io-classes:{io-classes,strict-stm,si-timers} >= 1.5 , iohk-monitoring ^>= 0.2 , microlens , mmap @@ -191,10 +190,10 @@ library , ouroboros-consensus-cardano ^>= 0.25 , ouroboros-consensus-diffusion ^>= 0.23 , ouroboros-consensus-protocol - , ouroboros-network-api ^>= 0.14 - , ouroboros-network ^>= 0.21.2 - , ouroboros-network-framework ^>= 0.18.0.1 - , ouroboros-network-protocols ^>= 0.14 + , ouroboros-network-api ^>= 0.16 + , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22 + , ouroboros-network-framework + , ouroboros-network-protocols ^>= 0.15 , prettyprinter , prettyprinter-ansi-terminal , psqueues @@ -202,12 +201,11 @@ library , resource-registry , safe-exceptions , scientific - , si-timers + , io-classes , sop-core -- avoid stm-2.5.2 https://github.com/haskell/stm/issues/76 , stm <2.5.2 || >=2.5.3 , strict-sop-core - , strict-stm , sop-core , sop-extras , text >= 2.0 @@ -218,8 +216,7 @@ library , tracer-transformers , transformers , transformers-except - , typed-protocols >= 0.3 - , typed-protocols-stateful >= 0.3 + , typed-protocols:{typed-protocols, stateful} >= 1.0 , yaml executable cardano-node @@ -265,13 +262,13 @@ test-suite cardano-node-test , filepath , hedgehog , hedgehog-corpus - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , iproute , mtl , ouroboros-consensus , ouroboros-consensus-cardano , ouroboros-consensus-diffusion - , ouroboros-network + , ouroboros-network:{ouroboros-network, cardano-diffusion} , ouroboros-network-api , strict-sop-core , text diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs index 8accffc3679..065f7d379f1 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Logging.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Logging.hs @@ -344,7 +344,7 @@ nodeBasicInfo nc (SomeConsensusProtocol whichP pForInfo) nodeStartTime' = do in getGenesisValues "Shelley" cfgShelley Api.CardanoBlockType -> let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo - cfgBabbage cfgConway = Consensus.configLedger cfg + cfgBabbage cfgConway cfgDjikstra = Consensus.configLedger cfg in getGenesisValuesByron cfg cfgByron ++ getGenesisValues "Shelley" cfgShelley ++ getGenesisValues "Allegra" cfgAllegra @@ -352,6 +352,7 @@ nodeBasicInfo nc (SomeConsensusProtocol whichP pForInfo) nodeStartTime' = do ++ getGenesisValues "Alonzo" cfgAlonzo ++ getGenesisValues "Babbage" cfgBabbage ++ getGenesisValues "Conway" cfgConway + ++ getGenesisValues "Djikstra" cfgDjikstra items = nub $ [ ("protocol", pack . show $ ncProtocol nc) , ("version", pack . showVersion $ version) diff --git a/cardano-node/src/Cardano/Node/Configuration/NodeAddress.hs b/cardano-node/src/Cardano/Node/Configuration/NodeAddress.hs index a252d7b644e..afdadaa5dd3 100644 --- a/cardano-node/src/Cardano/Node/Configuration/NodeAddress.hs +++ b/cardano-node/src/Cardano/Node/Configuration/NodeAddress.hs @@ -16,7 +16,7 @@ module Cardano.Node.Configuration.NodeAddress , NodeDnsAddress , nodeIPv4ToIPAddress , nodeIPv6ToIPAddress - , nodeDnsAddressToDomainAddress + , nodeDnsAddressToRelayAccessPoint , NodeHostIPAddress (..) , nodeHostIPAddressToSockAddr , NodeHostIPv4Address (..) @@ -32,7 +32,7 @@ module Cardano.Node.Configuration.NodeAddress import Cardano.Api -import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint (..)) +import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Data.Aeson (Value (..), object, withObject, (.:), (.=)) import Data.IP (IP (..), IPv4, IPv6) @@ -76,9 +76,9 @@ nodeIPv4ToIPAddress = fmap nodeHostIPv4AddressToIPAddress nodeIPv6ToIPAddress :: NodeIPv6Address -> NodeIPAddress nodeIPv6ToIPAddress = fmap nodeHostIPv6AddressToIPAddress -nodeDnsAddressToDomainAddress :: NodeDnsAddress -> DomainAccessPoint -nodeDnsAddressToDomainAddress NodeAddress { naHostAddress = NodeHostDnsAddress dns, naPort } - = DomainAccessPoint (Text.encodeUtf8 dns) naPort +nodeDnsAddressToRelayAccessPoint :: NodeDnsAddress -> RelayAccessPoint +nodeDnsAddressToRelayAccessPoint NodeAddress { naHostAddress = NodeHostDnsAddress dns, naPort } + = RelayAccessDomain (Text.encodeUtf8 dns) naPort nodeAddressToSockAddr :: NodeIPAddress -> SockAddr nodeAddressToSockAddr (NodeAddress addr port) = diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 7091e9b2e62..e79e5513818 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -14,7 +14,6 @@ module Cardano.Node.Configuration.POM ( NodeConfiguration (..) , ResponderCoreAffinityPolicy (..) , NetworkP2PMode (..) - , SomeNetworkP2PMode (..) , PartialNodeConfiguration(..) , TimeoutOverride (..) , defaultPartialNodeConfiguration @@ -29,6 +28,7 @@ where import Cardano.Crypto (RequiresNetworkMagic (..)) import Cardano.Logging.Types +import qualified Cardano.Network.Diffusion.Configuration as Cardano import Cardano.Network.Types (NumberOfBigLedgerPeers (..)) import Cardano.Node.Configuration.LedgerDB import Cardano.Node.Configuration.Socket (SocketConfig (..)) @@ -37,11 +37,9 @@ import Cardano.Node.Protocol.Types (Protocol (..)) import Cardano.Node.Types import Cardano.Tracing.Config import Cardano.Tracing.OrphanInstances.Network () -import qualified Ouroboros.Cardano.Network.Diffusion.Configuration as Cardano import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..)) import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) -import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Node.Genesis (GenesisConfig, GenesisConfigFlags, defaultGenesisConfigFlags, mkGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.Args (QueryBatchSize (..)) @@ -76,25 +74,6 @@ import Generic.Data.Orphans () data NetworkP2PMode = EnabledP2PMode | DisabledP2PMode deriving (Eq, Show, Generic) -data SomeNetworkP2PMode where - SomeNetworkP2PMode :: forall p2p. - Consensus.NetworkP2PMode p2p - -> SomeNetworkP2PMode - -instance Eq SomeNetworkP2PMode where - (==) (SomeNetworkP2PMode Consensus.EnabledP2PMode) - (SomeNetworkP2PMode Consensus.EnabledP2PMode) - = True - (==) (SomeNetworkP2PMode Consensus.DisabledP2PMode) - (SomeNetworkP2PMode Consensus.DisabledP2PMode) - = True - (==) _ _ - = False - -instance Show SomeNetworkP2PMode where - show (SomeNetworkP2PMode mode@Consensus.EnabledP2PMode) = show mode - show (SomeNetworkP2PMode mode@Consensus.DisabledP2PMode) = show mode - -- | Isomorphic to a `Maybe DiffTime`, but expresses what `Nothing` means, in -- this case that we want to /NOT/ override the default timeout. data TimeoutOverride = NoTimeoutOverride | TimeoutOverride DiffTime @@ -192,9 +171,6 @@ data NodeConfiguration -- in Genesis mode , ncMinBigLedgerPeersForTrustedState :: NumberOfBigLedgerPeers - -- Enable experimental P2P mode - , ncEnableP2P :: SomeNetworkP2PMode - -- Enable Peer Sharing , ncPeerSharing :: PeerSharing @@ -290,9 +266,6 @@ data PartialNodeConfiguration -- Consensus mode for diffusion layer , pncConsensusMode :: !(Last ConsensusMode) - -- Network P2P mode - , pncEnableP2P :: !(Last NetworkP2PMode) - -- Peer Sharing , pncPeerSharing :: !(Last PeerSharing) @@ -399,14 +372,6 @@ instance FromJSON PartialNodeConfiguration where pncChainSyncIdleTimeout <- Last <$> v .:? "ChainSyncIdleTimeout" - -- Enable P2P switch - p2pSwitch <- v .:? "EnableP2P" .!= Just False - let pncEnableP2P = - case p2pSwitch of - Nothing -> mempty - Just False -> Last $ Just DisabledP2PMode - Just True -> Last $ Just EnabledP2PMode - -- Peer Sharing pncPeerSharing <- Last <$> v .:? "PeerSharing" @@ -459,7 +424,6 @@ instance FromJSON PartialNodeConfiguration where , pncSyncTargetOfActiveBigLedgerPeers , pncMinBigLedgerPeersForTrustedState , pncConsensusMode - , pncEnableP2P , pncPeerSharing , pncGenesisConfigFlags , pncResponderCoreAffinityPolicy @@ -704,7 +668,6 @@ defaultPartialNodeConfiguration = -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/cardano-diffusion/Cardano-Network-Diffusion-Configuration.html#v:defaultNumberOfBigLedgerPeers , pncConsensusMode = Last (Just Ouroboros.defaultConsensusMode) -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultConsensusMode - , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = mempty -- the default is defined in `makeNodeConfiguration` , pncGenesisConfigFlags = Last (Just defaultGenesisConfigFlags) @@ -794,9 +757,6 @@ makeNodeConfiguration pnc = do ncAcceptedConnectionsLimit <- lastToEither "Missing AcceptedConnectionsLimit" $ pncAcceptedConnectionsLimit pnc - enableP2P <- - lastToEither "Missing EnableP2P" - $ pncEnableP2P pnc ncChainSyncIdleTimeout <- Right $ maybe NoTimeoutOverride TimeoutOverride @@ -891,9 +851,6 @@ makeNodeConfiguration pnc = do , ncSyncTargetOfEstablishedBigLedgerPeers , ncSyncTargetOfActiveBigLedgerPeers , ncMinBigLedgerPeersForTrustedState - , ncEnableP2P = case enableP2P of - EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode - DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing , ncConsensusMode , ncGenesisConfig diff --git a/cardano-node/src/Cardano/Node/Configuration/Socket.hs b/cardano-node/src/Cardano/Node/Configuration/Socket.hs index c35c78fee7d..f0de1bbb3f2 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Socket.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Socket.hs @@ -195,7 +195,7 @@ gatherConfiguredSockets SocketConfig { ncNodeIPv4Addr, let firstUnixSocket :: Maybe LocalSocket firstUnixSocket = join $ listToMaybe . (\(_, _, a) -> a) <$> systemDSockets - -- only when 'ncSocketpath' is specified or a unix socket is passed through + -- only when 'ncSocketPath' is specified or a UNIX socket is passed through -- socket activation local <- case (getLast ncSocketPath, firstUnixSocket) of (Nothing, Nothing) -> return Nothing diff --git a/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs b/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs index e8260ef3474..ca13e80574f 100644 --- a/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs +++ b/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs @@ -46,7 +46,7 @@ module Cardano.Node.Handlers.TopLevel -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -import qualified Ouroboros.Network.Diffusion.Common as Network +import qualified Ouroboros.Network.Diffusion.Types as Network import Prelude diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index 9b1c747fa60..a511674370c 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -9,12 +8,13 @@ module Cardano.Node.Orphans () where import Cardano.Api () +import Cardano.Network.OrphanInstances () import Ouroboros.Consensus.Node import Ouroboros.Consensus.Node.Genesis (GenesisConfigFlags (..)) import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (Flag(..)) -import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) +import Ouroboros.Network.OrphanInstances () import Data.Aeson.Types import qualified Data.Text as Text @@ -26,29 +26,6 @@ deriving instance Show NodeDatabasePaths instance PrintfArg SizeInBytes where formatArg (SizeInBytes s) = formatArg s -instance ToJSON AcceptedConnectionsLimit where - toJSON AcceptedConnectionsLimit - { acceptedConnectionsHardLimit - , acceptedConnectionsSoftLimit - , acceptedConnectionsDelay - } = - object [ "AcceptedConnectionsLimit" .= - object [ "hardLimit" .= - toJSON acceptedConnectionsHardLimit - , "softLimit" .= - toJSON acceptedConnectionsSoftLimit - , "delay" .= - toJSON acceptedConnectionsDelay - ] - ] - -instance FromJSON AcceptedConnectionsLimit where - parseJSON = withObject "AcceptedConnectionsLimit" $ \v -> - AcceptedConnectionsLimit - <$> v .: "hardLimit" - <*> v .: "softLimit" - <*> v .: "delay" - instance FromJSON NodeDatabasePaths where parseJSON o@(Object{})= withObject "NodeDatabasePaths" diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 39f997e0c5c..86773d3726c 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -137,7 +137,6 @@ nodeRunParser = do , pncSyncTargetOfActiveBigLedgerPeers = mempty , pncMinBigLedgerPeersForTrustedState = mempty , pncConsensusMode = mempty - , pncEnableP2P = mempty , pncPeerSharing = mempty , pncGenesisConfigFlags = mempty , pncResponderCoreAffinityPolicy = mempty diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 6575bf34ec0..16286bf892a 100644 --- a/cardano-node/src/Cardano/Node/Queries.hs +++ b/cardano-node/src/Cardano/Node/Queries.hs @@ -42,8 +42,10 @@ import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hashing as Byron.Crypto import Cardano.Crypto.KES.Class (Period) import Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe) +import qualified Cardano.Ledger.Conway.State as Conway import qualified Cardano.Ledger.Hashes as Ledger import qualified Cardano.Ledger.Shelley.LedgerState as Shelley +import qualified Cardano.Ledger.State as Ledger import qualified Cardano.Ledger.TxIn as Ledger import qualified Cardano.Ledger.UMap as UM import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) @@ -241,7 +243,8 @@ instance LedgerQueries Byron.ByronBlock where ledgerDRepCount _ = 0 ledgerDRepMapSize _ = 0 -instance Shelley.EraCertState era => LedgerQueries (Shelley.ShelleyBlock protocol era) where +-- TODO should this be ConwayEraCertState constraint? Wouldn't this break queries for older eras? +instance Conway.ConwayEraCertState era => LedgerQueries (Shelley.ShelleyBlock protocol era) where ledgerUtxoSize = (\(Shelley.UTxO xs)-> Map.size xs) . Shelley.utxosUtxo @@ -252,7 +255,9 @@ instance Shelley.EraCertState era => LedgerQueries (Shelley.ShelleyBlock protoco ledgerDelegMapSize = UM.size . UM.SPoolUView - . Shelley.dsUnified + . undefined -- TODO what should be here? + . (^. Conway.accountsMapL) + . Ledger.dsAccounts . (^. Shelley.certDStateL) . Shelley.lsCertState . Shelley.esLState @@ -260,8 +265,8 @@ instance Shelley.EraCertState era => LedgerQueries (Shelley.ShelleyBlock protoco . Shelley.shelleyLedgerState ledgerDRepCount = Map.size - . Shelley.vsDReps - . (^. Shelley.certVStateL) + . Conway.vsDReps + . (^. Conway.certVStateL) . Shelley.lsCertState . Shelley.esLState . Shelley.nesEs @@ -269,7 +274,8 @@ instance Shelley.EraCertState era => LedgerQueries (Shelley.ShelleyBlock protoco ledgerDRepMapSize = UM.size . UM.DRepUView - . Shelley.dsUnified + . undefined -- TODO what should be here? + . Ledger.dsAccounts . (^. Shelley.certDStateL) . Shelley.lsCertState . Shelley.esLState @@ -283,39 +289,45 @@ instance (LedgerQueries x, NoHardForks x) ledgerDRepCount = ledgerDRepCount . unFlip . project . Flip ledgerDRepMapSize = ledgerDRepMapSize . unFlip . project . Flip +-- TODO those states make no sense, since required lenses got moved to Conway +-- TODO(geo2a): fill in TODOs following the pattern, after adding missing instances instance LedgerQueries (Cardano.CardanoBlock c) where ledgerUtxoSize = \case - Cardano.LedgerStateByron ledgerByron -> ledgerUtxoSize ledgerByron - Cardano.LedgerStateShelley ledgerShelley -> ledgerUtxoSize ledgerShelley - Cardano.LedgerStateAllegra ledgerAllegra -> ledgerUtxoSize ledgerAllegra - Cardano.LedgerStateMary ledgerMary -> ledgerUtxoSize ledgerMary - Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerUtxoSize ledgerAlonzo - Cardano.LedgerStateBabbage ledgerBabbage -> ledgerUtxoSize ledgerBabbage - Cardano.LedgerStateConway ledgerConway -> ledgerUtxoSize ledgerConway + Cardano.LedgerStateByron ledgerByron -> ledgerUtxoSize ledgerByron + Cardano.LedgerStateShelley _ledgerShelley -> undefined -- TODO(geo2a) + Cardano.LedgerStateAllegra _ledgerAllegra -> undefined -- TODO(geo2a) + Cardano.LedgerStateMary _ledgerMary -> undefined -- TODO(geo2a) + Cardano.LedgerStateAlonzo _ledgerAlonzo -> undefined -- TODO(geo2a) + Cardano.LedgerStateBabbage _ledgerBabbage -> undefined -- TODO(geo2a) + Cardano.LedgerStateConway ledgerConway -> ledgerUtxoSize ledgerConway + Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerUtxoSize ledgerDijkstra ledgerDelegMapSize = \case Cardano.LedgerStateByron ledgerByron -> ledgerDelegMapSize ledgerByron - Cardano.LedgerStateShelley ledgerShelley -> ledgerDelegMapSize ledgerShelley - Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDelegMapSize ledgerAllegra - Cardano.LedgerStateMary ledgerMary -> ledgerDelegMapSize ledgerMary - Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDelegMapSize ledgerAlonzo - Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDelegMapSize ledgerBabbage + Cardano.LedgerStateShelley _ledgerShelley -> undefined -- TODO(geo2a) + Cardano.LedgerStateAllegra _ledgerAllegra -> undefined -- TODO(geo2a) + Cardano.LedgerStateMary _ledgerMary -> undefined -- TODO(geo2a) + Cardano.LedgerStateAlonzo _ledgerAlonzo -> undefined -- TODO(geo2a) + Cardano.LedgerStateBabbage _ledgerBabbage -> undefined -- TODO(geo2a) Cardano.LedgerStateConway ledgerConway -> ledgerDelegMapSize ledgerConway + Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDelegMapSize ledgerDijkstra ledgerDRepCount = \case Cardano.LedgerStateByron ledgerByron -> ledgerDRepCount ledgerByron - Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepCount ledgerShelley - Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepCount ledgerAllegra - Cardano.LedgerStateMary ledgerMary -> ledgerDRepCount ledgerMary - Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepCount ledgerAlonzo - Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepCount ledgerBabbage + Cardano.LedgerStateShelley _ledgerShelley -> undefined -- TODO(geo2a) + Cardano.LedgerStateAllegra _ledgerAllegra -> undefined -- TODO(geo2a) + Cardano.LedgerStateMary _ledgerMary -> undefined -- TODO(geo2a) + Cardano.LedgerStateAlonzo _ledgerAlonzo -> undefined -- TODO(geo2a) + Cardano.LedgerStateBabbage _ledgerBabbage -> undefined -- TODO(geo2a) Cardano.LedgerStateConway ledgerConway -> ledgerDRepCount ledgerConway + Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDRepCount ledgerDijkstra ledgerDRepMapSize = \case Cardano.LedgerStateByron ledgerByron -> ledgerDRepMapSize ledgerByron - Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepMapSize ledgerShelley - Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepMapSize ledgerAllegra - Cardano.LedgerStateMary ledgerMary -> ledgerDRepMapSize ledgerMary - Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepMapSize ledgerAlonzo - Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepMapSize ledgerBabbage + Cardano.LedgerStateShelley _ledgerShelley -> undefined -- TODO(geo2a) + Cardano.LedgerStateAllegra _ledgerAllegra -> undefined -- TODO(geo2a) + Cardano.LedgerStateMary _ledgerMary -> undefined -- TODO(geo2a) + Cardano.LedgerStateAlonzo _ledgerAlonzo -> undefined -- TODO(geo2a) + Cardano.LedgerStateBabbage _ledgerBabbage -> undefined -- TODO(geo2a) Cardano.LedgerStateConway ledgerConway -> ledgerDRepMapSize ledgerConway + Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDRepMapSize ledgerDijkstra -- -- * Node kernel diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 18a83515fd8..9f6cc1fec50 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -37,9 +37,11 @@ import Cardano.Node.Configuration.Logging (LoggingLayer (..), createLo nodeBasicInfo, shutdownLoggingLayer) import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..), - PartialNodeConfiguration (..), SomeNetworkP2PMode (..), TimeoutOverride (..), - defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP, getForkPolicy) -import Cardano.Node.Configuration.Socket (SocketOrSocketInfo' (..), + PartialNodeConfiguration (..), TimeoutOverride (..), + defaultPartialNodeConfiguration, makeNodeConfiguration, + parseNodeConfigurationFP, getForkPolicy) +import Cardano.Node.Configuration.Socket (LocalSocketOrSocketInfo, + SocketOrSocketInfo, SocketOrSocketInfo' (..), gatherConfiguredSockets, getSocketOrSocketInfoAddr) import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P import Cardano.Node.Configuration.TopologyP2P @@ -66,10 +68,10 @@ import Cardano.Tracing.Tracers import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) -import Ouroboros.Consensus.Node (SnapshotPolicyArgs (..), NetworkP2PMode (..), +import Ouroboros.Consensus.Node (SnapshotPolicyArgs (..), NodeDatabasePaths (..), RunNodeArgs (..), StdRunNodeArgs (..)) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) -import Ouroboros.Consensus.Node (NetworkP2PMode (..), RunNodeArgs (..), +import Ouroboros.Consensus.Node (RunNodeArgs (..), SnapshotPolicyArgs (..), StdRunNodeArgs (..)) import qualified Ouroboros.Consensus.Node as Node (NodeDatabasePaths (..), getChainDB, run) import Ouroboros.Consensus.Node.Genesis @@ -81,49 +83,41 @@ import Ouroboros.Consensus.Storage.LedgerDB.V2.Args import Ouroboros.Consensus.Util.Args import Ouroboros.Consensus.Util.Orphans () +import qualified Cardano.Network.Diffusion as Cardano.Diffusion +import qualified Cardano.Network.Diffusion.Configuration as Configuration import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable) +import qualified Cardano.Network.PeerSelection.PeerSelectionActions as Cardano +import Cardano.Network.PeerSelection.Churn (ChurnMode (..), peerChurnGovernor) +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionActions as Cardano.PeerSelection +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano.PeerSelection +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as CPST +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano +import qualified Cardano.Network.PeerSelection.Governor.Types as CPSV +import qualified Cardano.Network.PeerSelection.PublicRootPeers as Cardano.PublicRoots +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionActions as Cardano.PeerSelection +import qualified Cardano.Network.LedgerPeerConsensusInterface as Cardano +import qualified Cardano.Network.PeerSelection.PeerSelectionActions as Cardano +import qualified Cardano.Network.PeerSelection.Churn as Cardano.Churn import Cardano.Network.Types (NumberOfBigLedgerPeers (..)) -import Cardano.Network.ConsensusMode (ConsensusMode (..)) -import qualified Ouroboros.Cardano.PeerSelection.PeerSelectionActions as Cardano -import Ouroboros.Cardano.PeerSelection.Churn (peerChurnGovernor) -import Ouroboros.Cardano.Network.Types (ChurnMode (..)) -import Ouroboros.Cardano.Network.Diffusion.Handlers (sigUSR1Handler) -import qualified Ouroboros.Cardano.Network.ArgumentsExtra as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionActions as Cardano.PeerSelection -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano.PeerSelection -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as CPST -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as CPSV -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRoots -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionActions as Cardano.PeerSelection -import qualified Ouroboros.Cardano.Network.LedgerPeerConsensusInterface as Cardano -import qualified Ouroboros.Cardano.PeerSelection.PeerSelectionActions as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Churn.ExtraArguments as Cardano.Churn -import qualified Ouroboros.Cardano.Network.Diffusion.Configuration as Configuration import Ouroboros.Network.BlockFetch (FetchMode) import qualified Ouroboros.Network.Diffusion as Diffusion -import qualified Ouroboros.Network.Diffusion.Common as Diffusion +import qualified Ouroboros.Network.Diffusion.Types as Diffusion import qualified Ouroboros.Network.Diffusion.Configuration as Configuration -import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P -import qualified Ouroboros.Network.Diffusion.P2P as P2P import Ouroboros.Network.Mux (noBindForkPolicy, responderForkPolicy, ForkPolicy) import Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket (..)) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), ConnectionId, PeerSelectionTargets (..), RemoteAddress) -import Ouroboros.Network.PeerSelection.Governor.Types (BootstrapPeersCriticalTimeoutError, - PeerSelectionState, PeerSelectionTargets (..), PublicPeerSelectionState, - makePublicPeerSelectionStateVar) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (AfterSlot (..), - LedgerPeerSnapshot (..), UseLedgerPeers (..)) +import Ouroboros.Network.PeerSelection.Governor.Types (PeerSelectionState, + PublicPeerSelectionState, makePublicPeerSelectionStateVar, BootstrapPeersCriticalTimeoutError) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..), + UseLedgerPeers (..), AfterSlot (..)) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers (TracePublicRootPeers) import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, LocalRootConfig (..), WarmValency) import Ouroboros.Network.Protocol.ChainSync.Codec -import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..), - IPSubscriptionTarget (..)) import Control.Applicative (empty) import Control.Concurrent (killThread, mkWeakThreadId, myThreadId, getNumCapabilities) @@ -234,98 +228,90 @@ handleNodeWithTracers -> NodeConfiguration -> SomeConsensusProtocol -> IO () -handleNodeWithTracers cmdPc nc0 p@(SomeConsensusProtocol blockType runP) = do +handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do let ProtocolInfo{pInfoConfig} = fst $ Api.protocolInfo @IO runP networkMagic :: Api.NetworkMagic = getNetworkMagic $ Consensus.configBlock pInfoConfig -- This IORef contains node kernel structure which holds node kernel. -- Used for ledger queries and peer connection status. nodeKernelData <- mkNodeKernelData let ProtocolInfo { pInfoConfig = cfg } = fst $ Api.protocolInfo @IO runP - case ncEnableP2P nc0 of - SomeNetworkP2PMode p2pMode -> do - let fp = maybe "No file path found!" - unConfigPath - (getLast (pncConfigFile cmdPc)) - -- Overwrite configured peer sharing mode if p2p is not enabled - nc = case p2pMode of - DisabledP2PMode -> nc0 { ncPeerSharing = PeerSharingDisabled } - EnabledP2PMode -> nc0 - case ncTraceConfig nc of - TraceDispatcher{} -> do - blockForging <- snd (Api.protocolInfo runP) - tracers <- - initTraceDispatcher - nc - p - networkMagic - nodeKernelData - p2pMode - (null blockForging) - - startupInfo <- getStartupInfo nc p fp - mapM_ (traceWith $ startupTracer tracers) startupInfo - traceNodeStartupInfo (nodeStartupInfoTracer tracers) startupInfo - -- sends initial BlockForgingUpdate - let isNonProducing = ncStartAsNonProducingNode nc - traceWith (startupTracer tracers) - (BlockForgingUpdate (if isNonProducing || null blockForging - then DisabledBlockForging - else EnabledBlockForging)) - - handleSimpleNode blockType runP p2pMode tracers nc - (\nk -> do - setNodeKernel nodeKernelData nk - traceWith (nodeStateTracer tracers) NodeKernelOnline) - - _ -> do - eLoggingLayer <- runExceptT $ createLoggingLayer - (Text.pack (showVersion version)) - nc - p - - loggingLayer <- case eLoggingLayer of - Left err -> Exception.throwIO err - Right res -> return res - !trace <- setupTrace loggingLayer - let tracer = contramap pack $ toLogObject trace - logTracingVerbosity nc tracer - - -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'. - startTime <- getCurrentTime - traceCounter "nodeStartTime" trace (ceiling $ utcTimeToPOSIXSeconds startTime) - nbi <- nodeBasicInfo nc p startTime - forM_ nbi $ \(LogObject nm mt content) -> - traceNamedObject (appendName nm trace) (mt, content) - - tracers <- - mkTracers - (Consensus.configBlock cfg) - (ncTraceConfig nc) - trace - nodeKernelData - (llEKGDirect loggingLayer) - p2pMode - - getStartupInfo nc p fp - >>= mapM_ (traceWith $ startupTracer tracers) - - traceWith (nodeVersionTracer tracers) getNodeVersion - let isNonProducing = ncStartAsNonProducingNode nc - blockForging <- snd (Api.protocolInfo runP) - traceWith (startupTracer tracers) - (BlockForgingUpdate (if isNonProducing || null blockForging - then DisabledBlockForging - else EnabledBlockForging)) - - -- We ignore peer logging thread if it dies, but it will be killed - -- when 'handleSimpleNode' terminates. - handleSimpleNode blockType runP p2pMode tracers nc - (\nk -> do - setNodeKernel nodeKernelData nk - traceWith (nodeStateTracer tracers) NodeKernelOnline) - `finally` do - forM_ eLoggingLayer - shutdownLoggingLayer + let fp = maybe "No file path found!" + unConfigPath + (getLast (pncConfigFile cmdPc)) + case ncTraceConfig nc of + TraceDispatcher{} -> do + blockForging <- snd (Api.protocolInfo runP) + tracers <- + initTraceDispatcher + nc + p + networkMagic + nodeKernelData + (null blockForging) + + startupInfo <- getStartupInfo nc p fp + mapM_ (traceWith $ startupTracer tracers) startupInfo + traceNodeStartupInfo (nodeStartupInfoTracer tracers) startupInfo + -- sends initial BlockForgingUpdate + let isNonProducing = ncStartAsNonProducingNode nc + traceWith (startupTracer tracers) + (BlockForgingUpdate (if isNonProducing || null blockForging + then DisabledBlockForging + else EnabledBlockForging)) + + handleSimpleNode blockType runP tracers nc + (\nk -> do + setNodeKernel nodeKernelData nk + traceWith (nodeStateTracer tracers) NodeKernelOnline) + + _ -> do + eLoggingLayer <- runExceptT $ createLoggingLayer + (Text.pack (showVersion version)) + nc + p + + loggingLayer <- case eLoggingLayer of + Left err -> Exception.throwIO err + Right res -> return res + !trace <- setupTrace loggingLayer + let tracer = contramap pack $ toLogObject trace + logTracingVerbosity nc tracer + + -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'. + startTime <- getCurrentTime + traceCounter "nodeStartTime" trace (ceiling $ utcTimeToPOSIXSeconds startTime) + nbi <- nodeBasicInfo nc p startTime + forM_ nbi $ \(LogObject nm mt content) -> + traceNamedObject (appendName nm trace) (mt, content) + + tracers <- + mkTracers + (Consensus.configBlock cfg) + (ncTraceConfig nc) + trace + nodeKernelData + (llEKGDirect loggingLayer) + + getStartupInfo nc p fp + >>= mapM_ (traceWith $ startupTracer tracers) + + traceWith (nodeVersionTracer tracers) getNodeVersion + let isNonProducing = ncStartAsNonProducingNode nc + blockForging <- snd (Api.protocolInfo runP) + traceWith (startupTracer tracers) + (BlockForgingUpdate (if isNonProducing || null blockForging + then DisabledBlockForging + else EnabledBlockForging)) + + -- We ignore peer logging thread if it dies, but it will be killed + -- when 'handleSimpleNode' terminates. + handleSimpleNode blockType runP tracers nc + (\nk -> do + setNodeKernel nodeKernelData nk + traceWith (nodeStateTracer tracers) NodeKernelOnline) + `finally` do + forM_ eLoggingLayer + shutdownLoggingLayer -- | Currently, we trace only 'ShelleyBased'-info which will be asked -- by 'cardano-tracer' service as a datapoint. It can be extended in the future. @@ -385,29 +371,19 @@ handlePeersListSimple tr nodeKern = forever $ do -- create a new block. handleSimpleNode - :: forall blk p2p . + :: forall blk . ( Api.Protocol IO blk ) => Api.BlockType blk -> Api.ProtocolInfoArgs blk - -> NetworkP2PMode p2p - -> Tracers - RemoteAddress - LocalAddress - blk p2p - Cardano.PeerSelection.ExtraState - Cardano.PeerSelection.DebugPeerSelectionState - PeerTrustable - (Cardano.PublicRoots.ExtraPeers RemoteAddress) - (Cardano.ExtraPeerSelectionSetsWithSizes RemoteAddress) - IO + -> Tracers RemoteAddress LocalAddress blk IO -> NodeConfiguration -> (NodeKernel IO RemoteAddress LocalConnectionId blk -> IO ()) -- ^ Called on the 'NodeKernel' after creating it, but before the network -- layer is initialised. This implies this function must not block, -- otherwise the node won't actually start. -> IO () -handleSimpleNode blockType runP p2pMode tracers nc onKernel = do +handleSimpleNode blockType runP tracers nc onKernel = do logStartupWarnings logDeprecatedLedgerDBOptions @@ -432,31 +408,8 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do dbPath <- canonDbPath nc - publicPeerSelectionVar <- makePublicPeerSelectionStateVar - let diffusionArguments :: Diffusion.Arguments IO Socket RemoteAddress - LocalSocket LocalAddress - diffusionArguments = - Diffusion.Arguments { - Diffusion.daIPv4Address = - case publicIPv4SocketOrAddr of - Just (ActualSocket socket) -> Just (Left socket) - Just (SocketInfo addr) -> Just (Right addr) - Nothing -> Nothing - , Diffusion.daIPv6Address = - case publicIPv6SocketOrAddr of - Just (ActualSocket socket) -> Just (Left socket) - Just (SocketInfo addr) -> Just (Right addr) - Nothing -> Nothing - , Diffusion.daLocalAddress = - case localSocketOrPath of -- TODO allow expressing the Nothing case in the config - Just (ActualSocket localSocket) -> Just (Left localSocket) - Just (SocketInfo localAddr) -> Just (Right localAddr) - Nothing -> Nothing - , Diffusion.daAcceptedConnectionsLimit = ncAcceptedConnectionsLimit nc - , Diffusion.daMode = ncDiffusionMode nc - , Diffusion.daPublicPeerSelectionVar = publicPeerSelectionVar - , Diffusion.daEgressPollInterval = ncEgressPollInterval nc - } + (publicPeerSelectionVar :: StrictTVar IO (PublicPeerSelectionState RemoteAddress)) + <- makePublicPeerSelectionStateVar ipv4 <- traverse getSocketOrSocketInfoAddr publicIPv4SocketOrAddr ipv6 <- traverse getSocketOrSocketInfoAddr publicIPv6SocketOrAddr @@ -474,203 +427,140 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do )) withShutdownHandling (ncShutdownConfig nc) (shutdownTracer tracers) $ - case p2pMode of - EnabledP2PMode -> do - traceWith (startupTracer tracers) - (StartupP2PInfo (ncDiffusionMode nc)) - nt@TopologyP2P.RealNodeTopology - { ntUseLedgerPeers - , ntUseBootstrapPeers - , ntPeerSnapshotPath - } <- TopologyP2P.readTopologyFileOrError nc (startupTracer tracers) - let (localRoots, publicRoots) = producerAddresses nt - traceWith (startupTracer tracers) - $ NetworkConfig localRoots - publicRoots - ntUseLedgerPeers - ntPeerSnapshotPath - case ncPeerSharing nc of - PeerSharingEnabled - | hasProtocolFile (ncProtocolFiles nc) -> - traceWith (startupTracer tracers) . NetworkConfigUpdateWarning . Text.pack $ - "Mainnet block producers may not meet the Praos performance guarantees " - <> "and host IP address will be leaked since peer sharing is enabled." - _otherwise -> pure () - localRootsVar <- newTVarIO localRoots - publicRootsVar <- newTVarIO publicRoots - useLedgerVar <- newTVarIO ntUseLedgerPeers - useBootstrapVar <- newTVarIO ntUseBootstrapPeers - ledgerPeerSnapshotPathVar <- newTVarIO ntPeerSnapshotPath - ledgerPeerSnapshotVar <- newTVarIO =<< updateLedgerPeerSnapshot - (startupTracer tracers) - nc - (readTVar ledgerPeerSnapshotPathVar) - (readTVar useLedgerVar) - (const . pure $ ()) - - churnModeVar <- newTVarIO ChurnModeNormal - let nodeArgs = RunNodeArgs - { rnGenesisConfig = ncGenesisConfig nc - , rnTraceConsensus = consensusTracers tracers - , rnTraceNTN = nodeToNodeTracers tracers - , rnTraceNTC = nodeToClientTracers tracers - , rnProtocolInfo = pInfo - , rnNodeKernelHook = \registry nodeKernel -> do - -- set the initial block forging - blockForging <- snd (Api.protocolInfo runP) - - unless (ncStartAsNonProducingNode nc) $ - setBlockForging nodeKernel blockForging - - maybeSpawnOnSlotSyncedShutdownHandler - (ncShutdownConfig nc) - (shutdownTracer tracers) - registry - (Node.getChainDB nodeKernel) - onKernel nodeKernel - , rnEnableP2P = p2pMode - , rnPeerSharing = ncPeerSharing nc - , rnGetUseBootstrapPeers = readTVar useBootstrapVar - } -#ifdef UNIX - -- initial `SIGHUP` handler, which only rereads the topology file but - -- doesn't update block forging. The latter is only possible once - -- consensus initialised (e.g. reapplied all blocks). - _ <- Signals.installHandler - Signals.sigHUP - (Signals.Catch $ do - updateTopologyConfiguration - (startupTracer tracers) nc - localRootsVar publicRootsVar useLedgerVar useBootstrapVar - ledgerPeerSnapshotPathVar - void $ updateLedgerPeerSnapshot - (startupTracer tracers) - nc - (readTVar ledgerPeerSnapshotPathVar) - (readTVar useLedgerVar) - (writeTVar ledgerPeerSnapshotVar) - traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective) - ) - Nothing -#endif - nForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc - cForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc - void $ - let diffusionArgumentsExtra = - mkP2PArguments nForkPolicy cForkPolicy nc - (readTVar localRootsVar) - (readTVar publicRootsVar) - (readTVar useLedgerVar) - (readTVar useBootstrapVar) - (readTVar ledgerPeerSnapshotVar) - churnModeVar - in - Node.run - nodeArgs { - rnNodeKernelHook = \registry nodeKernel -> do - -- reinstall `SIGHUP` handler - installP2PSigHUPHandler (startupTracer tracers) blockType nc nodeKernel - localRootsVar publicRootsVar useLedgerVar useBootstrapVar - ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar - rnNodeKernelHook nodeArgs registry nodeKernel - } - StdRunNodeArgs - { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc - , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc - , srnChainDbValidateOverride = ncValidateDB nc - , srnDatabasePath = dbPath - , srnDiffusionArguments = diffusionArguments - , srnDiffusionArgumentsExtra = diffusionArgumentsExtra - , srnDiffusionTracers = diffusionTracers tracers - , srnDiffusionTracersExtra = diffusionTracersExtra tracers - , srnEnableInDevelopmentVersions = ncExperimentalProtocolsEnabled nc - , srnTraceChainDB = chainDBTracer tracers - , srnMaybeMempoolCapacityOverride = ncMaybeMempoolCapacityOverride nc - , srnChainSyncTimeout = customizeChainSyncTimeout - , srnSigUSR1SignalHandler = \(Diffusion.P2PTracers p2ptracers) -> sigUSR1Handler p2ptracers - , srnSnapshotPolicyArgs = snapshotPolicyArgs - , srnQueryBatchSize = queryBatchSize - , srnLdbFlavorArgs = selectorToArgs ldbBackend - } - DisabledP2PMode -> do - nt <- TopologyNonP2P.readTopologyFileOrError nc - let (ipProducerAddrs, dnsProducerAddrs) = producerAddressesNonP2P nt - - dnsProducers :: [DnsSubscriptionTarget] - dnsProducers = [ DnsSubscriptionTarget (Text.encodeUtf8 addr) port v - | (NodeAddress (NodeHostDnsAddress addr) port, v) <- dnsProducerAddrs - ] - - ipProducers :: IPSubscriptionTarget - ipProducers = IPSubscriptionTarget - [ toSockAddr (addr, port) - | (NodeAddress (NodeHostIPAddress addr) port) <- ipProducerAddrs - ] - (length ipProducerAddrs) - - nodeArgs = RunNodeArgs - { rnGenesisConfig = ncGenesisConfig nc - , rnTraceConsensus = consensusTracers tracers - , rnTraceNTN = nodeToNodeTracers tracers - , rnTraceNTC = nodeToClientTracers tracers - , rnProtocolInfo = pInfo - , rnNodeKernelHook = \registry nodeKernel -> do - -- set the initial block forging - blockForging <- snd (Api.protocolInfo runP) - - unless (ncStartAsNonProducingNode nc) $ - setBlockForging nodeKernel blockForging - - maybeSpawnOnSlotSyncedShutdownHandler - (ncShutdownConfig nc) - (shutdownTracer tracers) - registry - (Node.getChainDB nodeKernel) - onKernel nodeKernel - , rnEnableP2P = p2pMode - , rnPeerSharing = ncPeerSharing nc - , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers - } + traceWith (startupTracer tracers) + (StartupP2PInfo (ncDiffusionMode nc)) + nt@TopologyP2P.RealNodeTopology + { ntUseLedgerPeers + , ntUseBootstrapPeers + , ntPeerSnapshotPath + } <- TopologyP2P.readTopologyFileOrError nc (startupTracer tracers) + let (localRoots, publicRoots) = producerAddresses nt + traceWith (startupTracer tracers) + $ NetworkConfig localRoots + publicRoots + ntUseLedgerPeers + ntPeerSnapshotPath + case ncPeerSharing nc of + PeerSharingEnabled + | hasProtocolFile (ncProtocolFiles nc) -> + traceWith (startupTracer tracers) . NetworkConfigUpdateWarning . Text.pack $ + "Mainnet block producers may not meet the Praos performance guarantees " + <> "and host IP address will be leaked since peer sharing is enabled." + _otherwise -> pure () + localRootsVar <- newTVarIO localRoots + publicRootsVar <- newTVarIO publicRoots + useLedgerVar <- newTVarIO ntUseLedgerPeers + useBootstrapVar <- newTVarIO ntUseBootstrapPeers + ledgerPeerSnapshotPathVar <- newTVarIO ntPeerSnapshotPath + ledgerPeerSnapshotVar <- newTVarIO =<< updateLedgerPeerSnapshot + (startupTracer tracers) + nc + (readTVar ledgerPeerSnapshotPathVar) + (readTVar useLedgerVar) + (const . pure $ ()) + + let nodeArgs = RunNodeArgs + { rnGenesisConfig = ncGenesisConfig nc + , rnTraceConsensus = consensusTracers tracers + , rnTraceNTN = nodeToNodeTracers tracers + , rnTraceNTC = nodeToClientTracers tracers + , rnProtocolInfo = pInfo + , rnNodeKernelHook = \registry nodeKernel -> do + -- set the initial block forging + blockForging <- snd (Api.protocolInfo runP) + + unless (ncStartAsNonProducingNode nc) $ + setBlockForging nodeKernel blockForging + + maybeSpawnOnSlotSyncedShutdownHandler + (ncShutdownConfig nc) + (shutdownTracer tracers) + registry + (Node.getChainDB nodeKernel) + onKernel nodeKernel + , rnPeerSharing = ncPeerSharing nc + , rnGetUseBootstrapPeers = readTVar useBootstrapVar + } #ifdef UNIX - -- initial `SIGHUP` handler; it only warns that neither updating of - -- topology is supported nor updating block forging is yet possible. - -- It is still useful, without it the node would terminate when - -- receiving `SIGHUP`. - _ <- Signals.installHandler - Signals.sigHUP - (Signals.Catch $ do - traceWith (startupTracer tracers) NetworkConfigUpdateUnsupported - traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective)) - Nothing + -- initial `SIGHUP` handler, which only rereads the topology file but + -- doesn't update block forging. The latter is only possible once + -- consensus initialised (e.g. reapplied all blocks). + _ <- Signals.installHandler + Signals.sigHUP + (Signals.Catch $ do + updateTopologyConfiguration + (startupTracer tracers) nc + localRootsVar publicRootsVar useLedgerVar useBootstrapVar + ledgerPeerSnapshotPathVar + void $ updateLedgerPeerSnapshot + (startupTracer tracers) + (readTVar ledgerPeerSnapshotPathVar) + (readTVar useLedgerVar) + (writeTVar ledgerPeerSnapshotVar) + traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective) + ) + Nothing #endif - void $ - Node.run - nodeArgs { - rnNodeKernelHook = \registry nodeKernel -> do - -- reinstall `SIGHUP` handler - installNonP2PSigHUPHandler (startupTracer tracers) blockType nc nodeKernel - rnNodeKernelHook nodeArgs registry nodeKernel + nForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc + cForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc + void $ + let diffusionNodeArguments :: Cardano.Diffusion.CardanoNodeArguments IO + diffusionNodeArguments = Cardano.Diffusion.CardanoNodeArguments { + Cardano.Diffusion.consensusMode = ncConsensusMode nc, + Cardano.Diffusion.genesisPeerTargets = + PeerSelectionTargets { + targetNumberOfRootPeers = ncSyncTargetOfRootPeers nc, + targetNumberOfKnownPeers = ncSyncTargetOfKnownPeers nc, + targetNumberOfEstablishedPeers = ncSyncTargetOfEstablishedPeers nc, + targetNumberOfActivePeers = ncSyncTargetOfActivePeers nc, + targetNumberOfKnownBigLedgerPeers = ncSyncTargetOfKnownBigLedgerPeers nc, + targetNumberOfEstablishedBigLedgerPeers = ncSyncTargetOfEstablishedBigLedgerPeers nc, + targetNumberOfActiveBigLedgerPeers = ncSyncTargetOfActiveBigLedgerPeers nc + }, + Cardano.Diffusion.minNumOfBigLedgerPeers = ncMinBigLedgerPeersForTrustedState nc, + Cardano.Diffusion.tracerChurnMode = churnModeTracer tracers } - StdRunNodeArgs - { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc - , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc - , srnChainDbValidateOverride = ncValidateDB nc - , srnDatabasePath = dbPath - , srnDiffusionArguments = diffusionArguments - , srnDiffusionArgumentsExtra = \_ _ _ -> mkNonP2PArguments ipProducers dnsProducers - , srnDiffusionTracers = diffusionTracers tracers - , srnDiffusionTracersExtra = diffusionTracersExtra tracers - , srnEnableInDevelopmentVersions = ncExperimentalProtocolsEnabled nc - , srnTraceChainDB = chainDBTracer tracers - , srnChainSyncTimeout = customizeChainSyncTimeout - , srnMaybeMempoolCapacityOverride = ncMaybeMempoolCapacityOverride nc - , srnSigUSR1SignalHandler = mempty - , srnSnapshotPolicyArgs = snapshotPolicyArgs - , srnQueryBatchSize = queryBatchSize - , srnLdbFlavorArgs = selectorToArgs ldbBackend - } - where + diffusionConfiguration :: Cardano.Diffusion.CardanoConfiguration IO + diffusionConfiguration = + mkDiffusionConfiguration + publicIPv4SocketOrAddr + publicIPv6SocketOrAddr + localSocketOrPath + publicPeerSelectionVar + nForkPolicy cForkPolicy + (readTVar localRootsVar) + (readTVar publicRootsVar) + (readTVar useLedgerVar) + (readTVar ledgerPeerSnapshotVar) + nc + in + Node.run + nodeArgs { + rnNodeKernelHook = \registry nodeKernel -> do + -- reinstall `SIGHUP` handler + installSigHUPHandler (startupTracer tracers) blockType nc nodeKernel + localRootsVar publicRootsVar useLedgerVar useBootstrapVar + ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar + rnNodeKernelHook nodeArgs registry nodeKernel + } + StdRunNodeArgs + { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc + , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc + , srnChainDbValidateOverride = ncValidateDB nc + , srnDatabasePath = dbPath + , srnDiffusionConfiguration = diffusionConfiguration + , srnDiffusionArguments = diffusionNodeArguments + , srnDiffusionTracers = diffusionTracers tracers + , srnEnableInDevelopmentVersions = ncExperimentalProtocolsEnabled nc + , srnTraceChainDB = chainDBTracer tracers + , srnMaybeMempoolCapacityOverride = ncMaybeMempoolCapacityOverride nc + , srnChainSyncTimeout = customizeChainSyncTimeout + , srnSnapshotPolicyArgs = snapshotPolicyArgs + , srnQueryBatchSize = queryBatchSize + , srnLdbFlavorArgs = selectorToArgs ldbBackend + } + where customizeChainSyncTimeout :: Maybe (IO ChainSyncTimeout) customizeChainSyncTimeout = case ncChainSyncIdleTimeout nc of NoTimeoutOverride -> Nothing @@ -684,11 +574,6 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do logStartupWarnings :: IO () logStartupWarnings = do - (case p2pMode of - EnabledP2PMode -> return () - DisabledP2PMode -> traceWith (startupTracer tracers) NonP2PWarning - ) :: IO () -- annoying, but unavoidable for GADT type inference - let developmentNtnVersions = case latestReleasedNodeVersion (Proxy @blk) of (Just ntnVersion, _) -> filter (> ntnVersion) @@ -751,21 +636,21 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do -- | The P2P SIGHUP handler can update block forging & reconfigure network topology. -- -installP2PSigHUPHandler :: Tracer IO (StartupTrace blk) - -> Api.BlockType blk - -> NodeConfiguration - -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk - -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig PeerTrustable))] - -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) - -> StrictTVar IO UseLedgerPeers - -> StrictTVar IO UseBootstrapPeers - -> StrictTVar IO (Maybe PeerSnapshotFile) - -> StrictTVar IO (Maybe LedgerPeerSnapshot) - -> IO () +installSigHUPHandler :: Tracer IO (StartupTrace blk) + -> Api.BlockType blk + -> NodeConfiguration + -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk + -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig PeerTrustable))] + -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) + -> StrictTVar IO UseLedgerPeers + -> StrictTVar IO UseBootstrapPeers + -> StrictTVar IO (Maybe PeerSnapshotFile) + -> StrictTVar IO (Maybe LedgerPeerSnapshot) + -> IO () #ifndef UNIX -installP2PSigHUPHandler _ _ _ _ _ _ _ _ _ _ = return () +installSigHUPHandler _ _ _ _ _ _ _ _ _ _ = return () #else -installP2PSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar +installSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar = void $ Signals.installHandler Signals.sigHUP @@ -783,26 +668,6 @@ installP2PSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publ Nothing #endif --- | The NonP2P SIGHUP handler can only update block forging. --- -installNonP2PSigHUPHandler :: Tracer IO (StartupTrace blk) - -> Api.BlockType blk - -> NodeConfiguration - -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk - -> IO () -#ifndef UNIX -installNonP2PSigHUPHandler _ _ _ _ = return () -#else -installNonP2PSigHUPHandler startupTracer blockType nc nodeKernel = - void $ Signals.installHandler - Signals.sigHUP - (Signals.Catch $ do - updateBlockForging startupTracer blockType nodeKernel nc - traceWith startupTracer NetworkConfigUpdateUnsupported - ) - Nothing -#endif - #ifdef UNIX updateBlockForging :: Tracer IO (StartupTrace blk) @@ -955,10 +820,10 @@ checkVRFFilePermissions :: Tracer IO String -> File content direction -> ExceptT checkVRFFilePermissions tracer (File vrfPrivKey) = do fs <- liftIO $ getFileStatus vrfPrivKey let fm = fileMode fs - -- Check the the VRF private key file does not give read/write/exec permissions to others. + -- Check the VRF private key file does not give read/write/exec permissions to others. when (hasOtherPermissions fm) $ left $ OtherPermissionsExist vrfPrivKey - -- Check the the VRF private key file does not give read/write/exec permissions to any group. + -- Check the VRF private key file does not give read/write/exec permissions to any group. when (hasGroupPermissions fm) $ liftIO $ traceWith tracer $ ("WARNING: " <>) . displayError $ GroupPermissionsExist vrfPrivKey where @@ -986,178 +851,77 @@ checkVRFFilePermissions _ (File vrfPrivKey) = do #endif -mkP2PArguments - :: Ord ntnAddr - => ForkPolicy ntnAddr - -> ForkPolicy ntcAddr - -> NodeConfiguration +mkDiffusionConfiguration + :: Maybe SocketOrSocketInfo -- ^ ipv4 + -> Maybe SocketOrSocketInfo -- ^ ipv6 + -> Maybe LocalSocketOrSocketInfo -- ^ unix socket or a named pipe (Windows) + -> StrictTVar IO (PublicPeerSelectionState RemoteAddress) + -> ForkPolicy RemoteAddress + -> ForkPolicy LocalAddress -> STM IO [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig PeerTrustable))] -- ^ non-overlapping local root peers groups; the 'Int' denotes the -- valency of its group. -> STM IO (Map RelayAccessPoint PeerAdvertise) -> STM IO UseLedgerPeers - -> STM IO UseBootstrapPeers -> STM IO (Maybe LedgerPeerSnapshot) - -> StrictTVar IO ChurnMode - -> Diffusion.P2PDecision 'Diffusion.P2P (Tracer IO TracePublicRootPeers) () - -> Diffusion.P2PDecision 'Diffusion.P2P (STM IO FetchMode) () - -> Diffusion.P2PDecision 'Diffusion.P2P (Cardano.LedgerPeersConsensusInterface IO) () - -> Diffusion.ArgumentsExtra 'Diffusion.P2P - (Cardano.ExtraArguments IO) - Cardano.PeerSelection.ExtraState - extraDebugState - PeerTrustable - (Cardano.PublicRoots.ExtraPeers ntnAddr) - (Cardano.LedgerPeersConsensusInterface IO) - (Cardano.Churn.ExtraArguments IO) - (Cardano.ExtraPeerSelectionSetsWithSizes ntnAddr) - BootstrapPeersCriticalTimeoutError - ntnAddr - ntcAddr - Resolver - IOException - IO -mkP2PArguments nForkPolicy cForkPolicy NodeConfiguration { - ncDeadlineTargetOfRootPeers, - ncDeadlineTargetOfKnownPeers, - ncDeadlineTargetOfEstablishedPeers, - ncDeadlineTargetOfActivePeers, - ncDeadlineTargetOfKnownBigLedgerPeers, - ncDeadlineTargetOfEstablishedBigLedgerPeers, - ncDeadlineTargetOfActiveBigLedgerPeers, - ncSyncTargetOfRootPeers, - ncSyncTargetOfKnownPeers, - ncSyncTargetOfEstablishedPeers, - ncSyncTargetOfActivePeers, - ncSyncTargetOfKnownBigLedgerPeers, - ncSyncTargetOfEstablishedBigLedgerPeers, - ncSyncTargetOfActiveBigLedgerPeers, - ncMinBigLedgerPeersForTrustedState, - ncProtocolIdleTimeout, - ncTimeWaitTimeout, - ncPeerSharing, - ncConsensusMode - } - daReadLocalRootPeers - daReadPublicRootPeers - daReadUseLedgerPeers - daReadUseBootstrapPeers - daReadLedgerPeerSnapshot - churnModeVar - (Diffusion.P2PDecision tracer) - (Diffusion.P2PDecision getFetchMode) - (Diffusion.P2PDecision ledgerPeersConsensusInterface) = - Diffusion.P2PArguments P2P.ArgumentsExtra - { P2P.daReadLocalRootPeers - , P2P.daReadPublicRootPeers - , P2P.daReadUseLedgerPeers - , P2P.daReadLedgerPeerSnapshot - , P2P.daPeerSelectionTargets = peerSelectionTargets - , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout - , P2P.daTimeWaitTimeout = ncTimeWaitTimeout - , P2P.daDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval - , P2P.daBulkChurnInterval = Configuration.defaultBulkChurnInterval - , P2P.daEmptyExtraState = CPST.empty ncConsensusMode ncMinBigLedgerPeersForTrustedState - , P2P.daEmptyExtraCounters = CPSV.empty - , P2P.daExtraPeersAPI = Cardano.PublicRoots.cardanoPublicRootPeersAPI - , P2P.daPeerChurnGovernor = peerChurnGovernor - , P2P.daExtraChurnArgs = cardanoPeerChurnArgs - , P2P.daOwnPeerSharing = ncPeerSharing - , P2P.daPeerSelectionStateToExtraCounters = CPSV.cardanoPeerSelectionStatetoCounters - , P2P.daPeerSelectionGovernorArgs = Cardano.cardanoPeerSelectionGovernorArgs extraActions - , P2P.daRequestPublicRootPeers = Just $ Cardano.requestPublicRootPeers - tracer - daReadUseBootstrapPeers - (Cardano.getLedgerStateJudgement - ledgerPeersConsensusInterface) - daReadPublicRootPeers - , P2P.daToExtraPeers = - \publicRoots -> Cardano.PublicRoots.ExtraPeers { - Cardano.PublicRoots.getPublicConfigPeers = publicRoots, - Cardano.PublicRoots.getBootstrapPeers = Set.empty - } - , P2P.daMuxForkPolicy = nForkPolicy - , P2P.daLocalMuxForkPolicy = cForkPolicy - } + -> NodeConfiguration + -> Cardano.Diffusion.CardanoConfiguration IO +mkDiffusionConfiguration + publicIPv4SocketOrAddr + publicIPv6SocketOrAddr + localSocketOrPath + dcPublicPeerSelectionVar + dcMuxForkPolicy dcLocalMuxForkPolicy + dcReadLocalRootPeers + dcReadPublicRootPeers + dcReadUseLedgerPeers + dcReadLedgerPeerSnapshot + nc + = + Diffusion.Configuration + { Diffusion.dcIPv4Address = + case publicIPv4SocketOrAddr of + Just (ActualSocket socket) -> Just (Left socket) + Just (SocketInfo addr) -> Just (Right addr) + Nothing -> Nothing + , Diffusion.dcIPv6Address = + case publicIPv6SocketOrAddr of + Just (ActualSocket socket) -> Just (Left socket) + Just (SocketInfo addr) -> Just (Right addr) + Nothing -> Nothing + , Diffusion.dcLocalAddress = + case localSocketOrPath of + Just (ActualSocket localSocket) -> Just (Left localSocket) + Just (SocketInfo localAddr) -> Just (Right localAddr) + Nothing -> Nothing + , Diffusion.dcAcceptedConnectionsLimit = ncAcceptedConnectionsLimit nc + , Diffusion.dcMode = ncDiffusionMode nc + , Diffusion.dcPublicPeerSelectionVar + , Diffusion.dcPeerSelectionTargets + , Diffusion.dcReadLocalRootPeers + , Diffusion.dcReadPublicRootPeers + , Diffusion.dcReadLedgerPeerSnapshot + , Diffusion.dcReadUseLedgerPeers + , Diffusion.dcPeerSharing = ncPeerSharing nc + , Diffusion.dcProtocolIdleTimeout = ncProtocolIdleTimeout nc + , Diffusion.dcTimeWaitTimeout = ncTimeWaitTimeout nc + , Diffusion.dcDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval + , Diffusion.dcBulkChurnInterval = Configuration.defaultBulkChurnInterval + , Diffusion.dcMuxForkPolicy + , Diffusion.dcLocalMuxForkPolicy + , Diffusion.dcEgressPollInterval = ncEgressPollInterval nc + } where - peerSelectionTargets = PeerSelectionTargets { - targetNumberOfRootPeers = ncDeadlineTargetOfRootPeers, - targetNumberOfKnownPeers = ncDeadlineTargetOfKnownPeers, - targetNumberOfEstablishedPeers = ncDeadlineTargetOfEstablishedPeers, - targetNumberOfActivePeers = ncDeadlineTargetOfActivePeers, - targetNumberOfKnownBigLedgerPeers = ncDeadlineTargetOfKnownBigLedgerPeers, - targetNumberOfEstablishedBigLedgerPeers = ncDeadlineTargetOfEstablishedBigLedgerPeers, - targetNumberOfActiveBigLedgerPeers = ncDeadlineTargetOfActiveBigLedgerPeers + dcPeerSelectionTargets = PeerSelectionTargets { + targetNumberOfRootPeers = ncDeadlineTargetOfRootPeers nc, + targetNumberOfKnownPeers = ncDeadlineTargetOfKnownPeers nc, + targetNumberOfEstablishedPeers = ncDeadlineTargetOfEstablishedPeers nc, + targetNumberOfActivePeers = ncDeadlineTargetOfActivePeers nc, + targetNumberOfKnownBigLedgerPeers = ncDeadlineTargetOfKnownBigLedgerPeers nc, + targetNumberOfEstablishedBigLedgerPeers = ncDeadlineTargetOfEstablishedBigLedgerPeers nc, + targetNumberOfActiveBigLedgerPeers = ncDeadlineTargetOfActiveBigLedgerPeers nc } - genesisSelectionTargets = PeerSelectionTargets { - targetNumberOfRootPeers = ncSyncTargetOfRootPeers, - targetNumberOfKnownPeers = ncSyncTargetOfKnownPeers, - targetNumberOfEstablishedPeers = ncSyncTargetOfEstablishedPeers, - targetNumberOfActivePeers = ncSyncTargetOfActivePeers, - targetNumberOfKnownBigLedgerPeers = ncSyncTargetOfKnownBigLedgerPeers, - targetNumberOfEstablishedBigLedgerPeers = ncSyncTargetOfEstablishedBigLedgerPeers, - targetNumberOfActiveBigLedgerPeers = ncSyncTargetOfActiveBigLedgerPeers } - - cardanoPeerChurnArgs = - Cardano.Churn.ExtraArguments { - Cardano.Churn.modeVar = churnModeVar - , Cardano.Churn.readFetchMode = getFetchMode - , Cardano.Churn.genesisPeerTargets = genesisSelectionTargets - , Cardano.Churn.readUseBootstrap = daReadUseBootstrapPeers - , Cardano.Churn.consensusMode = ncConsensusMode - } - - extraActions :: Cardano.PeerSelection.ExtraPeerSelectionActions IO - extraActions = Cardano.PeerSelection.ExtraPeerSelectionActions { - Cardano.PeerSelection.genesisPeerTargets = genesisSelectionTargets, - Cardano.PeerSelection.readUseBootstrapPeers = daReadUseBootstrapPeers - } - -mkNonP2PArguments - :: IPSubscriptionTarget - -> [DnsSubscriptionTarget] - -> Diffusion.ArgumentsExtra - 'Diffusion.NonP2P - extraArgs - extraState - extraDebugState - extraAPI - extraPeers - extraFlags - extraChurnArgs - extraCounters - BootstrapPeersCriticalTimeoutError - ntnAddr - ntcAddr - Resolver - IOException - IO -mkNonP2PArguments daIpProducers daDnsProducers = - Diffusion.NonP2PArguments NonP2P.ArgumentsExtra - { NonP2P.daIpProducers - , NonP2P.daDnsProducers - } - --- | TODO: Only needed for enabling P2P switch --- -producerAddressesNonP2P - :: TopologyNonP2P.NetworkTopology TopologyNonP2P.RemoteAddress - -> ( [NodeIPAddress] - , [(NodeDnsAddress, Int)]) -producerAddressesNonP2P nt = - case nt of - TopologyNonP2P.RealNodeTopology producers' -> - partitionEithers - . mapMaybe TopologyNonP2P.remoteAddressToNodeAddress - $ producers' - TopologyNonP2P.MockNodeTopology nodeSetup -> - partitionEithers - . concatMap - ( mapMaybe TopologyNonP2P.remoteAddressToNodeAddress - . TopologyNonP2P.producers - ) - $ nodeSetup producerAddresses :: NetworkTopology RelayAccessPoint diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index d656a03747a..0d1850b1430 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -22,7 +22,7 @@ import Cardano.Ledger.Shelley.Genesis (sgSystemStart) import Cardano.Logging import Cardano.Logging.Types.NodeInfo (NodeInfo (..)) import Cardano.Logging.Types.NodeStartupInfo (NodeStartupInfo (..)) -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) +import Cardano.Network.Diffusion (CardanoLocalRootConfig) import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol) import Cardano.Node.Configuration.Socket import Cardano.Node.Protocol (ProtocolInstantiationError) @@ -44,9 +44,7 @@ import Ouroboros.Network.NodeToClient (NodeToClientVersion) import Ouroboros.Network.NodeToNode (DiffusionMode (..), NodeToNodeVersion, PeerAdvertise) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint) -import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, LocalRootConfig, WarmValency) -import Ouroboros.Network.Subscription.Dns (DnsSubscriptionTarget (..)) -import Ouroboros.Network.Subscription.Ip (IPSubscriptionTarget (..)) +import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) import Prelude @@ -119,7 +117,7 @@ data StartupTrace blk = -- | Log peer-to-peer network configuration, either on startup or when its -- updated. -- - | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig PeerTrustable))] + | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint CardanoLocalRootConfig)] (Map RelayAccessPoint PeerAdvertise) UseLedgerPeers (Maybe PeerSnapshotFile) @@ -181,8 +179,6 @@ data BasicInfoByron = BasicInfoByron { data BasicInfoNetwork = BasicInfoNetwork { niAddresses :: [SocketOrSocketInfo] , niDiffusionMode :: DiffusionMode - , niDnsProducers :: [DnsSubscriptionTarget] - , niIpProducers :: IPSubscriptionTarget } -- | Prepare basic info about the node. This info will be sent to 'cardano-tracer'. diff --git a/cardano-node/src/Cardano/Node/Tracing.hs b/cardano-node/src/Cardano/Node/Tracing.hs index ef25940209b..a79a3620cdf 100644 --- a/cardano-node/src/Cardano/Node/Tracing.hs +++ b/cardano-node/src/Cardano/Node/Tracing.hs @@ -23,17 +23,14 @@ import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode import qualified Ouroboros.Consensus.Node.Tracers as Consensus import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import Ouroboros.Network.ConnectionId -import qualified Ouroboros.Network.Diffusion as Diffusion -import qualified Ouroboros.Network.Diffusion.Common as Diffusion -import Ouroboros.Network.NodeToClient (LocalAddress, NodeToClientVersion) -import Ouroboros.Network.NodeToNode (NodeToNodeVersion, RemoteAddress) +import qualified Cardano.Network.Diffusion as Cardano.Diffusion import Prelude (IO) import Codec.CBOR.Read (DeserialiseFailure) import "contra-tracer" Control.Tracer (Tracer (..)) -data Tracers peer localPeer blk p2p extraState extraDebugState extraFlags extraPeers extraCounters m = Tracers +data Tracers peer localPeer blk m = Tracers { -- | Trace the ChainDB chainDBTracer :: !(Tracer IO (ChainDB.TraceEvent blk)) -- | Consensus-specific tracers. @@ -44,11 +41,8 @@ data Tracers peer localPeer blk p2p extraState extraDebugState extraFlags extraP -- | Tracers for the node-to-client protocols , nodeToClientTracers :: !(NodeToClient.Tracers IO (ConnectionId localPeer) blk DeserialiseFailure) -- | Diffusion tracers - , diffusionTracers :: !(Diffusion.Tracers RemoteAddress NodeToNodeVersion - LocalAddress NodeToClientVersion - IO) - , diffusionTracersExtra :: !(Diffusion.ExtraTracers p2p extraState extraDebugState extraFlags extraPeers extraCounters m) - + , diffusionTracers :: !(Cardano.Diffusion.CardanoTracers m) + , churnModeTracer :: !(Tracer IO Cardano.Diffusion.TraceChurnMode) , startupTracer :: !(Tracer IO (StartupTrace blk)) , shutdownTracer :: !(Tracer IO ShutdownTrace) , nodeInfoTracer :: !(Tracer IO NodeInfo) diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index 30c983ab942..5c51c592800 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -10,9 +10,7 @@ module Cardano.Node.Tracing.API import Cardano.Logging hiding (traceWith) import Cardano.Logging.Prometheus.TCPServer (runPrometheusSimple) -import qualified Cardano.Logging.Types as Net -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable) -import Cardano.Node.Configuration.NodeAddress (PortNumber) +import Cardano.Node.Configuration.NodeAddress (File (..), PortNumber) import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Protocol.Types import Cardano.Node.Queries @@ -26,12 +24,8 @@ import Cardano.Node.Tracing.Tracers.LedgerMetrics import Cardano.Node.Tracing.Tracers.Peer (startPeerTracer) import Cardano.Node.Tracing.Tracers.Resources (startResourceTracer) import Cardano.Node.Types -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent) -import Ouroboros.Consensus.Node (NetworkP2PMode) import Ouroboros.Consensus.Node.GSM import Ouroboros.Network.Block import Ouroboros.Network.ConnectionId (ConnectionId) @@ -57,7 +51,7 @@ import Trace.Forward.Utils.TraceObject (writeToSink) initTraceDispatcher :: - forall blk p2p. + forall blk. ( TraceConstraints blk , LogFormatting (LedgerEvent blk) , LogFormatting @@ -68,10 +62,9 @@ initTraceDispatcher :: -> SomeConsensusProtocol -> NetworkMagic -> NodeKernelData blk - -> NetworkP2PMode p2p -> Bool - -> IO (Tracers RemoteAddress LocalAddress blk p2p Cardano.ExtraState Cardano.DebugPeerSelectionState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers RemoteAddress) (Cardano.ExtraPeerSelectionSetsWithSizes RemoteAddress) IO) -initTraceDispatcher nc p networkMagic nodeKernel p2pMode noBlockForging = do + -> IO (Tracers RemoteAddress LocalAddress blk IO) +initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do trConfig <- readConfigurationWithDefault (unConfigPath $ ncConfigFile nc) defaultCardanoConfig @@ -154,7 +147,6 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode noBlockForging = do (Just ekgTrace) dpTracer trConfig - p2pMode p where diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 42732499ae1..89ca1b578eb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -31,14 +31,13 @@ import Cardano.Node.Tracing.Tracers.LedgerMetrics (LedgerMetrics) import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () import Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace) -import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer import Cardano.Node.Tracing.Tracers.Shutdown () import Cardano.Node.Tracing.Tracers.Startup () -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano +import qualified Cardano.Network.PeerSelection.ExtraRootPeers as Cardano.PublicRootPeers import Ouroboros.Consensus.Block.SupportsSanityCheck (SanityCheckIssue) import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime) import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) @@ -65,12 +64,12 @@ import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (.. import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager -import qualified Ouroboros.Network.Diffusion.Common as Common +import Ouroboros.Network.Diffusion (DiffusionTracer) import Ouroboros.Network.Driver.Simple (TraceSendRecv) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import qualified Ouroboros.Network.NodeToClient as NtC -import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), RemoteAddress, WithAddr (..)) +import Ouroboros.Network.NodeToNode (RemoteAddress) import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.Churn (ChurnCounters) import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (..), @@ -79,6 +78,7 @@ import Ouroboros.Network.PeerSelection.LedgerPeers (TraceLedgerPeers) import Ouroboros.Network.PeerSelection.PeerStateActions (PeerSelectionActionsTrace (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers (TraceLocalRootPeers (..)) +import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSTrace (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers (TracePublicRootPeers (..)) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch) @@ -89,14 +89,11 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuer import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) -import qualified Ouroboros.Network.Server2 as Server (Trace (..)) +import qualified Ouroboros.Network.Server as Server (Trace (..)) import Ouroboros.Network.Snocket (LocalAddress (..)) -import Ouroboros.Network.Subscription.Dns (DnsTrace (..), WithDomainName (..)) -import Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..)) import Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound) import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound) -import Control.Exception (SomeException) import qualified Data.Text as T import qualified Network.Mux as Mux import qualified Network.Socket as Socket @@ -283,7 +280,7 @@ getAllNamespaces = dtDiffusionInitializationNS = map (nsGetTuple . nsReplacePrefix ["Startup", "DiffusionInit"]) (allNamespaces :: [Namespace - (Common.DiffusionTracer Socket.SockAddr + (DiffusionTracer Socket.SockAddr LocalAddress)]) dtLedgerPeersNS = map (nsGetTuple . nsReplacePrefix ["Net", "Peers", "Ledger"]) @@ -294,7 +291,7 @@ getAllNamespaces = localRootPeersNS = map (nsGetTuple . nsReplacePrefix ["Net", "Peers", "LocalRoot"]) (allNamespaces :: [Namespace - (TraceLocalRootPeers PeerTrustable RemoteAddress SomeException)]) + (TraceLocalRootPeers PeerTrustable RemoteAddress)]) publicRootPeersNS = map (nsGetTuple . nsReplacePrefix ["Net", "Peers", "PublicRoot"]) (allNamespaces :: [Namespace TracePublicRootPeers]) @@ -363,28 +360,9 @@ getAllNamespaces = (InboundGovernor.Trace LocalAddress)]) --- -- DiffusionTracersExtra nonP2P - - dtIpSubscriptionNS = map (nsGetTuple . nsReplacePrefix - ["Net", "Subscription", "IP"]) - (allNamespaces :: [Namespace - (SubscriptionTrace Socket.SockAddr)]) - dtDnsSubscriptionNS = map (nsGetTuple . nsReplacePrefix - ["Net", "Subscription", "DNS"]) - (allNamespaces :: [Namespace - (WithDomainName (SubscriptionTrace Socket.SockAddr))]) dtDnsResolverNS = map (nsGetTuple . nsReplacePrefix ["Net", "DNSResolver"]) - (allNamespaces :: [Namespace - (WithDomainName DnsTrace)]) - dtErrorPolicyNS = map (nsGetTuple . nsReplacePrefix - ["Net", "ErrorPolicy", "Remote"]) - (allNamespaces :: [Namespace - (WithAddr Socket.SockAddr ErrorPolicyTrace)]) - dtLocalErrorPolicyNS = map (nsGetTuple . nsReplacePrefix - ["Net", "ErrorPolicy", "Local"]) - (allNamespaces :: [Namespace - (WithAddr LocalAddress ErrorPolicyTrace)]) + (allNamespaces :: [Namespace DNSTrace]) dtAcceptPolicyNS = map (nsGetTuple . nsReplacePrefix ["Net", "AcceptPolicy"]) (allNamespaces :: [Namespace @@ -457,12 +435,6 @@ getAllNamespaces = <> localConnectionManagerNS <> localServerNS <> localInboundGovernorNS - --- DiffusionTracersExtra nonP2P - <> dtIpSubscriptionNS - <> dtDnsSubscriptionNS <> dtDnsResolverNS - <> dtErrorPolicyNS - <> dtLocalErrorPolicyNS <> dtAcceptPolicyNS in allNamespaces' diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 6263ad40ba6..a8dbe4f1c6f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -44,14 +44,14 @@ import Cardano.Node.Tracing.Tracers.LedgerMetrics (LedgerMetrics) import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () import Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace) -import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer import Cardano.Node.Tracing.Tracers.Shutdown () import Cardano.Node.Tracing.Tracers.Startup () -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano +import qualified Cardano.Network.PeerSelection.ExtraRootPeers as Cardano.PublicRootPeers +import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Consensus.Block.SupportsSanityCheck (SanityCheckIssue) import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime) import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) @@ -78,12 +78,12 @@ import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (.. import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager -import qualified Ouroboros.Network.Diffusion.Common as Common +import Ouroboros.Network.Diffusion.Types (DiffusionTracer) import Ouroboros.Network.Driver.Simple (TraceSendRecv) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import qualified Ouroboros.Network.NodeToClient as NtC -import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), RemoteAddress, WithAddr (..)) +import Ouroboros.Network.NodeToNode (RemoteAddress) import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.Churn (ChurnCounters (..)) import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (..), @@ -102,15 +102,11 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuer import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) -import qualified Ouroboros.Network.Server2 as Server (Trace (..)) +import qualified Ouroboros.Network.Server as Server (Trace (..)) import Ouroboros.Network.Snocket (LocalAddress (..)) -import Ouroboros.Network.Subscription.Dns (DnsTrace (..), WithDomainName (..)) -import Ouroboros.Network.Subscription.Ip (WithIPList (..)) -import Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..)) import Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound) import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound) -import Control.Exception (SomeException) import Control.Monad (forM_) import Data.Aeson.Types (ToJSON) import Data.Proxy (Proxy (..)) @@ -580,7 +576,7 @@ docTracersFirstPhase condConfigFileName = do ["Startup", "DiffusionInit"] configureTracers configReflection trConfig [dtDiffusionInitializationTr] dtDiffusionInitializationTrDoc <- documentTracer (dtDiffusionInitializationTr :: - Logging.Trace IO (Common.DiffusionTracer Socket.SockAddr LocalAddress)) + Logging.Trace IO (DiffusionTracer Socket.SockAddr LocalAddress)) dtLedgerPeersTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -595,7 +591,7 @@ docTracersFirstPhase condConfigFileName = do ["Net", "Peers", "LocalRoot"] configureTracers configReflection trConfig [localRootPeersTr] localRootPeersTrDoc <- documentTracer (localRootPeersTr :: - Logging.Trace IO (TraceLocalRootPeers PeerTrustable RemoteAddress SomeException)) + Logging.Trace IO (TraceLocalRootPeers PeerTrustable RemoteAddress)) publicRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -709,44 +705,6 @@ docTracersFirstPhase condConfigFileName = do localInboundGovernorTrDoc <- documentTracer (localInboundGovernorTr :: Logging.Trace IO (InboundGovernor.Trace LocalAddress)) - --- -- DiffusionTracersExtra nonP2P - - dtIpSubscriptionTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Subscription", "IP"] - configureTracers configReflection trConfig [dtIpSubscriptionTr] - dtIpSubscriptionTrDoc <- documentTracer (dtIpSubscriptionTr :: - Logging.Trace IO (WithIPList (SubscriptionTrace Socket.SockAddr))) - - dtDnsSubscriptionTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Subscription", "DNS"] - configureTracers configReflection trConfig [dtDnsSubscriptionTr] - dtDnsSubscriptionTrDoc <- documentTracer (dtDnsSubscriptionTr :: - Logging.Trace IO (WithDomainName (SubscriptionTrace Socket.SockAddr))) - - dtDnsResolverTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "DNSResolver"] - configureTracers configReflection trConfig [dtDnsResolverTr] - dtDnsResolverTrDoc <- documentTracer (dtDnsResolverTr :: - Logging.Trace IO (WithDomainName DnsTrace)) - - dtErrorPolicyTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "ErrorPolicy", "Remote"] - configureTracers configReflection trConfig [dtErrorPolicyTr] - dtErrorPolicyTrDoc <- documentTracer (dtErrorPolicyTr :: - Logging.Trace IO (WithAddr Socket.SockAddr ErrorPolicyTrace)) - - dtLocalErrorPolicyTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "ErrorPolicy", "Local"] - configureTracers configReflection trConfig [dtLocalErrorPolicyTr] - dtLocalErrorPolicyTrDoc <- documentTracer (dtLocalErrorPolicyTr :: - Logging.Trace IO (WithAddr LocalAddress ErrorPolicyTrace)) - dtAcceptPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "AcceptPolicy"] @@ -831,12 +789,6 @@ docTracersFirstPhase condConfigFileName = do <> localConnectionManagerTrDoc <> localServerTrDoc <> localInboundGovernorTrDoc --- DiffusionTracersExtra nonP2P - <> dtIpSubscriptionTrDoc - <> dtDnsSubscriptionTrDoc - <> dtDnsResolverTrDoc - <> dtErrorPolicyTrDoc - <> dtLocalErrorPolicyTrDoc <> dtAcceptPolicyTrDoc -- Internal tracer <> internalTrDoc diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs index ef3d1eb3729..95e290c8553 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs @@ -17,6 +17,7 @@ import Cardano.Api (textShow) import Cardano.Chain.Block (ABlockOrBoundaryHdr (..), AHeader (..), ChainValidationError (..), delegationCertificate) +import Ouroboros.Consensus.Protocol.PBFT (PBft, PBftTiebreakerView(..)) import Cardano.Chain.Byron.API (ApplyMempoolPayloadErr (..)) import Cardano.Chain.Delegation (delegateVK) import Cardano.Crypto.Signing (VerificationKey) @@ -29,7 +30,6 @@ import Ouroboros.Consensus.Byron.Ledger (ByronBlock (..), import Ouroboros.Consensus.Byron.Ledger.Inspect (ByronLedgerUpdate (..), ProtocolUpdate (..), UpdateState (..)) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, txId) -import Ouroboros.Consensus.Protocol.PBFT (PBftSelectView (..)) import Ouroboros.Consensus.Util.Condense (condense) import Ouroboros.Network.Block (blockHash, blockNo, blockSlot) @@ -213,10 +213,9 @@ instance LogFormatting ByronOtherHeaderEnvelopeError where , "slot" .= slot ] -instance LogFormatting PBftSelectView where - forMachine _dtal (PBftSelectView blkNo isEBB) = +instance LogFormatting PBftTiebreakerView where + forMachine _dtal (PBftTiebreakerView isEBB) = mconcat [ "kind" .= String "PBftSelectView" - , "blockNo" .= blkNo , "isEBB" .= fromIsEBB isEBB ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs index 51f4eceb83f..7942c57536e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs @@ -23,10 +23,10 @@ import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeSta import Ouroboros.Consensus.BlockchainTime (getSlotLength) import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.HardFork.Combinator -import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), +import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), OneEraTiebreakerView (..), OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraForgeStateInfo (..), OneEraForgeStateUpdateError (..), OneEraLedgerError (..), - OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraSelectView (..), + OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..), mkEraMismatch) import Ouroboros.Consensus.HardFork.Combinator.Condense () import Ouroboros.Consensus.HardFork.History @@ -36,7 +36,7 @@ import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError) import Ouroboros.Consensus.Ledger.Abstract (LedgerError) import Ouroboros.Consensus.Ledger.Inspect (LedgerUpdate, LedgerWarning) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr) -import Ouroboros.Consensus.Protocol.Abstract (SelectView, ValidationErr) +import Ouroboros.Consensus.Protocol.Abstract (ValidationErr, TiebreakerView(..), SelectView(..)) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) @@ -349,19 +349,21 @@ instance LogFormatting (ForgeStateUpdateError blk) => LogFormatting (WrapForgeSt -- instances for HardForkSelectView -- -instance All (LogFormatting `Compose` WrapSelectView) xs => LogFormatting (HardForkSelectView xs) where - -- elide BlockNo as it is already contained in every per-era SelectView - -- TODO: use level DMinimal for a textual representation without the block number, - -- like this: `forMachine DMinimal . getHardForkSelectView`, and update the different SelectView instances - -- to not print the blockNr - forMachine dtal = forMachine dtal . dropBlockNo . getHardForkSelectView +instance All (LogFormatting `Compose` WrapTiebreakerView) xs => LogFormatting (HardForkTiebreakerView xs) where + forMachine dtal = forMachine dtal . getHardForkTiebreakerView -instance All (LogFormatting `Compose` WrapSelectView) xs => LogFormatting (OneEraSelectView xs) where +instance LogFormatting (TiebreakerView protocol) => LogFormatting (SelectView protocol) where + forMachine dtal sv = mconcat + [ "blockNo" .= svBlockNo sv + , forMachine dtal (svTiebreakerView sv) + ] + +instance All (LogFormatting `Compose` WrapTiebreakerView) xs => LogFormatting (OneEraTiebreakerView xs) where forMachine dtal = hcollapse - . hcmap (Proxy @(LogFormatting `Compose` WrapSelectView)) + . hcmap (Proxy @(LogFormatting `Compose` WrapTiebreakerView)) (K . forMachine dtal) - . getOneEraSelectView + . getOneEraTiebreakerView -instance LogFormatting (SelectView (BlockProtocol blk)) => LogFormatting (WrapSelectView blk) where - forMachine dtal = forMachine dtal . unwrapSelectView +instance LogFormatting (TiebreakerView (BlockProtocol blk)) => LogFormatting (WrapTiebreakerView blk) where + forMachine dtal = forMachine dtal . unwrapTiebreakerView diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 02637b1baeb..ee7153fbb44 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -22,7 +22,6 @@ import qualified Cardano.Api as Api import Cardano.Api.Ledger (fromVRFVerKeyHash) import qualified Cardano.Crypto.Hash.Class as Crypto -import qualified Cardano.Crypto.VRF.Class as Crypto import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure) import qualified Cardano.Ledger.Allegra.Rules as Allegra import qualified Cardano.Ledger.Allegra.Scripts as Allegra @@ -59,7 +58,6 @@ import Cardano.Tracing.OrphanInstances.Shelley () import Ouroboros.Consensus.Ledger.SupportsMempool (txId) import qualified Ouroboros.Consensus.Ledger.SupportsMempool as SupportsMempool import qualified Ouroboros.Consensus.Protocol.Praos as Praos -import Ouroboros.Consensus.Protocol.Praos.Common (PraosChainSelectView (..)) import Ouroboros.Consensus.Protocol.TPraos (TPraosCannotForge (..)) import Ouroboros.Consensus.Shelley.Ledger hiding (TxId) import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus @@ -70,12 +68,10 @@ import Ouroboros.Network.Block (SlotNo (..), blockHash, blockNo, block import Ouroboros.Network.Point (WithOrigin, withOriginToMaybe) import Data.Aeson (ToJSON (..), Value (..), (.=)) -import qualified Data.ByteString.Base16 as B16 import qualified Data.List.NonEmpty as NonEmpty import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) -import qualified Data.Text.Encoding as Text {- HLINT ignore "Use :" -} @@ -361,10 +357,6 @@ instance , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] - forMachine _ (MissingRequiredSigners missingKeyWitnesses) = - mconcat [ "kind" .= String "MissingRequiredSigners" - , "witnesses" .= Set.toList missingKeyWitnesses - ] forMachine _ (UnspendableUTxONoDatumHash txins) = mconcat [ "kind" .= String "MissingRequiredSigners" , "txins" .= Set.toList txins @@ -596,7 +588,7 @@ instance ] forMachine _dtal (WithdrawalsNotInRewardsDELEGS incorrectWithdrawals) = mconcat [ "kind" .= String "WithdrawalsNotInRewardsCERTS" - , "incorrectWithdrawals" .= incorrectWithdrawals + , "incorrectWithdrawals" .= unWithdrawals incorrectWithdrawals ] forMachine dtal (DelplFailure f) = forMachine dtal f @@ -740,9 +732,6 @@ instance ) => LogFormatting (ShelleyNewEpochPredFailure era) where forMachine dtal (EpochFailure f) = forMachine dtal f forMachine dtal (MirFailure f) = forMachine dtal f - forMachine _dtal (CorruptRewardUpdate update) = - mconcat [ "kind" .= String "CorruptRewardUpdate" - , "update" .= String (textShow update) ] instance @@ -1187,13 +1176,18 @@ instance , "invalidAccounts" .= accounts ] + forMachine _ (Conway.UnelectedCommitteeVoters voters) = + mconcat [ "kind" .= String "UnelectedCommitteeVoters" + , "unelectedCommitteeVoters" .= voters + ] + instance ( Consensus.ShelleyBasedEra era , LogFormatting (PredicateFailure (Ledger.EraRule "CERT" era)) ) => LogFormatting (Conway.ConwayCertsPredFailure era) where forMachine _ (Conway.WithdrawalsNotInRewardsCERTS rs) = mconcat [ "kind" .= String "WithdrawalsNotInRewardsCERTS" - , "rewardAccounts" .= rs + , "rewardAccounts" .= unWithdrawals rs ] forMachine dtal (Conway.CertFailure certFailure) = forMachine dtal certFailure @@ -1292,24 +1286,6 @@ instance LogFormatting Praos.PraosEnvelopeError where , "blockSize" .= blockSize ] -instance Ledger.Crypto c => LogFormatting (PraosChainSelectView c) where - forMachine _ PraosChainSelectView { - csvChainLength - , csvSlotNo - , csvIssuer - , csvIssueNo - , csvTieBreakVRF - } = - mconcat [ "kind" .= String "PraosChainSelectView" - , "chainLength" .= csvChainLength - , "slotNo" .= csvSlotNo - , "issuerHash" .= hashKey csvIssuer - , "issueNo" .= csvIssueNo - , "tieBreakVRF" .= renderVRF csvTieBreakVRF - ] - where - renderVRF = Text.decodeUtf8 . B16.encode . Crypto.getOutputVRFBytes - instance ( ToJSON (Alonzo.CollectError ledgerera) ) => LogFormatting (Conway.ConwayUtxosPredFailure ledgerera) where diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 9182fbb0842..c8649de1512 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -17,7 +17,7 @@ module Cardano.Node.Tracing.Tracers ) where import Cardano.Logging -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable) +import qualified Cardano.Network.Diffusion as Cardano.Diffusion import Cardano.Node.Protocol.Types (SomeConsensusProtocol) import Cardano.Node.Queries (NodeKernelData) import Cardano.Node.TraceConstraints @@ -36,22 +36,16 @@ import Cardano.Node.Tracing.Tracers.LedgerMetrics () import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () import Cardano.Node.Tracing.Tracers.NodeVersion (getNodeVersion) -import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Shutdown () import Cardano.Node.Tracing.Tracers.Startup () -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent) import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient import qualified Ouroboros.Consensus.Network.NodeToClient as NtC import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode import qualified Ouroboros.Consensus.Network.NodeToNode as NtN -import Ouroboros.Consensus.Node (NetworkP2PMode (..)) import Ouroboros.Consensus.Node.GSM -import Ouroboros.Consensus.Node.NetworkProtocolVersion import qualified Ouroboros.Consensus.Node.Run as Consensus import qualified Ouroboros.Consensus.Node.Tracers as Consensus import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB @@ -60,9 +54,6 @@ import Ouroboros.Network.Block import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.Diffusion as Diffusion -import qualified Ouroboros.Network.Diffusion.Common as Diffusion -import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P -import qualified Ouroboros.Network.Diffusion.P2P as P2P import Ouroboros.Network.NodeToClient (LocalAddress) import Ouroboros.Network.NodeToNode (RemoteAddress) @@ -71,12 +62,11 @@ import Control.Monad (unless) import "contra-tracer" Control.Tracer (Tracer (..)) import Data.Proxy (Proxy (..)) import Network.Mux.Trace (TraceLabelPeer (..)) -import Network.Socket (SockAddr) -- | Construct tracers for all system components. -- mkDispatchTracers - :: forall blk p2p . + :: forall blk . ( Consensus.RunNode blk , TraceConstraints blk , LogFormatting (LedgerEvent blk) @@ -92,17 +82,10 @@ mkDispatchTracers -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig - -> NetworkP2PMode p2p -> SomeConsensusProtocol - -> IO (Tracers RemoteAddress LocalAddress blk p2p - Cardano.ExtraState - Cardano.DebugPeerSelectionState - PeerTrustable - (Cardano.PublicRootPeers.ExtraPeers RemoteAddress) - (Cardano.ExtraPeerSelectionSetsWithSizes RemoteAddress) - IO) + -> IO (Tracers RemoteAddress LocalAddress blk IO) -mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enableP2P p = do +mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig p = do configReflection <- emptyConfigReflection @@ -171,16 +154,11 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl !nodeToNodeTr <- mkNodeToNodeTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig - !(diffusionTr :: Diffusion.Tracers - RemoteAddress - NodeToNodeVersion - LocalAddress - NodeToClientVersion - IO) <- + !(diffusionTr :: Cardano.Diffusion.CardanoTracers IO) <- mkDiffusionTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig - !diffusionTrExtra <- - mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG trDataPoint trConfig enableP2P + !churnModeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "ChurnMode"] + configureTracers configReflection trConfig [churnModeTr] traceTracerInfo trBase trForward configReflection @@ -198,10 +176,10 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl <> Tracer (traceWith replayBlockTr') <> Tracer (SR.traceNodeStateChainDB p nodeStateDP) , consensusTracers = consensusTr + , churnModeTracer = Tracer (traceWith churnModeTr) , nodeToClientTracers = nodeToClientTr , nodeToNodeTracers = nodeToNodeTr , diffusionTracers = diffusionTr - , diffusionTracersExtra = diffusionTrExtra , startupTracer = Tracer (traceWith startupTr) <> Tracer (SR.traceNodeStateStartup nodeStateDP) , shutdownTracer = Tracer (traceWith shutdownTr) @@ -524,8 +502,7 @@ mkDiffusionTracers -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig - -> IO (Diffusion.Tracers RemoteAddress NodeToNodeVersion - LocalAddress NodeToClientVersion IO) + -> IO (Cardano.Diffusion.CardanoTracers IO) mkDiffusionTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig = do !dtMuxTr <- mkCardanoTracer @@ -553,37 +530,6 @@ mkDiffusionTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Startup", "DiffusionInit"] configureTracers configReflection trConfig [dtDiffusionInitializationTr] - pure $ Diffusion.Tracers - { Diffusion.dtMuxTracer = Tracer $ - traceWith dtMuxTr - , Diffusion.dtLocalMuxTracer = Tracer $ - traceWith dtLocalMuxTr - , Diffusion.dtHandshakeTracer = Tracer $ - traceWith dtHandshakeTr - , Diffusion.dtLocalHandshakeTracer = Tracer $ - traceWith dtLocalHandshakeTr - , Diffusion.dtDiffusionTracer = Tracer $ - traceWith dtDiffusionInitializationTr - } - -mkDiffusionTracersExtra :: forall p2p . - ConfigReflection - -> Trace IO FormattedMessage - -> Trace IO FormattedMessage - -> Maybe (Trace IO FormattedMessage) - -> Trace IO DataPoint - -> TraceConfig - -> NetworkP2PMode p2p - -> IO (Diffusion.ExtraTracers - p2p - Cardano.ExtraState - Cardano.DebugPeerSelectionState - PeerTrustable - (Cardano.PublicRootPeers.ExtraPeers SockAddr) - (Cardano.ExtraPeerSelectionSetsWithSizes SockAddr) - IO) -mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG _trDataPoint trConfig EnabledP2PMode = do - !localRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "LocalRoot"] @@ -669,86 +615,56 @@ mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG _trDataPoint t ["Net", "Peers", "Ledger"] configureTracers configReflection trConfig [dtLedgerPeersTr] - pure $ Diffusion.P2PTracers P2P.TracersExtra - { P2P.dtTraceLocalRootPeersTracer = Tracer $ - traceWith localRootPeersTr - , P2P.dtTracePublicRootPeersTracer = Tracer $ - traceWith publicRootPeersTr - , P2P.dtTracePeerSelectionTracer = Tracer $ - traceWith peerSelectionTr - , P2P.dtDebugPeerSelectionInitiatorTracer = Tracer $ - traceWith debugPeerSelectionTr - , P2P.dtDebugPeerSelectionInitiatorResponderTracer = Tracer $ - traceWith debugPeerSelectionResponderTr - , P2P.dtTracePeerSelectionCounters = Tracer $ - traceWith peerSelectionCountersTr - , P2P.dtTraceChurnCounters = Tracer $ - traceWith churnCountersTr - , P2P.dtPeerSelectionActionsTracer = Tracer $ - traceWith peerSelectionActionsTr - , P2P.dtConnectionManagerTracer = Tracer $ - traceWith connectionManagerTr - , P2P.dtConnectionManagerTransitionTracer = Tracer $ - traceWith connectionManagerTransitionsTr - , P2P.dtServerTracer = Tracer $ - traceWith serverTr - , P2P.dtInboundGovernorTracer = Tracer $ - traceWith inboundGovernorTr - , P2P.dtLocalInboundGovernorTracer = Tracer $ - traceWith localInboundGovernorTr - , P2P.dtInboundGovernorTransitionTracer = Tracer $ - traceWith inboundGovernorTransitionsTr - , P2P.dtLocalConnectionManagerTracer = Tracer $ - traceWith localConnectionManagerTr - , P2P.dtLocalServerTracer = Tracer $ - traceWith localServerTr - , P2P.dtTraceLedgerPeersTracer = Tracer $ - traceWith dtLedgerPeersTr - } - -mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG _trDataPoint trConfig DisabledP2PMode = do - - !dtIpSubscriptionTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Subscription", "IP"] - configureTracers configReflection trConfig [dtIpSubscriptionTr] - - !dtDnsSubscriptionTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Subscription", "DNS"] - configureTracers configReflection trConfig [dtDnsSubscriptionTr] - - !dtDnsResolverTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "DNSResolver"] - configureTracers configReflection trConfig [dtDnsResolverTr] - - !dtErrorPolicyTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "ErrorPolicy", "Remote"] - configureTracers configReflection trConfig [dtErrorPolicyTr] - - !dtLocalErrorPolicyTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "ErrorPolicy", "Local"] - configureTracers configReflection trConfig [dtLocalErrorPolicyTr] - - !dtAcceptPolicyTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "AcceptPolicy"] - configureTracers configReflection trConfig [dtAcceptPolicyTr] - - pure $ Diffusion.NonP2PTracers NonP2P.TracersExtra - { NonP2P.dtIpSubscriptionTracer = Tracer $ - traceWith dtIpSubscriptionTr - , NonP2P.dtDnsSubscriptionTracer = Tracer $ - traceWith dtDnsSubscriptionTr - , NonP2P.dtDnsResolverTracer = Tracer $ - traceWith dtDnsResolverTr - , NonP2P.dtErrorPolicyTracer = Tracer $ - traceWith dtErrorPolicyTr - , NonP2P.dtLocalErrorPolicyTracer = Tracer $ - traceWith dtLocalErrorPolicyTr - , NonP2P.dtAcceptPolicyTracer = Tracer $ - traceWith dtAcceptPolicyTr + !dtDnsTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Net", "DNS"] + configureTracers configReflection trConfig [dtDnsTr] + + pure $ Diffusion.Tracers + { Diffusion.dtMuxTracer = Tracer $ + traceWith dtMuxTr + , Diffusion.dtLocalMuxTracer = Tracer $ + traceWith dtLocalMuxTr + , Diffusion.dtHandshakeTracer = Tracer $ + traceWith dtHandshakeTr + , Diffusion.dtLocalHandshakeTracer = Tracer $ + traceWith dtLocalHandshakeTr + , Diffusion.dtDiffusionTracer = Tracer $ + traceWith dtDiffusionInitializationTr + , Diffusion.dtTraceLocalRootPeersTracer = Tracer $ + traceWith localRootPeersTr + , Diffusion.dtTracePublicRootPeersTracer = Tracer $ + traceWith publicRootPeersTr + , Diffusion.dtTracePeerSelectionTracer = Tracer $ + traceWith peerSelectionTr + , Diffusion.dtDebugPeerSelectionInitiatorTracer = Tracer $ + traceWith debugPeerSelectionTr + , Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = Tracer $ + traceWith debugPeerSelectionResponderTr + , Diffusion.dtTracePeerSelectionCounters = Tracer $ + traceWith peerSelectionCountersTr + , Diffusion.dtTraceChurnCounters = Tracer $ + traceWith churnCountersTr + , Diffusion.dtPeerSelectionActionsTracer = Tracer $ + traceWith peerSelectionActionsTr + , Diffusion.dtConnectionManagerTracer = Tracer $ + traceWith connectionManagerTr + , Diffusion.dtConnectionManagerTransitionTracer = Tracer $ + traceWith connectionManagerTransitionsTr + , Diffusion.dtServerTracer = Tracer $ + traceWith serverTr + , Diffusion.dtInboundGovernorTracer = Tracer $ + traceWith inboundGovernorTr + , Diffusion.dtLocalInboundGovernorTracer = Tracer $ + traceWith localInboundGovernorTr + , Diffusion.dtInboundGovernorTransitionTracer = Tracer $ + traceWith inboundGovernorTransitionsTr + , Diffusion.dtLocalConnectionManagerTracer = Tracer $ + traceWith localConnectionManagerTr + , Diffusion.dtLocalServerTracer = Tracer $ + traceWith localServerTr + , Diffusion.dtTraceLedgerPeersTracer = Tracer $ + traceWith dtLedgerPeersTr + , Diffusion.dtDnsTracer = Tracer $ + traceWith dtDnsTr } diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 1bf1c7a1284..cd397e3e900 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -411,12 +411,10 @@ instance ( LogFormatting (Header blk) "About to add block to queue: " <> renderRealPointAsPhrase pt FallingEdgeWith sz -> "Block added to queue: " <> renderRealPointAsPhrase pt <> ", queue size " <> condenseT sz - forHuman (ChainDB.PoppedBlockFromQueue edgePt) = - case edgePt of - RisingEdge -> - "Popping block from queue" - FallingEdgeWith pt -> - "Popped block from queue: " <> renderRealPointAsPhrase pt + forHuman ChainDB.PoppingFromQueue = + "Popping block from queue" + forHuman (ChainDB.PoppedBlockFromQueue pt) = + "Popped block from queue: " <> renderRealPointAsPhrase pt forHuman (ChainDB.StoreButDontChange pt) = "Ignoring block: " <> renderRealPointAsPhrase pt forHuman (ChainDB.TryAddToCurrentChain pt) = @@ -437,8 +435,12 @@ instance ( LogFormatting (Header blk) RisingEdge -> "Chain about to add block " <> renderRealPointAsPhrase pt FallingEdge -> "Chain added block " <> renderRealPointAsPhrase pt forHuman (ChainDB.PipeliningEvent ev') = forHumanOrMachine ev' - forHuman ChainDB.AddedReprocessLoEBlocksToQueue = - "Added request to queue to reprocess blocks postponed by LoE." + forHuman (ChainDB.AddedReprocessLoEBlocksToQueue edgeSz) = + case edgeSz of + RisingEdge -> + "About to add request to queue to reprocess blocks postponed by LoE." + FallingEdgeWith sz -> + "Added request to queue to reprocess blocks postponed by LoE" <> ", queue size " <> condenseT sz forHuman ChainDB.PoppedReprocessLoEBlocksFromQueue = "Poppped request from queue to reprocess blocks postponed by LoE." forHuman ChainDB.ChainSelectionLoEDebug{} = @@ -459,11 +461,12 @@ instance ( LogFormatting (Header blk) , case edgeSz of RisingEdge -> "risingEdge" .= True FallingEdgeWith sz -> "queueSize" .= toJSON sz ] - forMachine dtal (ChainDB.PoppedBlockFromQueue edgePt) = + forMachine _dtal ChainDB.PoppingFromQueue = + mconcat [ "kind" .= String "PoppingFromQueue" + ] + forMachine dtal (ChainDB.PoppedBlockFromQueue pt) = mconcat [ "kind" .= String "TraceAddBlockEvent.PoppedBlockFromQueue" - , case edgePt of - RisingEdge -> "risingEdge" .= True - FallingEdgeWith pt -> "block" .= forMachine dtal pt ] + , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.StoreButDontChange pt) = mconcat [ "kind" .= String "StoreButDontChange" , "block" .= forMachine dtal pt ] @@ -556,8 +559,11 @@ instance ( LogFormatting (Header blk) <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ] forMachine dtal (ChainDB.PipeliningEvent ev') = forMachine dtal ev' - forMachine _dtal ChainDB.AddedReprocessLoEBlocksToQueue = - mconcat [ "kind" .= String "AddedReprocessLoEBlocksToQueue" ] + forMachine _dtal (ChainDB.AddedReprocessLoEBlocksToQueue edgeSz) = + mconcat [ "kind" .= String "AddedReprocessLoEBlocksToQueue" + , case edgeSz of + RisingEdge -> "risingEdge" .= True + FallingEdgeWith sz -> "queueSize" .= toJSON sz ] forMachine _dtal ChainDB.PoppedReprocessLoEBlocksFromQueue = mconcat [ "kind" .= String "PoppedReprocessLoEBlocksFromQueue" ] forMachine dtal (ChainDB.ChainSelectionLoEDebug curChain loeFrag) = @@ -627,6 +633,8 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where Namespace [] ["IgnoreInvalidBlock"] namespaceFor ChainDB.AddedBlockToQueue {} = Namespace [] ["AddedBlockToQueue"] + namespaceFor ChainDB.PoppingFromQueue {} = + Namespace [] ["PoppingFromQueue"] namespaceFor ChainDB.PoppedBlockFromQueue {} = Namespace [] ["PoppedBlockFromQueue"] namespaceFor ChainDB.AddedBlockToVolatileDB {} = @@ -647,7 +655,7 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where nsPrependInner "AddBlockValidation" (namespaceFor ev') namespaceFor (ChainDB.PipeliningEvent ev') = nsPrependInner "PipeliningEvent" (namespaceFor ev') - namespaceFor ChainDB.AddedReprocessLoEBlocksToQueue = + namespaceFor ChainDB.AddedReprocessLoEBlocksToQueue {} = Namespace [] ["AddedReprocessLoEBlocksToQueue"] namespaceFor ChainDB.PoppedReprocessLoEBlocksFromQueue = Namespace [] ["PoppedReprocessLoEBlocksFromQueue"] @@ -659,6 +667,7 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where severityFor (Namespace _ ["IgnoreInvalidBlock"]) _ = Just Info severityFor (Namespace _ ["AddedBlockToQueue"]) _ = Just Debug severityFor (Namespace _ ["AddedBlockToVolatileDB"]) _ = Just Debug + severityFor (Namespace _ ["PoppingFromQueue"]) _ = Just Debug severityFor (Namespace _ ["PoppedBlockFromQueue"]) _ = Just Debug severityFor (Namespace _ ["TryAddToCurrentChain"]) _ = Just Debug severityFor (Namespace _ ["TrySwitchToAFork"]) _ = Just Info @@ -778,6 +787,7 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where ] documentFor (Namespace _ ["AddedBlockToVolatileDB"]) = Just "A block was added to the Volatile DB" + documentFor (Namespace _ ["PoppingFromQueue"]) = Just "" documentFor (Namespace _ ["PoppedBlockFromQueue"]) = Just "" documentFor (Namespace _ ["TryAddToCurrentChain"]) = Just $ mconcat [ "The block fits onto the current chain, we'll try to use it to extend" @@ -819,6 +829,7 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where , Namespace [] ["IgnoreInvalidBlock"] , Namespace [] ["AddedBlockToQueue"] , Namespace [] ["AddedBlockToVolatileDB"] + , Namespace [] ["PoppingFromQueue"] , Namespace [] ["PoppedBlockFromQueue"] , Namespace [] ["TryAddToCurrentChain"] , Namespace [] ["TrySwitchToAFork"] @@ -1821,6 +1832,7 @@ instance LogFormatting LedgerDB.TraceForkerEvent where forMachine _dtals LedgerDB.ForkerReadStatistics = mempty forMachine _dtals LedgerDB.ForkerPushStart = mempty forMachine _dtals LedgerDB.ForkerPushEnd = mempty + forMachine _dtals LedgerDB.DanglingForkerClosed = mempty forHuman LedgerDB.ForkerOpen = "Opened forker" forHuman LedgerDB.ForkerCloseUncommitted = "Forker closed without committing" @@ -1832,6 +1844,7 @@ instance LogFormatting LedgerDB.TraceForkerEvent where forHuman LedgerDB.ForkerReadStatistics = "Gathering statistics" forHuman LedgerDB.ForkerPushStart = "Started to push" forHuman LedgerDB.ForkerPushEnd = "Pushed" + forHuman LedgerDB.DanglingForkerClosed = "Closed dangling forker" instance MetaTrace LedgerDB.TraceForkerEventWithKey where namespaceFor (LedgerDB.TraceForkerEventWithKey _ ev) = @@ -1854,6 +1867,7 @@ instance MetaTrace LedgerDB.TraceForkerEvent where namespaceFor LedgerDB.ForkerReadStatistics = Namespace [] ["Statistics"] namespaceFor LedgerDB.ForkerPushStart = Namespace [] ["StartPush"] namespaceFor LedgerDB.ForkerPushEnd = Namespace [] ["FinishPush"] + namespaceFor LedgerDB.DanglingForkerClosed = Namespace [] ["DanglingForkerClosed"] severityFor _ _ = Just Debug @@ -1871,6 +1885,7 @@ instance MetaTrace LedgerDB.TraceForkerEvent where documentFor (Namespace _ ("Statistics" : _tl)) = Just "Statistics were gathered from the forker" documentFor (Namespace _ ("StartPush" : _tl)) = Just "A ledger state is going to be pushed to the forker" documentFor (Namespace _ ("FinishPush" : _tl)) = Just "A ledger state was pushed to the forker" + documentFor (Namespace _ ("DanglingForkerClosed" : _tl)) = Just "A dangling forker was closed" documentFor _ = Nothing allNamespaces = [ @@ -1884,6 +1899,7 @@ instance MetaTrace LedgerDB.TraceForkerEvent where , Namespace [] ["Statistics"] , Namespace [] ["StartPush"] , Namespace [] ["FinishPush"] + , Namespace [] ["DanglingForkerClosed"] ] -------------------------------------------------------------------------------- @@ -2223,40 +2239,40 @@ instance MetaTrace V1.BackingStoreValueHandleTrace where ] instance LogFormatting V2.FlavorImplSpecificTrace where - forMachine _dtal V2.FlavorImplSpecificTraceInMemory = - mconcat [ "kind" .= String "InMemory" ] - forMachine _dtal V2.FlavorImplSpecificTraceOnDisk = - mconcat [ "kind" .= String "OnDisk" ] + forMachine _dtal V2.TraceLedgerTablesHandleCreate = + mconcat [ "kind" .= String "LedgerTablesHandleCreate" ] + forMachine _dtal V2.TraceLedgerTablesHandleClose = + mconcat [ "kind" .= String "LedgerTablesHandleClose" ] - forHuman V2.FlavorImplSpecificTraceInMemory = - "An in-memory backing store event was traced" - forHuman V2.FlavorImplSpecificTraceOnDisk = - "An on-disk backing store event was traced" + forHuman V2.TraceLedgerTablesHandleCreate = + "Created a new 'LedgerTablesHandle', potentially by duplicating an existing one" + forHuman V2.TraceLedgerTablesHandleClose = + "Closed a 'LedgerTablesHandle'" instance MetaTrace V2.FlavorImplSpecificTrace where - namespaceFor V2.FlavorImplSpecificTraceInMemory = - Namespace [] ["InMemory"] - namespaceFor V2.FlavorImplSpecificTraceOnDisk = - Namespace [] ["OnDisk"] + namespaceFor V2.TraceLedgerTablesHandleCreate = + Namespace [] ["LedgerTablesHandleCreate"] + namespaceFor V2.TraceLedgerTablesHandleClose = + Namespace [] ["LedgerTablesHandleClose"] - severityFor (Namespace _ ["InMemory"]) _ = Just Info - severityFor (Namespace _ ["OnDisk"]) _ = Just Info + severityFor (Namespace _ ["LedgerTablesHandleCreate"]) _ = Just Info + severityFor (Namespace _ ["LedgerTablesHandleClose"]) _ = Just Info severityFor _ _ = Nothing -- suspicious - privacyFor (Namespace _ ["InMemory"]) _ = Just Public - privacyFor (Namespace _ ["OnDisk"]) _ = Just Public + privacyFor (Namespace _ ["TraceLedgerTablesHandleCreate"]) _ = Just Public + privacyFor (Namespace _ ["LedgerTablesHandleClose"]) _ = Just Public privacyFor _ _ = Just Public - documentFor (Namespace _ ["InMemory"]) = + documentFor (Namespace _ ["TraceLedgerTablesHandleCreate"]) = Just "An in-memory backing store event" - documentFor (Namespace _ ["OnDisk"]) = + documentFor (Namespace _ ["LedgerTablesHandleClose"]) = Just "An on-disk backing store event" documentFor _ = Nothing allNamespaces = - [ Namespace [] ["InMemory"] - , Namespace [] ["OnDisk"] + [ Namespace [] ["TraceLedgerTablesHandleCreate"] + , Namespace [] ["LedgerTablesHandleClose"] ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 9d978244a14..4c91e284859 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -1293,22 +1293,16 @@ instance [ "kind" .= String "TraceMempoolAttemptingAdd" , "tx" .= forMachine dtal tx ] - forMachine dtal (TraceMempoolLedgerFound p) = - mconcat - [ "kind" .= String "TraceMempoolLedgerFound" - , "tip" .= forMachine dtal p - ] - forMachine dtal (TraceMempoolLedgerNotFound p) = - mconcat - [ "kind" .= String "TraceMempoolLedgerNotFound" - , "tip" .= forMachine dtal p - ] forMachine _dtal (TraceMempoolSynced et) = mconcat [ "kind" .= String "TraceMempoolSynced" , "enclosingTime" .= et ] + forMachine _dtal TraceMempoolTipMovedBetweenSTMBlocks = + mconcat + [ "kind" .= String "TraceMempoolTipMovedBetweenSTMBlocks" + ] asMetrics (TraceMempoolAddedTx _tx _mpSzBefore mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) @@ -1334,8 +1328,8 @@ instance asMetrics TraceMempoolSyncNotNeeded {} = [] asMetrics TraceMempoolAttemptingAdd {} = [] - asMetrics TraceMempoolLedgerFound {} = [] - asMetrics TraceMempoolLedgerNotFound {} = [] + + asMetrics TraceMempoolTipMovedBetweenSTMBlocks {} = [] instance LogFormatting MempoolSize where forMachine _dtal MempoolSize{msNumTxs, msNumBytes} = @@ -1353,8 +1347,8 @@ instance MetaTrace (TraceEventMempool blk) where namespaceFor TraceMempoolSynced {} = Namespace [] ["Synced"] namespaceFor TraceMempoolSyncNotNeeded {} = Namespace [] ["SyncNotNeeded"] namespaceFor TraceMempoolAttemptingAdd {} = Namespace [] ["AttemptAdd"] - namespaceFor TraceMempoolLedgerFound {} = Namespace [] ["LedgerFound"] - namespaceFor TraceMempoolLedgerNotFound {} = Namespace [] ["LedgerNotFound"] + namespaceFor TraceMempoolTipMovedBetweenSTMBlocks {} = Namespace [] ["TipMovedBetweenSTMBlocks"] + severityFor (Namespace _ ["AddedTx"]) _ = Just Info severityFor (Namespace _ ["RejectedTx"]) _ = Just Info @@ -1363,8 +1357,7 @@ instance MetaTrace (TraceEventMempool blk) where severityFor (Namespace _ ["ManuallyRemovedTxs"]) _ = Just Warning severityFor (Namespace _ ["SyncNotNeeded"]) _ = Just Debug severityFor (Namespace _ ["AttemptAdd"]) _ = Just Debug - severityFor (Namespace _ ["LedgerFound"]) _ = Just Debug - severityFor (Namespace _ ["LedgerNotFound"]) _ = Just Debug + severityFor (Namespace [] ["TipMovedBetweenSTMBlocks"]) _ = Just Debug severityFor _ _ = Nothing metricsDocFor (Namespace _ ["AddedTx"]) = @@ -1408,12 +1401,8 @@ instance MetaTrace (TraceEventMempool blk) where "The mempool and the LedgerDB are syncing or in sync depending on the argument on the trace." documentFor (Namespace _ ["AttemptAdd"]) = Just "Mempool is about to try to validate and add a transaction." - documentFor (Namespace _ ["LedgerNotFound"]) = Just $ mconcat - [ "Ledger state requested by the mempool no longer in LedgerDB." - , " Will have to re-sync." - ] - documentFor (Namespace _ ["LedgerFound"]) = Just - "Ledger state requested by the mempool is in the LedgerDB." + documentFor (Namespace _ ["TipMovedBetweenSTMBlocks"]) = Just + "LedgerDB moved to an alternative fork between two reads during re-sync." documentFor _ = Nothing allNamespaces = @@ -1424,8 +1413,7 @@ instance MetaTrace (TraceEventMempool blk) where , Namespace [] ["Synced"] , Namespace [] ["SyncNotNeeded"] , Namespace [] ["AttemptAdd"] - , Namespace [] ["LedgerNotFound"] - , Namespace [] ["LedgerFound"] + , Namespace [] ["TipMovedBetweenSTMBlocks"] ] -------------------------------------------------------------------------------- @@ -2072,6 +2060,14 @@ instance ( LogFormatting selection ) => LogFormatting (TraceGsmEvent selection) where forMachine dtal = \case + GsmEventInitializedInCaughtUp -> + mconcat + [ "kind" .= String "GsmEventInitializedInCaughtUp" + ] + GsmEventInitializedInPreSyncing -> + mconcat + [ "kind" .= String "GsmEventInitializedInPreSyncing" + ] GsmEventEnterCaughtUp i s -> mconcat [ "kind" .= String "GsmEventEnterCaughtUp" @@ -2109,6 +2105,8 @@ instance ( LogFormatting selection instance MetaTrace (TraceGsmEvent selection) where namespaceFor = \case + GsmEventInitializedInCaughtUp -> Namespace [] ["InitializedInCaughtUp"] + GsmEventInitializedInPreSyncing -> Namespace [] ["InitializedInPreSyncing"] GsmEventEnterCaughtUp {} -> Namespace [] ["EnterCaughtUp"] GsmEventLeaveCaughtUp {} -> Namespace [] ["LeaveCaughtUp"] GsmEventPreSyncingToSyncing {} -> Namespace [] ["PreSyncingToSyncing"] @@ -2116,13 +2114,18 @@ instance MetaTrace (TraceGsmEvent selection) where severityFor ns _ = case ns of - Namespace _ ["EnterCaughtUp"] -> Just Notice - Namespace _ ["LeaveCaughtUp"] -> Just Warning - Namespace _ ["PreSyncingToSyncing"] -> Just Notice - Namespace _ ["SyncingToPreSyncing"] -> Just Notice - Namespace _ _ -> Nothing + Namespace _ ["InitializedInCaughtUp"] -> Just Info + Namespace _ ["InitializedInPreSyncing"] -> Just Info + Namespace _ ["EnterCaughtUp"] -> Just Info + Namespace _ ["LeaveCaughtUp"] -> Just Info + Namespace _ ["GsmEventPreSyncingToSyncing"] -> Just Info + Namespace _ ["GsmEventSyncingToPreSyncing"] -> Just Info + Namespace _ _ -> Nothing documentFor = \case + Namespace _ ["InitializedInCaughtUp"] -> Just "The GSM was initialized in the 'CaughtUp' state" + Namespace _ ["InitializedInPreSyncing"] -> Just "The GSM was initialized in the 'PreSyncing' state" + Namespace _ ["EnterCaughtUp"] -> Just "Node is caught up" Namespace _ ["LeaveCaughtUp"] -> @@ -2150,7 +2153,9 @@ instance MetaTrace (TraceGsmEvent selection) where ] allNamespaces = - [ Namespace [] ["EnterCaughtUp"] + [ Namespace [] ["InitializedInCaughtUp"] + , Namespace [] ["InitializedInPreSyncing"] + , Namespace [] ["EnterCaughtUp"] , Namespace [] ["LeaveCaughtUp"] , Namespace [] ["PreSyncingToSyncing"] , Namespace [] ["SyncingToPreSyncing"] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 9230da8c202..7883dd70766 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -21,7 +21,7 @@ import Cardano.Node.Configuration.TopologyP2P () #ifdef linux_HOST_OS import Network.Mux.TCPInfo (StructTCPInfo (..)) #endif -import qualified Ouroboros.Network.Diffusion.Common as Common +import qualified Ouroboros.Network.Diffusion.Types as Diff import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.LedgerPeers (NumberOfPeers (..), PoolStake (..), TraceLedgerPeers (..)) @@ -615,108 +615,108 @@ instance MetaTrace (AnyMessage (HS.Handshake nt term)) where -------------------------------------------------------------------------------- instance (Show ntnAddr, Show ntcAddr) => - LogFormatting (Common.DiffusionTracer ntnAddr ntcAddr) where - forMachine _dtal (Common.RunServer sockAddr) = mconcat + LogFormatting (Diff.DiffusionTracer ntnAddr ntcAddr) where + forMachine _dtal (Diff.RunServer sockAddr) = mconcat [ "kind" .= String "RunServer" , "socketAddress" .= String (pack (show sockAddr)) ] - forMachine _dtal (Common.RunLocalServer localAddress) = mconcat + forMachine _dtal (Diff.RunLocalServer localAddress) = mconcat [ "kind" .= String "RunLocalServer" , "localAddress" .= String (pack (show localAddress)) ] - forMachine _dtal (Common.UsingSystemdSocket localAddress) = mconcat + forMachine _dtal (Diff.UsingSystemdSocket localAddress) = mconcat [ "kind" .= String "UsingSystemdSocket" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (Common.CreateSystemdSocketForSnocketPath localAddress) = mconcat + forMachine _dtal (Diff.CreateSystemdSocketForSnocketPath localAddress) = mconcat [ "kind" .= String "CreateSystemdSocketForSnocketPath" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (Common.CreatedLocalSocket localAddress) = mconcat + forMachine _dtal (Diff.CreatedLocalSocket localAddress) = mconcat [ "kind" .= String "CreatedLocalSocket" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (Common.ConfiguringLocalSocket localAddress socket) = mconcat + forMachine _dtal (Diff.ConfiguringLocalSocket localAddress socket) = mconcat [ "kind" .= String "ConfiguringLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.ListeningLocalSocket localAddress socket) = mconcat + forMachine _dtal (Diff.ListeningLocalSocket localAddress socket) = mconcat [ "kind" .= String "ListeningLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.LocalSocketUp localAddress fd) = mconcat + forMachine _dtal (Diff.LocalSocketUp localAddress fd) = mconcat [ "kind" .= String "LocalSocketUp" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show fd)) ] - forMachine _dtal (Common.CreatingServerSocket socket) = mconcat + forMachine _dtal (Diff.CreatingServerSocket socket) = mconcat [ "kind" .= String "CreatingServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.ListeningServerSocket socket) = mconcat + forMachine _dtal (Diff.ListeningServerSocket socket) = mconcat [ "kind" .= String "ListeningServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.ServerSocketUp socket) = mconcat + forMachine _dtal (Diff.ServerSocketUp socket) = mconcat [ "kind" .= String "ServerSocketUp" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.ConfiguringServerSocket socket) = mconcat + forMachine _dtal (Diff.ConfiguringServerSocket socket) = mconcat [ "kind" .= String "ConfiguringServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (Common.UnsupportedLocalSystemdSocket path) = mconcat + forMachine _dtal (Diff.UnsupportedLocalSystemdSocket path) = mconcat [ "kind" .= String "UnsupportedLocalSystemdSocket" , "path" .= String (pack (show path)) ] - forMachine _dtal Common.UnsupportedReadySocketCase = mconcat + forMachine _dtal Diff.UnsupportedReadySocketCase = mconcat [ "kind" .= String "UnsupportedReadySocketCase" ] - forMachine _dtal (Common.DiffusionErrored exception) = mconcat + forMachine _dtal (Diff.DiffusionErrored exception) = mconcat [ "kind" .= String "DiffusionErrored" , "error" .= String (pack (show exception)) ] - forMachine _dtal (Common.SystemdSocketConfiguration config) = mconcat + forMachine _dtal (Diff.SystemdSocketConfiguration config) = mconcat [ "kind" .= String "SystemdSocketConfiguration" , "path" .= String (pack (show config)) ] -instance MetaTrace (Common.DiffusionTracer ntnAddr ntcAddr) where - namespaceFor Common.RunServer {} = +instance MetaTrace (Diff.DiffusionTracer ntnAddr ntcAddr) where + namespaceFor Diff.RunServer {} = Namespace [] ["RunServer"] - namespaceFor Common.RunLocalServer {} = + namespaceFor Diff.RunLocalServer {} = Namespace [] ["RunLocalServer"] - namespaceFor Common.UsingSystemdSocket {} = + namespaceFor Diff.UsingSystemdSocket {} = Namespace [] ["UsingSystemdSocket"] - namespaceFor Common.CreateSystemdSocketForSnocketPath {} = + namespaceFor Diff.CreateSystemdSocketForSnocketPath {} = Namespace [] ["CreateSystemdSocketForSnocketPath"] - namespaceFor Common.CreatedLocalSocket {} = + namespaceFor Diff.CreatedLocalSocket {} = Namespace [] ["CreatedLocalSocket"] - namespaceFor Common.ConfiguringLocalSocket {} = + namespaceFor Diff.ConfiguringLocalSocket {} = Namespace [] ["ConfiguringLocalSocket"] - namespaceFor Common.ListeningLocalSocket {} = + namespaceFor Diff.ListeningLocalSocket {} = Namespace [] ["ListeningLocalSocket"] - namespaceFor Common.LocalSocketUp {} = + namespaceFor Diff.LocalSocketUp {} = Namespace [] ["LocalSocketUp"] - namespaceFor Common.CreatingServerSocket {} = + namespaceFor Diff.CreatingServerSocket {} = Namespace [] ["CreatingServerSocket"] - namespaceFor Common.ListeningServerSocket {} = + namespaceFor Diff.ListeningServerSocket {} = Namespace [] ["ListeningServerSocket"] - namespaceFor Common.ServerSocketUp {} = + namespaceFor Diff.ServerSocketUp {} = Namespace [] ["ServerSocketUp"] - namespaceFor Common.ConfiguringServerSocket {} = + namespaceFor Diff.ConfiguringServerSocket {} = Namespace [] ["ConfiguringServerSocket"] - namespaceFor Common.UnsupportedLocalSystemdSocket {} = + namespaceFor Diff.UnsupportedLocalSystemdSocket {} = Namespace [] ["UnsupportedLocalSystemdSocket"] - namespaceFor Common.UnsupportedReadySocketCase {} = + namespaceFor Diff.UnsupportedReadySocketCase {} = Namespace [] ["UnsupportedReadySocketCase"] - namespaceFor Common.DiffusionErrored {} = + namespaceFor Diff.DiffusionErrored {} = Namespace [] ["DiffusionErrored"] - namespaceFor Common.SystemdSocketConfiguration {} = + namespaceFor Diff.SystemdSocketConfiguration {} = Namespace [] ["SystemdSocketConfiguration"] severityFor (Namespace _ ["RunServer"]) _ = Just Info @@ -872,18 +872,6 @@ instance LogFormatting TraceLedgerPeers where [ "kind" .= String "TraceLedgerPeersDomains" , "domainAccessPoints" .= daps ] - forMachine _dtal (TraceLedgerPeersResult dap ips) = - mconcat - [ "kind" .= String "TraceLedgerPeersResult" - , "domainAccessPoint" .= show dap - , "ips" .= map show ips - ] - forMachine _dtal (TraceLedgerPeersFailure dap reason) = - mconcat - [ "kind" .= String "TraceLedgerPeersFailure" - , "domainAccessPoint" .= show dap - , "error" .= show reason - ] forMachine _dtal UsingBigLedgerPeerSnapshot = mconcat [ "kind" .= String "UsingBigLedgerPeerSnapshot" @@ -918,10 +906,6 @@ instance MetaTrace TraceLedgerPeers where Namespace [] ["NotEnoughBigLedgerPeers"] namespaceFor TraceLedgerPeersDomains {} = Namespace [] ["TraceLedgerPeersDomains"] - namespaceFor TraceLedgerPeersResult {} = - Namespace [] ["TraceLedgerPeersResult"] - namespaceFor TraceLedgerPeersFailure {} = - Namespace [] ["TraceLedgerPeersFailure"] namespaceFor UsingBigLedgerPeerSnapshot {} = Namespace [] ["UsingBigLedgerPeerSnapshot"] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs deleted file mode 100644 index 618f5ed61a0..00000000000 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs +++ /dev/null @@ -1,407 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - -module Cardano.Node.Tracing.Tracers.NonP2P - () where - -import Cardano.Logging -import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..)) -import qualified Ouroboros.Network.NodeToNode as NtN -import Ouroboros.Network.Snocket (LocalAddress (..)) -import Ouroboros.Network.Subscription.Dns (DnsTrace (..), WithDomainName (..)) -import Ouroboros.Network.Subscription.Ip (SubscriptionTrace, WithIPList (..)) -import Ouroboros.Network.Subscription.Worker (ConnectResult (..), SubscriberError, - SubscriptionTrace (..)) - -import Control.Exception (Exception (..), SomeException (..)) -import Data.Aeson (Value (String), (.=)) -import qualified Data.IP as IP -import Data.Text (pack) -import qualified Network.Socket as Socket - - --------------------------------------------------------------------------------- --- Addresses --------------------------------------------------------------------------------- - -instance LogFormatting LocalAddress where - forMachine _dtal (LocalAddress path) = - mconcat ["path" .= path] - -instance LogFormatting NtN.RemoteAddress where - forMachine _dtal (Socket.SockAddrInet port addr) = - let ip = IP.fromHostAddress addr in - mconcat [ "addr" .= show ip - , "port" .= show port - ] - forMachine _dtal (Socket.SockAddrInet6 port _ addr _) = - let ip = IP.fromHostAddress6 addr in - mconcat [ "addr" .= show ip - , "port" .= show port - ] - forMachine _dtal (Socket.SockAddrUnix path) = - mconcat [ "path" .= show path ] - --------------------------------------------------------------------------------- --- Subscription Tracer --------------------------------------------------------------------------------- - -instance LogFormatting (WithIPList (SubscriptionTrace Socket.SockAddr)) where - forMachine _dtal (WithIPList localAddresses dests ev) = - mconcat [ "kind" .= String "IP SubscriptionTrace" - , "localAddresses" .= String (pack $ show localAddresses) - , "dests" .= String (pack $ show dests) - , "event" .= String (pack $ show ev)] - 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) = - mconcat [ "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) - <> "." - -instance MetaTrace tr => MetaTrace (WithIPList tr) where - namespaceFor (WithIPList _ _ ev) = nsCast (namespaceFor ev) - severityFor ns Nothing = severityFor (nsCast ns :: Namespace tr) Nothing - severityFor ns (Just (WithIPList _ _ ev)) = - severityFor (nsCast ns) (Just ev) - detailsFor ns Nothing = detailsFor (nsCast ns :: Namespace tr) Nothing - detailsFor ns (Just (WithIPList _ _ ev)) = - detailsFor (nsCast ns) (Just ev) - privacyFor ns Nothing = privacyFor (nsCast ns :: Namespace tr) Nothing - privacyFor ns (Just (WithIPList _ _ ev)) = - privacyFor (nsCast ns) (Just ev) - documentFor ns = documentFor (nsCast ns :: Namespace tr) - allNamespaces = fmap nsCast - (allNamespaces :: [Namespace tr]) - -instance MetaTrace tr => MetaTrace (WithDomainName tr) where - namespaceFor (WithDomainName _ ev) = nsCast (namespaceFor ev) - severityFor ns Nothing = severityFor (nsCast ns :: Namespace tr) Nothing - severityFor ns (Just (WithDomainName _ ev)) = - severityFor (nsCast ns) (Just ev) - detailsFor ns Nothing = detailsFor (nsCast ns :: Namespace tr) Nothing - detailsFor ns (Just (WithDomainName _ ev)) = - detailsFor (nsCast ns) (Just ev) - privacyFor ns Nothing = privacyFor (nsCast ns :: Namespace tr) Nothing - privacyFor ns (Just (WithDomainName _ ev)) = - privacyFor (nsCast ns) (Just ev) - documentFor ns = documentFor (nsCast ns :: Namespace tr) - allNamespaces = fmap nsCast - (allNamespaces :: [Namespace tr]) - -instance MetaTrace (SubscriptionTrace adr) where - namespaceFor SubscriptionTraceConnectStart {} = - Namespace [] ["ConnectStart"] - namespaceFor SubscriptionTraceConnectEnd {} = - Namespace [] ["ConnectEnd"] - namespaceFor SubscriptionTraceConnectException {} = - Namespace [] ["ConnectException"] - namespaceFor SubscriptionTraceSocketAllocationException {} = - Namespace [] ["SocketAllocationException"] - namespaceFor SubscriptionTraceTryConnectToPeer {} = - Namespace [] ["TryConnectToPeer"] - namespaceFor SubscriptionTraceSkippingPeer {} = - Namespace [] ["SkippingPeer"] - namespaceFor SubscriptionTraceSubscriptionRunning = - Namespace [] ["SubscriptionRunning"] - namespaceFor SubscriptionTraceSubscriptionWaiting {} = - Namespace [] ["SubscriptionWaiting"] - namespaceFor SubscriptionTraceSubscriptionFailed = - Namespace [] ["SubscriptionFailed"] - namespaceFor SubscriptionTraceSubscriptionWaitingNewConnection {} = - Namespace [] ["SubscriptionWaitingNewConnection"] - namespaceFor SubscriptionTraceStart {} = - Namespace [] ["Start"] - namespaceFor SubscriptionTraceRestart {} = - Namespace [] ["Restart"] - namespaceFor SubscriptionTraceConnectionExist {} = - Namespace [] ["ConnectionExist"] - namespaceFor SubscriptionTraceUnsupportedRemoteAddr {} = - Namespace [] ["UnsupportedRemoteAddr"] - namespaceFor SubscriptionTraceMissingLocalAddress = - Namespace [] ["MissingLocalAddress"] - namespaceFor SubscriptionTraceApplicationException {} = - Namespace [] ["ApplicationException"] - namespaceFor SubscriptionTraceAllocateSocket {} = - Namespace [] ["AllocateSocket"] - namespaceFor SubscriptionTraceCloseSocket {} = - Namespace [] ["CloseSocket"] - - severityFor (Namespace _ ["ConnectStart"]) _ = Just Info - severityFor (Namespace _ ["ConnectEnd"]) - (Just (SubscriptionTraceConnectEnd _ connectResult)) = - case connectResult of - ConnectSuccess -> Just Info - ConnectSuccessLast -> Just Notice - ConnectValencyExceeded -> Just Warning - severityFor (Namespace _ ["ConnectEnd"]) Nothing = Just Info - severityFor (Namespace _ ["ConnectException"]) - (Just (SubscriptionTraceConnectException _ e)) = - case fromException $ SomeException e of - Just (_::SubscriberError) -> Just Debug - _ -> Just Info - severityFor (Namespace _ ["ConnectException"]) Nothing = Just Info - severityFor (Namespace _ ["SocketAllocationException"]) _ = Just Error - severityFor (Namespace _ ["TryConnectToPeer"]) _ = Just Info - severityFor (Namespace _ ["SkippingPeer"]) _ = Just Info - severityFor (Namespace _ ["SubscriptionRunning"]) _ = Just Debug - severityFor (Namespace _ ["SubscriptionWaiting"]) _ = Just Debug - severityFor (Namespace _ ["SubscriptionFailed"]) _ = Just Error - severityFor (Namespace _ ["SubscriptionWaitingNewConnection"]) _ = Just Notice - severityFor (Namespace _ ["Start"]) _ = Just Debug - severityFor (Namespace _ ["Restart"]) _ = Just Info - severityFor (Namespace _ ["ConnectionExist"]) _ = Just Notice - severityFor (Namespace _ ["UnsupportedRemoteAddr"]) _ = Just Error - severityFor (Namespace _ ["MissingLocalAddress"]) _ = Just Warning - severityFor (Namespace _ ["ApplicationException"]) - (Just (SubscriptionTraceApplicationException _ e)) = - case fromException $ SomeException e of - Just (_::SubscriberError) -> Just Debug - _ -> Just Error - severityFor (Namespace _ ["ApplicationException"]) Nothing = Just Error - severityFor (Namespace _ ["AllocateSocket"]) _ = Just Debug - severityFor (Namespace _ ["CloseSocket"]) _ = Just Info - severityFor _ _ = Nothing - - documentFor (Namespace _ ["ConnectStart"]) = Just - "Connection Attempt Start with destination." - documentFor (Namespace _ ["ConnectEnd"]) = Just - "Connection Attempt end with destination and outcome." - documentFor (Namespace _ ["ConnectException"]) = Just - "Socket Allocation Exception with destination and the exception." - documentFor (Namespace _ ["SocketAllocationException"]) = Just - "Socket Allocation Exception with destination and the exception." - documentFor (Namespace _ ["TryConnectToPeer"]) = Just - "Trying to connect to peer with address." - documentFor (Namespace _ ["SkippingPeer"]) = Just - "Skipping peer with address." - documentFor (Namespace _ ["SubscriptionRunning"]) = Just - "Required subscriptions started." - documentFor (Namespace _ ["SubscriptionWaiting"]) = Just - "Waiting on address with active connections." - documentFor (Namespace _ ["SubscriptionFailed"]) = Just - "Failed to start all required subscriptions." - documentFor (Namespace _ ["SubscriptionWaitingNewConnection"]) = Just - "Waiting delay time before attempting a new connection." - documentFor (Namespace _ ["Start"]) = Just - "Starting Subscription Worker with a valency." - documentFor (Namespace _ ["Restart"]) = Just $ mconcat - [ "Restarting Subscription after duration with desired valency and" - , " current valency." - ] - documentFor (Namespace _ ["ConnectionExist"]) = Just - "Connection exists to destination." - documentFor (Namespace _ ["UnsupportedRemoteAddr"]) = Just - "Unsupported remote target address." - documentFor (Namespace _ ["MissingLocalAddress"]) = Just - "Missing local address." - documentFor (Namespace _ ["ApplicationException"]) = Just - "Application Exception occurred." - documentFor (Namespace _ ["AllocateSocket"]) = Just - "Allocate socket to address." - documentFor (Namespace _ ["CloseSocket"]) = Just - "Closed socket to address." - documentFor _ = Nothing - - allNamespaces = [ - Namespace [] ["ConnectStart"] - , Namespace [] ["ConnectEnd"] - , Namespace [] ["ConnectException"] - , Namespace [] ["SocketAllocationException"] - , Namespace [] ["TryConnectToPeer"] - , Namespace [] ["SkippingPeer"] - , Namespace [] ["SubscriptionRunning"] - , Namespace [] ["SubscriptionWaiting"] - , Namespace [] ["SubscriptionFailed"] - , Namespace [] ["SubscriptionWaitingNewConnection"] - , Namespace [] ["Start"] - , Namespace [] ["Restart"] - , Namespace [] ["ConnectionExist"] - , Namespace [] ["UnsupportedRemoteAddr"] - , Namespace [] ["MissingLocalAddress"] - , Namespace [] ["ApplicationException"] - , Namespace [] ["AllocateSocket"] - , Namespace [] ["CloseSocket"] - ] - - - - --------------------------------------------------------------------------------- --- DNSResolver Tracer --------------------------------------------------------------------------------- - -instance LogFormatting (WithDomainName DnsTrace) where - forMachine _dtal (WithDomainName dom ev) = - mconcat [ "kind" .= String "DnsTrace" - , "domain" .= String (pack $ show dom) - , "event" .= String (pack $ show ev)] - forHuman (WithDomainName dom ev) = - pack (show ev) - <> ". Domain is " - <> pack (show dom) - <> "." - -instance MetaTrace DnsTrace where - namespaceFor DnsTraceLookupException {} = - Namespace [] ["LookupException"] - namespaceFor DnsTraceLookupAError {} = - Namespace [] ["LookupAError"] - namespaceFor DnsTraceLookupAAAAError {} = - Namespace [] ["LookupAAAAError"] - namespaceFor DnsTraceLookupIPv6First = - Namespace [] ["LookupIPv6First"] - namespaceFor DnsTraceLookupIPv4First = - Namespace [] ["LookupIPv4First"] - namespaceFor DnsTraceLookupAResult {} = - Namespace [] ["LookupAResult"] - namespaceFor DnsTraceLookupAAAAResult {} = - Namespace [] ["LookupAAAAResult"] - - severityFor (Namespace _ ["LookupException"]) _ = Just Error - severityFor (Namespace _ ["LookupAError"]) _ = Just Error - severityFor (Namespace _ ["LookupAAAAError"]) _ = Just Error - severityFor (Namespace _ ["LookupIPv6First"]) _ = Just Debug - severityFor (Namespace _ ["LookupIPv4First"]) _ = Just Debug - severityFor (Namespace _ ["LookupAResult"]) _ = Just Debug - severityFor (Namespace _ ["LookupAAAAResult"]) _ = Just Debug - severityFor _ _ = Nothing - - documentFor (Namespace _ ["LookupException"]) = Just - "A DNS lookup exception occurred." - documentFor (Namespace _ ["LookupAError"]) = Just - "A lookup failed with an error." - documentFor (Namespace _ ["LookupAAAAError"]) = Just - "AAAA lookup failed with an error." - documentFor (Namespace _ ["LookupIPv6First"]) = Just - "Returning IPv6 address first." - documentFor (Namespace _ ["LookupIPv4First"]) = Just - "Returning IPv4 address first." - documentFor (Namespace _ ["LookupAResult"]) = Just - "Lookup A result." - documentFor (Namespace _ ["LookupAAAAResult"]) = Just - "Lookup AAAA result." - documentFor _ = Nothing - - allNamespaces = [ - Namespace [] ["LookupException"] - , Namespace [] ["LookupAError"] - , Namespace [] ["LookupAAAAError"] - , Namespace [] ["LookupIPv6First"] - , Namespace [] ["LookupIPv4First"] - , Namespace [] ["LookupAResult"] - , Namespace [] ["LookupAAAAResult"] - ] - - --------------------------------------------------------------------------------- --- ErrorPolicy Tracer --------------------------------------------------------------------------------- - -instance Show addr => LogFormatting (NtN.WithAddr addr NtN.ErrorPolicyTrace) where - forMachine _dtal (NtN.WithAddr addr ev) = - mconcat [ "kind" .= String "ErrorPolicyTrace" - , "address" .= show addr - , "event" .= show ev ] - forHuman (NtN.WithAddr addr ev) = "With address " <> showT addr <> ". " <> showT ev - -instance MetaTrace tr => MetaTrace (NtN.WithAddr addr tr) where - namespaceFor (NtN.WithAddr _ ev) = nsCast (namespaceFor ev) - severityFor ns Nothing = severityFor (nsCast ns :: Namespace tr) Nothing - severityFor ns (Just (NtN.WithAddr _ ev)) = - severityFor (nsCast ns) (Just ev) - detailsFor ns Nothing = detailsFor (nsCast ns :: Namespace tr) Nothing - detailsFor ns (Just (NtN.WithAddr _ ev)) = - detailsFor (nsCast ns) (Just ev) - privacyFor ns Nothing = privacyFor (nsCast ns :: Namespace tr) Nothing - privacyFor ns (Just (NtN.WithAddr _ ev)) = - privacyFor (nsCast ns) (Just ev) - documentFor ns = documentFor (nsCast ns :: Namespace tr) - allNamespaces = fmap nsCast - (allNamespaces :: [Namespace tr]) - -instance MetaTrace NtN.ErrorPolicyTrace where - namespaceFor ErrorPolicySuspendPeer {} = - Namespace [] ["SuspendPeer"] - namespaceFor ErrorPolicySuspendConsumer {} = - Namespace [] ["SuspendConsumer"] - namespaceFor ErrorPolicyLocalNodeError {} = - Namespace [] ["LocalNodeError"] - namespaceFor ErrorPolicyResumePeer {} = - Namespace [] ["ResumePeer"] - namespaceFor ErrorPolicyKeepSuspended {} = - Namespace [] ["KeepSuspended"] - namespaceFor ErrorPolicyResumeConsumer {} = - Namespace [] ["ResumeConsumer"] - namespaceFor ErrorPolicyResumeProducer {} = - Namespace [] ["ResumeProducer"] - namespaceFor ErrorPolicyUnhandledApplicationException {} = - Namespace [] ["UnhandledApplicationException"] - namespaceFor ErrorPolicyUnhandledConnectionException {} = - Namespace [] ["UnhandledConnectionException"] - namespaceFor ErrorPolicyAcceptException {} = - Namespace [] ["AcceptException"] - - severityFor (Namespace _ ["SuspendPeer"]) _ = Just Warning - severityFor (Namespace _ ["SuspendConsumer"]) _ = Just Notice - severityFor (Namespace _ ["LocalNodeError"]) _ = Just Error - severityFor (Namespace _ ["ResumePeer"]) _ = Just Debug - severityFor (Namespace _ ["KeepSuspended"]) _ = Just Debug - severityFor (Namespace _ ["ResumeConsumer"]) _ = Just Debug - severityFor (Namespace _ ["ResumeProducer"]) _ = Just Debug - severityFor (Namespace _ ["UnhandledApplicationException"]) _ = Just Error - severityFor (Namespace _ ["UnhandledConnectionException"]) _ = Just Error - severityFor (Namespace _ ["AcceptException"]) _ = Just Error - severityFor _ _ = Nothing - - documentFor (Namespace _ ["SuspendPeer"]) = Just - "Suspending peer with a given exception." - documentFor (Namespace _ ["SuspendConsumer"]) = Just - "Suspending consumer." - documentFor (Namespace _ ["LocalNodeError"]) = Just - "Caught a local exception." - documentFor (Namespace _ ["ResumePeer"]) = Just - "Resume a peer (both consumer and producer)." - documentFor (Namespace _ ["KeepSuspended"]) = Just - "Consumer was suspended until producer will resume." - documentFor (Namespace _ ["ResumeConsumer"]) = Just - "Resume consumer." - documentFor (Namespace _ ["ResumeProducer"]) = Just - "Resume producer." - documentFor (Namespace _ ["UnhandledApplicationException"]) = Just - "An application threw an exception, which was not handled." - documentFor (Namespace _ ["UnhandledConnectionException"]) = Just - "" - documentFor (Namespace _ ["AcceptException"]) = Just - "'accept' threw an exception." - documentFor _ = Nothing - - allNamespaces = [ - Namespace [] ["SuspendPeer"] - , Namespace [] ["SuspendConsumer"] - , Namespace [] ["LocalNodeError"] - , Namespace [] ["ResumePeer"] - , Namespace [] ["KeepSuspended"] - , Namespace [] ["ResumeConsumer"] - , Namespace [] ["ResumeProducer"] - , Namespace [] ["UnhandledApplicationException"] - , Namespace [] ["UnhandledConnectionException"] - , Namespace [] ["AcceptException"] - ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 6f8ff8de124..6d5e77ef320 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -13,14 +13,14 @@ module Cardano.Node.Tracing.Tracers.P2P () where import Cardano.Logging +import Cardano.Network.Diffusion (TraceChurnMode (..)) +import qualified Cardano.Network.PeerSelection.ExtraRootPeers as Cardano.PublicRootPeers +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable) import Cardano.Node.Configuration.TopologyP2P () import Cardano.Node.Tracing.Tracers.NodeToNode () -import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Tracing.OrphanInstances.Network () -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..)) @@ -31,6 +31,7 @@ import Ouroboros.Network.InboundGovernor as InboundGovernor (Trace (.. import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.InboundGovernor.State as InboundGovernor (Counters (..)) import qualified Ouroboros.Network.NodeToNode as NtN +import Ouroboros.Network.OrphanInstances () import Ouroboros.Network.PeerSelection.Churn (ChurnCounters (..)) import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (..), DebugPeerSelectionState (..), PeerSelectionCounters, PeerSelectionState (..), @@ -39,6 +40,7 @@ import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (. import Ouroboros.Network.PeerSelection.Governor.Types (DemotionTimeoutException) import Ouroboros.Network.PeerSelection.PeerStateActions (PeerSelectionActionsTrace (..)) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint) +import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSTrace (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers (TraceLocalRootPeers (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers @@ -47,7 +49,7 @@ import qualified Ouroboros.Network.PeerSelection.State.KnownPeers as KnownPeers import Ouroboros.Network.PeerSelection.Types () import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount (..)) import Ouroboros.Network.RethrowPolicy (ErrorCommand (..)) -import Ouroboros.Network.Server2 as Server +import Ouroboros.Network.Server as Server import Ouroboros.Network.Snocket (LocalAddress (..)) import Control.Exception (displayException, fromException) @@ -56,12 +58,34 @@ import Data.Aeson (Object, ToJSON, ToJSONKey, Value (..), object, toJS import Data.Aeson.Types (listValue) import Data.Bifunctor (Bifunctor (..)) import Data.Foldable (Foldable (..)) +import qualified Data.IP as IP import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Text (pack) import Network.Socket (SockAddr (..)) +-------------------------------------------------------------------------------- +-- Addresses +-------------------------------------------------------------------------------- + +instance LogFormatting LocalAddress where + forMachine _dtal (LocalAddress path) = + mconcat ["path" .= path] + +instance LogFormatting NtN.RemoteAddress where + forMachine _dtal (SockAddrInet port addr) = + let ip = IP.fromHostAddress addr in + mconcat [ "addr" .= show ip + , "port" .= show port + ] + forMachine _dtal (SockAddrInet6 port _ addr _) = + let ip = IP.fromHostAddress6 addr in + mconcat [ "addr" .= show ip + , "port" .= show port + ] + forMachine _dtal (SockAddrUnix path) = + mconcat [ "path" .= show path ] -------------------------------------------------------------------------------- -- LocalRootPeers Tracer @@ -72,35 +96,32 @@ instance , ToJSON ntnAddr , ToJSONKey RelayAccessPoint , Show ntnAddr - , Show exception - ) => LogFormatting (TraceLocalRootPeers PeerTrustable ntnAddr exception) where + ) => LogFormatting (TraceLocalRootPeers PeerTrustable ntnAddr) where forMachine _dtal (TraceLocalRootDomains groups) = mconcat [ "kind" .= String "LocalRootDomains" , "localRootDomains" .= toJSON groups ] forMachine _dtal (TraceLocalRootWaiting d dt) = mconcat [ "kind" .= String "LocalRootWaiting" + -- TODO: `domainAddress` -> `accessPoint` , "domainAddress" .= toJSON d , "diffTime" .= show dt ] - forMachine _dtal (TraceLocalRootResult d res) = - mconcat [ "kind" .= String "LocalRootResult" - , "domainAddress" .= toJSON d - , "result" .= toJSONList res - ] forMachine _dtal (TraceLocalRootGroups groups) = mconcat [ "kind" .= String "LocalRootGroups" , "localRootGroups" .= toJSON groups ] forMachine _dtal (TraceLocalRootFailure d exception) = mconcat [ "kind" .= String "LocalRootFailure" + -- TODO: `domainAddress` -> `accessPoint` , "domainAddress" .= toJSON d - , "reason" .= show exception + , "reason" .= displayException exception ] forMachine _dtal (TraceLocalRootError d exception) = mconcat [ "kind" .= String "LocalRootError" - , "domainAddress" .= toJSON d - , "reason" .= show exception + -- TODO: `domainAddress` -> `domain` + , "domainAddress" .= String (pack . show $ d) + , "reason" .= displayException exception ] forMachine _dtal (TraceLocalRootReconfigured d exception) = mconcat [ "kind" .= String "LocalRootReconfigured" @@ -114,11 +135,10 @@ instance ] forHuman = pack . show -instance MetaTrace (TraceLocalRootPeers ntnAddr extraFlags exception) where +instance MetaTrace (TraceLocalRootPeers ntnAddr extraFlags) where namespaceFor = \case TraceLocalRootDomains {} -> Namespace [] ["LocalRootDomains"] TraceLocalRootWaiting {} -> Namespace [] ["LocalRootWaiting"] - TraceLocalRootResult {} -> Namespace [] ["LocalRootResult"] TraceLocalRootGroups {} -> Namespace [] ["LocalRootGroups"] TraceLocalRootFailure {} -> Namespace [] ["LocalRootFailure"] TraceLocalRootError {} -> Namespace [] ["LocalRootError"] @@ -177,23 +197,11 @@ instance LogFormatting TracePublicRootPeers where mconcat [ "kind" .= String "PublicRootDomains" , "domainAddresses" .= toJSONList domains ] - forMachine _dtal (TracePublicRootResult b res) = - mconcat [ "kind" .= String "PublicRootResult" - , "domain" .= show b - , "result" .= toJSONList res - ] - forMachine _dtal (TracePublicRootFailure b d) = - mconcat [ "kind" .= String "PublicRootFailure" - , "domain" .= show b - , "reason" .= show d - ] forHuman = pack . show instance MetaTrace TracePublicRootPeers where namespaceFor TracePublicRootRelayAccessPoint {} = Namespace [] ["PublicRootRelayAccessPoint"] namespaceFor TracePublicRootDomains {} = Namespace [] ["PublicRootDomains"] - namespaceFor TracePublicRootResult {} = Namespace [] ["PublicRootResult"] - namespaceFor TracePublicRootFailure {} = Namespace [] ["PublicRootFailure"] severityFor (Namespace [] ["PublicRootRelayAccessPoint"]) _ = Just Info severityFor (Namespace [] ["PublicRootDomains"]) _ = Just Info @@ -495,9 +503,6 @@ instance LogFormatting (TracePeerSelection Cardano.DebugPeerSelectionState PeerT mconcat [ "kind" .= String "ChurnWait" , "diffTime" .= toJSON dt ] - forMachine _dtal (TraceChurnMode c) = - mconcat [ "kind" .= String "ChurnMode" - , "event" .= show c ] forMachine _dtal (TracePickInboundPeers targetNumberOfKnownPeers numberOfKnownPeers selected available) = mconcat [ "kind" .= String "PickInboundPeers" , "targetKnown" .= targetNumberOfKnownPeers @@ -670,8 +675,6 @@ instance MetaTrace (TracePeerSelection extraDebugState extraFlags extraPeers Soc Namespace [] ["GovernorWakeup"] namespaceFor TraceChurnWait {} = Namespace [] ["ChurnWait"] - namespaceFor TraceChurnMode {} = - Namespace [] ["ChurnMode"] namespaceFor TracePickInboundPeers {} = Namespace [] ["PickInboundPeers"] namespaceFor TraceLedgerStateJudgementChanged {} = @@ -1705,7 +1708,7 @@ instance LogFormatting (InboundGovernor.Trace LocalAddress) where asMetrics _ = [] -forMachineGov :: (ToJSON adr, Show adr) => DetailLevel -> InboundGovernor.Trace adr -> Object +forMachineGov :: (ToJSON adr, Show adr, ToJSONKey adr) => DetailLevel -> InboundGovernor.Trace adr -> Object forMachineGov _dtal (TrNewConnection p connId) = mconcat [ "kind" .= String "NewConnection" , "provenance" .= show p @@ -2001,3 +2004,88 @@ instance MetaTrace NtN.AcceptConnectionsPolicyTrace where , Namespace [] ["ConnectionHardLimit"] , Namespace [] ["ConnectionLimitResume"] ] + +-------------------------------------------------------------------------------- +-- DNSTrace Tracer +-------------------------------------------------------------------------------- + +instance LogFormatting DNSTrace where + forMachine _dtal (DNSLookupResult peerKind domain Nothing results) = + mconcat [ "kind" .= String "DNSLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "results" .= results + ] + forMachine _dtal (DNSLookupResult peerKind domain (Just srv) results) = + mconcat [ "kind" .= String "DNSLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "srv" .= String (pack . show $ srv) + , "results" .= results + ] + forMachine _dtal (DNSLookupError peerKind lookupType domain dnsError) = + mconcat [ "kind" .= String "DNSLookupError" + , "peerKind" .= String (pack . show $ peerKind) + , "lookupKind" .= String (pack . show $ lookupType) + , "domain" .= String (pack . show $ domain) + , "dnsError" .= String (pack . show $ dnsError) + ] + forMachine _dtal (SRVLookupResult peerKind domain results) = + mconcat [ "kind" .= String "SRVLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "results" .= [ (show a, b, c, d, e) + | (a, b, c, d, e) <- results + ] + ] + forMachine _dtal (SRVLookupError peerKind domain) = + mconcat [ "kind" .= String "SRVLookupError" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + ] + +instance MetaTrace DNSTrace where + namespaceFor DNSLookupResult {} = + Namespace [] ["DNSLookupResult"] + namespaceFor DNSLookupError {} = + Namespace [] ["DNSLookupError"] + namespaceFor SRVLookupResult {} = + Namespace [] ["SRVLookupResult"] + namespaceFor SRVLookupError {} = + Namespace [] ["SRVLookupError"] + + severityFor _ (Just DNSLookupResult {}) = Just Info + severityFor _ (Just DNSLookupError {}) = Just Info + severityFor _ (Just SRVLookupResult{}) = Just Info + severityFor _ (Just SRVLookupError{}) = Just Info + severityFor _ Nothing = Nothing + + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["DNSLookupResult"] + , Namespace [] ["DNSLookupError"] + , Namespace [] ["SRVLookupResult"] + , Namespace [] ["SRVLookupError"] + ] + +-------------------------------------------------------------------------------- +-- ChurnMode Tracer +-------------------------------------------------------------------------------- + +instance LogFormatting TraceChurnMode where + forMachine _dtal (TraceChurnMode mode) = + mconcat [ "kind" .= String "ChurnMode" + , "churnMode" .= String (pack . show $ mode) + ] +instance MetaTrace TraceChurnMode where + namespaceFor TraceChurnMode {} = + Namespace [] ["PeerSelection", "ChurnMode"] + severityFor _ (Just TraceChurnMode {}) = Just Info + severityFor _ Nothing = Nothing + + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["PeerSelection", "ChurnMode"] + ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index f12b7de13d0..740cc9fd764 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -266,8 +266,6 @@ instance ( Show (BlockNodeToNodeVersion blk) mconcat [ "kind" .= String "BasicInfoNetwork" , "addresses" .= String (showT niAddresses) , "diffusionMode" .= String (showT niDiffusionMode) - , "dnsProducers" .= String (showT niDnsProducers) - , "ipProducers" .= String (showT niIpProducers) ] forMachine _dtal (BIByron BasicInfoByron {..}) = mconcat [ "kind" .= String "BasicInfoByron" @@ -604,8 +602,6 @@ ppStartupInfoTrace (WarningDevelopmentNodeToClientVersions ntcVersions) = ppStartupInfoTrace (BINetwork BasicInfoNetwork {..}) = "Addresses " <> showT niAddresses <> ", DiffusionMode " <> showT niDiffusionMode - <> ", DnsProducers " <> showT niDnsProducers - <> ", IpProducers " <> showT niIpProducers ppStartupInfoTrace (BIByron BasicInfoByron {..}) = "Era Byron" diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 279c7442400..cc9e6a3f3cb 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -185,6 +186,8 @@ type TracePeerSharingProtocol = ("TracePeerSharingProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) type TraceCsj = ("TraceCsj" :: Symbol) type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol) +type TraceChurnMode = ("TraceChurnMode" :: Symbol) +type TraceDNS = ("TraceDNS" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -261,6 +264,8 @@ data TraceSelection , traceGsm :: OnOff TraceGsm , traceCsj :: OnOff TraceCsj , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch + , traceChurnMode :: OnOff TraceChurnMode + , traceDNS :: OnOff TraceDNS } deriving (Eq, Show) @@ -331,6 +336,8 @@ data PartialTraceSelection , pTraceGsm :: Last (OnOff TraceGsm) , pTraceCsj :: Last (OnOff TraceCsj) , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch) + , pTraceChurnMode :: Last (OnOff TraceChurnMode) + , pTraceDNS :: Last (OnOff TraceDNS) } deriving (Eq, Generic, Show) @@ -402,6 +409,8 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceGsm) v <*> parseTracer (Proxy @TraceCsj) v <*> parseTracer (Proxy @TraceDevotedBlockFetch) v + <*> parseTracer (Proxy @TraceChurnMode) v + <*> parseTracer (Proxy @TraceDNS) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -470,6 +479,8 @@ defaultPartialTraceConfiguration = , pTraceGsm = pure $ OnOff True , pTraceCsj = pure $ OnOff True , pTraceDevotedBlockFetch = pure $ OnOff True + , pTraceChurnMode = pure $ OnOff True + , pTraceDNS = pure $ OnOff True } @@ -540,6 +551,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch + traceChurnMode <- proxyLastToEither (Proxy @TraceChurnMode) pTraceChurnMode + traceDNS <- proxyLastToEither (Proxy @TraceDNS) pTraceDNS Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -603,6 +616,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch + , traceChurnMode + , traceDNS } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -670,6 +685,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch + traceChurnMode <- proxyLastToEither (Proxy @TraceChurnMode) pTraceChurnMode + traceDNS <- proxyLastToEither (Proxy @TraceDNS) pTraceDNS Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -733,6 +750,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch + , traceChurnMode + , traceDNS } proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 5112a7e3891..35ccc9fa59a 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs @@ -12,6 +12,9 @@ module Cardano.Tracing.OrphanInstances.Byron () where import Cardano.Api (textShow) +import Ouroboros.Consensus.Protocol.Abstract (SelectView (..)) +import Ouroboros.Consensus.Protocol.PBFT (PBft, PBftTiebreakerView(..)) +import Ouroboros.Consensus.Block.EBB (fromIsEBB) import Cardano.Chain.Block (ABlockOrBoundaryHdr (..), AHeader (..), ChainValidationError (..), delegationCertificate) import Cardano.Chain.Byron.API (ApplyMempoolPayloadErr (..)) @@ -21,14 +24,12 @@ import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Consensus () import Cardano.Tracing.Render (renderTxId) import Ouroboros.Consensus.Block (Header) -import Ouroboros.Consensus.Block.EBB (fromIsEBB) import Ouroboros.Consensus.Byron.Ledger (ByronBlock (..), ByronNodeToClientVersion (..), ByronNodeToNodeVersion (..), ByronOtherHeaderEnvelopeError (..), TxId (..), byronHeaderRaw) import Ouroboros.Consensus.Byron.Ledger.Inspect (ByronLedgerUpdate (..), ProtocolUpdate (..), UpdateState (..)) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, txId) -import Ouroboros.Consensus.Protocol.PBFT (PBftSelectView (..)) import Ouroboros.Consensus.Util.Condense (condense) import Ouroboros.Network.Block (blockHash, blockNo, blockSlot) @@ -221,10 +222,9 @@ instance ToJSON ByronNodeToNodeVersion where toJSON ByronNodeToNodeVersion1 = String "ByronNodeToNodeVersion1" toJSON ByronNodeToNodeVersion2 = String "ByronNodeToNodeVersion2" -instance ToObject PBftSelectView where - toObject _verb (PBftSelectView blkNo isEBB) = +instance ToObject PBftTiebreakerView where + toObject _verb (PBftTiebreakerView isEBB) = mconcat - [ "kind" .= String "PBftSelectView" - , "blockNo" .= blkNo + [ "kind" .= String "PBftTiebreakerView" , "isEBB" .= fromIsEBB isEBB ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index d75a38541a9..07ceae75929 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -31,7 +31,7 @@ import Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderH renderWithOrigin) import Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge, ConvertRawHash (..), ForgeStateUpdateError, GenesisWindow (..), GetHeader (..), - Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, pointHash, + Header, RealPoint (..), blockNo, blockPoint, blockPrevHash, getHeader, pointHash, realPointHash, realPointSlot, withOriginToMaybe) import Ouroboros.Consensus.Block.SupportsSanityCheck import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), @@ -152,6 +152,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where ChainDB.IgnoreInvalidBlock {} -> Info ChainDB.AddedBlockToQueue {} -> Debug ChainDB.PoppedBlockFromQueue {} -> Debug + ChainDB.PoppingFromQueue {} -> Debug ChainDB.AddedBlockToVolatileDB {} -> Debug ChainDB.TryAddToCurrentChain {} -> Debug ChainDB.TrySwitchToAFork {} -> Info @@ -166,7 +167,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where ChainDB.ValidCandidate {} -> Info ChainDB.UpdateLedgerDbTraceEvent {} -> Debug ChainDB.PipeliningEvent {} -> Debug - ChainDB.AddedReprocessLoEBlocksToQueue -> Debug + ChainDB.AddedReprocessLoEBlocksToQueue {} -> Debug ChainDB.PoppedReprocessLoEBlocksFromQueue -> Debug ChainDB.ChainSelectionLoEDebug _ _ -> Debug @@ -289,14 +290,13 @@ instance HasSeverityAnnotation (TraceChainSyncServerEvent blk) where instance HasPrivacyAnnotation (TraceEventMempool blk) instance HasSeverityAnnotation (TraceEventMempool blk) where getSeverityAnnotation TraceMempoolAddedTx{} = Info + getSeverityAnnotation TraceMempoolTipMovedBetweenSTMBlocks{} = Info getSeverityAnnotation TraceMempoolRejectedTx{} = Info getSeverityAnnotation TraceMempoolRemoveTxs{} = Debug getSeverityAnnotation TraceMempoolManuallyRemovedTxs{} = Warning getSeverityAnnotation TraceMempoolSyncNotNeeded{} = Debug getSeverityAnnotation TraceMempoolSynced{} = Debug getSeverityAnnotation TraceMempoolAttemptingAdd{} = Debug - getSeverityAnnotation TraceMempoolLedgerFound{} = Debug - getSeverityAnnotation TraceMempoolLedgerNotFound{} = Debug instance HasPrivacyAnnotation () instance HasSeverityAnnotation () where @@ -540,19 +540,16 @@ instance ( ConvertRawHash blk "About to add block to queue: " <> renderRealPointAsPhrase pt FallingEdgeWith sz -> "Block added to queue: " <> renderRealPointAsPhrase pt <> " queue size " <> condenseT sz - ChainDB.AddedReprocessLoEBlocksToQueue -> + ChainDB.AddedReprocessLoEBlocksToQueue {} -> "Added request to queue to reprocess blocks postponed by LoE." ChainDB.PoppedReprocessLoEBlocksFromQueue -> "Poppped request from queue to reprocess blocks postponed by LoE." ChainDB.ChainSelectionLoEDebug {} -> "ChainDB LoE debug event" - - ChainDB.PoppedBlockFromQueue edgePt -> - case edgePt of - RisingEdge -> - "Popping block from queue" - FallingEdgeWith pt -> - "Popped block from queue: " <> renderRealPointAsPhrase pt + ChainDB.PoppingFromQueue -> + "Popping block from queue" + ChainDB.PoppedBlockFromQueue pt -> + "Popped block from queue: " <> renderRealPointAsPhrase pt ChainDB.StoreButDontChange pt -> "Ignoring block: " <> renderRealPointAsPhrase pt ChainDB.TryAddToCurrentChain pt -> @@ -947,11 +944,13 @@ instance ( ConvertRawHash blk , case edgeSz of RisingEdge -> "risingEdge" .= True FallingEdgeWith sz -> "queueSize" .= toJSON sz ] - ChainDB.PoppedBlockFromQueue edgePt -> + ChainDB.PoppingFromQueue -> + mconcat [ "kind" .= String "TraceAddBlockEvent.PoppingFromQueue" + ] + ChainDB.PoppedBlockFromQueue pt -> mconcat [ "kind" .= String "TraceAddBlockEvent.PoppedBlockFromQueue" - , case edgePt of - RisingEdge -> "risingEdge" .= True - FallingEdgeWith pt -> "block" .= toObject verb pt ] + , "block" .= toObject verb pt + ] ChainDB.StoreButDontChange pt -> mconcat [ "kind" .= String "TraceAddBlockEvent.StoreButDontChange" , "block" .= toObject verb pt ] @@ -1027,8 +1026,10 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TraceAddBlockEvent.PipeliningEvent.OutdatedTentativeHeader" , "block" .= renderPointForVerbosity verb (blockPoint hdr) ] - ChainDB.AddedReprocessLoEBlocksToQueue -> + ChainDB.AddedReprocessLoEBlocksToQueue RisingEdge -> mconcat [ "kind" .= String "AddedReprocessLoEBlocksToQueue" ] + ChainDB.AddedReprocessLoEBlocksToQueue (FallingEdgeWith _) -> + mconcat [ "kind" .= String "AddedReprocessLoEBlocksToQueue TODO" ] ChainDB.PoppedReprocessLoEBlocksFromQueue -> mconcat [ "kind" .= String "PoppedReprocessLoEBlocksFromQueue" ] ChainDB.ChainSelectionLoEDebug curChain loeFrag -> @@ -1586,15 +1587,10 @@ instance ( ToObject (ApplyTxErr blk), ToObject (GenTx blk), [ "kind" .= String "TraceMempoolAttemptingAdd" , "tx" .= toObject verb tx ] - toObject verb (TraceMempoolLedgerFound p) = - mconcat - [ "kind" .= String "TraceMempoolLedgerFound" - , "tip" .= toObject verb p - ] - toObject verb (TraceMempoolLedgerNotFound p) = + + toObject _verb TraceMempoolTipMovedBetweenSTMBlocks = mconcat - [ "kind" .= String "TraceMempoolLedgerNotFound" - , "tip" .= toObject verb p + [ "kind" .= String "TraceMempoolTipMovedBetweenSTMBlocks" ] instance ToObject MempoolSize where @@ -1788,6 +1784,15 @@ instance ToObject selection => ToObject (TraceGsmEvent selection) where mconcat [ "kind" .= String "GsmEventSyncingToPreSyncing" ] + toObject _verb (GsmEventInitializedInCaughtUp) = + mconcat + [ "kind" .= String "GsmEventInitializedInCaughtUp" + ] + toObject _verb (GsmEventInitializedInPreSyncing) = + mconcat + [ "kind" .= String "GsmEventInitializedInPreSyncing" + ] + instance HasPrivacyAnnotation (TraceGDDEvent peer blk) where instance HasSeverityAnnotation (TraceGDDEvent peer blk) where diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 6b625395fd8..9053e950980 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -22,14 +22,14 @@ import Cardano.Slotting.Slot (EpochSize (..)) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Consensus () import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateInfo, - ForgeStateUpdateError) + ForgeStateUpdateError, BlockSupportsProtocol (tiebreakerView)) import Ouroboros.Consensus.BlockchainTime (getSlotLength) import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraForgeStateInfo (..), - OneEraForgeStateUpdateError (..), OneEraLedgerError (..), - OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraSelectView (..), + OneEraForgeStateUpdateError (..), OneEraLedgerError (..), OneEraTiebreakerView (..), + OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..), mkEraMismatch) import Ouroboros.Consensus.HardFork.Combinator.Condense () import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common @@ -43,9 +43,10 @@ import Ouroboros.Consensus.Ledger.Inspect (LedgerUpdate, LedgerWarning import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr) import Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToClientVersion, BlockNodeToNodeVersion) -import Ouroboros.Consensus.Protocol.Abstract (SelectView, ValidationErr) +import Ouroboros.Consensus.Protocol.Abstract (ValidationErr, SelectView (svTiebreakerView, svBlockNo), ConsensusProtocol (TiebreakerView)) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) +import Ouroboros.Consensus.Cardano (ProtocolByron) import Data.Aeson import qualified Data.ByteString.Base16 as Base16 @@ -431,16 +432,21 @@ instance (ToJSON (BlockNodeToNodeVersion blk)) => ToJSON (WrapNodeToNodeVersion -- instances for HardForkSelectView -- -instance All (ToObject `Compose` WrapSelectView) xs => ToObject (HardForkSelectView xs) where - -- elide BlockNo as it is already contained in every per-era SelectView - toObject verb = toObject verb . dropBlockNo . getHardForkSelectView +instance All (ToObject `Compose` WrapTiebreakerView) xs => ToObject (HardForkTiebreakerView xs) where + toObject verb = toObject verb . getHardForkTiebreakerView -instance All (ToObject `Compose` WrapSelectView) xs => ToObject (OneEraSelectView xs) where +instance ToObject (TiebreakerView protocol) => ToObject (SelectView protocol) where + toObject verb sv = mconcat + [ "blockNo" .= svBlockNo sv + , toObject verb (svTiebreakerView sv) + ] + +instance All (ToObject `Compose` WrapTiebreakerView) xs => ToObject (OneEraTiebreakerView xs) where toObject verb = hcollapse - . hcmap (Proxy @(ToObject `Compose` WrapSelectView)) + . hcmap (Proxy @(ToObject `Compose` WrapTiebreakerView)) (K . toObject verb) - . getOneEraSelectView + . getOneEraTiebreakerView -instance ToObject (SelectView (BlockProtocol blk)) => ToObject (WrapSelectView blk) where - toObject verb = toObject verb . unwrapSelectView +instance ToObject (TiebreakerView (BlockProtocol blk)) => ToObject (WrapTiebreakerView blk) where + toObject verb = toObject verb . unwrapTiebreakerView diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 5451af4ba91..f10b19b6500 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -29,12 +29,12 @@ import Ouroboros.Consensus.Ledger.Query (BlockQuery, Query) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs (..), TxId, txId) import Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize) -import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers(..)) -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable(..)) -import Cardano.Network.Types (LedgerStateJudgement(..)) -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers +import Cardano.Network.Diffusion (CardanoDebugPeerSelection, + CardanoTraceLocalRootPeers, CardanoTracePeerSelection, + CardanoPeerSelectionCounters, TraceChurnMode (..)) +import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano +import qualified Cardano.Network.PeerSelection.ExtraRootPeers as Cardano.PublicRootPeers import qualified Ouroboros.Network.AnchoredFragment as AF import qualified Ouroboros.Network.AnchoredSeq as AS import Ouroboros.Network.Block @@ -46,51 +46,35 @@ import qualified Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.ConnectionManager.Core as ConnMgr (Trace (..)) -import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..), LocalAddr (..)) +import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..)) import Ouroboros.Network.ConnectionManager.State (ConnStateId (..)) -import Ouroboros.Network.ConnectionManager.Types (AbstractState (..), - ConnectionManagerCounters (..), - OperationResult (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnMgr -import qualified Ouroboros.Network.Diffusion.Common as Diffusion +import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSTrace (..)) +import qualified Ouroboros.Network.Diffusion.Types as Diffusion import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) -import Ouroboros.Network.Driver.Limits (ProtocolLimitFailure (..)) import qualified Ouroboros.Network.Driver.Stateful as Stateful -import Ouroboros.Network.ExitPolicy (RepromoteDelay (..)) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import qualified Ouroboros.Network.InboundGovernor.State as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) -import Ouroboros.Network.Magic (NetworkMagic (..)) -import Ouroboros.Network.NodeToClient (NodeToClientVersion (..), - NodeToClientVersionData (..)) +import Ouroboros.Network.NodeToClient (NodeToClientVersion (..)) import qualified Ouroboros.Network.NodeToClient as NtC -import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), NodeToNodeVersion (..), - NodeToNodeVersionData (..), RemoteAddress, TraceSendRecv (..), WithAddr (..)) +import Ouroboros.Network.NodeToNode (NodeToNodeVersion (..), + RemoteAddress, TraceSendRecv (..)) import qualified Ouroboros.Network.NodeToNode as NtN -import Ouroboros.Network.PeerSelection.Governor (AssociationMode (..), DebugPeerSelection (..), +import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (..), DebugPeerSelectionState (..), PeerSelectionCounters, PeerSelectionState (..), PeerSelectionTargets (..), PeerSelectionView (..), TracePeerSelection (..), peerSelectionStateToCounters) import Ouroboros.Network.PeerSelection.LedgerPeers -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerStateActions (PeerSelectionActionsTrace (..)) -import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers) -import qualified Ouroboros.Network.PeerSelection.PublicRootPeers as PublicRootPeers import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers (TraceLocalRootPeers (..)) import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers (TracePublicRootPeers (..)) -import Ouroboros.Network.PeerSelection.State.KnownPeers (KnownPeerInfo (..)) import qualified Ouroboros.Network.PeerSelection.State.KnownPeers as KnownPeers -import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..), - LocalRootPeers, WarmValency (..), LocalRootConfig (..)) -import qualified Ouroboros.Network.PeerSelection.State.LocalRootPeers as LocalRootPeers -import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch, Message (..)) import Ouroboros.Network.Protocol.ChainSync.Type (ChainSync) import qualified Ouroboros.Network.Protocol.ChainSync.Type as ChainSync -import Ouroboros.Network.Protocol.Handshake (HandshakeException (..), - HandshakeProtocolError (..), RefuseReason (..)) import qualified Ouroboros.Network.Protocol.KeepAlive.Type as KA import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery) import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery @@ -98,37 +82,31 @@ import Ouroboros.Network.Protocol.LocalTxMonitor.Type (LocalTxMonitor) import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LocalTxMonitor import Ouroboros.Network.Protocol.LocalTxSubmission.Type (LocalTxSubmission) import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LocalTxSub -import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount (..), - PeerSharingResult (..)) +import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount (..)) import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PeerSharing import Ouroboros.Network.Protocol.TxSubmission2.Type as TxSubmission2 import Ouroboros.Network.RethrowPolicy (ErrorCommand (..)) -import Ouroboros.Network.Server2 as Server +import Ouroboros.Network.Server as Server import Ouroboros.Network.Snocket (LocalAddress (..)) -import Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..), - SubscriberError (..), SubscriptionTrace (..), WithDomainName (..), - WithIPList (..)) import Ouroboros.Network.TxSubmission.Inbound (ProcessedTxCount (..), TraceTxSubmissionInbound (..)) import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound (..)) -import Control.Exception (Exception (..), SomeException (..)) +import Cardano.Network.OrphanInstances () +import Ouroboros.Network.OrphanInstances () + +import Control.Exception (Exception (..)) import Control.Monad.Class.MonadTime.SI (DiffTime, Time (..)) -import Data.Aeson (FromJSON (..), Value (..)) +import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (listValue) -import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (Bifunctor (first)) import Data.Data (Proxy (..)) import Data.Foldable (Foldable (..)) -import Data.Functor.Identity (Identity (..)) import qualified Data.IP as IP import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Text (Text, pack) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import Network.Mux (MiniProtocolNum (..)) import qualified Network.Mux as Mux import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) @@ -259,137 +237,27 @@ instance HasSeverityAnnotation TraceLedgerPeers where NotEnoughLedgerPeers {} -> Warning NotEnoughBigLedgerPeers {} -> Warning TraceLedgerPeersDomains {} -> Debug - TraceLedgerPeersResult {} -> Debug - TraceLedgerPeersFailure {} -> Debug + -- TraceLedgerPeersResult {} -> Debug + -- TraceLedgerPeersFailure {} -> Debug UsingBigLedgerPeerSnapshot {} -> Debug -instance HasPrivacyAnnotation (WithAddr addr ErrorPolicyTrace) -instance HasSeverityAnnotation (WithAddr addr ErrorPolicyTrace) where - getSeverityAnnotation (WithAddr _ ev) = case ev of - ErrorPolicySuspendPeer {} -> Warning -- peer misbehaved - ErrorPolicySuspendConsumer {} -> Notice -- peer temporarily not useful - ErrorPolicyLocalNodeError {} -> Error - ErrorPolicyResumePeer {} -> Debug - ErrorPolicyKeepSuspended {} -> Debug - ErrorPolicyResumeConsumer {} -> Debug - ErrorPolicyResumeProducer {} -> Debug - ErrorPolicyUnhandledApplicationException {} -> Error - ErrorPolicyUnhandledConnectionException {} -> Error - ErrorPolicyAcceptException {} -> Error - - -instance HasPrivacyAnnotation (WithDomainName DnsTrace) -instance HasSeverityAnnotation (WithDomainName DnsTrace) where - getSeverityAnnotation (WithDomainName _ ev) = case ev of - DnsTraceLookupException {} -> Error - DnsTraceLookupAError {} -> Error - DnsTraceLookupAAAAError {} -> Error - DnsTraceLookupIPv6First -> Debug - DnsTraceLookupIPv4First -> Debug - DnsTraceLookupAResult {} -> Debug - DnsTraceLookupAAAAResult {} -> Debug - - -instance HasPrivacyAnnotation (WithDomainName (SubscriptionTrace SockAddr)) -instance HasSeverityAnnotation (WithDomainName (SubscriptionTrace SockAddr)) where - getSeverityAnnotation (WithDomainName _ ev) = case ev 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 - - -instance HasPrivacyAnnotation (WithIPList (SubscriptionTrace SockAddr)) -instance HasSeverityAnnotation (WithIPList (SubscriptionTrace SockAddr)) where - getSeverityAnnotation (WithIPList _ _ ev) = case ev of - SubscriptionTraceConnectStart _ -> Info - SubscriptionTraceConnectEnd _ connectResult -> case connectResult of - ConnectSuccess -> Info - ConnectSuccessLast -> Notice - ConnectValencyExceeded -> Warning - SubscriptionTraceConnectException _ e -> - case fromException $ SomeException e of - Just (_::SubscriberError) -> Debug - Nothing -> Error - SubscriptionTraceSocketAllocationException {} -> Error - SubscriptionTraceTryConnectToPeer {} -> Info - SubscriptionTraceSkippingPeer {} -> Info - SubscriptionTraceSubscriptionRunning -> Debug - SubscriptionTraceSubscriptionWaiting {} -> Debug - SubscriptionTraceSubscriptionFailed -> Error - SubscriptionTraceSubscriptionWaitingNewConnection {} -> Notice - SubscriptionTraceStart {} -> Debug - SubscriptionTraceRestart {} -> Info - SubscriptionTraceConnectionExist {} -> Notice - SubscriptionTraceUnsupportedRemoteAddr {} -> Error - SubscriptionTraceMissingLocalAddress -> Warning - SubscriptionTraceApplicationException _ e -> - case fromException $ SomeException e of - Just (_::SubscriberError) -> Debug - Nothing -> Error - SubscriptionTraceAllocateSocket {} -> Debug - SubscriptionTraceCloseSocket {} -> Info - - -instance HasPrivacyAnnotation (Identity (SubscriptionTrace LocalAddress)) -instance HasSeverityAnnotation (Identity (SubscriptionTrace LocalAddress)) where - getSeverityAnnotation (Identity ev) = case ev of - SubscriptionTraceConnectStart {} -> Notice - SubscriptionTraceConnectEnd {} -> Notice - SubscriptionTraceConnectException {} -> Error - SubscriptionTraceSocketAllocationException {} -> Error - SubscriptionTraceTryConnectToPeer {} -> Notice - SubscriptionTraceSkippingPeer {} -> Info - SubscriptionTraceSubscriptionRunning -> Notice - SubscriptionTraceSubscriptionWaiting {} -> Debug - SubscriptionTraceSubscriptionFailed -> Warning - SubscriptionTraceSubscriptionWaitingNewConnection {} -> Debug - SubscriptionTraceStart {} -> Notice - SubscriptionTraceRestart {} -> Notice - SubscriptionTraceConnectionExist {} -> Debug - SubscriptionTraceUnsupportedRemoteAddr {} -> Warning - SubscriptionTraceMissingLocalAddress -> Warning - SubscriptionTraceApplicationException {} -> Error - SubscriptionTraceAllocateSocket {} -> Debug - SubscriptionTraceCloseSocket {} -> Debug - - -instance Transformable Text IO (Identity (SubscriptionTrace LocalAddress)) where - trTransformer = trStructuredText -instance HasTextFormatter (Identity (SubscriptionTrace LocalAddress)) where - formatText a _ = pack (show a) - - -instance ToObject (Identity (SubscriptionTrace LocalAddress)) where - toObject _verb (Identity ev) = - mconcat [ "kind" .= ("SubscriptionTrace" :: String) - , "event" .= show ev - ] - - instance HasPrivacyAnnotation (Mux.WithBearer peer Mux.Trace) instance HasSeverityAnnotation (Mux.WithBearer peer Mux.Trace) where + getSeverityAnnotation (Mux.WithBearer _ ev) = case ev of + Mux.TraceState {} -> Info + Mux.TraceCleanExit {} -> Notice + Mux.TraceExceptionExit {} -> Notice + Mux.TraceStartEagerly _ _ -> Info + Mux.TraceStartOnDemand _ _ -> Info + Mux.TraceStartedOnDemand _ _ -> Info + Mux.TraceStartOnDemandAny {} -> Info + Mux.TraceTerminating {} -> Debug + Mux.TraceStopping -> Debug + Mux.TraceStopped -> Debug + +instance HasPrivacyAnnotation (Mux.WithBearer peer Mux.BearerTrace) +instance HasSeverityAnnotation (Mux.WithBearer peer Mux.BearerTrace) where getSeverityAnnotation (Mux.WithBearer _ ev) = case ev of Mux.TraceRecvHeaderStart -> Debug Mux.TraceRecvHeaderEnd {} -> Debug @@ -398,41 +266,24 @@ instance HasSeverityAnnotation (Mux.WithBearer peer Mux.Trace) where Mux.TraceRecvEnd {} -> Debug Mux.TraceSendStart {} -> Debug Mux.TraceSendEnd -> Debug - Mux.TraceState {} -> Info - Mux.TraceCleanExit {} -> Notice - Mux.TraceExceptionExit {} -> Notice - Mux.TraceChannelRecvStart {} -> Debug - Mux.TraceChannelRecvEnd {} -> Debug - Mux.TraceChannelSendStart {} -> Debug - Mux.TraceChannelSendEnd {} -> Debug - Mux.TraceHandshakeStart -> Debug - Mux.TraceHandshakeClientEnd {} -> Info - Mux.TraceHandshakeServerEnd -> Debug - Mux.TraceHandshakeClientError {} -> Error - Mux.TraceHandshakeServerError {} -> Error + Mux.TraceEmitDeltaQ -> Debug Mux.TraceRecvDeltaQObservation {} -> Debug Mux.TraceRecvDeltaQSample {} -> Debug Mux.TraceSDUReadTimeoutException -> Notice Mux.TraceSDUWriteTimeoutException -> Notice - Mux.TraceStartEagerly _ _ -> Info - Mux.TraceStartOnDemand _ _ -> Info - Mux.TraceStartedOnDemand _ _ -> Info - Mux.TraceStartOnDemandAny {} -> Info - Mux.TraceTerminating {} -> Debug - Mux.TraceStopping -> Debug - Mux.TraceStopped -> Debug Mux.TraceTCPInfo {} -> Debug -instance HasPrivacyAnnotation (TraceLocalRootPeers extraFlags RemoteAddress exception) -instance HasSeverityAnnotation (TraceLocalRootPeers extraFlags RemoteAddress exception) where + +instance HasPrivacyAnnotation CardanoTraceLocalRootPeers +instance HasSeverityAnnotation CardanoTraceLocalRootPeers where getSeverityAnnotation _ = Info instance HasPrivacyAnnotation TracePublicRootPeers instance HasSeverityAnnotation TracePublicRootPeers where getSeverityAnnotation _ = Info -instance HasPrivacyAnnotation (TracePeerSelection extraDebugState extraFlags (Cardano.PublicRootPeers.ExtraPeers addr) addr) -instance HasSeverityAnnotation (TracePeerSelection extraDebugState extraFlags (Cardano.PublicRootPeers.ExtraPeers addr) addr) where +instance HasPrivacyAnnotation CardanoTracePeerSelection +instance HasSeverityAnnotation CardanoTracePeerSelection where getSeverityAnnotation ev = case ev of TraceLocalRootPeersChanged {} -> Notice @@ -465,7 +316,7 @@ instance HasSeverityAnnotation (TracePeerSelection extraDebugState extraFlags (C TraceDemoteLocalAsynchronous {} -> Warning TraceGovernorWakeup {} -> Info TraceChurnWait {} -> Info - TraceChurnMode {} -> Info + -- TraceChurnMode {} -> Info TraceForgetBigLedgerPeers {} -> Info @@ -508,8 +359,8 @@ instance HasSeverityAnnotation (TracePeerSelection extraDebugState extraFlags (C TraceVerifyPeerSnapshot True -> Info TraceVerifyPeerSnapshot False -> Error -instance HasPrivacyAnnotation (DebugPeerSelection extraState extraFlags (Cardano.PublicRootPeers.ExtraPeers addr) addr) -instance HasSeverityAnnotation (DebugPeerSelection extraState extraFlags (Cardano.PublicRootPeers.ExtraPeers addr) addr) where +instance HasPrivacyAnnotation CardanoDebugPeerSelection +instance HasSeverityAnnotation CardanoDebugPeerSelection where getSeverityAnnotation _ = Debug instance HasPrivacyAnnotation (PeerSelectionActionsTrace SockAddr lAddr) @@ -517,6 +368,7 @@ instance HasSeverityAnnotation (PeerSelectionActionsTrace SockAddr lAddr) where getSeverityAnnotation ev = case ev of PeerStatusChanged {} -> Info + PeerHotDuration {} -> Info PeerStatusChangeFailure {} -> Error PeerMonitoringError {} -> Error PeerMonitoringResult {} -> Debug @@ -739,30 +591,6 @@ instance HasTextFormatter TraceLedgerPeers where formatText _ = pack . show . toList -instance Show addr => Transformable Text IO (WithAddr addr ErrorPolicyTrace) where - trTransformer = trStructuredText -instance Show addr => HasTextFormatter (WithAddr addr ErrorPolicyTrace) where - formatText a _ = pack (show a) - - -instance Transformable Text IO (WithDomainName (SubscriptionTrace SockAddr)) where - trTransformer = trStructuredText -instance HasTextFormatter (WithDomainName (SubscriptionTrace SockAddr)) where - formatText a _ = pack (show a) - - -instance Transformable Text IO (WithDomainName DnsTrace) where - trTransformer = trStructuredText -instance HasTextFormatter (WithDomainName DnsTrace) where - formatText a _ = pack (show a) - - -instance Transformable Text IO (WithIPList (SubscriptionTrace SockAddr)) where - trTransformer = trStructuredText -instance HasTextFormatter (WithIPList (SubscriptionTrace SockAddr)) where - formatText a _ = pack (show a) - - instance (Show peer, ToObject peer) => Transformable Text IO (Mux.WithBearer peer Mux.Trace) where trTransformer = trStructuredText @@ -773,9 +601,9 @@ instance (Show peer) <> " event: " <> pack (show ev) -instance Show exception => Transformable Text IO (TraceLocalRootPeers PeerTrustable RemoteAddress exception) where +instance Transformable Text IO CardanoTraceLocalRootPeers where trTransformer = trStructuredText -instance Show exception => HasTextFormatter (TraceLocalRootPeers PeerTrustable RemoteAddress exception) where +instance HasTextFormatter CardanoTraceLocalRootPeers where formatText a _ = pack (show a) instance Transformable Text IO TracePublicRootPeers where @@ -783,14 +611,14 @@ instance Transformable Text IO TracePublicRootPeers where instance HasTextFormatter TracePublicRootPeers where formatText a _ = pack (show a) -instance Transformable Text IO (TracePeerSelection Cardano.DebugPeerSelectionState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers SockAddr) SockAddr) where +instance Transformable Text IO CardanoTracePeerSelection where trTransformer = trStructuredText -instance (Show extraDebugState, Show extraFlags, Show (Cardano.PublicRootPeers.ExtraPeers addr)) => HasTextFormatter (TracePeerSelection extraDebugState extraFlags (Cardano.PublicRootPeers.ExtraPeers addr) SockAddr) where +instance HasTextFormatter CardanoTracePeerSelection where formatText a _ = pack (show a) -instance Transformable Text IO (DebugPeerSelection Cardano.ExtraState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers SockAddr) SockAddr) where +instance Transformable Text IO CardanoDebugPeerSelection where trTransformer = trStructuredText -instance HasTextFormatter (DebugPeerSelection extraDebugState extraFlags (Cardano.PublicRootPeers.ExtraPeers SockAddr) SockAddr) where +instance HasTextFormatter CardanoDebugPeerSelection where -- One can only change what is logged with respect to verbosity using json -- format. formatText _ obj = pack (show obj) @@ -800,7 +628,7 @@ instance Show lAddr => Transformable Text IO (PeerSelectionActionsTrace SockAddr instance Show lAddr => HasTextFormatter (PeerSelectionActionsTrace SockAddr lAddr) where formatText a _ = pack (show a) -instance (ToJSON addr, Show addr) => Transformable Text IO (PeerSelectionCounters (Cardano.ExtraPeerSelectionSetsWithSizes addr)) where +instance Transformable Text IO CardanoPeerSelectionCounters where trTransformer = trStructuredText instance Show extraCounters => HasTextFormatter (PeerSelectionCounters extraCounters) where formatText a _ = pack (show a) @@ -832,7 +660,7 @@ instance Show addr => HasTextFormatter (Server.Trace addr) where formatText a _ = pack (show a) -instance (ToJSON addr, Show addr) +instance (ToJSON addr, Show addr, Aeson.ToJSONKey addr) => Transformable Text IO (InboundGovernor.Trace addr) where trTransformer = trStructuredText instance Show addr @@ -1143,26 +971,6 @@ instance ToJSON peerAddr => ToObject (AnyMessage (PeerSharing.PeerSharing peerAd ] -instance ToJSON peerAddr => ToJSON (ConnectionId peerAddr) where - toJSON ConnectionId { localAddress, remoteAddress } = - Aeson.object [ "localAddress" .= toJSON localAddress - , "remoteAddress" .= toJSON remoteAddress - ] - -instance Aeson.ToJSON ConnectionManagerCounters where - toJSON ConnectionManagerCounters { fullDuplexConns - , duplexConns - , unidirectionalConns - , inboundConns - , outboundConns - } = - Aeson.object [ "fullDuplex" .= toJSON fullDuplexConns - , "duplex" .= toJSON duplexConns - , "unidirectional" .= toJSON unidirectionalConns - , "inbound" .= inboundConns - , "outbound" .= outboundConns - ] - -- TODO: use 'ToJSON' constraints instance (Show ntnAddr, Show ntcAddr) => ToObject (Diffusion.DiffusionTracer ntnAddr ntcAddr) where toObject _verb (Diffusion.RunServer sockAddr) = mconcat @@ -1247,11 +1055,6 @@ instance ToObject (NtN.HandshakeTr RemoteAddress NodeToNodeVersion) where , "bearer" .= show b , "event" .= show ev ] -instance ToJSON LocalAddress where - toJSON (LocalAddress path) = String (pack path) - -instance Aeson.ToJSONKey LocalAddress where - instance ToObject NtN.AcceptConnectionsPolicyTrace where toObject _verb (NtN.ServerTraceAcceptConnectionRateLimiting delay numOfConnections) = mconcat [ "kind" .= String "ServerTraceAcceptConnectionRateLimiting" @@ -1333,12 +1136,6 @@ instance (ConvertRawHash blk, HasHeader blk) => ToObject (AF.AnchoredFragment bl , "length" .= toJSON (AF.length frag) ] -instance ToJSON PeerGSV where - toJSON PeerGSV { outboundGSV = GSV outboundG _ _ - , inboundGSV = GSV inboundG _ _ - } = - Aeson.object ["G" .= (realToFrac (outboundG + inboundG) :: Double)] - instance (HasHeader header, ConvertRawHash header) => ToObject (TraceFetchClientState header) where toObject _verb BlockFetch.AddedFetchRequest {} = @@ -1395,14 +1192,6 @@ instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where toObject verb (TraceLabelPeer peerid a) = mconcat [ "peer" .= toObject verb peerid ] <> toObject verb a -instance (ToJSON peer, ToJSON point) - => ToJSON (TraceLabelPeer peer (FetchDecision [point])) where - toJSON (TraceLabelPeer peer decision) = - Aeson.object - [ "peer" .= toJSON peer - , "decision" .= toJSON (FetchDecisionToJSON decision) - ] - instance (ToJSON peer, ToJSON (Verbose point)) => ToJSON (Verbose (TraceLabelPeer peer (FetchDecision [point]))) where toJSON (Verbose (TraceLabelPeer peer decision)) = @@ -1472,24 +1261,6 @@ instance ToObject (TraceTxSubmissionInbound txid tx) where , "count" .= toJSON count ] -instance Aeson.ToJSONKey PeerTrustable where - -instance Aeson.ToJSONKey SockAddr where - -instance Aeson.ToJSON SockAddr where - toJSON (SockAddrInet port addr) = - let ip = IP.fromHostAddress addr in - Aeson.object [ "address" .= toJSON ip - , "port" .= show port - ] - toJSON (SockAddrInet6 port _ addr _) = - let ip = IP.fromHostAddress6 addr in - Aeson.object [ "address" .= toJSON ip - , "port" .= show port - ] - toJSON (SockAddrUnix path) = - Aeson.object [ "socketPath" .= show path ] - -- TODO: use the json encoding of transactions instance (Show txid, Show tx) => ToObject (TraceTxSubmissionOutbound txid tx) where @@ -1614,110 +1385,44 @@ instance ToObject TraceLedgerPeers where [ "kind" .= String "TraceLedgerPeersDomains" , "domainAccessPoints" .= daps ] - toObject _verb (TraceLedgerPeersResult dap ips) = - mconcat - [ "kind" .= String "TraceLedgerPeersResult" - , "domainAccessPoint" .= show dap - , "ips" .= map show ips - ] - toObject _verb (TraceLedgerPeersFailure dap reason) = - mconcat - [ "kind" .= String "TraceLedgerPeersFailure" - , "domainAccessPoint" .= show dap - , "error" .= show reason - ] toObject _verb UsingBigLedgerPeerSnapshot = mconcat [ "kind" .= String "UsingBigLedgerPeerSnapshot" ] -instance Show addr => ToObject (WithAddr addr ErrorPolicyTrace) where - toObject _verb (WithAddr addr ev) = - mconcat [ "kind" .= String "ErrorPolicyTrace" - , "address" .= show addr - , "event" .= show ev ] - - -instance ToObject (WithIPList (SubscriptionTrace SockAddr)) where - toObject _verb (WithIPList localAddresses dests ev) = - mconcat [ "kind" .= String "WithIPList SubscriptionTrace" - , "localAddresses" .= show localAddresses - , "dests" .= show dests - , "event" .= show ev ] - - -instance ToObject (WithDomainName DnsTrace) where - toObject _verb (WithDomainName dom ev) = - mconcat [ "kind" .= String "DnsTrace" - , "domain" .= show dom - , "event" .= show ev ] - - -instance ToObject (WithDomainName (SubscriptionTrace SockAddr)) where - toObject _verb (WithDomainName dom ev) = - mconcat [ "kind" .= String "SubscriptionTrace" - , "domain" .= show dom - , "event" .= show ev ] - - instance ToObject peer => ToObject (Mux.WithBearer peer Mux.Trace) where toObject verb (Mux.WithBearer b ev) = mconcat [ "kind" .= String "Mux.Trace" , "bearer" .= toObject verb b , "event" .= show ev ] -instance Aeson.ToJSONKey RelayAccessPoint where - -instance ToJSON HotValency where - toJSON (HotValency v) = toJSON v -instance ToJSON WarmValency where - toJSON (WarmValency v) = toJSON v - -instance FromJSON HotValency where - parseJSON v = HotValency <$> parseJSON v - -instance FromJSON WarmValency where - parseJSON v = WarmValency <$> parseJSON v - -instance ToJSON (LocalRootConfig PeerTrustable) where - toJSON LocalRootConfig { peerAdvertise, - extraFlags = peerTrustable, - diffusionMode } = - Aeson.object - [ "peerAdvertise" .= peerAdvertise - , "diffusionMode" .= show diffusionMode - , "extraFlags" .= show peerTrustable - ] - -instance Show exception => ToObject (TraceLocalRootPeers PeerTrustable RemoteAddress exception) where +instance ToObject CardanoTraceLocalRootPeers where toObject _verb (TraceLocalRootDomains groups) = mconcat [ "kind" .= String "LocalRootDomains" , "localRootDomains" .= toJSON groups ] toObject _verb (TraceLocalRootWaiting d dt) = mconcat [ "kind" .= String "LocalRootWaiting" + -- TODO: `domainAddress` -> `accessPoint` , "domainAddress" .= toJSON d , "diffTime" .= show dt ] - toObject _verb (TraceLocalRootResult d res) = - mconcat [ "kind" .= String "LocalRootResult" - , "domainAddress" .= toJSON d - , "result" .= Aeson.toJSONList res - ] toObject _verb (TraceLocalRootGroups groups) = mconcat [ "kind" .= String "LocalRootGroups" , "localRootGroups" .= toJSON groups ] toObject _verb (TraceLocalRootFailure d dexception) = mconcat [ "kind" .= String "LocalRootFailure" + -- TODO: `domainAddress` -> `accessPoint` , "domainAddress" .= toJSON d - , "reason" .= show dexception + , "reason" .= displayException dexception ] toObject _verb (TraceLocalRootError d dexception) = mconcat [ "kind" .= String "LocalRootError" - , "domainAddress" .= toJSON d - , "reason" .= show dexception + -- TODO: `domainAddress` -> `domain` + , "domainAddress" .= String (pack $ show d) + , "reason" .= displayException dexception ] toObject _verb (TraceLocalRootReconfigured _ _) = mconcat [ "kind" .= String "LocalRootReconfigured" @@ -1728,15 +1433,6 @@ instance Show exception => ToObject (TraceLocalRootPeers PeerTrustable RemoteAdd , "dnsMap" .= dnsMap ] -instance Aeson.ToJSONKey DomainAccessPoint where - toJSONKey = Aeson.toJSONKeyText render - where - render da = mconcat - [ Text.decodeUtf8 (dapDomain da) - , ":" - , Text.pack $ show @Int (fromIntegral (dapPortNumber da)) - ] - instance ToJSON IP where toJSON ip = String (pack . show $ ip) @@ -1749,81 +1445,9 @@ instance ToObject TracePublicRootPeers where mconcat [ "kind" .= String "PublicRootDomains" , "domainAddresses" .= Aeson.toJSONList domains ] - toObject _verb (TracePublicRootResult b res) = - mconcat [ "kind" .= String "PublicRootResult" - , "domain" .= show b - , "result" .= Aeson.toJSONList res - ] - toObject _verb (TracePublicRootFailure b d) = - mconcat [ "kind" .= String "PublicRootFailure" - , "domain" .= show b - , "reason" .= show d - ] - -instance ToJSON KnownPeerInfo where - toJSON (KnownPeerInfo - nKnownPeerFailCount - nKnownPeerTepid - nKnownPeerSharing - nKnownPeerAdvertise - nKnownSuccessfulConnection - ) = - Aeson.object [ "kind" .= String "KnownPeerInfo" - , "failCount" .= nKnownPeerFailCount - , "tepid" .= nKnownPeerTepid - , "peerSharing" .= nKnownPeerSharing - , "peerAdvertise" .= nKnownPeerAdvertise - , "successfulConnection" .= nKnownSuccessfulConnection - ] - -instance ToJSON PeerStatus where - toJSON = String . pack . show - -instance (Aeson.ToJSONKey peerAddr, ToJSON peerAddr, Ord peerAddr, Show peerAddr) - => ToJSON (LocalRootPeers PeerTrustable peerAddr) where - toJSON lrp = - Aeson.object [ "kind" .= String "LocalRootPeers" - , "groups" .= Aeson.toJSONList (LocalRootPeers.toGroups lrp) - ] - -instance ToJSON PeerSelectionTargets where - toJSON (PeerSelectionTargets - nRootPeers - nKnownPeers - nEstablishedPeers - nActivePeers - nKnownBigLedgerPeers - nEstablishedBigLedgerPeers - nActiveBigLedgerPeers - ) = - Aeson.object [ "kind" .= String "PeerSelectionTargets" - , "targetRootPeers" .= nRootPeers - , "targetKnownPeers" .= nKnownPeers - , "targetEstablishedPeers" .= nEstablishedPeers - , "targetActivePeers" .= nActivePeers - - , "targetKnownBigLedgerPeers" .= nKnownBigLedgerPeers - , "targetEstablishedBigLedgerPeers" .= nEstablishedBigLedgerPeers - , "targetActiveBigLedgerPeers" .= nActiveBigLedgerPeers - ] - -instance ToJSON peerAddr => ToJSON (PublicRootPeers (Cardano.PublicRootPeers.ExtraPeers peerAddr) peerAddr) where - toJSON prp = - Aeson.object [ "kind" .= String "PublicRootPeers" - , "bootstrapPeers" .= PublicRootPeers.getBootstrapPeers prp - , "ledgerPeers" .= PublicRootPeers.getLedgerPeers prp - , "bigLedgerPeers" .= PublicRootPeers.getBigLedgerPeers prp - , "publicConfigPeers" .= Map.keysSet (PublicRootPeers.getPublicConfigPeers prp) - ] -instance ToJSON RepromoteDelay where - toJSON = toJSON . repromoteDelay -instance ToJSON addr => ToJSON (PeerSharingResult addr) where - toJSON (PeerSharingResult addrs) = Aeson.toJSONList addrs - toJSON PeerSharingNotRegisteredYet = String "PeerSharingNotRegisteredYet" - -instance ToObject (TracePeerSelection Cardano.DebugPeerSelectionState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers SockAddr) SockAddr) where +instance ToObject CardanoTracePeerSelection where toObject _verb (TraceLocalRootPeersChanged lrp lrp') = mconcat [ "kind" .= String "LocalRootPeersChanged" , "previous" .= toJSON lrp @@ -2096,9 +1720,9 @@ instance ToObject (TracePeerSelection Cardano.DebugPeerSelectionState PeerTrusta mconcat [ "kind" .= String "ChurnWait" , "diffTime" .= toJSON dt ] - toObject _verb (TraceChurnMode c) = - mconcat [ "kind" .= String "ChurnMode" - , "event" .= show c ] + -- toObject _verb (TraceChurnMode c) = + -- mconcat [ "kind" .= String "ChurnMode" + -- , "event" .= show c ] toObject _verb (TracePickInboundPeers targetNumberOfKnownPeers numberOfKnownPeers selected available) = mconcat [ "kind" .= String "PickInboundPeers" , "targetKnown" .= targetNumberOfKnownPeers @@ -2162,45 +1786,6 @@ instance ToObject (TracePeerSelection Cardano.DebugPeerSelectionState PeerTrusta , "associationMode" .= dpssAssociationMode ds ] --- Connection manager abstract state. For explanation of each state see --- -instance Aeson.ToJSON AbstractState where - toJSON UnknownConnectionSt = - Aeson.object [ "kind" .= String "UnknownConnectionSt" ] - toJSON ReservedOutboundSt = - Aeson.object [ "kind" .= String "ReservedOutboundSt" ] - toJSON (UnnegotiatedSt provenance) = - Aeson.object [ "kind" .= String "UnnegotiatedSt" - , "provenance" .= String (pack . show $ provenance) - ] - toJSON (InboundIdleSt dataFlow) = - Aeson.object [ "kind" .= String "InboundIdleSt" - , "dataFlow" .= String (pack . show $ dataFlow) - ] - toJSON (InboundSt dataFlow) = - Aeson.object [ "kind" .= String "InboundSt" - , "dataFlow" .= String (pack . show $ dataFlow) - ] - toJSON OutboundUniSt = - Aeson.object [ "kind" .= String "OutboundUniSt" ] - toJSON (OutboundDupSt timeoutExpired) = - Aeson.object [ "kind" .= String "OutboundDupSt" - , "timeoutState" .= String (pack . show $ timeoutExpired) - ] - toJSON (OutboundIdleSt dataFlow) = - Aeson.object [ "kind" .= String "OutboundIdleSt" - , "dataFlow" .= String (pack . show $ dataFlow) - ] - toJSON DuplexSt = - Aeson.object [ "kind" .= String "DuplexSt" ] - toJSON WaitRemoteIdleSt = - Aeson.object [ "kind" .= String "WaitRemoteIdleSt" ] - toJSON TerminatingSt = - Aeson.object [ "kind" .= String "TerminatingSt" ] - toJSON TerminatedSt = - Aeson.object [ "kind" .= String "TerminatedSt" ] - - peerSelectionTargetsToObject :: PeerSelectionTargets -> Value peerSelectionTargetsToObject PeerSelectionTargets { targetNumberOfRootPeers, @@ -2221,7 +1806,7 @@ peerSelectionTargetsToObject , "activeBigLedgerPeers" .= targetNumberOfActiveBigLedgerPeers ] -instance ToObject (DebugPeerSelection Cardano.ExtraState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers SockAddr) SockAddr) where +instance ToObject CardanoDebugPeerSelection where toObject verb (TraceGovernorState blockedAt wakeupAfter st@PeerSelectionState { targets }) | verb <= NormalVerbosity = @@ -2249,6 +1834,11 @@ instance Show lAddr => ToObject (PeerSelectionActionsTrace SockAddr lAddr) where mconcat [ "kind" .= String "PeerStatusChanged" , "peerStatusChangeType" .= show ps ] + toObject _verb (PeerHotDuration connId dur) = + mconcat [ "kind" .= String "PeerHotDuration" + , "connectionId" .= connId + , "duration" .= show dur + ] toObject _verb (PeerStatusChangeFailure ps f) = mconcat [ "kind" .= String "PeerStatusChangeFailure" , "peerStatusChangeType" .= show ps @@ -2269,7 +1859,7 @@ instance Show lAddr => ToObject (PeerSelectionActionsTrace SockAddr lAddr) where , "error" .= displayException exception ] -instance ToJSON peeraddr => ToObject (PeerSelectionCounters (Cardano.ExtraPeerSelectionSetsWithSizes peeraddr)) where +instance ToObject CardanoPeerSelectionCounters where toObject _verb PeerSelectionCounters {..} = mconcat [ "kind" .= String "PeerSelectionCounters" @@ -2313,99 +1903,6 @@ instance ToJSON peeraddr => ToObject (PeerSelectionCounters (Cardano.ExtraPeerSe , "activeBootstrapPeersDemotions" .= snd (Cardano.viewActiveBootstrapPeersDemotions extraCounters) ] -instance ToJSON ProtocolLimitFailure where - toJSON (ExceededSizeLimit tok) = - Aeson.object [ "kind" .= String "ProtocolLimitFailure" - , "agency" .= show tok - ] - toJSON (ExceededTimeLimit tok) = - Aeson.object [ "kind" .= String "ProtocolLimitFailure" - , "agency" .= show tok - ] - -instance Show vNumber => ToJSON (RefuseReason vNumber) where - toJSON (VersionMismatch vNumber tags) = - Aeson.object [ "kind" .= String "VersionMismatch" - , "versionNumber" .= show vNumber - , "tags" .= Aeson.toJSONList tags - ] - toJSON (HandshakeDecodeError vNumber t) = - Aeson.object [ "kind" .= String "HandshakeDecodeError" - , "versionNumber" .= show vNumber - , "text" .= String (pack $ show t) - ] - toJSON (Refused vNumber t) = - Aeson.object [ "kind" .= String "Refused" - , "versionNumber" .= show vNumber - , "text" .= String (pack $ show t) - ] - -instance Show vNumber => ToJSON (HandshakeProtocolError vNumber) where - toJSON (HandshakeError rvNumber) = - Aeson.object [ "kind" .= String "HandshakeError" - , "reason" .= toJSON rvNumber - ] - toJSON (NotRecognisedVersion vNumber) = - Aeson.object [ "kind" .= String "NotRecognisedVersion" - , "versionNumber" .= show vNumber - ] - toJSON (InvalidServerSelection vNumber t) = - Aeson.object [ "kind" .= String "InvalidServerSelection" - , "versionNumber" .= show vNumber - , "reason" .= String (pack $ show t) - ] - toJSON QueryNotSupported = - Aeson.object [ "kind" .= String "QueryNotSupported" - ] - -instance Show vNumber => ToJSON (HandshakeException vNumber) where - toJSON (HandshakeProtocolLimit plf) = - Aeson.object [ "kind" .= String "HandshakeProtocolLimit" - , "handshakeProtocolLimit" .= toJSON plf - ] - toJSON (HandshakeProtocolError err) = - Aeson.object [ "kind" .= String "HandshakeProtocolError" - , "reason" .= show err - ] - -instance ToJSON NodeToNodeVersion where - toJSON NodeToNodeV_14 = Number 14 - -instance FromJSON NodeToNodeVersion where - parseJSON (Number 14) = return NodeToNodeV_14 - parseJSON (Number x) = fail ("FromJSON.NodeToNodeVersion: unsupported node-to-node protocol version " ++ show x) - parseJSON x = fail ("FromJSON.NodeToNodeVersion: error parsing NodeToNodeVersion: " ++ show x) - -instance ToJSON NodeToClientVersion where - toJSON NodeToClientV_16 = Number 16 - toJSON NodeToClientV_17 = Number 17 - toJSON NodeToClientV_18 = Number 18 - toJSON NodeToClientV_19 = Number 19 - toJSON NodeToClientV_20 = Number 20 - -- NB: When adding a new version here, update FromJSON below as well! - -instance FromJSON NodeToClientVersion where - parseJSON (Number 16) = return NodeToClientV_16 - parseJSON (Number 17) = return NodeToClientV_17 - parseJSON (Number 18) = return NodeToClientV_18 - parseJSON (Number 19) = return NodeToClientV_19 - parseJSON (Number x) = fail ("FromJSON.NodeToClientVersion: unsupported node-to-client protocol version " ++ show x) - parseJSON x = fail ("FromJSON.NodeToClientVersion: error parsing NodeToClientVersion: " ++ show x) - -instance ToJSON NodeToNodeVersionData where - toJSON (NodeToNodeVersionData (NetworkMagic m) dm ps q) = - Aeson.object [ "networkMagic" .= toJSON m - , "diffusionMode" .= show dm - , "peerSharing" .= show ps - , "query" .= toJSON q - ] - -instance ToJSON NodeToClientVersionData where - toJSON (NodeToClientVersionData (NetworkMagic m) q) = - Aeson.object [ "networkMagic" .= toJSON m - , "query" .= toJSON q - ] - instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) => ToObject (ConnectionHandlerTrace versionNumber agreedOptions) where toObject _verb (TrHandshakeSuccess versionNumber agreedOptions) = @@ -2440,16 +1937,6 @@ instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) , "command" .= show cerr ] -instance ToJSON addr => ToJSON (LocalAddr addr) where - toJSON (LocalAddr addr) = toJSON addr - toJSON UnknownLocalAddr = Null - -instance ToJSON NtN.DiffusionMode where - toJSON = String . pack . show - -instance ToJSON ConnStateId where - toJSON (ConnStateId connStateId) = toJSON connStateId - instance ToObject ConnStateId where toObject _ connStateId = mconcat [ "connStateId" .= toJSON connStateId ] @@ -2596,22 +2083,6 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, , "info" .= String (pack . show $ info) ] -instance ToJSON state => ToJSON (ConnMgr.MaybeUnknown state) where - toJSON (ConnMgr.Known st) = - Aeson.object - [ "state" .= toJSON st - , "type" .= String "known" - ] - toJSON (ConnMgr.Race st) = - Aeson.object - [ "state" .= toJSON st - , "type" .= String "race" - ] - toJSON ConnMgr.Unknown = - Aeson.object - [ "type" .= String "unknown" ] - - instance (Show addr, ToObject addr, ToJSON addr) => ToObject (ConnMgr.AbstractTransitionTrace addr) where toObject _verb (ConnMgr.TransitionTrace addr tr) = @@ -2647,31 +2118,6 @@ instance (Show addr, ToObject addr, ToJSON addr) , "reason" .= show exception ] -instance ToJSON MiniProtocolNum where - toJSON (MiniProtocolNum w) = - Aeson.object [ "kind" .= String "MiniProtocolNum" - , "num" .= w - ] - -instance ToJSON addr => ToJSON (OperationResult addr) where - toJSON (UnsupportedState as) = - Aeson.object [ "kind" .= String "UnsupportedState" - , "unsupportedState" .= toJSON as - ] - toJSON (OperationSuccess addr) = - Aeson.object [ "kind" .= String "OperationSuccess" - , "operationSuccess" .= toJSON addr - ] - toJSON (TerminatedConnection as) = - Aeson.object [ "kind" .= String "TerminatedConnection" - , "terminatedConnection" .= toJSON as - ] - -instance ToJSON RemoteSt where - toJSON = String . pack . show - -instance ToJSON addr => Aeson.ToJSONKey (ConnectionId addr) where - instance ToObject NtN.RemoteAddress where toObject _verb (SockAddrInet port addr) = let ip = IP.fromHostAddress addr in @@ -2704,7 +2150,7 @@ instance ToObject NtC.LocalConnectionId where mconcat [ "local" .= toObject verb l , "remote" .= toObject verb r ] -instance (ToJSON addr, Show addr) +instance (ToJSON addr, Show addr, Aeson.ToJSONKey addr) => ToObject (InboundGovernor.Trace addr) where toObject _verb (InboundGovernor.TrNewConnection p connId) = mconcat [ "kind" .= String "NewConnection" @@ -2808,60 +2254,57 @@ instance ToJSON addr , "to" .= toJSON (ConnMgr.toState tr) ] -instance FromJSON PeerSharing where - parseJSON = Aeson.withBool "PeerSharing" $ \b -> - pure $ if b then PeerSharingEnabled - else PeerSharingDisabled - -instance ToJSON PeerSharing where - toJSON PeerSharingEnabled = Bool True - toJSON PeerSharingDisabled = Bool False - -instance FromJSON UseLedgerPeers where - parseJSON (Number slot) = return $ - case compare slot 0 of - GT -> UseLedgerPeers (After (SlotNo (floor slot))) - EQ -> UseLedgerPeers Always - LT -> DontUseLedgerPeers - parseJSON invalid = fail $ "Parsing of slot number failed due to type mismatch. " - <> "Encountered: " <> show invalid - -instance ToJSON LedgerStateJudgement where - toJSON YoungEnough = String "YoungEnough" - toJSON TooOld = String "TooOld" - -instance FromJSON LedgerStateJudgement where - parseJSON (String "YoungEnough") = pure YoungEnough - parseJSON (String "TooOld") = pure TooOld - parseJSON _ = fail "Invalid JSON for LedgerStateJudgement" - -instance ToJSON AssociationMode where - toJSON LocalRootsOnly = String "LocalRootsOnly" - toJSON Unrestricted = String "Unrestricted" - -instance FromJSON AssociationMode where - parseJSON (String "LocalRootsOnly") = pure LocalRootsOnly - parseJSON (String "Unrestricted") = pure Unrestricted - parseJSON _ = fail "Invalid JSON for AssociationMode" - -instance ToJSON UseLedgerPeers where - toJSON DontUseLedgerPeers = Number (-1) - toJSON (UseLedgerPeers Always) = Number 0 - toJSON (UseLedgerPeers (After (SlotNo s))) = Number (fromIntegral s) - -instance ToJSON UseBootstrapPeers where - toJSON DontUseBootstrapPeers = Null - toJSON (UseBootstrapPeers dps) = toJSON dps - -instance FromJSON UseBootstrapPeers where - parseJSON Null = pure DontUseBootstrapPeers - parseJSON v = UseBootstrapPeers <$> parseJSON v - -instance FromJSON PeerTrustable where - parseJSON = Aeson.withBool "PeerTrustable" $ \b -> - pure $ if b then IsTrustable - else IsNotTrustable - -instance ToJSON PeerTrustable where - toJSON IsTrustable = Bool True - toJSON IsNotTrustable = Bool False +instance HasPrivacyAnnotation TraceChurnMode where +instance HasSeverityAnnotation TraceChurnMode where + getSeverityAnnotation TraceChurnMode {} = Info +instance Transformable Text IO TraceChurnMode where + trTransformer = trStructuredText +instance HasTextFormatter TraceChurnMode where + formatText a _ = pack (show a) +instance ToObject TraceChurnMode where + toObject _verb (TraceChurnMode churnMode) = + mconcat [ "kind" .= String "ChurnMode" + , "churnMode" .= String (pack . show $ churnMode) + ] + +instance HasPrivacyAnnotation DNSTrace where +instance HasSeverityAnnotation DNSTrace where + getSeverityAnnotation _ = Info +instance Transformable Text IO DNSTrace where + trTransformer = trStructuredText +instance HasTextFormatter DNSTrace where + formatText a _ = pack (show a) +instance ToObject DNSTrace where + toObject _verb (DNSLookupResult peerKind domain Nothing results) = + mconcat [ "kind" .= String "DNSLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "results" .= results + ] + toObject _verb (DNSLookupResult peerKind domain (Just srv) results) = + mconcat [ "kind" .= String "DNSLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "srv" .= String (pack . show $ srv) + , "results" .= results + ] + toObject _verb (DNSLookupError peerKind lookupType domain dnsError) = + mconcat [ "kind" .= String "DNSLookupError" + , "peerKind" .= String (pack . show $ peerKind) + , "lookupKind" .= String (pack . show $ lookupType) + , "domain" .= String (pack . show $ domain) + , "dnsError" .= String (pack . show $ dnsError) + ] + toObject _verb (SRVLookupResult peerKind domain results) = + mconcat [ "kind" .= String "SRVLookupResult" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + , "results" .= [ (show a, b, c, d, e) + | (a, b, c, d, e) <- results + ] + ] + toObject _verb (SRVLookupError peerKind domain) = + mconcat [ "kind" .= String "SRVLookupError" + , "peerKind" .= String (pack . show $ peerKind) + , "domain" .= String (pack . show $ domain) + ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 19539f9807e..6a9c9e37656 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -23,7 +23,6 @@ import Cardano.Api (textShow) import qualified Cardano.Api as Api import qualified Cardano.Crypto.Hash.Class as Crypto -import qualified Cardano.Crypto.VRF.Class as Crypto import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure) import qualified Cardano.Ledger.Allegra.Rules as Allegra import qualified Cardano.Ledger.Alonzo.Plutus.Evaluate as Alonzo @@ -64,7 +63,6 @@ import Ouroboros.Consensus.Ledger.SupportsMempool (txId) import qualified Ouroboros.Consensus.Ledger.SupportsMempool as SupportsMempool import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import qualified Ouroboros.Consensus.Protocol.Praos as Praos -import Ouroboros.Consensus.Protocol.Praos.Common (PraosChainSelectView (..)) import Ouroboros.Consensus.Protocol.TPraos (TPraosCannotForge (..)) import Ouroboros.Consensus.Shelley.Ledger hiding (TxId) import Ouroboros.Consensus.Shelley.Ledger.Inspect @@ -75,13 +73,11 @@ import Ouroboros.Network.Point (WithOrigin, withOriginToMaybe) import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Base16 as B16 import qualified Data.List.NonEmpty as NonEmpty import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text {- HLINT ignore "Use :" -} @@ -424,13 +420,18 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe mconcat [ "kind" .= String "TreasuryWithdrawalReturnAccountsDoNotExist" , "invalidAccounts" .= accounts ] + toObject _ (Conway.UnelectedCommitteeVoters creds) = + mconcat [ "kind" .= String "UnelectedCommitteeVoters" + , "unelectedCommitteeVoters" .= creds + ] + instance ( ToObject (PredicateFailure (Ledger.EraRule "CERT" era)) ) => ToObject (Conway.ConwayCertsPredFailure era) where toObject verb = \case Conway.WithdrawalsNotInRewardsCERTS incorrectWithdrawals -> - mconcat [ "kind" .= String "WithdrawalsNotInRewardsCERTS" , "incorrectWithdrawals" .= incorrectWithdrawals ] + mconcat [ "kind" .= String "WithdrawalsNotInRewardsCERTS" , "incorrectWithdrawals" .= unWithdrawals incorrectWithdrawals ] Conway.CertFailure f -> toObject verb f @@ -461,10 +462,6 @@ instance , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] - toObject _ (MissingRequiredSigners missingKeyWitnesses) = - mconcat [ "kind" .= String "MissingRequiredSigners" - , "witnesses" .= Set.toList missingKeyWitnesses - ] toObject _ (UnspendableUTxONoDatumHash txins) = mconcat [ "kind" .= String "MissingRequiredSigners" , "txins" .= Set.toList txins @@ -695,7 +692,7 @@ instance ] toObject _verb (WithdrawalsNotInRewardsDELEGS incorrectWithdrawals) = mconcat [ "kind" .= String "WithdrawalsNotInRewardsCERTS" - , "incorrectWithdrawals" .= incorrectWithdrawals + , "incorrectWithdrawals" .= unWithdrawals incorrectWithdrawals ] toObject verb (DelplFailure f) = toObject verb f @@ -859,9 +856,6 @@ instance ) => ToObject (ShelleyNewEpochPredFailure ledgerera) where toObject verb (EpochFailure f) = toObject verb f toObject verb (MirFailure f) = toObject verb f - toObject _verb (CorruptRewardUpdate update) = - mconcat [ "kind" .= String "CorruptRewardUpdate" - , "update" .= String (textShow update) ] instance @@ -1326,24 +1320,8 @@ instance ToJSON ShelleyNodeToClientVersion where toJSON ShelleyNodeToClientVersion10 = String "ShelleyNodeToClientVersion10" toJSON ShelleyNodeToClientVersion11 = String "ShelleyNodeToClientVersion11" toJSON ShelleyNodeToClientVersion12 = String "ShelleyNodeToClientVersion12" - -instance Core.Crypto c => ToObject (PraosChainSelectView c) where - toObject _ PraosChainSelectView { - csvChainLength - , csvSlotNo - , csvIssuer - , csvIssueNo - , csvTieBreakVRF - } = - mconcat [ "kind" .= String "PraosChainSelectView" - , "chainLength" .= csvChainLength - , "slotNo" .= csvSlotNo - , "issuerHash" .= hashKey csvIssuer - , "issueNo" .= csvIssueNo - , "tieBreakVRF" .= renderVRF csvTieBreakVRF - ] - where - renderVRF = Text.decodeUtf8 . B16.encode . Crypto.getOutputVRFBytes + toJSON ShelleyNodeToClientVersion13 = String "ShelleyNodeToClientVersion13" + toJSON ShelleyNodeToClientVersion14 = String "ShelleyNodeToClientVersion14" -------------------------------------------------------------------------------- -- Conway related diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 62bb30a4e3d..549735a61f5 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -25,8 +25,7 @@ module Cardano.Tracing.Tracers ( Tracers (..) , TraceOptions , mkTracers - , nullTracersP2P - , nullTracersNonP2P + , nullDiffusionTracers , traceCounter ) where @@ -45,6 +44,7 @@ import qualified Cardano.Node.STM as STM import Cardano.Node.TraceConstraints import Cardano.Node.Tracing import Cardano.Node.Tracing.Tracers.NodeVersion +import Cardano.Network.Diffusion (CardanoPeerSelectionCounters) import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (..)) import Cardano.Tracing.Config @@ -72,7 +72,6 @@ import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server import Ouroboros.Consensus.MiniProtocol.ChainSync.Server import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode -import Ouroboros.Consensus.Node (NetworkP2PMode (..)) import qualified Ouroboros.Consensus.Node.Run as Consensus (RunNode) import qualified Ouroboros.Consensus.Node.Tracers as Consensus import Ouroboros.Consensus.Protocol.Abstract (SelectView, ValidationErr) @@ -81,10 +80,8 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import Ouroboros.Consensus.Util.Enclose -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable) -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers +import qualified Cardano.Network.Diffusion.Types as Cardano.Diffusion +import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), HasHeader (..), Point, @@ -97,9 +94,6 @@ import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..)) import qualified Ouroboros.Network.Diffusion as Diffusion -import qualified Ouroboros.Network.Diffusion.Common as Diffusion -import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P -import qualified Ouroboros.Network.Diffusion.P2P as P2P import qualified Ouroboros.Network.Driver.Stateful as Stateful import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.InboundGovernor.State as InboundGovernor @@ -107,7 +101,7 @@ import Ouroboros.Network.NodeToClient (LocalAddress) import Ouroboros.Network.NodeToNode (RemoteAddress) import Ouroboros.Network.PeerSelection.Churn (ChurnCounters (..)) import Ouroboros.Network.PeerSelection.Governor ( - PeerSelectionCounters, PeerSelectionView (..)) + PeerSelectionView (..)) import qualified Ouroboros.Network.PeerSelection.Governor as Governor import Ouroboros.Network.Point (fromWithOrigin) import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery, ShowQuery) @@ -166,43 +160,8 @@ data ForgeTracers = ForgeTracers , ftTraceAdoptionThreadDied :: Trace IO Text } -nullTracersP2P :: Applicative m => Tracers peer localPeer blk 'Diffusion.P2P extraState extraDebugState extraFlags extraPeers extraCounters m -nullTracersP2P = Tracers - { chainDBTracer = nullTracer - , consensusTracers = Consensus.nullTracers - , nodeToClientTracers = NodeToClient.nullTracers - , nodeToNodeTracers = NodeToNode.nullTracers - , diffusionTracers = Diffusion.nullTracers - , diffusionTracersExtra = Diffusion.P2PTracers P2P.nullTracersExtra - , startupTracer = nullTracer - , shutdownTracer = nullTracer - , nodeInfoTracer = nullTracer - , nodeStartupInfoTracer = nullTracer - , nodeStateTracer = nullTracer - , nodeVersionTracer = nullTracer - , resourcesTracer = nullTracer - , peersTracer = nullTracer - , ledgerMetricsTracer = nullTracer - } - -nullTracersNonP2P :: Tracers peer localPeer blk 'Diffusion.NonP2P extraState extraDebugState extraFlags extraPeers extraCounters m -nullTracersNonP2P = Tracers - { chainDBTracer = nullTracer - , consensusTracers = Consensus.nullTracers - , nodeToClientTracers = NodeToClient.nullTracers - , nodeToNodeTracers = NodeToNode.nullTracers - , diffusionTracers = Diffusion.nullTracers - , diffusionTracersExtra = Diffusion.NonP2PTracers NonP2P.nullTracers - , startupTracer = nullTracer - , shutdownTracer = nullTracer - , nodeInfoTracer = nullTracer - , nodeStartupInfoTracer = nullTracer - , nodeStateTracer = nullTracer - , nodeVersionTracer = nullTracer - , resourcesTracer = nullTracer - , peersTracer = nullTracer - , ledgerMetricsTracer = nullTracer - } +nullDiffusionTracers :: Applicative m => Cardano.Diffusion.CardanoTracers m +nullDiffusionTracers = Cardano.Diffusion.nullTracers indexGCType :: ChainDB.TraceGCEvent a -> Int indexGCType ChainDB.ScheduledGC{} = 1 @@ -342,7 +301,7 @@ instance (StandardHash header, Eq peer) => ElidingTracer -- | Tracers for all system components. -- mkTracers - :: forall blk p2p . + :: forall blk. ( Consensus.RunNode blk , TraceConstraints blk ) @@ -351,20 +310,12 @@ mkTracers -> Trace IO Text -> NodeKernelData blk -> Maybe EKGDirect - -> NetworkP2PMode p2p - -> IO (Tracers RemoteAddress - LocalAddress - blk p2p - Cardano.ExtraState - Cardano.DebugPeerSelectionState - PeerTrustable - (Cardano.PublicRootPeers.ExtraPeers RemoteAddress) - (Cardano.ExtraPeerSelectionSetsWithSizes RemoteAddress) - IO) -mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enableP2P = do + -> IO (Tracers RemoteAddress LocalAddress blk IO) +mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect = do fStats <- mkForgingStats consensusTracers <- mkConsensusTracers ekgDirect trSel verb tr nodeKern fStats elidedChainDB <- newstate -- for eliding messages in ChainDB tracer + let churnModeTracer = tracerOnOff (traceChurnMode trSel) verb "Churn" tr tForks <- STM.newTVarIO 0 pure Tracers @@ -381,7 +332,7 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable , nodeToClientTracers = nodeToClientTracers' trSel verb tr , nodeToNodeTracers = nodeToNodeTracers' trSel verb tr , diffusionTracers - , diffusionTracersExtra = diffusionTracersExtra' enableP2P + , churnModeTracer -- TODO: startupTracer should ignore severity level (i.e. it should always -- be printed)! , startupTracer = toLogObject' verb (appendName "startup" tr) @@ -422,95 +373,78 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable (getCardanoBuildInfo ev) Nothing -> pure () - diffusionTracers = Diffusion.Tracers + diffusionTracers :: Cardano.Diffusion.CardanoTracers IO + diffusionTracers = Cardano.Diffusion.Tracers { Diffusion.dtMuxTracer = muxTracer , Diffusion.dtHandshakeTracer = handshakeTracer , Diffusion.dtLocalMuxTracer = localMuxTracer , Diffusion.dtLocalHandshakeTracer = localHandshakeTracer , Diffusion.dtDiffusionTracer = initializationTracer + , Diffusion.dtTraceLocalRootPeersTracer = + tracerOnOff (traceLocalRootPeers trSel) + verb "LocalRootPeers" tr + , Diffusion.dtTracePublicRootPeersTracer = + tracerOnOff (tracePublicRootPeers trSel) + verb "PublicRootPeers" tr + , Diffusion.dtTracePeerSelectionTracer = + tracerOnOff (tracePeerSelection trSel) + verb "PeerSelection" tr + <> tracePeerSelectionTracerMetrics + (tracePeerSelection trSel) + ekgDirect + , Diffusion.dtTraceChurnCounters = + traceChurnCountersMetrics + ekgDirect + , Diffusion.dtDebugPeerSelectionInitiatorTracer = + tracerOnOff (traceDebugPeerSelectionInitiatorTracer trSel) + verb "DebugPeerSelection" tr + , Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = + tracerOnOff (traceDebugPeerSelectionInitiatorResponderTracer trSel) + verb "DebugPeerSelection" tr + , Diffusion.dtTracePeerSelectionCounters = + tracePeerSelectionCountersMetrics + (tracePeerSelectionCounters trSel) + ekgDirect + <> tracerOnOff (tracePeerSelectionCounters trSel) + verb "PeerSelectionCounters" tr + , Diffusion.dtPeerSelectionActionsTracer = + tracerOnOff (tracePeerSelectionActions trSel) + verb "PeerSelectionActions" tr + , Diffusion.dtConnectionManagerTracer = + traceConnectionManagerTraceMetrics + (traceConnectionManagerCounters trSel) + ekgDirect + <> tracerOnOff (traceConnectionManager trSel) + verb "ConnectionManager" tr + , Diffusion.dtConnectionManagerTransitionTracer = + tracerOnOff (traceConnectionManagerTransitions trSel) + verb "ConnectionManagerTransition" tr + , Diffusion.dtServerTracer = + tracerOnOff (traceServer trSel) verb "Server" tr + , Diffusion.dtInboundGovernorTracer = + traceInboundGovernorCountersMetrics + (traceInboundGovernorCounters trSel) + ekgDirect + <> tracerOnOff (traceInboundGovernor trSel) + verb "InboundGovernor" tr + , Diffusion.dtInboundGovernorTransitionTracer = + tracerOnOff (traceInboundGovernorTransitions trSel) + verb "InboundGovernorTransition" tr + , Diffusion.dtLocalConnectionManagerTracer = + tracerOnOff (traceLocalConnectionManager trSel) + verb "LocalConnectionManager" tr + , Diffusion.dtLocalServerTracer = + tracerOnOff (traceLocalServer trSel) + verb "LocalServer" tr + , Diffusion.dtLocalInboundGovernorTracer = + tracerOnOff (traceLocalInboundGovernor trSel) + verb "LocalInboundGovernor" tr + , Diffusion.dtTraceLedgerPeersTracer = + tracerOnOff (traceLedgerPeers trSel) + verb "LedgerPeers" tr + , Diffusion.dtDnsTracer = + tracerOnOff (traceDNS trSel) verb "DNS" tr } - diffusionTracersExtra' enP2P = - case enP2P of - EnabledP2PMode -> - Diffusion.P2PTracers P2P.TracersExtra - { P2P.dtTraceLocalRootPeersTracer = - tracerOnOff (traceLocalRootPeers trSel) - verb "LocalRootPeers" tr - , P2P.dtTracePublicRootPeersTracer = - tracerOnOff (tracePublicRootPeers trSel) - verb "PublicRootPeers" tr - , P2P.dtTracePeerSelectionTracer = - tracerOnOff (tracePeerSelection trSel) - verb "PeerSelection" tr - <> tracePeerSelectionTracerMetrics - (tracePeerSelection trSel) - ekgDirect - , P2P.dtTraceChurnCounters = - traceChurnCountersMetrics - ekgDirect - , P2P.dtDebugPeerSelectionInitiatorTracer = - tracerOnOff (traceDebugPeerSelectionInitiatorTracer trSel) - verb "DebugPeerSelection" tr - , P2P.dtDebugPeerSelectionInitiatorResponderTracer = - tracerOnOff (traceDebugPeerSelectionInitiatorResponderTracer trSel) - verb "DebugPeerSelection" tr - , P2P.dtTracePeerSelectionCounters = - tracePeerSelectionCountersMetrics - (tracePeerSelectionCounters trSel) - ekgDirect - <> tracerOnOff (tracePeerSelectionCounters trSel) - verb "PeerSelectionCounters" tr - , P2P.dtPeerSelectionActionsTracer = - tracerOnOff (tracePeerSelectionActions trSel) - verb "PeerSelectionActions" tr - , P2P.dtConnectionManagerTracer = - traceConnectionManagerTraceMetrics - (traceConnectionManagerCounters trSel) - ekgDirect - <> tracerOnOff (traceConnectionManager trSel) - verb "ConnectionManager" tr - , P2P.dtConnectionManagerTransitionTracer = - tracerOnOff (traceConnectionManagerTransitions trSel) - verb "ConnectionManagerTransition" tr - , P2P.dtServerTracer = - tracerOnOff (traceServer trSel) verb "Server" tr - , P2P.dtInboundGovernorTracer = - traceInboundGovernorCountersMetrics - (traceInboundGovernorCounters trSel) - ekgDirect - <> tracerOnOff (traceInboundGovernor trSel) - verb "InboundGovernor" tr - , P2P.dtInboundGovernorTransitionTracer = - tracerOnOff (traceInboundGovernorTransitions trSel) - verb "InboundGovernorTransition" tr - , P2P.dtLocalConnectionManagerTracer = - tracerOnOff (traceLocalConnectionManager trSel) - verb "LocalConnectionManager" tr - , P2P.dtLocalServerTracer = - tracerOnOff (traceLocalServer trSel) - verb "LocalServer" tr - , P2P.dtLocalInboundGovernorTracer = - tracerOnOff (traceLocalInboundGovernor trSel) - verb "LocalInboundGovernor" tr - , P2P.dtTraceLedgerPeersTracer = - tracerOnOff (traceLedgerPeers trSel) - verb "LedgerPeers" tr - } - DisabledP2PMode -> - Diffusion.NonP2PTracers NonP2P.TracersExtra - { NonP2P.dtIpSubscriptionTracer = - tracerOnOff (traceIpSubscription trSel) verb "IpSubscription" tr - , NonP2P.dtDnsSubscriptionTracer = - tracerOnOff (traceDnsSubscription trSel) verb "DnsSubscription" tr - , NonP2P.dtDnsResolverTracer = - tracerOnOff (traceDnsResolver trSel) verb "DnsResolver" tr - , NonP2P.dtErrorPolicyTracer = - tracerOnOff (traceErrorPolicy trSel) verb "ErrorPolicy" tr - , NonP2P.dtLocalErrorPolicyTracer = - tracerOnOff (traceLocalErrorPolicy trSel) verb "LocalErrorPolicy" tr - , NonP2P.dtAcceptPolicyTracer = - tracerOnOff (traceAcceptPolicy trSel) verb "AcceptPolicy" tr - } verb :: TracingVerbosity verb = traceVerbosity trSel muxTracer = @@ -525,7 +459,7 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable tracerOnOff (traceDiffusionInitialization trSel) verb "DiffusionInitializationTracer" tr -mkTracers _ _ _ _ _ enableP2P = +mkTracers _ _ _ _ _ = pure Tracers { chainDBTracer = nullTracer , consensusTracers = Consensus.Tracers @@ -566,10 +500,7 @@ mkTracers _ _ _ _ _ enableP2P = , NodeToNode.tPeerSharingTracer = nullTracer } , diffusionTracers = Diffusion.nullTracers - , diffusionTracersExtra = - case enableP2P of - EnabledP2PMode -> Diffusion.P2PTracers P2P.nullTracersExtra - DisabledP2PMode -> Diffusion.NonP2PTracers NonP2P.nullTracers + , churnModeTracer = nullTracer , startupTracer = nullTracer , shutdownTracer = nullTracer , nodeInfoTracer = nullTracer @@ -1616,12 +1547,12 @@ tracePeerSelectionTracerMetrics (OnOff True) (Just ekgDirect) = pstTracer tracePeerSelectionCountersMetrics :: OnOff TracePeerSelectionCounters -> Maybe EKGDirect - -> Tracer IO (PeerSelectionCounters (Cardano.ExtraPeerSelectionSetsWithSizes addr)) + -> Tracer IO CardanoPeerSelectionCounters tracePeerSelectionCountersMetrics _ Nothing = nullTracer tracePeerSelectionCountersMetrics (OnOff False) _ = nullTracer tracePeerSelectionCountersMetrics (OnOff True) (Just ekgDirect) = pscTracer where - pscTracer :: Tracer IO (PeerSelectionCounters (Cardano.ExtraPeerSelectionSetsWithSizes addr)) + pscTracer :: Tracer IO CardanoPeerSelectionCounters pscTracer = Tracer $ \psc -> do let PeerSelectionCountersHWC {..} = psc -- Deprecated counters; they will be removed in a future version diff --git a/cardano-node/test/Test/Cardano/Node/Gen.hs b/cardano-node/test/Test/Cardano/Node/Gen.hs index f042fc74206..4468bb47991 100644 --- a/cardano-node/test/Test/Cardano/Node/Gen.hs +++ b/cardano-node/test/Test/Cardano/Node/Gen.hs @@ -32,8 +32,7 @@ import Cardano.Slotting.Slot (SlotNo (..)) import Ouroboros.Network.NodeToNode.Version import Ouroboros.Network.PeerSelection.LedgerPeers.Type (AfterSlot (..), UseLedgerPeers (..)) -import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint (..), - RelayAccessPoint (..)) +import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..), WarmValency (..)) @@ -155,23 +154,21 @@ genNodeSetup = <*> Gen.list (Range.linear 0 6) genRootConfig <*> genUseLedgerPeers -genDomainAddress :: Gen DomainAccessPoint -genDomainAddress = - DomainAccessPoint - <$> Gen.element cooking - <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) - +-- Generates only fully qualified domain names. +-- genRelayAddress :: Gen RelayAccessPoint -genRelayAddress = do - isDomain <- Gen.bool - if isDomain - then RelayDomainAccessPoint <$> genDomainAddress - else RelayAccessAddress - <$> Gen.choice - [ IP.IPv4 . unNodeHostIPv4Address <$> genNodeHostIPv4Address - , IP.IPv6 . unNodeHostIPv6Address <$> genNodeHostIPv6Address - ] - <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) +genRelayAddress = + Gen.choice + [ RelayAccessDomain <$> ((<> ".") <$> Gen.element cooking) + <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) + , RelayAccessSRVDomain . (<> ".") <$> Gen.element cooking + , RelayAccessAddress + <$> Gen.choice + [ IP.IPv4 . unNodeHostIPv4Address <$> genNodeHostIPv4Address + , IP.IPv6 . unNodeHostIPv6Address <$> genNodeHostIPv6Address + ] + <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) + ] genRootConfig :: Gen (RootConfig RelayAccessPoint) genRootConfig = do diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index ff996959fc2..f4b165ffeac 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -8,6 +8,7 @@ module Test.Cardano.Node.POM import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic (..)) +import Cardano.Network.Diffusion.Configuration (defaultNumberOfBigLedgerPeers) import Cardano.Node.Configuration.LedgerDB import Cardano.Node.Configuration.POM import Cardano.Node.Configuration.Socket @@ -15,9 +16,7 @@ import Cardano.Node.Handlers.Shutdown import Cardano.Node.Types import Cardano.Tracing.Config (PartialTraceOptions (..), defaultPartialTraceConfiguration, partialTraceSelectionToEither) -import Ouroboros.Cardano.Network.Diffusion.Configuration (defaultNumberOfBigLedgerPeers) import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) -import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Node.Genesis (disableGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.Args import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..), @@ -163,7 +162,6 @@ testPartialYamlConfig = , pncSyncTargetOfEstablishedBigLedgerPeers = mempty , pncSyncTargetOfActiveBigLedgerPeers = mempty , pncMinBigLedgerPeersForTrustedState = mempty - , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) , pncConsensusMode = mempty , pncGenesisConfigFlags = mempty @@ -214,7 +212,6 @@ testPartialCliConfig = , pncSyncTargetOfEstablishedBigLedgerPeers = mempty , pncSyncTargetOfActiveBigLedgerPeers = mempty , pncMinBigLedgerPeersForTrustedState = Last (Just defaultNumberOfBigLedgerPeers) - , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) , pncConsensusMode = Last (Just PraosMode) , pncGenesisConfigFlags = mempty @@ -272,7 +269,6 @@ eExpectedConfig = do , ncSyncTargetOfEstablishedBigLedgerPeers = 40 , ncSyncTargetOfActiveBigLedgerPeers = 30 , ncMinBigLedgerPeersForTrustedState = defaultNumberOfBigLedgerPeers - , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled , ncConsensusMode = PraosMode , ncGenesisConfig = disableGenesisConfig diff --git a/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs b/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs index 9ce11415100..9e693c4c99b 100644 --- a/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs +++ b/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs @@ -33,8 +33,7 @@ tests = do , "goodConfig.yaml" ) , ( [ "Config namespace error: Illegal namespace ChainDB.CopyToImmutableDBEvent2.CopiedBlockToImmutableDB" - , "Config namespace error: Illegal namespace SubscriptionDNS" - ] + ] , testSubdir , "badConfig.yaml" ) diff --git a/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/badConfig.yaml b/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/badConfig.yaml index 1c0ebf78c09..0f23a53c33f 100644 --- a/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/badConfig.yaml +++ b/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/badConfig.yaml @@ -54,15 +54,6 @@ TraceOptions: Net.DNSResolver: severity: Info - Net.ErrorPolicy: - severity: Info - - Net.Subscription.IP: - severity: Info - - SubscriptionDNS: - severity: Info - Resources: severity: Info @@ -74,4 +65,4 @@ TraceOptions: TraceOptionPeerFrequency: 2000 -TraceOptionResourceFrequency: 5000 \ No newline at end of file +TraceOptionResourceFrequency: 5000 diff --git a/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/goodConfig.yaml b/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/goodConfig.yaml index 558d186ae7f..bfc9b6be514 100644 --- a/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/goodConfig.yaml +++ b/cardano-node/test/Test/Cardano/Tracing/NewTracing/data/goodConfig.yaml @@ -54,12 +54,6 @@ TraceOptions: Net.DNSResolver: severity: Info - Net.ErrorPolicy: - severity: Info - - Net.Subscription: - severity: Info - Resources: severity: Info @@ -71,4 +65,4 @@ TraceOptions: TraceOptionPeerFrequency: 2000 -TraceOptionResourceFrequency: 5000 \ No newline at end of file +TraceOptionResourceFrequency: 5000 diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 4da66a25165..0509f28e7f5 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -39,9 +39,9 @@ library , aeson , async , bytestring - , cardano-api ^>= 10.17 + , cardano-api ^>= 10.18 , cardano-binary - , cardano-cli ^>= 10.11.1 + , cardano-cli ^>= 10.12 , cardano-crypto-class ^>= 2.2 , http-media , iohk-monitoring @@ -49,7 +49,7 @@ library , network , optparse-applicative-fork , ouroboros-consensus-cardano - , ouroboros-network ^>= 0.21.2 + , ouroboros-network ^>= 0.22 , ouroboros-network-protocols , prometheus >= 2.2.4 , safe-exceptions @@ -73,7 +73,6 @@ library , Cardano.TxSubmit.Rest.Parsers , Cardano.TxSubmit.Rest.Types , Cardano.TxSubmit.Rest.Web - , Cardano.TxSubmit.Tracing.ToObjectOrphans , Cardano.TxSubmit.Types , Cardano.TxSubmit.Util , Cardano.TxSubmit.Web diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs b/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs deleted file mode 100644 index 506825f80c8..00000000000 --- a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} - -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Cardano.TxSubmit.Tracing.ToObjectOrphans () where - -import Cardano.BM.Data.Severity (Severity (Debug, Error, Notice, Warning)) -import Cardano.BM.Data.Tracer (HasPrivacyAnnotation, HasSeverityAnnotation (..), - HasTextFormatter, ToObject (toObject), Transformable (..), trStructured) -import Ouroboros.Network.NodeToClient (ErrorPolicyTrace (..), WithAddr (..)) - -import Data.Aeson ((.=)) -import Data.Text (Text) -import qualified Network.Socket as Socket - -instance HasPrivacyAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) -instance HasSeverityAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) where - getSeverityAnnotation (WithAddr _ ev) = case ev of - ErrorPolicySuspendPeer {} -> Warning -- peer misbehaved - ErrorPolicySuspendConsumer {} -> Notice -- peer temporarily not useful - ErrorPolicyLocalNodeError {} -> Error - ErrorPolicyResumePeer {} -> Debug - ErrorPolicyKeepSuspended {} -> Debug - ErrorPolicyResumeConsumer {} -> Debug - ErrorPolicyResumeProducer {} -> Debug - ErrorPolicyUnhandledApplicationException {} -> Error - ErrorPolicyUnhandledConnectionException {} -> Error - ErrorPolicyAcceptException {} -> Error - -instance HasTextFormatter (WithAddr Socket.SockAddr ErrorPolicyTrace) where - --- transform @ErrorPolicyTrace@ -instance Transformable Text IO (WithAddr Socket.SockAddr ErrorPolicyTrace) where - trTransformer = trStructured - -instance ToObject (WithAddr Socket.SockAddr ErrorPolicyTrace) where - toObject _verb (WithAddr addr ev) = - mconcat [ "kind" .= ("ErrorPolicyTrace" :: String) - , "address" .= show addr - , "event" .= show ev ] diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 7c86eeb6a7e..f6ae63afdff 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -40,8 +40,8 @@ library , aeson-pretty , ansi-terminal , bytestring - , cardano-api ^>= 10.17 - , cardano-cli:{cardano-cli, cardano-cli-test-lib} ^>= 10.11.1 + , cardano-api ^>= 10.18 + , cardano-cli:{cardano-cli, cardano-cli-test-lib} ^>= 10.12 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>= 0.2.2 @@ -55,7 +55,7 @@ library , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley , cardano-node - , cardano-ping ^>= 0.8 + , cardano-ping >= 0.9 , cardano-prelude , contra-tracer , containers @@ -70,7 +70,7 @@ library , extra , filepath , hedgehog - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , http-conduit , lens-aeson , microlens @@ -80,7 +80,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.21 + , ouroboros-network ^>= 0.22 , ouroboros-network-api , prettyprinter , process @@ -88,7 +88,7 @@ library , retry , safe-exceptions , scientific - , si-timers + , io-classes , stm , tasty ^>= 1.5 , tasty-expected-failure @@ -266,6 +266,7 @@ test-suite cardano-testnet-test , mtl , process , regex-compat + , rio , tasty ^>= 1.5 , text , time diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index f2b42e20fb8..1ae29345ad3 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -5,7 +5,8 @@ module Parsers.Cardano , cmdCreateEnv ) where -import Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..)) +import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), Eon(..) + , forEraInEonMaybe, convert, ShelleyBasedEra(..), AnyCardanoEra(..)) import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) @@ -16,7 +17,8 @@ import Control.Applicative import Data.Default.Class import Data.Functor import qualified Data.List as L -import Data.Maybe (fromMaybe) +import Data.Maybe +import Data.Typeable import Data.Word (Word64) import Options.Applicative (CommandFields, Mod, Parser) import qualified Options.Applicative as OA @@ -80,6 +82,35 @@ pCardanoTestnetCliOptions envCli = CardanoTestnetOptions pAnyShelleyBasedEra' = pAnyShelleyBasedEra envCli <&> (\(EraInEon x) -> AnyShelleyBasedEra x) +pAnyShelleyBasedEra :: EnvCli -> Parser (EraInEon ShelleyBasedEra) +pAnyShelleyBasedEra envCli = + asum $ + mconcat + [ + [ OA.flag' (EraInEon ShelleyBasedEraShelley) $ + mconcat [OA.long "shelley-era", OA.help $ "Specify the Shelley era" <> deprecationText] + , OA.flag' (EraInEon ShelleyBasedEraAllegra) $ + mconcat [OA.long "allegra-era", OA.help $ "Specify the Allegra era" <> deprecationText] + , OA.flag' (EraInEon ShelleyBasedEraMary) $ + mconcat [OA.long "mary-era", OA.help $ "Specify the Mary era" <> deprecationText] + , OA.flag' (EraInEon ShelleyBasedEraAlonzo) $ + mconcat [OA.long "alonzo-era", OA.help $ "Specify the Alonzo era" <> deprecationText] + , OA.flag' (EraInEon ShelleyBasedEraBabbage) $ + mconcat [OA.long "babbage-era", OA.help $ "Specify the Babbage era (default)" <> deprecationText] + , fmap (EraInEon . convert) $ pConwayEra envCli + ] + , maybeToList $ pure <$> envCliAnyEon envCli + , pure $ pure $ EraInEon ShelleyBasedEraConway + ] + where + deprecationText :: String + deprecationText = " - DEPRECATED - will be removed in the future" + + envCliAnyEon :: Typeable eon => Eon eon => EnvCli -> Maybe (EraInEon eon) + envCliAnyEon envCli' = do + AnyCardanoEra era <- envCliAnyCardanoEra envCli' + forEraInEonMaybe era EraInEon + pTestnetNodeOptions :: Parser [NodeOption] pTestnetNodeOptions = -- If `--num-pool-nodes N` is present, return N nodes with option `SpoNodeOptions []`. diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 07fe905d98f..b039ba78b08 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -48,6 +48,7 @@ import qualified Data.Vector as Vector import GHC.Exts (IsList (..)) import GHC.Stack (HasCallStack, withFrozenCallStack) import qualified GHC.Stack as GHC +import RIO (runRIO) import System.Directory (makeAbsolute) import System.FilePath (()) @@ -481,7 +482,6 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. readVerificationKeyFromFile :: ( HasCallStack , MonadIO m - , MonadCatch m , MonadTest m , HasTextEnvelope (VerificationKey keyrole) , SerialiseAsBech32 (VerificationKey keyrole) @@ -490,7 +490,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -> File content direction -> m (VerificationKey keyrole) readVerificationKeyFromFile work = - H.evalEitherM . liftIO . runExceptT . readVerificationKeyOrFile . VerificationKeyFilePath . File . (work ) . unFile + H.evalIO . runRIO () . readVerificationKeyOrFile . VerificationKeyFilePath . File . (work ) . unFile _verificationStakeKeyToStakeAddress :: Int -> VerificationKey StakeKey -> StakeAddress _verificationStakeKeyToStakeAddress testnetMagic delegatorVKey = diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index e60e54546a6..4c361fa23ef 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -178,7 +178,7 @@ library , contra-tracer , directory , ekg-core - , ekg-forward >= 0.9 + , ekg-forward >= 1.0 , ekg-wai , extra , filepath @@ -187,8 +187,8 @@ library , network , network-mux >= 0.8 , optparse-applicative - , ouroboros-network ^>= 0.21.2 - , ouroboros-network-api ^>= 0.14 + , ouroboros-network ^>= 0.22 + , ouroboros-network-api ^>= 0.16 , ouroboros-network-framework , signal , slugify @@ -421,7 +421,7 @@ test-suite cardano-tracer-test-ext , network , network-mux , optparse-applicative-fork >= 0.18.1 - , ouroboros-network ^>= 0.21.2 + , ouroboros-network , ouroboros-network-api , ouroboros-network-framework , process diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index 98b3ab10f14..bddab08a27a 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -4,6 +4,8 @@ module Cardano.Tracer.Acceptors.Server ( runAcceptorsServer ) where +import "contra-tracer" Control.Tracer (nullTracer) + import Cardano.Logging (TraceObject) import qualified Cardano.Logging.Types as Net import Cardano.Tracer.Acceptors.Utils @@ -14,30 +16,23 @@ import Cardano.Tracer.MetaTrace import Cardano.Tracer.Utils (connIdToNodeId) import Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..)) import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) -import Ouroboros.Network.ErrorPolicy (nullErrorPolicies) import Ouroboros.Network.IOManager (withIOManager) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), MiniProtocolNum (..), OuroborosApplication (..), - OuroborosApplicationWithMinimalCtx, RunMiniProtocol (..), miniProtocolLimits, - miniProtocolNum, miniProtocolRun) -import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, - codecHandshake, noTimeLimitsHandshake, timeLimitsHandshake) -import Ouroboros.Network.Protocol.Handshake.Type (Handshake) -import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion, - simpleSingletonVersions) + RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) +import Ouroboros.Network.Protocol.Handshake (Handshake, HandshakeArguments (..)) +import qualified Ouroboros.Network.Protocol.Handshake as Handshake import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, - localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer, - socketSnocket) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectionId (..), - HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, - newNetworkMutableState, nullNetworkServerTracers, withServerNode) + localAddressFromPath, localSnocket, makeLocalBearer) +import Ouroboros.Network.Socket (ConnectionId (..), + SomeResponderApplication (..)) +import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) -import Control.Concurrent.Async (race_, wait) +import Control.Concurrent.Async (wait) import qualified Data.ByteString.Lazy as LBS -import Data.List.NonEmpty (NonEmpty ((:|))) -import qualified Data.Text as Text +import Data.Functor (void) import Data.Void (Void) import Data.Word (Word32) import qualified Network.Mux as Mux @@ -64,36 +59,19 @@ runAcceptorsServer -> IO () runAcceptorsServer tracerEnv tracerEnvRTView howToConnect ( ekgConfig, tfConfig, dpfConfig) = withIOManager \iocp -> do - traceWith (teTracer tracerEnv) $ TracerSockListen (Net.howToConnectString howToConnect) - case howToConnect of - Net.LocalPipe p -> - doListenToForwarderLocal - (localSnocket iocp) - (localAddressFromPath p) - (TC.networkMagic $ teConfig tracerEnv) - noTimeLimitsHandshake $ - -- Please note that we always run all the supported protocols, - -- there is no mechanism to disable some of them. - appResponder - [ (runEKGAcceptor tracerEnv ekgConfig errorHandler, 1) - , (runTraceObjectsAcceptor tracerEnv tracerEnvRTView tfConfig errorHandler, 2) - , (runDataPointsAcceptor tracerEnv dpfConfig errorHandler, 3) - ] - - Net.RemoteSocket host port -> do - listenAddress:|_ <- Socket.getAddrInfo Nothing (Just (Text.unpack host)) (Just (show port)) - doListenToForwarderSocket - (socketSnocket iocp) - (Socket.addrAddress listenAddress) - (TC.networkMagic $ teConfig tracerEnv) - timeLimitsHandshake $ - -- Please note that we always run all the supported protocols, - -- there is no mechanism to disable some of them. - appResponder - [ (runEKGAcceptor tracerEnv ekgConfig errorHandler, 1) - , (runTraceObjectsAcceptor tracerEnv tracerEnvRTView tfConfig errorHandler, 2) - , (runDataPointsAcceptor tracerEnv dpfConfig errorHandler, 3) - ] + traceWith (teTracer tracerEnv) $ TracerSockListen p + doListenToForwarder + (localSnocket iocp) + (localAddressFromPath p) + (TC.networkMagic $ teConfig tracerEnv) + Handshake.noTimeLimitsHandshake $ + -- Please note that we always run all the supported protocols, + -- there is no mechanism to disable some of them. + appResponder + [ (runEKGAcceptor tracerEnv ekgConfig errorHandler, 1) + , (runTraceObjectsAcceptor tracerEnv tracerEnvRTView tfConfig errorHandler, 2) + , (runDataPointsAcceptor tracerEnv dpfConfig errorHandler, 3) + ] where appResponder protocolsWithNums = OuroborosApplication @@ -123,27 +101,25 @@ doListenToForwarderLocal (ResponderContext LocalAddress) LBS.ByteString IO Void () -> IO () -doListenToForwarderLocal snocket address netMagic timeLimits app = do - networkState <- newNetworkMutableState - race_ (cleanNetworkMutableState networkState) do - withServerNode +doListenToForwarder snocket address netMagic timeLimits app = + void $ Server.with snocket makeLocalBearer mempty -- LocalSocket does not need to be configured - nullNetworkServerTracers - networkState - (AcceptedConnectionsLimit maxBound maxBound 0) address - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - (HandshakeCallbacks acceptableVersion queryVersion) - (simpleSingletonVersions + HandshakeArguments { + haHandshakeTracer = nullTracer, + haHandshakeCodec = Handshake.codecHandshake forwardingVersionCodec, + haVersionDataCodec = Handshake.cborTermVersionDataCodec forwardingCodecCBORTerm, + haAcceptVersion = Handshake.acceptableVersion, + haQueryVersion = Handshake.queryVersion, + haTimeLimits = timeLimits + } + (Handshake.simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ NetworkMagic netMagic) (\_ -> SomeResponderApplication app) ) - nullErrorPolicies $ \_ serverAsync -> wait serverAsync -- Block until async exception. doListenToForwarderSocket diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index e16cf5b73c9..329fe0e02dd 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -23,22 +23,20 @@ import Cardano.Tracer.Test.TestSetup import Cardano.Tracer.Test.Utils import Cardano.Tracer.Utils import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) -import Ouroboros.Network.ErrorPolicy (nullErrorPolicies) import Ouroboros.Network.IOManager (IOManager, withIOManager) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, - codecHandshake, noTimeLimitsHandshake, timeLimitsHandshake) -import Ouroboros.Network.Protocol.Handshake.Type (Handshake) -import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion, - simpleSingletonVersions) + codecHandshake, noTimeLimitsHandshake) +import Ouroboros.Network.Protocol.Handshake (Handshake, HandshakeArguments (..)) +import qualified Ouroboros.Network.Protocol.Handshake as Handshake import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, - makeLocalBearer, makeSocketBearer, socketSnocket) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..), - HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, - connectToNode, newNetworkMutableState, nullNetworkConnectTracers, - nullNetworkServerTracers, withServerNode) + makeLocalBearer) +import Ouroboros.Network.Socket (ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), + connectToNode, nullNetworkConnectTracers) +import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) import Control.Concurrent (threadDelay) @@ -49,9 +47,7 @@ import Control.Monad (forever) import "contra-tracer" Control.Tracer (contramap, nullTracer, stdoutTracer) import Data.Aeson (FromJSON, ToJSON) import qualified Data.ByteString.Lazy as LBS -import Data.Foldable (for_) -import Data.List.NonEmpty (NonEmpty ((:|))) -import qualified Data.Text as Text +import Data.Functor (void) import Data.Time.Clock (getCurrentTime) import Data.Void (Void, absurd) import Data.Word (Word16) @@ -213,7 +209,7 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi muxBearer args mempty - (simpleSingletonVersions + (Handshake.simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ unI tsNetworkMagic) (const $ forwarderApp [ (forwardEKGMetrics ekgConfig store, 1) @@ -228,14 +224,14 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi Left err -> throwIO err Right choice -> case choice of Left () -> return () - Right void -> absurd void + Right void_ -> absurd void_ where args = ConnectToArgs { ctaHandshakeCodec = codecHandshake forwardingVersionCodec, ctaHandshakeTimeLimits = timeLimits, ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, ctaConnectTracers = nullNetworkConnectTracers, - ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } + ctaHandshakeCallbacks = HandshakeCallbacks Handshake.acceptableVersion Handshake.queryVersion } forwarderApp :: [(RunMiniProtocol 'Mux.InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)] @@ -252,8 +248,7 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi ] doListenToAcceptor - :: Ord addr - => TestSetup Identity + :: TestSetup Identity -> Snocket IO fd addr -> MakeBearer IO fd -> addr @@ -271,33 +266,31 @@ doListenToAcceptor TestSetup{..} sink <- initForwardSink tfConfig (\ _ -> pure ()) dpStore <- initDataPointStore writeToStore dpStore "test.data.point" $ DataPoint mkTestDataPoint - withAsync (traceObjectsWriter sink) \_ -> do - networkState <- newNetworkMutableState - race_ (cleanNetworkMutableState networkState) - $ withServerNode - snocket - muxBearer - mempty - nullNetworkServerTracers - networkState - (AcceptedConnectionsLimit maxBound maxBound 0) - address - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - (HandshakeCallbacks acceptableVersion queryVersion) - (simpleSingletonVersions - ForwardingV_1 - (ForwardingVersionData $ unI tsNetworkMagic) - (const $ SomeResponderApplication $ - forwarderApp [ (forwardEKGMetricsResp ekgConfig store, 1) - , (forwardTraceObjectsResp tfConfig sink, 2) - , (forwardDataPointsResp dpfConfig dpStore, 3) - ] - ) - ) - nullErrorPolicies - $ \_ serverAsync -> wait serverAsync -- Block until async exception. + withAsync (traceObjectsWriter sink) $ \_ -> + void $ Server.with + snocket + muxBearer + mempty + address + HandshakeArguments { + haHandshakeTracer = nullTracer, + haHandshakeCodec = codecHandshake forwardingVersionCodec, + haVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + haAcceptVersion = Handshake.acceptableVersion, + haQueryVersion = Handshake.queryVersion, + haTimeLimits = timeLimits + } + (Handshake.simpleSingletonVersions + ForwardingV_1 + (ForwardingVersionData $ unI tsNetworkMagic) + (const $ SomeResponderApplication $ + forwarderApp [ (forwardEKGMetricsResp ekgConfig store, 1) + , (forwardTraceObjectsResp tfConfig sink, 2) + , (forwardDataPointsResp dpfConfig dpStore, 3) + ] + ) + ) + $ \_ serverAsync -> wait serverAsync -- Block until async exception. where forwarderApp :: [(RunMiniProtocol 'Mux.ResponderMode initCtx respCtx LBS.ByteString IO Void (), Word16)] diff --git a/configuration/cardano/mainnet-config-new-tracing.json b/configuration/cardano/mainnet-config-new-tracing.json index ed9b5164375..38ac230c175 100644 --- a/configuration/cardano/mainnet-config-new-tracing.json +++ b/configuration/cardano/mainnet-config-new-tracing.json @@ -51,15 +51,9 @@ "Net.ConnectionManager.Remote": { "severity": "Info" }, - "Net.Subscription.DNS": { - "severity": "Info" - }, "Startup.DiffusionInit": { "severity": "Info" }, - "Net.ErrorPolicy": { - "severity": "Info" - }, "Forge.Loop": { "severity": "Info" }, @@ -69,12 +63,6 @@ "Net.InboundGovernor.Remote": { "severity": "Info" }, - "Net.Subscription.IP": { - "severity": "Info" - }, - "Net.ErrorPolicy.Local": { - "severity": "Info" - }, "Mempool": { "severity": "Info" }, diff --git a/flake.lock b/flake.lock index 79eae66edee..ca3f3309682 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1751362725, - "narHash": "sha256-RQpTHF6VDPWELM4MHQahZrpEtv6ZxSx8oceWGAzJKco=", + "lastModified": 1758727647, + "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "4a6a3769c8cc8297ae8722e51fa5a4700b2db759", + "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", "type": "github" }, "original": { @@ -256,11 +256,11 @@ "hackage-for-stackage": { "flake": false, "locked": { - "lastModified": 1750897618, - "narHash": "sha256-MgzSJDtk9qXf+OYjqaGX7zebArRS236tgFKDAxV3OXw=", + "lastModified": 1755649550, + "narHash": "sha256-YNKeqYIezur2MvPmfVI/aHjcVRwOdBW7Du3jg6iXjKs=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "5ac996932a885bee0083893ba7a4727b654b7e8d", + "rev": "5e56db8bc478dfb7466ea83744c3ab928aff0329", "type": "github" }, "original": { @@ -289,11 +289,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1750944318, - "narHash": "sha256-DwjXWJqd3+Uhvx1OewJDMGxtny20vQvRF4iB+H8a3fs=", + "lastModified": 1758759934, + "narHash": "sha256-VrTBELvtzIdsye3FZ5YVGb2CXQiyOFZPo3vsLZOFiO4=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "1df55daef81b543cf3ccab4b1a5a536e32d8ce2a", + "rev": "84e95f44c5b56a81495f59702f56fa7d18695dcd", "type": "github" }, "original": { @@ -344,11 +344,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1750899099, - "narHash": "sha256-8Wy0VIdPoGd7JqaHT4ehfS87kW+xRn9XwSiRxu0nD9g=", + "lastModified": 1755663895, + "narHash": "sha256-76Ns29GQsO5S5gPRcic+vagcJicOSvhA+oKQ9r9kjFE=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "c16c3c648b3a2eef0cb1fb3706da801764d77565", + "rev": "71fcc9f531993aada52173fceb4ff4ce2148207d", "type": "github" }, "original": { @@ -637,11 +637,11 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1750543273, - "narHash": "sha256-WaswH0Y+Fmupvv8AkIlQBlUy/IdD3Inx9PDuE+5iRYY=", + "lastModified": 1755040634, + "narHash": "sha256-8W7uHpAIG8HhO3ig5OGHqvwduoye6q6dlrea1IrP2eI=", "owner": "stable-haskell", "repo": "iserv-proxy", - "rev": "a53c57c9a8d22a66a2f0c4c969e806da03f08c28", + "rev": "1383d199a2c64f522979005d112b4fbdee38dd92", "type": "github" }, "original": { @@ -835,11 +835,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1750292027, - "narHash": "sha256-rmEsCxLWS/rAdIzZPSi0XbrY2BOztBlSHQHgYoXyovU=", + "lastModified": 1755648773, + "narHash": "sha256-NhcOu6GwYal+awBQLoMT4vf7L7Ar1DectDjK2mF653I=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "3f8c717e24953914821f1ddb4797dd768326faa6", + "rev": "1a0ea16d99761b93456460c255a8b723647b2c77", "type": "github" }, "original": { diff --git a/nix/haskell.nix b/nix/haskell.nix index f55e63a55a7..7179869ba55 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -367,8 +367,8 @@ let }; }) ({ lib, pkgs, ... }: lib.mkIf (pkgs.stdenv.hostPlatform != pkgs.stdenv.buildPlatform) { - # Remove hsc2hs build-tool dependencies (suitable version will be available as part of the ghc derivation) - packages.Win32.components.library.build-tools = lib.mkForce [ ]; + # TODO: error: The option `packages.Win32' does not exist. + # packages.Win32.components.library.build-tools = lib.mkForce [ ]; packages.terminal-size.components.library.build-tools = lib.mkForce [ ]; packages.network.components.library.build-tools = lib.mkForce [ ]; }) diff --git a/trace-forward/src/Trace/Forward/Forwarding.hs b/trace-forward/src/Trace/Forward/Forwarding.hs index 363f258588b..5a8ec774a6a 100644 --- a/trace-forward/src/Trace/Forward/Forwarding.hs +++ b/trace-forward/src/Trace/Forward/Forwarding.hs @@ -8,40 +8,39 @@ {-# LANGUAGE ViewPatterns #-} module Trace.Forward.Forwarding - ( - initForwarding + ( initForwarding , initForwardingDelayed ) where import Cardano.Logging.Types import Cardano.Logging.Utils (runInLoop) import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) -import Ouroboros.Network.ErrorPolicy (nullErrorPolicies) import Ouroboros.Network.IOManager (IOManager) import Ouroboros.Network.Magic (NetworkMagic) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) +import Ouroboros.Network.Protocol.Handshake (HandshakeArguments (..)) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, codecHandshake, noTimeLimitsHandshake, timeLimitsHandshake) import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion, simpleSingletonVersions) -import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, MakeBearer, Snocket, - localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer, - socketSnocket) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..), - HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, - connectToNode, newNetworkMutableState, nullNetworkConnectTracers, - nullNetworkServerTracers, withServerNode) +import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, + makeLocalBearer, LocalAddress, socketSnocket, makeSocketBearer, LocalSocket) +import Ouroboros.Network.Socket (ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), + connectToNode, nullNetworkConnectTracers) +import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) -import Control.Concurrent.Async (async, race_, wait) +import Control.Concurrent.Async (async) import Control.Exception (throwIO) -import Control.Monad (void) +import Control.Monad.Class.MonadAsync (wait) import Control.Monad.IO.Class import "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer) import qualified Data.ByteString.Lazy as LBS +import Data.Functor import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (isNothing) import qualified Data.Text as Text @@ -296,9 +295,7 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits Nothing -> forwardEKGMetricsDummy doListenToAcceptor - :: forall fd addr. () - => Ord addr - => NetworkMagic + :: NetworkMagic -> Snocket IO fd addr -> MakeBearer IO fd -> (fd -> addr -> IO ()) @@ -312,34 +309,33 @@ doListenToAcceptor -> DataPointStore -> IO () doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits - ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do - networkState <- newNetworkMutableState - race_ (cleanNetworkMutableState networkState) - $ withServerNode - snocket - makeBearer - configureSocket - nullNetworkServerTracers - networkState - (AcceptedConnectionsLimit maxBound maxBound 0) - address - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - (HandshakeCallbacks acceptableVersion queryVersion) - (simpleSingletonVersions - ForwardingV_1 - (ForwardingVersionData magic) - (const $ SomeResponderApplication $ - forwarderApp [ (forwardEKGMetricsRespRun, 1) - , (forwardTraceObjectsResp tfConfig sink, 2) - , (forwardDataPointsResp dpfConfig dpStore, 3) - ] - ) - ) - nullErrorPolicies - $ \_ serverAsync -> - wait serverAsync -- Block until async exception. + ekgConfig tfConfig dpfConfig sink ekgStore dpStore = + void $ Server.with + snocket + makeBearer + configureSocket + address + HandshakeArguments { + haBearerTracer = nullTracer, + haHandshakeTracer = nullTracer, + haHandshakeCodec = codecHandshake forwardingVersionCodec, + haVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + haAcceptVersion = acceptableVersion, + haQueryVersion = queryVersion, + haTimeLimits = timeLimits + } + (simpleSingletonVersions + ForwardingV_1 + (ForwardingVersionData magic) + (const $ SomeResponderApplication $ + forwarderApp [ (forwardEKGMetricsRespRun, 1) + , (forwardTraceObjectsResp tfConfig sink, 2) + , (forwardDataPointsResp dpfConfig dpStore, 3) + ] + ) + ) + $ \_ serverAsync -> + wait serverAsync -- Block until async exception. where forwarderApp :: [(RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void (), Word16)] diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index f94e72f1043..1b9780b5122 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -70,15 +70,14 @@ library , network-mux , ouroboros-network-api , ekg-core - , ekg-forward >= 0.9 + , ekg-forward >= 1.0 , singletons ^>= 3.0 - , ouroboros-network-framework ^>= 0.18.0.1 + , ouroboros-network-framework ^>= 0.19 , serialise , stm , text , trace-dispatcher - , typed-protocols ^>= 0.3 - , typed-protocols-cborg + , typed-protocols:{typed-protocols, cborg} ^>= 1.0 test-suite test import: project-config