From dc0b68b5e2a11016c7891e5f13a44a2ad5528b06 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 19:33:32 +0200 Subject: [PATCH 01/54] Bump `cardano-cli` to `10.12.0.0` and `cardano-api` to `10.18` --- .../plutus-scripts-bench/plutus-scripts-bench.cabal | 2 +- bench/tx-generator/tx-generator.cabal | 4 ++-- cabal.project | 13 ++++++++++++- cardano-node-chairman/cardano-node-chairman.cabal | 2 +- cardano-node/cardano-node.cabal | 2 +- cardano-submit-api/cardano-submit-api.cabal | 4 ++-- cardano-testnet/cardano-testnet.cabal | 4 ++-- flake.lock | 6 +++--- 8 files changed, 24 insertions(+), 13 deletions(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 0ba33110946..13f42124d15 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -82,7 +82,7 @@ library -- IOG dependencies -------------------------- build-depends: - , cardano-api ^>=10.17 + , cardano-api ^>=10.18 , plutus-ledger-api ^>=1.45 , plutus-tx ^>=1.45 , plutus-tx-plugin ^>=1.45 diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index f4a5391ee62..282e8bb4908 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 diff --git a/cabal.project b/cabal.project index 509e7bfbb6f..30262824b24 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,18 @@ repository cardano-haskell-packages -- 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 + , cardano-haskell-packages 2025-09-15T19:20:34Z + +-- BEGIN SRP STANZAS MANAGED BY STANZAMAN -- + +source-repository-package + type: git + location: https://github.com/intersectmbo/cardano-cli.git + tag: 8da6794d196cfa749b5525e72d7d44db962ab272 + subdir: cardano-cli + --sha256: 0lsfxxj1dkz6afpqq9izr2g5rj538bksxkq30s4j0jhpcwzn9qcv + +-- END SRP STANZAS MANAGED BY STANZAMAN -- packages: cardano-node diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 3ee509f4c65..22cd7bdeb4a 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -90,5 +90,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..e4618effea2 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -142,7 +142,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 diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 4da66a25165..5453d438669 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 diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 7c86eeb6a7e..dc3f99a44df 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 diff --git a/flake.lock b/flake.lock index 79eae66edee..e0fe3ab3449 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1751362725, - "narHash": "sha256-RQpTHF6VDPWELM4MHQahZrpEtv6ZxSx8oceWGAzJKco=", + "lastModified": 1758019900, + "narHash": "sha256-e+avZgySRCz8VyI1m/lmNT45DP3e9gs+MFoMZ2y+Tt0=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "4a6a3769c8cc8297ae8722e51fa5a4700b2db759", + "rev": "a6d287cdc826a7a8d4de86b60d0443e45472ca28", "type": "github" }, "original": { From 653ce0cd2212c8bb67a986b4f3a1f8c5cffb0609 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 20:29:57 +0200 Subject: [PATCH 02/54] Fix compilation errors --- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 5 ++- cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Parsers/Cardano.hs | 37 +++++++++++++++++-- .../Cardano/Testnet/Test/Cli/Query.hs | 4 +- 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index b9da17c9869..e07a895c10b 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -3,6 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Cardano.TxGenerator.Setup.Plutus @@ -23,7 +24,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra import Control.Monad.Writer (runWriter) -import Cardano.CLI.Read (readFileScriptInAnyLang) +import Cardano.CLI.Read (readFileScriptInAnyLang, ScriptDecodeError) import Cardano.Api import Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits) @@ -71,7 +72,7 @@ readPlutusScript (Left s) doLoad fp = second (second (const $ ResolvedToFallback asFileName)) <$> readPlutusScript (Right fp) readPlutusScript (Right fp) = runExceptT $ do - script <- firstExceptT ApiError $ + script <- firstExceptT (ApiError @ScriptDecodeError) $ readFileScriptInAnyLang fp case script of ScriptInAnyLang (PlutusScriptLanguage _) _ -> pure (script, ResolvedToFileName fp) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index dc3f99a44df..d81890ce526 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -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..029fbe70290 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -5,18 +5,17 @@ module Parsers.Cardano , cmdCreateEnv ) where -import Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..)) +import Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), ShelleyBasedEra (..), Convert (..), Eon, AnyCardanoEra (..), forEraInEonMaybe) import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) - import Prelude import Control.Applicative import Data.Default.Class import Data.Functor import qualified Data.List as L -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList) import Data.Word (Word64) import Options.Applicative (CommandFields, Mod, Parser) import qualified Options.Applicative as OA @@ -24,6 +23,8 @@ import qualified Options.Applicative as OA import Testnet.Start.Cardano import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) +import qualified Options.Applicative as Opt +import Cardano.Prelude (Typeable) optsTestnet :: EnvCli -> Parser CardanoTestnetCliOptions optsTestnet envCli = CardanoTestnetCliOptions @@ -78,7 +79,35 @@ pCardanoTestnetCliOptions envCli = CardanoTestnetOptions where pAnyShelleyBasedEra' :: Parser AnyShelleyBasedEra pAnyShelleyBasedEra' = - pAnyShelleyBasedEra envCli <&> (\(EraInEon x) -> AnyShelleyBasedEra x) + pAnyShelleyBasedEra <&> (\(EraInEon x) -> AnyShelleyBasedEra x) + 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 + + pAnyShelleyBasedEra = + asum $ + mconcat + [ + [ Opt.flag' (EraInEon ShelleyBasedEraShelley) $ + mconcat [Opt.long "shelley-era", Opt.help $ "Specify the Shelley era" <> deprecationText] + , Opt.flag' (EraInEon ShelleyBasedEraAllegra) $ + mconcat [Opt.long "allegra-era", Opt.help $ "Specify the Allegra era" <> deprecationText] + , Opt.flag' (EraInEon ShelleyBasedEraMary) $ + mconcat [Opt.long "mary-era", Opt.help $ "Specify the Mary era" <> deprecationText] + , Opt.flag' (EraInEon ShelleyBasedEraAlonzo) $ + mconcat [Opt.long "alonzo-era", Opt.help $ "Specify the Alonzo era" <> deprecationText] + , Opt.flag' (EraInEon ShelleyBasedEraBabbage) $ + mconcat [Opt.long "babbage-era", Opt.help $ "Specify the Babbage era (default)" <> deprecationText] + , EraInEon . convert <$> pConwayEra envCli + ] + , maybeToList $ pure <$> envCliAnyEon envCli + , pure $ pure $ EraInEon ShelleyBasedEraConway + ] pTestnetNodeOptions :: Parser [NodeOption] pTestnetNodeOptions = 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..d1e10d11df7 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 @@ -62,6 +62,7 @@ import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types (GenesisOptions (..), NumPools (..), cardanoNumPools) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) import Testnet.Types +import RIO (runRIO) import Hedgehog import qualified Hedgehog as H @@ -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 = From bb2c3b16cba2eaadca7d32728a72a2b04de08f8f Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 23 Sep 2025 19:29:17 +0300 Subject: [PATCH 03/54] WIP: bump upper bounds --- cabal.project | 53 +++++++++++++++++++++++++-------- cardano-node/cardano-node.cabal | 8 ++--- flake.lock | 12 ++++---- 3 files changed, 50 insertions(+), 23 deletions(-) diff --git a/cabal.project b/cabal.project index 30262824b24..e0db3bf5b3c 100644 --- a/cabal.project +++ b/cabal.project @@ -13,19 +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-09-15T19:20:34Z - --- BEGIN SRP STANZAS MANAGED BY STANZAMAN -- - -source-repository-package - type: git - location: https://github.com/intersectmbo/cardano-cli.git - tag: 8da6794d196cfa749b5525e72d7d44db962ab272 - subdir: cardano-cli - --sha256: 0lsfxxj1dkz6afpqq9izr2g5rj538bksxkq30s4j0jhpcwzn9qcv - --- END SRP STANZAS MANAGED BY STANZAMAN -- + , hackage.haskell.org 2025-09-11T01:58:40Z + , cardano-haskell-packages 2025-09-20T20:31:08Z packages: cardano-node @@ -83,3 +72,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: 9205bba98c35c3a158081104a202a59864472445 + --sha256: sha256-JViaos6axYtRntdRP7GV34wY3LO2NCjyofZ+cEQG8ug= + 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/cardano-node.cabal b/cardano-node/cardano-node.cabal index e4618effea2..723ba16126e 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -191,10 +191,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 ^>= 0.22.3 + , ouroboros-network-framework ^>= 0.19.1 + , ouroboros-network-protocols ^>= 0.15 , prettyprinter , prettyprinter-ansi-terminal , psqueues diff --git a/flake.lock b/flake.lock index e0fe3ab3449..941647391c4 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758019900, - "narHash": "sha256-e+avZgySRCz8VyI1m/lmNT45DP3e9gs+MFoMZ2y+Tt0=", + "lastModified": 1758547838, + "narHash": "sha256-QvqwgT4yN+52SWxQWQ3cS5V64C1rQrQKaLCYRZH7bC4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "a6d287cdc826a7a8d4de86b60d0443e45472ca28", + "rev": "6174af87848e7b5e652bb19035f658e10f094299", "type": "github" }, "original": { @@ -289,11 +289,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1750944318, - "narHash": "sha256-DwjXWJqd3+Uhvx1OewJDMGxtny20vQvRF4iB+H8a3fs=", + "lastModified": 1758633641, + "narHash": "sha256-F70VZjt/AlmelvF9VHbHP6UaUnUgeWR5t/r0jsmAPVg=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "1df55daef81b543cf3ccab4b1a5a536e32d8ce2a", + "rev": "4601442c80824463bc4794a70a04091f2bf87a22", "type": "github" }, "original": { From 14be36d99a25577840a84b61aa6279dd37b6a93f Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:04:14 +0300 Subject: [PATCH 04/54] WIP: fix dependencies --- bench/locli/locli.cabal | 2 +- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 6 +++--- bench/tx-generator/tx-generator.cabal | 1 - cabal.project | 6 ++++++ cardano-node-chairman/cardano-node-chairman.cabal | 4 +--- cardano-node/cardano-node.cabal | 6 ++---- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 6 ++---- cardano-tracer/cardano-tracer.cabal | 8 ++++---- trace-forward/trace-forward.cabal | 4 ++-- 10 files changed, 22 insertions(+), 23 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 336d0186b4d..db130b95f45 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 diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 13f42124d15..897fcb80fe9 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.18 - , plutus-ledger-api ^>=1.45 - , plutus-tx ^>=1.45 - , plutus-tx-plugin ^>=1.45 + , plutus-ledger-api ^>=1.53 + , plutus-tx ^>=1.53 + , plutus-tx-plugin ^>=1.53 ------------------------ -- Non-IOG dependencies diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 282e8bb4908..d619749983e 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -154,7 +154,6 @@ library , random , serialise , streaming - , strict-stm , cardano-ledger-shelley , prettyprinter , stm diff --git a/cabal.project b/cabal.project index e0db3bf5b3c..ad77442697f 100644 --- a/cabal.project +++ b/cabal.project @@ -110,3 +110,9 @@ source-repository-package --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= subdir: kes-agent + +source-repository-package + type: git + location: https://github.com/input-output-hk/ekg-forward + tag: bce3027d9123d51b51a9423dfce8090d132493b0 + --sha256: sha256-jLyJRIhDAQehaXKWp+RxruyFSSBtVsyM0QI12qa93V0= diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 22cd7bdeb4a..1528118ea28 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.18 , cardano-node ^>= 10.5 , cardano-prelude , containers @@ -55,8 +55,6 @@ executable cardano-node-chairman , ouroboros-consensus-cardano , ouroboros-network-api , ouroboros-network-protocols - , strict-stm - , si-timers , text , time diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 723ba16126e..449ca48826f 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -202,12 +202,10 @@ library , resource-registry , safe-exceptions , scientific - , si-timers , 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,8 @@ library , tracer-transformers , transformers , transformers-except - , typed-protocols >= 0.3 - , typed-protocols-stateful >= 0.3 + , typed-protocols >= 0.1 + , typed-protocols-stateful >= 0.1 , yaml executable cardano-node diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 5453d438669..d96e0e40b18 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -49,7 +49,7 @@ library , network , optparse-applicative-fork , ouroboros-consensus-cardano - , ouroboros-network ^>= 0.21.2 + , ouroboros-network ^>= 0.22.3 , ouroboros-network-protocols , prometheus >= 2.2.4 , safe-exceptions diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index d81890ce526..c509838363c 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -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 @@ -80,7 +80,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.21 + , ouroboros-network ^>= 0.22.3 , ouroboros-network-api , prettyprinter , process @@ -88,8 +88,6 @@ library , retry , safe-exceptions , scientific - , si-timers - , stm , tasty ^>= 1.5 , tasty-expected-failure , tasty-hedgehog diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index e60e54546a6..6bf078476a4 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -17,7 +17,7 @@ extra-doc-files: README.md CHANGELOG.md flag rtview - description: Enable RTView. False by default. Enable with `-f +rtview`. + description: Enab2.3e RTView. False by default. Enable with `-f +rtview`. default: False manual: True @@ -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.3 + , 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 ^>= 0.22.3 , ouroboros-network-api , ouroboros-network-framework , process diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index f94e72f1043..9afb9f0ac1c 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -72,12 +72,12 @@ library , ekg-core , ekg-forward >= 0.9 , singletons ^>= 3.0 - , ouroboros-network-framework ^>= 0.18.0.1 + , ouroboros-network-framework ^>= 0.19.1 , serialise , stm , text , trace-dispatcher - , typed-protocols ^>= 0.3 + , typed-protocols ^>= 1.0 , typed-protocols-cborg test-suite test From 015b9552caae9dfc32f1ad4786b3a45dd597fea9 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:07:50 +0300 Subject: [PATCH 05/54] Depend on new ekg-forward --- cabal.project | 8 +------- flake.lock | 6 +++--- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/cabal.project b/cabal.project index ad77442697f..6dff0ca5190 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2025-09-11T01:58:40Z - , cardano-haskell-packages 2025-09-20T20:31:08Z + , cardano-haskell-packages 2025-09-24T09:43:13Z packages: cardano-node @@ -110,9 +110,3 @@ source-repository-package --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= subdir: kes-agent - -source-repository-package - type: git - location: https://github.com/input-output-hk/ekg-forward - tag: bce3027d9123d51b51a9423dfce8090d132493b0 - --sha256: sha256-jLyJRIhDAQehaXKWp+RxruyFSSBtVsyM0QI12qa93V0= diff --git a/flake.lock b/flake.lock index 941647391c4..69b858d9689 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758547838, - "narHash": "sha256-QvqwgT4yN+52SWxQWQ3cS5V64C1rQrQKaLCYRZH7bC4=", + "lastModified": 1758714403, + "narHash": "sha256-1nejLJgkcqYc4dBczfTfEn/EzoRLzwHTGMyz2yfGvhk=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "6174af87848e7b5e652bb19035f658e10f094299", + "rev": "12422309cf465da471e5eaa8dfbe68364e58721b", "type": "github" }, "original": { From b47ed9ab6513dccf2c48c4976aaf58a2502afce6 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 16:27:15 +0300 Subject: [PATCH 06/54] Fix all dependency issues --- trace-forward/trace-forward.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 9afb9f0ac1c..2f287af05f7 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -77,8 +77,7 @@ library , stm , text , trace-dispatcher - , typed-protocols ^>= 1.0 - , typed-protocols-cborg + , typed-protocols:{typed-protocols, cborg} ^>= 1.0 test-suite test import: project-config From c38a12e7ec86c4300f07d1a96ce8eb278614da38 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 24 Jul 2025 15:26:21 -0400 Subject: [PATCH 07/54] Propagate changes from cardano-cli --- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 5 +-- cardano-node/cardano-node.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Parsers/Cardano.hs | 35 +++++++++++++++++-- .../Cardano/Testnet/Test/Cli/Query.hs | 4 +-- 5 files changed, 40 insertions(+), 7 deletions(-) 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/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index c0874d28f06..014e715d8b8 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -142,7 +142,7 @@ library , async , base16-bytestring , bytestring - , cardano-api ^>= 10.17.1 + , cardano-api ^>= 10.17 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>=0.2.2 diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 7c86eeb6a7e..2c673e3d637 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -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 = From f6a5b9937ee2b3ee19c46b0c7bf33a6bb2c7b9b0 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 24 Jul 2025 15:31:07 -0400 Subject: [PATCH 08/54] REMOVE ME: Srps --- cabal.project | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 509e7bfbb6f..b825bb84f0a 100644 --- a/cabal.project +++ b/cabal.project @@ -13,7 +13,7 @@ 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 + , hackage.haskell.org 2025-07-14T17:31:29Z , cardano-haskell-packages 2025-07-01T09:22:51Z packages: @@ -72,3 +72,19 @@ 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: 31d46d77278cb3ea5b1606ee2fc20ae7c3b5c59a + --sha256: sha256-Lqg+eGfdYphLbgS3LZ0Qf62mTLkibl6L8i7GOia0hoo= + subdir: cardano-cli + + +source-repository-package + type: git + location: https://github.com/intersectmbo/cardano-api.git + tag: 159822505a74a6479fff037ef5bdc881437aae53 + --sha256: sha256-V9PZ4X7N1Kg0pSxS/qVByEwxA5VASZFNRT+n8JDBlgc= + subdir: cardano-api + From b7b0f1596392700a903784b29e59b3c292e5932f Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Sat, 9 Aug 2025 11:17:55 -0400 Subject: [PATCH 09/54] WIP: 10.6 dependency bump --- .../plutus-scripts-bench.cabal | 2 +- cabal.project | 69 +++++++++++++++++-- cardano-node/cardano-node.cabal | 12 ++-- trace-forward/trace-forward.cabal | 2 +- 4 files changed, 70 insertions(+), 15 deletions(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 0ba33110946..d3229efa065 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -83,7 +83,7 @@ library -------------------------- build-depends: , cardano-api ^>=10.17 - , plutus-ledger-api ^>=1.45 + , plutus-ledger-api ^>=1.50 , plutus-tx ^>=1.45 , plutus-tx-plugin ^>=1.45 diff --git a/cabal.project b/cabal.project index b825bb84f0a..0806ce2c599 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-07-14T17:31:29Z - , cardano-haskell-packages 2025-07-01T09:22:51Z + , hackage.haskell.org 2025-07-22T09:13:54Z + , cardano-haskell-packages 2025-07-28T14:33:19Z packages: cardano-node @@ -61,6 +61,14 @@ 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 @@ -76,15 +84,62 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/intersectmbo/cardano-cli.git - tag: 31d46d77278cb3ea5b1606ee2fc20ae7c3b5c59a + tag: a894d0063f403222677c33152b3396bba87450bc --sha256: sha256-Lqg+eGfdYphLbgS3LZ0Qf62mTLkibl6L8i7GOia0hoo= subdir: cardano-cli source-repository-package type: git - location: https://github.com/intersectmbo/cardano-api.git - tag: 159822505a74a6479fff037ef5bdc881437aae53 - --sha256: sha256-V9PZ4X7N1Kg0pSxS/qVByEwxA5VASZFNRT+n8JDBlgc= - subdir: cardano-api + location: https://github.com/IntersectMBO/cardano-api + tag: 0eeff17265628f2ad055c9e63e0f9698759c2e0b + --sha256: sha256-XmuQTZdD/ZdCNlRuD+V5cNslEM05xwTACmMunzuCCJY= + subdir: + cardano-api + + + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 15fc8c4fee64473350e1904347bfd5852f9cdbfa + --sha256: sha256-Tvw0dLGZkBAflpvcEwl7Acnrux9H5UaniW5YwMvIeIs= + 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/IntersectMBO/cardano-ledger + tag: 20485948f78ab139d246695e540f9ec00963a16e + --sha256: sha256-SHnyp+GvNeR82UXoKeDEgsp1AUE2yF5dGL4HIZm0zK8= + subdir: + eras/allegra/impl + eras/alonzo/impl + eras/alonzo/test-suite + eras/babbage/impl + eras/babbage/test-suite + eras/byron/chain/executable-spec + eras/byron/crypto + eras/byron/ledger/executable-spec + eras/byron/ledger/impl + eras/conway/impl + eras/dijkstra + eras/mary/impl + eras/shelley/impl + eras/shelley-ma/test-suite + eras/shelley/test-suite + libs/cardano-data + libs/cardano-ledger-api + libs/cardano-ledger-binary + libs/cardano-ledger-core + libs/cardano-protocol-tpraos + libs/non-integral + libs/set-algebra + libs/small-steps + libs/vector-map diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 014e715d8b8..e3e432f5dd8 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -191,10 +191,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 ^>= 0.22 + , ouroboros-network-framework + , ouroboros-network-protocols ^>= 0.15 , prettyprinter , prettyprinter-ansi-terminal , psqueues @@ -218,8 +218,8 @@ library , tracer-transformers , transformers , transformers-except - , typed-protocols >= 0.3 - , typed-protocols-stateful >= 0.3 + , typed-protocols >= 1.0 + , typed-protocols-stateful , yaml executable cardano-node diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index f94e72f1043..62116e54d4c 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -77,7 +77,7 @@ library , stm , text , trace-dispatcher - , typed-protocols ^>= 0.3 + , typed-protocols ^>= 1.0 , typed-protocols-cborg test-suite test From 1768396609f7827a3ffc7a723968473a35688f3c Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 14 Aug 2025 17:26:29 +0200 Subject: [PATCH 10/54] Update deps --- bench/locli/locli.cabal | 2 +- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 4 ++-- bench/tx-generator/tx-generator.cabal | 1 - cabal.project | 5 ++++- cardano-node-chairman/cardano-node-chairman.cabal | 5 ++--- cardano-node/cardano-node.cabal | 3 +-- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 6 +++--- cardano-tracer/cardano-tracer.cabal | 6 +++--- trace-forward/trace-forward.cabal | 2 +- 10 files changed, 18 insertions(+), 18 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 336d0186b4d..db130b95f45 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 diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index d3229efa065..5854af24479 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -84,8 +84,8 @@ library build-depends: , cardano-api ^>=10.17 , plutus-ledger-api ^>=1.50 - , plutus-tx ^>=1.45 - , plutus-tx-plugin ^>=1.45 + , plutus-tx ^>=1.50 + , plutus-tx-plugin ^>=1.50 ------------------------ -- Non-IOG dependencies diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index f4a5391ee62..775b74ffbc7 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -154,7 +154,6 @@ library , random , serialise , streaming - , strict-stm , cardano-ledger-shelley , prettyprinter , stm diff --git a/cabal.project b/cabal.project index 0806ce2c599..7248ded2471 100644 --- a/cabal.project +++ b/cabal.project @@ -68,6 +68,9 @@ allow-newer: , fin:QuickCheck , bin:QuickCheck + -- TODO update those in ekg-forward instead of allow-newer + , ekg-forward:typed-protocols + , ekg-forward:ouroboros-network-framework if impl (ghc >= 9.12) allow-newer: @@ -110,7 +113,7 @@ source-repository-package ouroboros-consensus-diffusion ouroboros-consensus-protocol sop-extras - strict-sop-core + strict-sop-core source-repository-package type: git diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 3ee509f4c65..676e6a5b395 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 diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index e3e432f5dd8..d54fc2be39e 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -202,12 +202,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 diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 4da66a25165..2946815840c 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -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 diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 2c673e3d637..38313db38ee 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -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 @@ -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 diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index e60e54546a6..54df857f441 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -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/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 62116e54d4c..ae6cd857400 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -72,7 +72,7 @@ library , ekg-core , ekg-forward >= 0.9 , singletons ^>= 3.0 - , ouroboros-network-framework ^>= 0.18.0.1 + , ouroboros-network-framework ^>= 0.19 , serialise , stm , text From 0323395bf95b436bbebfddef840a2be356b0f214 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 18 Aug 2025 13:11:15 +0200 Subject: [PATCH 11/54] Try update ekg-forward --- cabal.project | 12 ++-- cardano-node/cardano-node.cabal | 3 +- .../src/Cardano/Node/Handlers/TopLevel.hs | 2 +- flake.lock | 24 +++---- trace-forward/src/Trace/Forward/Forwarding.hs | 69 +++++++++---------- trace-forward/trace-forward.cabal | 3 +- 6 files changed, 57 insertions(+), 56 deletions(-) diff --git a/cabal.project b/cabal.project index 7248ded2471..d53b1a6a9d8 100644 --- a/cabal.project +++ b/cabal.project @@ -68,10 +68,6 @@ allow-newer: , fin:QuickCheck , bin:QuickCheck - -- TODO update those in ekg-forward instead of allow-newer - , ekg-forward:typed-protocols - , ekg-forward:ouroboros-network-framework - if impl (ghc >= 9.12) allow-newer: -- https://github.com/kapralVV/Unique/issues/11 @@ -146,3 +142,11 @@ source-repository-package libs/small-steps libs/vector-map +source-repository-package + type: git + location: https://github.com/input-output-hk/ekg-forward/ + -- https://github.com/input-output-hk/ekg-forward/pull/42 + tag: d99a44f96b821770f4611f826e50452c89a9abe6 + --sha256: sha256-SHnyp+GvNeR82UXoKeDEgsp1AUE2yF5dGL4HIZm0zK8= + subdir: + . diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index d54fc2be39e..77e906f8363 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -217,8 +217,7 @@ library , tracer-transformers , transformers , transformers-except - , typed-protocols >= 1.0 - , typed-protocols-stateful + , typed-protocols:{typed-protocols, stateful} >= 1.0 , yaml executable cardano-node diff --git a/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs b/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs index e8260ef3474..d3f75919a97 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 as Network import Prelude diff --git a/flake.lock b/flake.lock index 79eae66edee..4983e4e0f8e 100644 --- a/flake.lock +++ b/flake.lock @@ -256,11 +256,11 @@ "hackage-for-stackage": { "flake": false, "locked": { - "lastModified": 1750897618, - "narHash": "sha256-MgzSJDtk9qXf+OYjqaGX7zebArRS236tgFKDAxV3OXw=", + "lastModified": 1755476929, + "narHash": "sha256-PnVieqvtAd43r1oUNEvMWN1gNGxkcdKRAKQldbrWEf8=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "5ac996932a885bee0083893ba7a4727b654b7e8d", + "rev": "729fb5197e8be4252291ac6e594e27d03c8ca79b", "type": "github" }, "original": { @@ -344,11 +344,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1750899099, - "narHash": "sha256-8Wy0VIdPoGd7JqaHT4ehfS87kW+xRn9XwSiRxu0nD9g=", + "lastModified": 1755478346, + "narHash": "sha256-aByPWQcReSv/mEWp4J7q3CI87YrUrAheEgMZvC5/LR0=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "c16c3c648b3a2eef0cb1fb3706da801764d77565", + "rev": "50cdda42e7eb2fbe2a229c3c5150c1b803b23fc2", "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": 1755476086, + "narHash": "sha256-WMAcokVQw3kSW6d4yoYBAIkhirrkc9yLzYkmV3mpSVE=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "3f8c717e24953914821f1ddb4797dd768326faa6", + "rev": "72c1b79dbcb8a9a7501c0d4c9fbb52a6ba6d8faf", "type": "github" }, "original": { diff --git a/trace-forward/src/Trace/Forward/Forwarding.hs b/trace-forward/src/Trace/Forward/Forwarding.hs index 363f258588b..b82ecee8c46 100644 --- a/trace-forward/src/Trace/Forward/Forwarding.hs +++ b/trace-forward/src/Trace/Forward/Forwarding.hs @@ -8,40 +8,40 @@ {-# 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 qualified Ouroboros.Network.Server.Simple as OServer 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.Socket (ConnectToArgs (..), HandshakeCallbacks (..), + SomeResponderApplication (..), connectToNode, nullNetworkConnectTracers) 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 @@ -313,34 +313,33 @@ doListenToAcceptor -> 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. + OServer.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) + responderApp + ) + $ \_ serverAsync -> + wait (serverAsync $> ()) where + responderApp _ = SomeResponderApplication $ + forwarderApp [ (forwardEKGMetricsRespRun, 1) + , (forwardTraceObjectsResp tfConfig sink, 2) + , (forwardDataPointsResp dpfConfig dpStore, 3) + ] forwarderApp :: [(RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void (), Word16)] -> OuroborosApplication 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index ae6cd857400..8ec1701bdd6 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -77,8 +77,7 @@ library , stm , text , trace-dispatcher - , typed-protocols ^>= 1.0 - , typed-protocols-cborg + , typed-protocols:{typed-protocols, cborg} ^>= 1.0 test-suite test import: project-config From 2c8dae5d424f6cbaa611a9dd30561ae2ce604e52 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 12 Jun 2025 15:16:47 +0200 Subject: [PATCH 12/54] Integrated ouroboros-network:cardano-diffusion package --- cardano-node/cardano-node.cabal | 7 +- .../Cardano/Node/Configuration/NodeAddress.hs | 10 +- .../src/Cardano/Node/Configuration/POM.hs | 44 +- .../src/Cardano/Node/Configuration/Socket.hs | 2 +- .../src/Cardano/Node/Handlers/TopLevel.hs | 2 +- cardano-node/src/Cardano/Node/Orphans.hs | 27 +- cardano-node/src/Cardano/Node/Parsers.hs | 1 - cardano-node/src/Cardano/Node/Run.hs | 863 +++++++----------- cardano-node/src/Cardano/Node/Startup.hs | 10 +- cardano-node/src/Cardano/Node/Tracing.hs | 14 +- cardano-node/src/Cardano/Node/Tracing/API.hs | 16 +- .../src/Cardano/Node/Tracing/Consistency.hs | 48 +- .../src/Cardano/Node/Tracing/Documentation.hs | 66 +- .../src/Cardano/Node/Tracing/Tracers.hs | 206 ++--- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 86 +- .../Cardano/Node/Tracing/Tracers/NonP2P.hs | 407 --------- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 158 +++- .../Cardano/Node/Tracing/Tracers/Startup.hs | 4 - cardano-node/src/Cardano/Tracing/Config.hs | 19 + .../Tracing/OrphanInstances/Network.hs | 770 +++------------- cardano-node/src/Cardano/Tracing/Tracers.hs | 233 ++--- cardano-node/test/Test/Cardano/Node/Gen.hs | 31 +- cardano-node/test/Test/Cardano/Node/POM.hs | 6 +- cardano-submit-api/cardano-submit-api.cabal | 1 - .../TxSubmit/Tracing/ToObjectOrphans.hs | 42 - .../src/Cardano/Tracer/Acceptors/Server.hs | 94 +- .../test/Cardano/Tracer/Test/Forwarder.hs | 83 +- trace-forward/src/Trace/Forward/Forwarding.hs | 40 +- 28 files changed, 889 insertions(+), 2401 deletions(-) delete mode 100644 cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs delete mode 100644 cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 77e906f8363..07b66586802 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 @@ -192,8 +191,8 @@ library , ouroboros-consensus-diffusion ^>= 0.23 , ouroboros-consensus-protocol , ouroboros-network-api ^>= 0.16 - , ouroboros-network ^>= 0.22 - , ouroboros-network-framework + , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22 + , ouroboros-network-framework , ouroboros-network-protocols ^>= 0.15 , prettyprinter , prettyprinter-ansi-terminal @@ -269,7 +268,7 @@ test-suite cardano-node-test , 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/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..09a952e05dd 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 @@ -794,9 +758,6 @@ makeNodeConfiguration pnc = do ncAcceptedConnectionsLimit <- lastToEither "Missing AcceptedConnectionsLimit" $ pncAcceptedConnectionsLimit pnc - enableP2P <- - lastToEither "Missing EnableP2P" - $ pncEnableP2P pnc ncChainSyncIdleTimeout <- Right $ maybe NoTimeoutOverride TimeoutOverride @@ -891,9 +852,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 d3f75919a97..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 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/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 18a83515fd8..88aec92ff3c 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,139 @@ 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 = nullTracer } - 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 - } + diffusionConfiguration :: Cardano.Diffusion.CardanoConfiguration IO + diffusionConfiguration = + mkDiffusionConfiguration + publicIPv4SocketOrAddr + publicIPv6SocketOrAddr + localSocketOrPath + publicPeerSelectionVar + nForkPolicy cForkPolicy + nc + (readTVar localRootsVar) + (readTVar publicRootsVar) + (readTVar useLedgerVar) + (readTVar ledgerPeerSnapshotVar) + 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 +573,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 +635,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 +667,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 +819,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 +850,77 @@ checkVRFFilePermissions _ (File vrfPrivKey) = do #endif -mkP2PArguments - :: Ord ntnAddr - => ForkPolicy ntnAddr - -> ForkPolicy ntcAddr +mkDiffusionConfiguration + :: Maybe SocketOrSocketInfo -- ^ ipv4 + -> Maybe SocketOrSocketInfo -- ^ ipv6 + -> Maybe LocalSocketOrSocketInfo -- ^ unix socket or a named pipe (Windows) + -> StrictTVar IO (PublicPeerSelectionState RemoteAddress) + -> ForkPolicy RemoteAddress + -> ForkPolicy LocalAddress -> NodeConfiguration -> 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 - } + -> Cardano.Diffusion.CardanoConfiguration IO +mkDiffusionConfiguration + publicIPv4SocketOrAddr + publicIPv6SocketOrAddr + localSocketOrPath + publicPeerSelectionVar + nForkPolicy cForkPolicy + nc + dcReadLocalRootPeers + dcReadPublicRootPeers + dcReadUseLedgerPeers + dcReadLedgerPeerSnapshot + = + 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 -- TODO allow expressing the Nothing case in the config + Just (ActualSocket localSocket) -> Just (Left localSocket) + Just (SocketInfo localAddr) -> Just (Right localAddr) + Nothing -> Nothing + , Diffusion.dcAcceptedConnectionsLimit = ncAcceptedConnectionsLimit nc + , Diffusion.dcMode = ncDiffusionMode nc + , Diffusion.dcPublicPeerSelectionVar = publicPeerSelectionVar + , Diffusion.dcPeerSelectionTargets = peerSelectionTargets + , 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 = nForkPolicy + , Diffusion.dcLocalMuxForkPolicy = cForkPolicy + , Diffusion.dcEgressPollInterval = ncEgressPollInterval nc + } where peerSelectionTargets = PeerSelectionTargets { - targetNumberOfRootPeers = ncDeadlineTargetOfRootPeers, - targetNumberOfKnownPeers = ncDeadlineTargetOfKnownPeers, - targetNumberOfEstablishedPeers = ncDeadlineTargetOfEstablishedPeers, - targetNumberOfActivePeers = ncDeadlineTargetOfActivePeers, - targetNumberOfKnownBigLedgerPeers = ncDeadlineTargetOfKnownBigLedgerPeers, - targetNumberOfEstablishedBigLedgerPeers = ncDeadlineTargetOfEstablishedBigLedgerPeers, - targetNumberOfActiveBigLedgerPeers = ncDeadlineTargetOfActiveBigLedgerPeers + 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/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/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/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 5451af4ba91..d33408a4bad 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.Diffusion.Types (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,135 +237,11 @@ 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 @@ -423,16 +277,16 @@ instance HasSeverityAnnotation (Mux.WithBearer peer Mux.Trace) where 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 +319,7 @@ instance HasSeverityAnnotation (TracePeerSelection extraDebugState extraFlags (C TraceDemoteLocalAsynchronous {} -> Warning TraceGovernorWakeup {} -> Info TraceChurnWait {} -> Info - TraceChurnMode {} -> Info + -- TraceChurnMode {} -> Info TraceForgetBigLedgerPeers {} -> Info @@ -508,8 +362,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) @@ -739,30 +593,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 +603,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 +613,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 +630,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 +662,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 +973,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 +1057,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 +1138,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 +1194,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 +1263,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 +1387,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 +1435,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 +1447,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 +1722,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 +1788,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 +1808,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 = @@ -2269,7 +1856,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 +1900,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 +1934,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 +2080,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 +2115,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 +2147,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 +2251,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/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..36da1005296 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,19 @@ genNodeSetup = <*> Gen.list (Range.linear 0 6) genRootConfig <*> genUseLedgerPeers -genDomainAddress :: Gen DomainAccessPoint -genDomainAddress = - DomainAccessPoint - <$> Gen.element cooking - <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) - 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-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 2946815840c..f00288fae1a 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -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-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/trace-forward/src/Trace/Forward/Forwarding.hs b/trace-forward/src/Trace/Forward/Forwarding.hs index b82ecee8c46..6a58331e8b3 100644 --- a/trace-forward/src/Trace/Forward/Forwarding.hs +++ b/trace-forward/src/Trace/Forward/Forwarding.hs @@ -26,12 +26,12 @@ import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionData import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion, simpleSingletonVersions) -import qualified Ouroboros.Network.Server.Simple as OServer -import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, MakeBearer, Snocket, - localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer, - socketSnocket) -import Ouroboros.Network.Socket (ConnectToArgs (..), HandshakeCallbacks (..), - SomeResponderApplication (..), connectToNode, nullNetworkConnectTracers) +import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, + makeLocalBearer, LocalAddress) +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) @@ -296,9 +296,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,28 +310,32 @@ doListenToAcceptor -> DataPointStore -> IO () doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits - ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do - OServer.with + ekgConfig tfConfig dpfConfig sink ekgStore dpStore = + void $ Server.with snocket makeBearer configureSocket address HandshakeArguments { - haBearerTracer = nullTracer, - haHandshakeTracer = nullTracer, - haHandshakeCodec = codecHandshake forwardingVersionCodec, + haHandshakeTracer = nullTracer, + haHandshakeCodec = codecHandshake forwardingVersionCodec, haVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, - haAcceptVersion = acceptableVersion, - haQueryVersion = queryVersion, - haTimeLimits = timeLimits + haAcceptVersion = acceptableVersion, + haQueryVersion = queryVersion, + haTimeLimits = timeLimits } (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData magic) - responderApp + (const $ SomeResponderApplication $ + forwarderApp [ (forwardEKGMetricsRespRun, 1) + , (forwardTraceObjectsResp tfConfig sink, 2) + , (forwardDataPointsResp dpfConfig dpStore, 3) + ] + ) ) $ \_ serverAsync -> - wait (serverAsync $> ()) + wait serverAsync -- Block until async exception. where responderApp _ = SomeResponderApplication $ forwarderApp [ (forwardEKGMetricsRespRun, 1) From 81422ce7e53e282e043c5b67a11ce9c1db6f0243 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Mon, 16 Jun 2025 16:36:18 +0200 Subject: [PATCH 13/54] Fixed failing tests --- cardano-node/test/Test/Cardano/Node/Gen.hs | 6 ++++-- .../Test/Cardano/Tracing/NewTracing/Consistency.hs | 3 +-- .../Cardano/Tracing/NewTracing/data/badConfig.yaml | 11 +---------- .../Cardano/Tracing/NewTracing/data/goodConfig.yaml | 8 +------- .../cardano/mainnet-config-new-tracing.json | 12 ------------ 5 files changed, 7 insertions(+), 33 deletions(-) diff --git a/cardano-node/test/Test/Cardano/Node/Gen.hs b/cardano-node/test/Test/Cardano/Node/Gen.hs index 36da1005296..4468bb47991 100644 --- a/cardano-node/test/Test/Cardano/Node/Gen.hs +++ b/cardano-node/test/Test/Cardano/Node/Gen.hs @@ -154,12 +154,14 @@ genNodeSetup = <*> Gen.list (Range.linear 0 6) genRootConfig <*> genUseLedgerPeers +-- Generates only fully qualified domain names. +-- genRelayAddress :: Gen RelayAccessPoint genRelayAddress = Gen.choice - [ RelayAccessDomain <$> Gen.element cooking + [ RelayAccessDomain <$> ((<> ".") <$> Gen.element cooking) <*> (fromIntegral <$> Gen.int (Range.linear 1000 9000)) - , RelayAccessSRVDomain <$> Gen.element cooking + , RelayAccessSRVDomain . (<> ".") <$> Gen.element cooking , RelayAccessAddress <$> Gen.choice [ IP.IPv4 . unNodeHostIPv4Address <$> genNodeHostIPv4Address 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/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" }, From c0d305b159ae30a4e1c630da767065d649b26f73 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Mon, 16 Jun 2025 17:19:08 +0200 Subject: [PATCH 14/54] Removed a stale TODO comment --- cardano-node/src/Cardano/Node/Run.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 88aec92ff3c..9f6cc1fec50 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -518,8 +518,9 @@ handleSimpleNode blockType runP tracers nc onKernel = do targetNumberOfActiveBigLedgerPeers = ncSyncTargetOfActiveBigLedgerPeers nc }, Cardano.Diffusion.minNumOfBigLedgerPeers = ncMinBigLedgerPeersForTrustedState nc, - Cardano.Diffusion.tracerChurnMode = nullTracer + Cardano.Diffusion.tracerChurnMode = churnModeTracer tracers } + diffusionConfiguration :: Cardano.Diffusion.CardanoConfiguration IO diffusionConfiguration = mkDiffusionConfiguration @@ -528,11 +529,11 @@ handleSimpleNode blockType runP tracers nc onKernel = do localSocketOrPath publicPeerSelectionVar nForkPolicy cForkPolicy - nc (readTVar localRootsVar) (readTVar publicRootsVar) (readTVar useLedgerVar) (readTVar ledgerPeerSnapshotVar) + nc in Node.run nodeArgs { @@ -857,25 +858,25 @@ mkDiffusionConfiguration -> StrictTVar IO (PublicPeerSelectionState RemoteAddress) -> ForkPolicy RemoteAddress -> ForkPolicy LocalAddress - -> NodeConfiguration -> 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 (Maybe LedgerPeerSnapshot) + -> NodeConfiguration -> Cardano.Diffusion.CardanoConfiguration IO mkDiffusionConfiguration publicIPv4SocketOrAddr publicIPv6SocketOrAddr localSocketOrPath - publicPeerSelectionVar - nForkPolicy cForkPolicy - nc + dcPublicPeerSelectionVar + dcMuxForkPolicy dcLocalMuxForkPolicy dcReadLocalRootPeers dcReadPublicRootPeers dcReadUseLedgerPeers dcReadLedgerPeerSnapshot + nc = Diffusion.Configuration { Diffusion.dcIPv4Address = @@ -889,14 +890,14 @@ mkDiffusionConfiguration Just (SocketInfo addr) -> Just (Right addr) Nothing -> Nothing , Diffusion.dcLocalAddress = - case localSocketOrPath of -- TODO allow expressing the Nothing case in the config + 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 = publicPeerSelectionVar - , Diffusion.dcPeerSelectionTargets = peerSelectionTargets + , Diffusion.dcPublicPeerSelectionVar + , Diffusion.dcPeerSelectionTargets , Diffusion.dcReadLocalRootPeers , Diffusion.dcReadPublicRootPeers , Diffusion.dcReadLedgerPeerSnapshot @@ -906,12 +907,12 @@ mkDiffusionConfiguration , Diffusion.dcTimeWaitTimeout = ncTimeWaitTimeout nc , Diffusion.dcDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval , Diffusion.dcBulkChurnInterval = Configuration.defaultBulkChurnInterval - , Diffusion.dcMuxForkPolicy = nForkPolicy - , Diffusion.dcLocalMuxForkPolicy = cForkPolicy + , Diffusion.dcMuxForkPolicy + , Diffusion.dcLocalMuxForkPolicy , Diffusion.dcEgressPollInterval = ncEgressPollInterval nc } where - peerSelectionTargets = PeerSelectionTargets { + dcPeerSelectionTargets = PeerSelectionTargets { targetNumberOfRootPeers = ncDeadlineTargetOfRootPeers nc, targetNumberOfKnownPeers = ncDeadlineTargetOfKnownPeers nc, targetNumberOfEstablishedPeers = ncDeadlineTargetOfEstablishedPeers nc, From 92081aa0b4442df8da2a22b4b58b4e05178e8dca Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 19 Aug 2025 18:48:08 +0200 Subject: [PATCH 15/54] More fixes, still not compiling yet --- cardano-node/cardano-node.cabal | 2 +- .../src/Cardano/Node/Configuration/Logging.hs | 3 +- .../src/Cardano/Node/Configuration/POM.hs | 1 - cardano-node/src/Cardano/Node/Queries.hs | 66 +++++++++++-------- .../src/Cardano/Node/Tracing/Era/Byron.hs | 9 --- .../src/Cardano/Node/Tracing/Era/HardFork.hs | 24 +------ .../src/Cardano/Node/Tracing/Era/Shelley.hs | 38 ++--------- .../Cardano/Tracing/OrphanInstances/Byron.hs | 10 --- .../Tracing/OrphanInstances/Consensus.hs | 55 +++++++++------- .../Tracing/OrphanInstances/HardFork.hs | 21 +----- .../Tracing/OrphanInstances/Network.hs | 45 +++++++------ .../Tracing/OrphanInstances/Shelley.hs | 40 +++-------- trace-forward/src/Trace/Forward/Forwarding.hs | 9 +-- 13 files changed, 116 insertions(+), 207 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 07b66586802..4ce5098120e 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -171,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 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/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 09a952e05dd..e79e5513818 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -668,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) diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 6575bf34ec0..0e3a1db1885 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,38 +289,40 @@ 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 non-exhaustive pattern matches 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.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 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.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.LedgerStateConway ledgerConway -> ledgerDelegMapSize ledgerConway 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.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.LedgerStateConway ledgerConway -> ledgerDRepCount ledgerConway 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.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.LedgerStateConway ledgerConway -> ledgerDRepMapSize ledgerConway -- diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs index ef3d1eb3729..7cd1390d8b8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs @@ -29,7 +29,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) @@ -212,11 +211,3 @@ instance LogFormatting ByronOtherHeaderEnvelopeError where [ "kind" .= String "UnexpectedEBBInSlot" , "slot" .= slot ] - -instance LogFormatting PBftSelectView where - forMachine _dtal (PBftSelectView blkNo 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..846378a12bf 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs @@ -26,7 +26,7 @@ import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), 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) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) @@ -345,23 +345,3 @@ instance All (LogFormatting `Compose` WrapForgeStateUpdateError) xs => LogFormat instance LogFormatting (ForgeStateUpdateError blk) => LogFormatting (WrapForgeStateUpdateError blk) where forMachine dtal = forMachine dtal . unwrapForgeStateUpdateError --- --- 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` WrapSelectView) xs => LogFormatting (OneEraSelectView xs) where - forMachine dtal = - hcollapse - . hcmap (Proxy @(LogFormatting `Compose` WrapSelectView)) - (K . forMachine dtal) - . getOneEraSelectView - -instance LogFormatting (SelectView (BlockProtocol blk)) => LogFormatting (WrapSelectView blk) where - forMachine dtal = forMachine dtal . unwrapSelectView 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/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 5112a7e3891..9edfde1eb44 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs @@ -21,14 +21,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) @@ -220,11 +218,3 @@ instance ToJSON ByronNodeToClientVersion where instance ToJSON ByronNodeToNodeVersion where toJSON ByronNodeToNodeVersion1 = String "ByronNodeToNodeVersion1" toJSON ByronNodeToNodeVersion2 = String "ByronNodeToNodeVersion2" - -instance ToObject PBftSelectView where - toObject _verb (PBftSelectView blkNo isEBB) = - mconcat - [ "kind" .= String "PBftSelectView" - , "blockNo" .= blkNo - , "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..d7f3f1a20a3 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 (RealPoint slotNo _headerHash) -> + "Popped block from queue at " <> Text.show slotNo 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..e467efed409 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -29,7 +29,7 @@ import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraForgeStateInfo (..), OneEraForgeStateUpdateError (..), OneEraLedgerError (..), - OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraSelectView (..), + OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..), mkEraMismatch) import Ouroboros.Consensus.HardFork.Combinator.Condense () import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common @@ -43,7 +43,7 @@ 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) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) @@ -427,20 +427,3 @@ instance ToJSON HardForkSpecificNodeToNodeVersion where instance (ToJSON (BlockNodeToNodeVersion blk)) => ToJSON (WrapNodeToNodeVersion blk) where toJSON (WrapNodeToNodeVersion blockNodeToNodeVersion) = toJSON blockNodeToNodeVersion --- --- 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` WrapSelectView) xs => ToObject (OneEraSelectView xs) where - toObject verb = - hcollapse - . hcmap (Proxy @(ToObject `Compose` WrapSelectView)) - (K . toObject verb) - . getOneEraSelectView - -instance ToObject (SelectView (BlockProtocol blk)) => ToObject (WrapSelectView blk) where - toObject verb = toObject verb . unwrapSelectView diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index d33408a4bad..f10b19b6500 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -49,7 +49,7 @@ import Ouroboros.Network.ConnectionManager.Core as ConnMgr (Trace (..) import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..)) import Ouroboros.Network.ConnectionManager.State (ConnStateId (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnMgr -import Ouroboros.Network.Diffusion.Types (DNSTrace (..)) +import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSTrace (..)) import qualified Ouroboros.Network.Diffusion.Types as Diffusion import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import qualified Ouroboros.Network.Driver.Stateful as Stateful @@ -244,6 +244,20 @@ instance HasSeverityAnnotation TraceLedgerPeers where 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 @@ -252,31 +266,14 @@ 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 CardanoTraceLocalRootPeers instance HasSeverityAnnotation CardanoTraceLocalRootPeers where getSeverityAnnotation _ = Info @@ -371,6 +368,7 @@ instance HasSeverityAnnotation (PeerSelectionActionsTrace SockAddr lAddr) where getSeverityAnnotation ev = case ev of PeerStatusChanged {} -> Info + PeerHotDuration {} -> Info PeerStatusChangeFailure {} -> Error PeerMonitoringError {} -> Error PeerMonitoringResult {} -> Debug @@ -1422,7 +1420,7 @@ instance ToObject CardanoTraceLocalRootPeers where ] toObject _verb (TraceLocalRootError d dexception) = mconcat [ "kind" .= String "LocalRootError" - -- TODO: `domainAddress` -> `domain` + -- TODO: `domainAddress` -> `domain` , "domainAddress" .= String (pack $ show d) , "reason" .= displayException dexception ] @@ -1836,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 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/trace-forward/src/Trace/Forward/Forwarding.hs b/trace-forward/src/Trace/Forward/Forwarding.hs index 6a58331e8b3..5a8ec774a6a 100644 --- a/trace-forward/src/Trace/Forward/Forwarding.hs +++ b/trace-forward/src/Trace/Forward/Forwarding.hs @@ -27,7 +27,7 @@ import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion, simpleSingletonVersions) import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, - makeLocalBearer, LocalAddress) + makeLocalBearer, LocalAddress, socketSnocket, makeSocketBearer, LocalSocket) import Ouroboros.Network.Socket (ConnectToArgs (..), HandshakeCallbacks (..), SomeResponderApplication (..), connectToNode, nullNetworkConnectTracers) @@ -36,7 +36,6 @@ import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) 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) @@ -317,6 +316,7 @@ doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits configureSocket address HandshakeArguments { + haBearerTracer = nullTracer, haHandshakeTracer = nullTracer, haHandshakeCodec = codecHandshake forwardingVersionCodec, haVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, @@ -337,11 +337,6 @@ doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits $ \_ serverAsync -> wait serverAsync -- Block until async exception. where - responderApp _ = SomeResponderApplication $ - forwarderApp [ (forwardEKGMetricsRespRun, 1) - , (forwardTraceObjectsResp tfConfig sink, 2) - , (forwardDataPointsResp dpfConfig dpStore, 3) - ] forwarderApp :: [(RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void (), Word16)] -> OuroborosApplication 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () From 6c289f3fb7c8ed48f265c227dbd8ab91e0eca89e Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Aug 2025 17:18:01 +0200 Subject: [PATCH 16/54] Update SRPs and flake.lock --- cabal.project | 17 ++++++++--------- flake.lock | 30 +++++++++++++++--------------- 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/cabal.project b/cabal.project index d53b1a6a9d8..85a5a8814e4 100644 --- a/cabal.project +++ b/cabal.project @@ -83,33 +83,32 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/intersectmbo/cardano-cli.git - tag: a894d0063f403222677c33152b3396bba87450bc - --sha256: sha256-Lqg+eGfdYphLbgS3LZ0Qf62mTLkibl6L8i7GOia0hoo= + tag: 801b1d7cce99c6d5afbe6af7d7ad1d7a2cde087c + --sha256: sha256-s6SvoDHCFXfMC5bNBFoDgxMDZuMhnE1ZZwx1L15yjL0= subdir: cardano-cli source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: 0eeff17265628f2ad055c9e63e0f9698759c2e0b - --sha256: sha256-XmuQTZdD/ZdCNlRuD+V5cNslEM05xwTACmMunzuCCJY= + tag: 64e62e7d6ac1bd250e4b61346f09ecd697ee2e90 + --sha256: sha256-RsLNzqPx0nDvXCUpBCVcylE3+kUoWBwUSHAQQERR5Pc= subdir: cardano-api - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 15fc8c4fee64473350e1904347bfd5852f9cdbfa - --sha256: sha256-Tvw0dLGZkBAflpvcEwl7Acnrux9H5UaniW5YwMvIeIs= + tag: 5aac28bec41b7709f75a5c9f20e2431259cf237f + --sha256: sha256-PXnD7mAIZgnodqbMU3ImCb/uoat61vLsqnc6dUyTRIw= subdir: ouroboros-consensus ouroboros-consensus-cardano ouroboros-consensus-diffusion ouroboros-consensus-protocol sop-extras - strict-sop-core + strict-sop-core source-repository-package type: git @@ -147,6 +146,6 @@ source-repository-package location: https://github.com/input-output-hk/ekg-forward/ -- https://github.com/input-output-hk/ekg-forward/pull/42 tag: d99a44f96b821770f4611f826e50452c89a9abe6 - --sha256: sha256-SHnyp+GvNeR82UXoKeDEgsp1AUE2yF5dGL4HIZm0zK8= + --sha256: sha256-HYE//uXDRrMBH+z49N7FQqFLVCJal++edANY6ioczJs= subdir: . diff --git a/flake.lock b/flake.lock index 4983e4e0f8e..d7c88fd4daa 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1751362725, - "narHash": "sha256-RQpTHF6VDPWELM4MHQahZrpEtv6ZxSx8oceWGAzJKco=", + "lastModified": 1755197699, + "narHash": "sha256-Qpmv1zYOfOzYZfU3sB3bsv/sGtI1c6MGTFiyhnYmmRA=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "4a6a3769c8cc8297ae8722e51fa5a4700b2db759", + "rev": "982aa1c76e28e26e592e26e8fd8b73eea87dbdc2", "type": "github" }, "original": { @@ -256,11 +256,11 @@ "hackage-for-stackage": { "flake": false, "locked": { - "lastModified": 1755476929, - "narHash": "sha256-PnVieqvtAd43r1oUNEvMWN1gNGxkcdKRAKQldbrWEf8=", + "lastModified": 1755649550, + "narHash": "sha256-YNKeqYIezur2MvPmfVI/aHjcVRwOdBW7Du3jg6iXjKs=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "729fb5197e8be4252291ac6e594e27d03c8ca79b", + "rev": "5e56db8bc478dfb7466ea83744c3ab928aff0329", "type": "github" }, "original": { @@ -289,11 +289,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1750944318, - "narHash": "sha256-DwjXWJqd3+Uhvx1OewJDMGxtny20vQvRF4iB+H8a3fs=", + "lastModified": 1755678982, + "narHash": "sha256-XKdl7BSKIxmhDvaINSSTRh82y8Fp9IOugTJuVZsj8Hw=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "1df55daef81b543cf3ccab4b1a5a536e32d8ce2a", + "rev": "6a9d82cf56bc2fd001515420b55d8e818e8cb072", "type": "github" }, "original": { @@ -344,11 +344,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1755478346, - "narHash": "sha256-aByPWQcReSv/mEWp4J7q3CI87YrUrAheEgMZvC5/LR0=", + "lastModified": 1755663895, + "narHash": "sha256-76Ns29GQsO5S5gPRcic+vagcJicOSvhA+oKQ9r9kjFE=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "50cdda42e7eb2fbe2a229c3c5150c1b803b23fc2", + "rev": "71fcc9f531993aada52173fceb4ff4ce2148207d", "type": "github" }, "original": { @@ -835,11 +835,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1755476086, - "narHash": "sha256-WMAcokVQw3kSW6d4yoYBAIkhirrkc9yLzYkmV3mpSVE=", + "lastModified": 1755648773, + "narHash": "sha256-NhcOu6GwYal+awBQLoMT4vf7L7Ar1DectDjK2mF653I=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "72c1b79dbcb8a9a7501c0d4c9fbb52a6ba6d8faf", + "rev": "1a0ea16d99761b93456460c255a8b723647b2c77", "type": "github" }, "original": { From b8a9e20b7b32021e8134e9ba2d13923d80bb61e3 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Aug 2025 17:29:34 +0200 Subject: [PATCH 17/54] nix build fix --- nix/haskell.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 [ ]; }) From 4f23de1353a43bae77fc136b6d5eaab0885f52f0 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 09:57:39 +0200 Subject: [PATCH 18/54] Fix non-exhaustive pattern-matching in LedgerQueries --- cardano-node/src/Cardano/Node/Queries.hs | 56 +++++++++++++----------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 0e3a1db1885..16286bf892a 100644 --- a/cardano-node/src/Cardano/Node/Queries.hs +++ b/cardano-node/src/Cardano/Node/Queries.hs @@ -290,40 +290,44 @@ instance (LedgerQueries x, NoHardForks x) ledgerDRepMapSize = ledgerDRepMapSize . unFlip . project . Flip -- TODO those states make no sense, since required lenses got moved to Conway --- TODO non-exhaustive pattern matches +-- 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.LedgerStateByron ledgerByron -> ledgerDelegMapSize 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 -> 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.LedgerStateByron ledgerByron -> ledgerDRepCount 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 -> 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.LedgerStateByron ledgerByron -> ledgerDRepMapSize 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 -> ledgerDRepMapSize ledgerConway + Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDRepMapSize ledgerDijkstra -- -- * Node kernel From b2c11707c20d0f957f1d26eb1ecb2e5d8958909f Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:08:26 +0200 Subject: [PATCH 19/54] Consensus traces: update ChainDB.PoppedBlockFromQueue trace --- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 41 ++++++++++++------- .../Tracing/OrphanInstances/Consensus.hs | 4 +- 2 files changed, 28 insertions(+), 17 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 1bf1c7a1284..3477f7b563e 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"] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index d7f3f1a20a3..07ceae75929 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -548,8 +548,8 @@ instance ( ConvertRawHash blk "ChainDB LoE debug event" ChainDB.PoppingFromQueue -> "Popping block from queue" - ChainDB.PoppedBlockFromQueue (RealPoint slotNo _headerHash) -> - "Popped block from queue at " <> Text.show slotNo + ChainDB.PoppedBlockFromQueue pt -> + "Popped block from queue: " <> renderRealPointAsPhrase pt ChainDB.StoreButDontChange pt -> "Ignoring block: " <> renderRealPointAsPhrase pt ChainDB.TryAddToCurrentChain pt -> From 66cd58a40527d7498aaeb8262bc136223211762a Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:32:11 +0200 Subject: [PATCH 20/54] Consensus traces: update Mempool traces --- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 36 +++++++------------ 1 file changed, 12 insertions(+), 24 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 9d978244a14..4fb7da5d442 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"] ] -------------------------------------------------------------------------------- From 34552bcd9fc1e3985061756f233bc329a6bc54d9 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:32:27 +0200 Subject: [PATCH 21/54] Consensus traces: update Genesis State Machine traces --- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 29 +++++++++++++++---- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 4fb7da5d442..4c91e284859 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -2060,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" @@ -2097,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"] @@ -2104,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"] -> @@ -2138,7 +2153,9 @@ instance MetaTrace (TraceGsmEvent selection) where ] allNamespaces = - [ Namespace [] ["EnterCaughtUp"] + [ Namespace [] ["InitializedInCaughtUp"] + , Namespace [] ["InitializedInPreSyncing"] + , Namespace [] ["EnterCaughtUp"] , Namespace [] ["LeaveCaughtUp"] , Namespace [] ["PreSyncingToSyncing"] , Namespace [] ["SyncingToPreSyncing"] From 782dc0afb04f2e56b69dc11b25e8745e02881584 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:39:26 +0200 Subject: [PATCH 22/54] Consensus traces: update LedgerDB.V2.FlavorImplSpecificTrace --- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 3477f7b563e..5c942c00c53 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -2234,40 +2234,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"] ] -------------------------------------------------------------------------------- From bd5c990e01952df019ee80a283f297c1b9b86b60 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 11:02:14 +0200 Subject: [PATCH 23/54] Consensus traces: update LedgerDB.TraceForkerEvent trace --- cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 5c942c00c53..cd397e3e900 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -1832,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" @@ -1843,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) = @@ -1865,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 @@ -1882,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 = [ @@ -1895,6 +1899,7 @@ instance MetaTrace LedgerDB.TraceForkerEvent where , Namespace [] ["Statistics"] , Namespace [] ["StartPush"] , Namespace [] ["FinishPush"] + , Namespace [] ["DanglingForkerClosed"] ] -------------------------------------------------------------------------------- From 82d3a804498cff4082af36ae74a4c6a3d823baf5 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 14:18:01 +0200 Subject: [PATCH 24/54] Consensus traces: update SelectView traces --- .../src/Cardano/Node/Tracing/Era/Byron.hs | 8 +++++ .../src/Cardano/Node/Tracing/Era/HardFork.hs | 28 +++++++++++++++-- .../Cardano/Tracing/OrphanInstances/Byron.hs | 10 ++++++ .../Tracing/OrphanInstances/HardFork.hs | 31 ++++++++++++++++--- 4 files changed, 70 insertions(+), 7 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs index 7cd1390d8b8..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) @@ -211,3 +212,10 @@ instance LogFormatting ByronOtherHeaderEnvelopeError where [ "kind" .= String "UnexpectedEBBInSlot" , "slot" .= slot ] + +instance LogFormatting PBftTiebreakerView where + forMachine _dtal (PBftTiebreakerView isEBB) = + mconcat + [ "kind" .= String "PBftSelectView" + , "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 846378a12bf..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 (..), + 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 (ValidationErr) +import Ouroboros.Consensus.Protocol.Abstract (ValidationErr, TiebreakerView(..), SelectView(..)) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) @@ -345,3 +345,25 @@ instance All (LogFormatting `Compose` WrapForgeStateUpdateError) xs => LogFormat instance LogFormatting (ForgeStateUpdateError blk) => LogFormatting (WrapForgeStateUpdateError blk) where forMachine dtal = forMachine dtal . unwrapForgeStateUpdateError +-- +-- instances for HardForkSelectView +-- + +instance All (LogFormatting `Compose` WrapTiebreakerView) xs => LogFormatting (HardForkTiebreakerView xs) where + forMachine dtal = forMachine dtal . getHardForkTiebreakerView + +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` WrapTiebreakerView)) + (K . forMachine dtal) + . getOneEraTiebreakerView + +instance LogFormatting (TiebreakerView (BlockProtocol blk)) => LogFormatting (WrapTiebreakerView blk) where + forMachine dtal = forMachine dtal . unwrapTiebreakerView diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 9edfde1eb44..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 (..)) @@ -218,3 +221,10 @@ instance ToJSON ByronNodeToClientVersion where instance ToJSON ByronNodeToNodeVersion where toJSON ByronNodeToNodeVersion1 = String "ByronNodeToNodeVersion1" toJSON ByronNodeToNodeVersion2 = String "ByronNodeToNodeVersion2" + +instance ToObject PBftTiebreakerView where + toObject _verb (PBftTiebreakerView isEBB) = + mconcat + [ "kind" .= String "PBftTiebreakerView" + , "isEBB" .= fromIsEBB isEBB + ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index e467efed409..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 (..), + 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 (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 @@ -427,3 +428,25 @@ instance ToJSON HardForkSpecificNodeToNodeVersion where instance (ToJSON (BlockNodeToNodeVersion blk)) => ToJSON (WrapNodeToNodeVersion blk) where toJSON (WrapNodeToNodeVersion blockNodeToNodeVersion) = toJSON blockNodeToNodeVersion +-- +-- instances for HardForkSelectView +-- + +instance All (ToObject `Compose` WrapTiebreakerView) xs => ToObject (HardForkTiebreakerView xs) where + toObject verb = toObject verb . getHardForkTiebreakerView + +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` WrapTiebreakerView)) + (K . toObject verb) + . getOneEraTiebreakerView + +instance ToObject (TiebreakerView (BlockProtocol blk)) => ToObject (WrapTiebreakerView blk) where + toObject verb = toObject verb . unwrapTiebreakerView From e6e2465432dc026a7d5818b7f4f7785e1983752d Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 24 Sep 2025 20:16:30 +0200 Subject: [PATCH 25/54] Bump cardano-api & cardano-cli --- bench/locli/locli.cabal | 2 +- bench/tx-generator/tx-generator.cabal | 4 ++-- cardano-node-chairman/cardano-node-chairman.cabal | 4 ++-- cardano-node/cardano-node.cabal | 4 ++-- cardano-submit-api/cardano-submit-api.cabal | 4 ++-- cardano-testnet/cardano-testnet.cabal | 6 +++--- cardano-tracer/cardano-tracer.cabal | 2 +- trace-forward/trace-forward.cabal | 2 +- 8 files changed, 14 insertions(+), 14 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index db130b95f45..46c7cbafa8f 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -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/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 775b74ffbc7..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 diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 676e6a5b395..0d523a5ba2c 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -74,7 +74,7 @@ test-suite chairman-tests , data-default-class , filepath , hedgehog - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , network , process , random @@ -89,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 4ce5098120e..58f6d333c7c 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -141,7 +141,7 @@ library , async , base16-bytestring , bytestring - , cardano-api ^>= 10.17 + , cardano-api ^>= 10.18 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>=0.2.2 @@ -262,7 +262,7 @@ test-suite cardano-node-test , filepath , hedgehog , hedgehog-corpus - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , iproute , mtl , ouroboros-consensus diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index f00288fae1a..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 diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 38313db38ee..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 @@ -70,7 +70,7 @@ library , extra , filepath , hedgehog - , hedgehog-extras ^>= 0.8 + , hedgehog-extras ^>= 0.10 , http-conduit , lens-aeson , microlens diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 54df857f441..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 diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 8ec1701bdd6..1b9780b5122 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -70,7 +70,7 @@ library , network-mux , ouroboros-network-api , ekg-core - , ekg-forward >= 0.9 + , ekg-forward >= 1.0 , singletons ^>= 3.0 , ouroboros-network-framework ^>= 0.19 , serialise From fd237cd442e4352f807c855e00791878dccf2da5 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 12:14:47 +0300 Subject: [PATCH 26/54] Update project and flake --- cabal.project | 66 +++++++++++++-------------------------------------- flake.lock | 12 +++++----- 2 files changed, 23 insertions(+), 55 deletions(-) diff --git a/cabal.project b/cabal.project index 85a5a8814e4..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-07-22T09:13:54Z - , cardano-haskell-packages 2025-07-28T14:33:19Z + , hackage.haskell.org 2025-09-24T20:00:55Z + , cardano-haskell-packages 2025-09-24T15:29:30Z packages: cardano-node @@ -91,61 +91,29 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: 64e62e7d6ac1bd250e4b61346f09ecd697ee2e90 - --sha256: sha256-RsLNzqPx0nDvXCUpBCVcylE3+kUoWBwUSHAQQERR5Pc= + tag: 7388805c2a56e2f628ca46924c648268cc61bbd2 + --sha256: sha256-YdFyulwmlwLDjVd6Bk+8IxQAdBSRCpacL5HzW3aCb7c= subdir: cardano-api - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 5aac28bec41b7709f75a5c9f20e2431259cf237f - --sha256: sha256-PXnD7mAIZgnodqbMU3ImCb/uoat61vLsqnc6dUyTRIw= - 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/IntersectMBO/cardano-ledger - tag: 20485948f78ab139d246695e540f9ec00963a16e - --sha256: sha256-SHnyp+GvNeR82UXoKeDEgsp1AUE2yF5dGL4HIZm0zK8= + -- latest master + tag: 71b02607c8a39ed4d8c983b281b05452ed8c01ce + --sha256: sha256-/vnZnAPsEuqQMzG5NGHaWk9vyefBWMft7/rKQ+yyYTQ= subdir: - eras/allegra/impl - eras/alonzo/impl - eras/alonzo/test-suite - eras/babbage/impl - eras/babbage/test-suite - eras/byron/chain/executable-spec - eras/byron/crypto - eras/byron/ledger/executable-spec - eras/byron/ledger/impl - eras/conway/impl - eras/dijkstra - eras/mary/impl - eras/shelley/impl - eras/shelley-ma/test-suite - eras/shelley/test-suite - libs/cardano-data - libs/cardano-ledger-api - libs/cardano-ledger-binary - libs/cardano-ledger-core - libs/cardano-protocol-tpraos - libs/non-integral - libs/set-algebra - libs/small-steps - libs/vector-map + 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/ekg-forward/ - -- https://github.com/input-output-hk/ekg-forward/pull/42 - tag: d99a44f96b821770f4611f826e50452c89a9abe6 - --sha256: sha256-HYE//uXDRrMBH+z49N7FQqFLVCJal++edANY6ioczJs= + location: https://github.com/input-output-hk/kes-agent + tag: bf203c4e7f7e6aab947b077e178baac3ecb2541d + --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= subdir: - . + kes-agent diff --git a/flake.lock b/flake.lock index d7c88fd4daa..ca3f3309682 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1755197699, - "narHash": "sha256-Qpmv1zYOfOzYZfU3sB3bsv/sGtI1c6MGTFiyhnYmmRA=", + "lastModified": 1758727647, + "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "982aa1c76e28e26e592e26e8fd8b73eea87dbdc2", + "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", "type": "github" }, "original": { @@ -289,11 +289,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1755678982, - "narHash": "sha256-XKdl7BSKIxmhDvaINSSTRh82y8Fp9IOugTJuVZsj8Hw=", + "lastModified": 1758759934, + "narHash": "sha256-VrTBELvtzIdsye3FZ5YVGb2CXQiyOFZPo3vsLZOFiO4=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6a9d82cf56bc2fd001515420b55d8e818e8cb072", + "rev": "84e95f44c5b56a81495f59702f56fa7d18695dcd", "type": "github" }, "original": { From 5ef078813e65f6d0afc2606af14ad2f679b4c526 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 19:33:32 +0200 Subject: [PATCH 27/54] Bump `cardano-cli` to `10.12.0.0` and `cardano-api` to `10.18` --- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 5854af24479..5501cf2645e 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -82,7 +82,7 @@ library -- IOG dependencies -------------------------- build-depends: - , cardano-api ^>=10.17 + , cardano-api ^>=10.18 , plutus-ledger-api ^>=1.50 , plutus-tx ^>=1.50 , plutus-tx-plugin ^>=1.50 From 470800342b373b9b2741ad9eeee98368aaabee15 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 20:29:57 +0200 Subject: [PATCH 28/54] Fix compilation errors --- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 7 ++-- cardano-testnet/src/Parsers/Cardano.hs | 37 +++++++++++++++++-- .../Cardano/Testnet/Test/Cli/Query.hs | 1 + 3 files changed, 38 insertions(+), 7 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index 92e69d15730..970cdf76a38 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -3,6 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Cardano.TxGenerator.Setup.Plutus @@ -24,7 +25,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra import Control.Monad.Writer (runWriter) -import Cardano.CLI.Read (readFileScriptInAnyLang) +import Cardano.CLI.Read (readFileScriptInAnyLang, ScriptDecodeError) import Cardano.Api import Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits) @@ -72,8 +73,8 @@ readPlutusScript (Left s) doLoad fp = second (second (const $ ResolvedToFallback asFileName)) <$> readPlutusScript (Right fp) readPlutusScript (Right fp) = runExceptT $ do - script <- - handleExceptT (\(e :: SomeException) -> ApiError $ displayException e) (readFileScriptInAnyLang fp) + script <- firstExceptT (ApiError @ScriptDecodeError) $ + 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/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index 1ae29345ad3..4419367f292 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -10,15 +10,13 @@ import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) - import Prelude import Control.Applicative import Data.Default.Class import Data.Functor import qualified Data.List as L -import Data.Maybe -import Data.Typeable +import Data.Maybe (fromMaybe, maybeToList) import Data.Word (Word64) import Options.Applicative (CommandFields, Mod, Parser) import qualified Options.Applicative as OA @@ -26,6 +24,8 @@ import qualified Options.Applicative as OA import Testnet.Start.Cardano import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) +import qualified Options.Applicative as Opt +import Cardano.Prelude (Typeable) optsTestnet :: EnvCli -> Parser CardanoTestnetCliOptions optsTestnet envCli = CardanoTestnetCliOptions @@ -80,7 +80,36 @@ pCardanoTestnetCliOptions envCli = CardanoTestnetOptions where pAnyShelleyBasedEra' :: Parser AnyShelleyBasedEra pAnyShelleyBasedEra' = - pAnyShelleyBasedEra envCli <&> (\(EraInEon x) -> AnyShelleyBasedEra x) + pAnyShelleyBasedEra <&> (\(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 pAnyShelleyBasedEra :: EnvCli -> Parser (EraInEon ShelleyBasedEra) pAnyShelleyBasedEra envCli = 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 b039ba78b08..3d013966327 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 @@ -63,6 +63,7 @@ import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types (GenesisOptions (..), NumPools (..), cardanoNumPools) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) import Testnet.Types +import RIO (runRIO) import Hedgehog import qualified Hedgehog as H From 8c9a9e7821fa4dba935acdf4b62bda6eadd6cc7d Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 23 Sep 2025 19:29:17 +0300 Subject: [PATCH 29/54] WIP: bump upper bounds --- cardano-node/cardano-node.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 58f6d333c7c..4fcdf59dcbb 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -191,8 +191,8 @@ library , ouroboros-consensus-diffusion ^>= 0.23 , ouroboros-consensus-protocol , ouroboros-network-api ^>= 0.16 - , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22 - , ouroboros-network-framework + , ouroboros-network ^>= 0.22.3 + , ouroboros-network-framework ^>= 0.19.1 , ouroboros-network-protocols ^>= 0.15 , prettyprinter , prettyprinter-ansi-terminal From 0db70eb0efea9f8cb503ce72f5b5bb3006c69750 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:04:14 +0300 Subject: [PATCH 30/54] WIP: fix dependencies --- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 6 +++--- cabal.project | 6 ++++++ cardano-node-chairman/cardano-node-chairman.cabal | 3 +-- cardano-node/cardano-node.cabal | 1 - cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 6 ++---- cardano-tracer/cardano-tracer.cabal | 6 +++--- trace-forward/trace-forward.cabal | 2 +- 8 files changed, 17 insertions(+), 15 deletions(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 5501cf2645e..897fcb80fe9 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.18 - , plutus-ledger-api ^>=1.50 - , plutus-tx ^>=1.50 - , plutus-tx-plugin ^>=1.50 + , plutus-ledger-api ^>=1.53 + , plutus-tx ^>=1.53 + , plutus-tx-plugin ^>=1.53 ------------------------ -- Non-IOG dependencies diff --git a/cabal.project b/cabal.project index 19155923773..7bb9462f411 100644 --- a/cabal.project +++ b/cabal.project @@ -117,3 +117,9 @@ source-repository-package --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= subdir: kes-agent + +source-repository-package + type: git + location: https://github.com/input-output-hk/ekg-forward + tag: bce3027d9123d51b51a9423dfce8090d132493b0 + --sha256: sha256-jLyJRIhDAQehaXKWp+RxruyFSSBtVsyM0QI12qa93V0= diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 0d523a5ba2c..5e9458c92bd 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.18 , cardano-node ^>= 10.5 , cardano-prelude , containers @@ -55,7 +55,6 @@ executable cardano-node-chairman , ouroboros-consensus-cardano , ouroboros-network-api , ouroboros-network-protocols - , io-classes , text , time diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 4fcdf59dcbb..b2e3d985c56 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -201,7 +201,6 @@ library , resource-registry , safe-exceptions , scientific - , io-classes , sop-core -- avoid stm-2.5.2 https://github.com/haskell/stm/issues/76 , stm <2.5.2 || >=2.5.3 diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 0509f28e7f5..0986cbc43b3 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -49,7 +49,7 @@ library , network , optparse-applicative-fork , ouroboros-consensus-cardano - , ouroboros-network ^>= 0.22 + , ouroboros-network ^>= 0.22.3 , ouroboros-network-protocols , prometheus >= 2.2.4 , safe-exceptions diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index f6ae63afdff..976804a2829 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -55,7 +55,7 @@ library , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley , cardano-node - , cardano-ping >= 0.9 + , cardano-ping ^>= 0.9 , cardano-prelude , contra-tracer , containers @@ -80,7 +80,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.22 + , ouroboros-network ^>= 0.22.3 , ouroboros-network-api , prettyprinter , process @@ -88,8 +88,6 @@ library , retry , safe-exceptions , scientific - , io-classes - , stm , tasty ^>= 1.5 , tasty-expected-failure , tasty-hedgehog diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 4c361fa23ef..d538b5ca1c3 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -17,7 +17,7 @@ extra-doc-files: README.md CHANGELOG.md flag rtview - description: Enable RTView. False by default. Enable with `-f +rtview`. + description: Enab2.3e RTView. False by default. Enable with `-f +rtview`. default: False manual: True @@ -187,7 +187,7 @@ library , network , network-mux >= 0.8 , optparse-applicative - , ouroboros-network ^>= 0.22 + , ouroboros-network ^>= 0.22.3 , ouroboros-network-api ^>= 0.16 , ouroboros-network-framework , signal @@ -421,7 +421,7 @@ test-suite cardano-tracer-test-ext , network , network-mux , optparse-applicative-fork >= 0.18.1 - , ouroboros-network + , ouroboros-network ^>= 0.22.3 , ouroboros-network-api , ouroboros-network-framework , process diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 1b9780b5122..7366cebc3aa 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -72,7 +72,7 @@ library , ekg-core , ekg-forward >= 1.0 , singletons ^>= 3.0 - , ouroboros-network-framework ^>= 0.19 + , ouroboros-network-framework ^>= 0.19.1 , serialise , stm , text From 1057b4fc8b2836614a17e14ab5bcfa02a838964c Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:07:50 +0300 Subject: [PATCH 31/54] Depend on new ekg-forward --- cabal.project | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cabal.project b/cabal.project index 7bb9462f411..19155923773 100644 --- a/cabal.project +++ b/cabal.project @@ -117,9 +117,3 @@ source-repository-package --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= subdir: kes-agent - -source-repository-package - type: git - location: https://github.com/input-output-hk/ekg-forward - tag: bce3027d9123d51b51a9423dfce8090d132493b0 - --sha256: sha256-jLyJRIhDAQehaXKWp+RxruyFSSBtVsyM0QI12qa93V0= From 57dd6c8c1f82ee62e17fa38bc3ff11e69f106828 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 12:59:33 +0300 Subject: [PATCH 32/54] Regenerate flake.lock --- flake.lock | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/flake.lock b/flake.lock index a63b7e39c62..ca3f3309682 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758714403, - "narHash": "sha256-1nejLJgkcqYc4dBczfTfEn/EzoRLzwHTGMyz2yfGvhk=", + "lastModified": 1758727647, + "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "12422309cf465da471e5eaa8dfbe68364e58721b", + "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", "type": "github" }, "original": { @@ -289,11 +289,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1758633641, - "narHash": "sha256-F70VZjt/AlmelvF9VHbHP6UaUnUgeWR5t/r0jsmAPVg=", + "lastModified": 1758759934, + "narHash": "sha256-VrTBELvtzIdsye3FZ5YVGb2CXQiyOFZPo3vsLZOFiO4=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "4601442c80824463bc4794a70a04091f2bf87a22", + "rev": "84e95f44c5b56a81495f59702f56fa7d18695dcd", "type": "github" }, "original": { From 57da6675939ef6148c4fefbe594db458f65c6277 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 15:46:41 +0300 Subject: [PATCH 33/54] WIP: fix compilation errors in cardano-node package --- cardano-node/cardano-node.cabal | 2 +- cardano-node/src/Cardano/Node/Configuration/POM.hs | 2 +- cardano-node/src/Cardano/Node/Orphans.hs | 2 -- cardano-node/src/Cardano/Node/Tracing/Render.hs | 2 ++ cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs | 2 +- cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs | 1 + 6 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index b2e3d985c56..27ceb438c5b 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -191,7 +191,7 @@ library , ouroboros-consensus-diffusion ^>= 0.23 , ouroboros-consensus-protocol , ouroboros-network-api ^>= 0.16 - , ouroboros-network ^>= 0.22.3 + , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22.3 , ouroboros-network-framework ^>= 0.19.1 , ouroboros-network-protocols ^>= 0.15 , prettyprinter diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index e79e5513818..94383e5ac43 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -646,7 +646,7 @@ defaultPartialNodeConfiguration = -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultAcceptedConnectionsLimit , pncChainSyncIdleTimeout = mempty - , pncDeadlineTargetOfRootPeers = Last (Just $ targetNumberOfRootPeers Ouroboros.defaultDeadlineTargets) + , pncDeadlineTargetOfRootPeers = Last (Just $ targetNumberOfRootPeers (Ouroboros.defaultDeadlineTargets _)) , pncDeadlineTargetOfKnownPeers = Last (Just $ targetNumberOfKnownPeers Ouroboros.defaultDeadlineTargets) , pncDeadlineTargetOfEstablishedPeers = Last (Just $ targetNumberOfEstablishedPeers Ouroboros.defaultDeadlineTargets) , pncDeadlineTargetOfActivePeers = Last (Just $ targetNumberOfActivePeers Ouroboros.defaultDeadlineTargets) diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index a511674370c..beee7e97337 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -8,13 +8,11 @@ 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.SizeInBytes (SizeInBytes (..)) -import Ouroboros.Network.OrphanInstances () import Data.Aeson.Types import qualified Data.Text as Text diff --git a/cardano-node/src/Cardano/Node/Tracing/Render.hs b/cardano-node/src/Cardano/Node/Tracing/Render.hs index 21eb099be60..0c84e550b4b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Render.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Render.hs @@ -208,6 +208,8 @@ renderScriptPurpose = Api.AlonzoEraOnwardsAlonzo -> renderAlonzoPlutusPurpose Api.AlonzoEraOnwardsBabbage -> renderAlonzoPlutusPurpose Api.AlonzoEraOnwardsConway -> renderConwayPlutusPurpose + -- TODO: fix + Api.AlonzoEraOnwardsDijkstra -> undefined ) renderAlonzoPlutusPurpose :: () diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index f10b19b6500..d464a8dd0d2 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -2307,4 +2307,4 @@ instance ToObject DNSTrace where mconcat [ "kind" .= String "SRVLookupError" , "peerKind" .= String (pack . show $ peerKind) , "domain" .= String (pack . show $ domain) - ] + ] \ No newline at end of file diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index bddab08a27a..2e58c655c9a 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PackageImports #-} module Cardano.Tracer.Acceptors.Server ( runAcceptorsServer From 8abde9fd3bd5b291751dd19ed3fff215fedbc12f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 2 Oct 2025 19:52:26 +0200 Subject: [PATCH 34/54] WIP: partial fixes for ledger stuff --- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 52 ++++-------------- .../Tracing/OrphanInstances/Consensus.hs | 13 +++-- .../Tracing/OrphanInstances/HardFork.hs | 2 +- .../Tracing/OrphanInstances/Shelley.hs | 55 ++++--------------- 4 files changed, 31 insertions(+), 91 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index ee7153fbb44..7e4100dde02 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -182,6 +182,9 @@ instance LogFormatting (Conway.ConwayDelegPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "Delegated rep is not registered for provided stake key" ] + -- TODO: fix + Conway.DepositIncorrectDELEG _ -> undefined + Conway.RefundIncorrectDELEG _ -> undefined instance ( ShelleyCompatible protocol era @@ -376,6 +379,8 @@ instance ] ) (Api.shelleyBasedEra :: Api.ShelleyBasedEra era) + -- TODO: fix + forMachine _ (ScriptIntegrityHashMismatch _ _) = undefined instance ( Consensus.ShelleyBasedEra era @@ -543,8 +548,6 @@ instance , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] - forMachine _dtal Allegra.TriesToForgeADA = - mconcat [ "kind" .= String "TriesToForgeADA" ] forMachine _dtal (Allegra.OutputTooBigUTxO badOutputs) = mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs @@ -714,48 +717,13 @@ instance LogFormatting (ShelleyPoolPredFailure era) where , "poolId" .= String (textShow poolId) , "error" .= String "Wrong network ID in pool registration certificate" ] + -- TODO: fix + forMachine _dtal (VRFKeyHashAlreadyRegistered _ _) = undefined -instance - ( LogFormatting (PredicateFailure (Ledger.EraRule "NEWEPOCH" era)) - , LogFormatting (PredicateFailure (Ledger.EraRule "RUPD" era)) - ) => LogFormatting (ShelleyTickPredFailure era) where - forMachine dtal (NewEpochFailure f) = forMachine dtal f - forMachine dtal (RupdFailure f) = forMachine dtal f - instance LogFormatting TicknPredicateFailure where forMachine _dtal x = case x of {} -- no constructors -instance - ( LogFormatting (PredicateFailure (Ledger.EraRule "EPOCH" era)) - , LogFormatting (PredicateFailure (Ledger.EraRule "MIR" era)) - ) => LogFormatting (ShelleyNewEpochPredFailure era) where - forMachine dtal (EpochFailure f) = forMachine dtal f - forMachine dtal (MirFailure f) = forMachine dtal f - - -instance - ( LogFormatting (PredicateFailure (Ledger.EraRule "POOLREAP" era)) - , LogFormatting (PredicateFailure (Ledger.EraRule "SNAP" era)) - , LogFormatting (UpecPredFailure era) - ) => LogFormatting (ShelleyEpochPredFailure era) where - forMachine dtal (PoolReapFailure f) = forMachine dtal f - forMachine dtal (SnapFailure f) = forMachine dtal f - forMachine dtal (UpecFailure f) = forMachine dtal f - - -instance LogFormatting (ShelleyPoolreapPredFailure era) where - forMachine _dtal x = case x of {} -- no constructors - -instance LogFormatting (ShelleySnapPredFailure era) where - forMachine _dtal x = case x of {} -- no constructors - -instance LogFormatting (ShelleyMirPredFailure era) where - forMachine _dtal x = case x of {} -- no constructors - -instance LogFormatting (ShelleyRupdPredFailure era) where - forMachine _dtal x = case x of {} -- no constructors - instance ( Ledger.Crypto crypto @@ -937,8 +905,6 @@ instance , "outputs" .= txouts , "error" .= String "The Byron address attributes are too big" ] - forMachine _dtal Alonzo.TriesToForgeADA = - mconcat [ "kind" .= String "TriesToForgeADA" ] forMachine _dtal (Alonzo.OutputTooBigUTxO badOutputs) = mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs @@ -1057,6 +1023,8 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= s ] + -- TODO: fix + Babbage.ScriptIntegrityHashMismatch _ _ -> undefined -------------------------------------------------------------------------------- -- Conway related -------------------------------------------------------------------------------- @@ -1506,6 +1474,8 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= scripts ] + -- TODO: fix + Conway.ScriptIntegrityHashMismatch _ -> undefined -------------------------------------------------------------------------------- -- Helper functions diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 07ceae75929..ecd3889c233 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -147,7 +147,7 @@ instance ConvertRawHash blk => ConvertRawHash (HeaderWithTime blk) where instance HasPrivacyAnnotation (ChainDB.TraceEvent blk) instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where getSeverityAnnotation (ChainDB.TraceAddBlockEvent ev) = case ev of - ChainDB.IgnoreBlockOlderThanK {} -> Info + ChainDB.IgnoreBlockOlderThanImmTip {} -> Info ChainDB.IgnoreBlockAlreadyInVolatileDB {} -> Info ChainDB.IgnoreInvalidBlock {} -> Info ChainDB.AddedBlockToQueue {} -> Debug @@ -528,8 +528,8 @@ instance ( ConvertRawHash blk formatText tev _obj = case tev of ChainDB.TraceLastShutdownUnclean -> "ChainDB is not clean. Validating all immutable chunks" ChainDB.TraceAddBlockEvent ev -> case ev of - ChainDB.IgnoreBlockOlderThanK pt -> - "Ignoring block older than K: " <> renderRealPointAsPhrase pt + ChainDB.IgnoreBlockOlderThanImmTip pt -> + "Ignoring block older than ImmTip: " <> renderRealPointAsPhrase pt ChainDB.IgnoreBlockAlreadyInVolatileDB pt -> "Ignoring block already in DB: " <> renderRealPointAsPhrase pt ChainDB.IgnoreInvalidBlock pt _reason -> @@ -928,8 +928,8 @@ instance ( ConvertRawHash blk toObject _verb ChainDB.TraceLastShutdownUnclean = mconcat [ "kind" .= String "TraceLastShutdownUnclean" ] toObject verb (ChainDB.TraceAddBlockEvent ev) = case ev of - ChainDB.IgnoreBlockOlderThanK pt -> - mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockOlderThanK" + ChainDB.IgnoreBlockOlderThanImmTip pt -> + mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockOlderThanImmTip" , "block" .= toObject verb pt ] ChainDB.IgnoreBlockAlreadyInVolatileDB pt -> mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockAlreadyInVolatileDB" @@ -1759,6 +1759,9 @@ instance HasSeverityAnnotation (TraceGsmEvent selection) where GsmEventLeaveCaughtUp{} -> Warning GsmEventPreSyncingToSyncing{} -> Notice GsmEventSyncingToPreSyncing{} -> Notice + -- TODO: fix + GsmEventInitializedInCaughtUp{} -> undefined + GsmEventInitializedInPreSyncing{} -> undefined instance ToObject selection => Transformable Text IO (TraceGsmEvent selection) where trTransformer = trStructured diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 9053e950980..14186c2f1dd 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -22,7 +22,7 @@ import Cardano.Slotting.Slot (EpochSize (..)) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Consensus () import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateInfo, - ForgeStateUpdateError, BlockSupportsProtocol (tiebreakerView)) + ForgeStateUpdateError) import Ouroboros.Consensus.BlockchainTime (getSlotLength) import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.HardFork.Combinator diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 6a9c9e37656..fa52067f8a1 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -220,6 +220,9 @@ instance ToObject (Conway.ConwayDelegPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "Delegated rep is not registered for provided stake key" ] + -- TODO: fix + Conway.DepositIncorrectDELEG _ -> undefined + Conway.RefundIncorrectDELEG _ -> undefined instance ToObject (Set (Credential 'Staking)) where toObject _verb creds = @@ -481,6 +484,8 @@ instance ] ) (Api.shelleyBasedEra :: Api.ShelleyBasedEra era) + -- TODO: fix + toObject _ _ = undefined instance ( ToObject (PredicateFailure (Core.EraRule "UTXO" ledgerera)) @@ -649,8 +654,6 @@ instance , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] - toObject _verb Allegra.TriesToForgeADA = - mconcat [ "kind" .= String "TriesToForgeADA" ] toObject _verb (Allegra.OutputTooBigUTxO badOutputs) = mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs @@ -811,6 +814,8 @@ instance ToObject (ShelleyPoolPredFailure era) where , "hashSize" .= String (textShow hashSize) , "error" .= String "The stake pool metadata hash is too large" ] + -- TODO: fix + toObject _verb (VRFKeyHashAlreadyRegistered _ _) = undefined -- Apparently this should never happen according to the Shelley exec spec -- toObject _verb (WrongCertificateTypePOOL index) = @@ -840,49 +845,9 @@ instance ToObject (ShelleyPoolPredFailure era) where , "error" .= String "Wrong network ID in pool registration certificate" ] -instance - ( ToObject (PredicateFailure (Core.EraRule "NEWEPOCH" ledgerera)) - , ToObject (PredicateFailure (Core.EraRule "RUPD" ledgerera)) - ) => ToObject (ShelleyTickPredFailure ledgerera) where - toObject verb (NewEpochFailure f) = toObject verb f - toObject verb (RupdFailure f) = toObject verb f - instance ToObject TicknPredicateFailure where toObject _verb x = case x of {} -- no constructors -instance - ( ToObject (PredicateFailure (Core.EraRule "EPOCH" ledgerera)) - , ToObject (PredicateFailure (Core.EraRule "MIR" ledgerera)) - ) => ToObject (ShelleyNewEpochPredFailure ledgerera) where - toObject verb (EpochFailure f) = toObject verb f - toObject verb (MirFailure f) = toObject verb f - - -instance - ( ToObject (PredicateFailure (Core.EraRule "POOLREAP" ledgerera)) - , ToObject (PredicateFailure (Core.EraRule "SNAP" ledgerera)) - , ToObject (UpecPredFailure ledgerera) - ) => ToObject (ShelleyEpochPredFailure ledgerera) where - toObject verb (PoolReapFailure f) = toObject verb f - toObject verb (SnapFailure f) = toObject verb f - toObject verb (UpecFailure f) = toObject verb f - - -instance ToObject (ShelleyPoolreapPredFailure ledgerera) where - toObject _verb x = case x of {} -- no constructors - - -instance ToObject (ShelleySnapPredFailure ledgerera) where - toObject _verb x = case x of {} -- no constructors - -instance ToObject (ShelleyMirPredFailure ledgerera) where - toObject _verb x = case x of {} -- no constructors - - -instance ToObject (ShelleyRupdPredFailure ledgerera) where - toObject _verb x = case x of {} -- no constructors - - instance Core.Crypto crypto => ToObject (PrtclPredicateFailure crypto) where toObject verb (OverlayFailure f) = toObject verb f toObject verb (UpdnFailure f) = toObject verb f @@ -1095,8 +1060,6 @@ instance , "outputs" .= txouts , "error" .= String "The Byron address attributes are too big" ] - toObject _verb Alonzo.TriesToForgeADA = - mconcat [ "kind" .= String "TriesToForgeADA" ] toObject _verb (Alonzo.OutputTooBigUTxO badOutputs) = mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs @@ -1219,6 +1182,8 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= s ] + -- TODO: fix + Babbage.ScriptIntegrityHashMismatch _ _ -> undefined instance Core.Crypto crypto => ToObject (Praos.PraosValidationErr crypto) where toObject _ err' = @@ -1559,6 +1524,8 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= scripts ] + -- TODO: fix + Conway.ScriptIntegrityHashMismatch _ _ -> undefined -------------------------------------------------------------------------------- -- Helper functions From e49332752a0a69cd71ee2852b51ad083d58d800a Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 17:01:21 +0300 Subject: [PATCH 35/54] WIP: fix ledger stuff --- cardano-node/src/Cardano/Node/Protocol/Shelley.hs | 6 +++--- cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs | 2 +- .../src/Cardano/Node/Tracing/Tracers/ChainDB.hs | 12 ++++++------ .../src/Cardano/Node/Tracing/Tracers/Consensus.hs | 3 +++ .../src/Cardano/Tracing/OrphanInstances/Byron.hs | 3 +-- .../src/Cardano/Tracing/OrphanInstances/HardFork.hs | 1 - 6 files changed, 14 insertions(+), 13 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index 63371c48259..91d067c5ba2 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -259,11 +259,11 @@ mkPraosLeaderCredentials ShelleyLeaderCredentials { shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader { - praosCanBeLeaderOpCert = opcert, praosCanBeLeaderColdVerKey = coerceKeyRole vkey, - praosCanBeLeaderSignKeyVRF = vrfKey + praosCanBeLeaderSignKeyVRF = vrfKey, + -- TODO: fix + praosCanBeLeaderCredentialsSource = undefined }, - shelleyLeaderCredentialsInitSignKey = kesKey, shelleyLeaderCredentialsLabel = "Shelley" } diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 7e4100dde02..436b2fcb96f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -1475,7 +1475,7 @@ instance , "scripts" .= scripts ] -- TODO: fix - Conway.ScriptIntegrityHashMismatch _ -> undefined + Conway.ScriptIntegrityHashMismatch _ _ -> undefined -------------------------------------------------------------------------------- -- Helper functions diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index cd397e3e900..11371a80571 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -399,8 +399,8 @@ instance ( LogFormatting (Header blk) , InspectLedger blk , HasIssuer blk ) => LogFormatting (ChainDB.TraceAddBlockEvent blk) where - forHuman (ChainDB.IgnoreBlockOlderThanK pt) = - "Ignoring block older than K: " <> renderRealPointAsPhrase pt + forHuman (ChainDB.IgnoreBlockOlderThanImmTip pt) = + "Ignoring block older than ImmTip: " <> renderRealPointAsPhrase pt forHuman (ChainDB.IgnoreBlockAlreadyInVolatileDB pt) = "Ignoring block already in DB: " <> renderRealPointAsPhrase pt forHuman (ChainDB.IgnoreInvalidBlock pt _reason) = @@ -445,8 +445,8 @@ instance ( LogFormatting (Header blk) "Poppped request from queue to reprocess blocks postponed by LoE." forHuman ChainDB.ChainSelectionLoEDebug{} = "ChainDB LoE debug event" - forMachine dtal (ChainDB.IgnoreBlockOlderThanK pt) = - mconcat [ "kind" .= String "IgnoreBlockOlderThanK" + forMachine dtal (ChainDB.IgnoreBlockOlderThanImmTip pt) = + mconcat [ "kind" .= String "IgnoreBlockOlderThanImmTip" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.IgnoreBlockAlreadyInVolatileDB pt) = mconcat [ "kind" .= String "IgnoreBlockAlreadyInVolatileDB" @@ -625,8 +625,8 @@ instance ( LogFormatting (Header blk) instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where - namespaceFor ChainDB.IgnoreBlockOlderThanK {} = - Namespace [] ["IgnoreBlockOlderThanK"] + namespaceFor ChainDB.IgnoreBlockOlderThanImmTip {} = + Namespace [] ["IgnoreBlockOlderThanImmTip"] namespaceFor ChainDB.IgnoreBlockAlreadyInVolatileDB {} = Namespace [] ["IgnoreBlockAlreadyInVolatileDB"] namespaceFor ChainDB.IgnoreInvalidBlock {} = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 4c91e284859..6f45d6225cc 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -2097,6 +2097,9 @@ instance ( LogFormatting selection GsmEventLeaveCaughtUp {} -> [preSyncing] GsmEventPreSyncingToSyncing {} -> [syncing] GsmEventSyncingToPreSyncing {} -> [preSyncing] + -- TODO: fix + GsmEventInitializedInCaughtUp {} -> undefined + GsmEventInitializedInPreSyncing {} -> undefined where preSyncing = IntM "GSM.state" 0 syncing = IntM "GSM.state" 1 diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 35ccc9fa59a..b0c53901553 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs @@ -12,8 +12,7 @@ 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.Protocol.PBFT (PBftTiebreakerView(..)) import Ouroboros.Consensus.Block.EBB (fromIsEBB) import Cardano.Chain.Block (ABlockOrBoundaryHdr (..), AHeader (..), ChainValidationError (..), delegationCertificate) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 14186c2f1dd..8c75604c5cb 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -46,7 +46,6 @@ import Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToCli 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 From bcb34b7bee5fb7b00c9994d10b1c75407e700d3f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:08:59 +0200 Subject: [PATCH 36/54] New Dijkstra configuration --- cardano-node/cardano-node.cabal | 2 + .../src/Cardano/Node/Configuration/POM.hs | 15 ++++++ cardano-node/src/Cardano/Node/Protocol.hs | 2 + .../src/Cardano/Node/Protocol/Cardano.hs | 27 +++++++++- .../src/Cardano/Node/Protocol/Dijkstra.hs | 54 +++++++++++++++++++ cardano-node/src/Cardano/Node/Startup.hs | 3 +- .../Cardano/Node/Tracing/Tracers/Startup.hs | 15 +++--- cardano-node/src/Cardano/Node/Types.hs | 21 +++++++- 8 files changed, 128 insertions(+), 11 deletions(-) create mode 100644 cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 27ceb438c5b..3a82bf3d035 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -78,6 +78,7 @@ library Cardano.Node.Protocol.Cardano Cardano.Node.Protocol.Checkpoints Cardano.Node.Protocol.Conway + Cardano.Node.Protocol.Dijkstra Cardano.Node.Protocol.Shelley Cardano.Node.Protocol.Types Cardano.Node.Queries @@ -153,6 +154,7 @@ library , cardano-ledger-byron , cardano-ledger-conway , cardano-ledger-core + , cardano-ledger-dijkstra , cardano-ledger-shelley , cardano-prelude , cardano-protocol-tpraos >= 1.4 diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 94383e5ac43..e397d356145 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -332,6 +332,7 @@ instance FromJSON PartialNodeConfiguration where <*> parseShelleyProtocol v <*> parseAlonzoProtocol v <*> parseConwayProtocol v + <*> parseDijkstraProtocol v <*> parseHardForkProtocol v <*> parseCheckpoints v pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v @@ -545,6 +546,14 @@ instance FromJSON PartialNodeConfiguration where , npcConwayGenesisFileHash } + parseDijkstraProtocol v = do + npcDijkstraGenesisFile <- v .: "DijkstraGenesisFile" + npcDijkstraGenesisFileHash <- v .:? "DijkstraGenesisHash" + pure NodeDijkstraProtocolConfiguration { + npcDijkstraGenesisFile + , npcDijkstraGenesisFileHash + } + parseHardForkProtocol v = do npcExperimentalHardForksEnabled <- do @@ -576,6 +585,9 @@ instance FromJSON PartialNodeConfiguration where npcTestConwayHardForkAtEpoch <- v .:? "TestConwayHardForkAtEpoch" npcTestConwayHardForkAtVersion <- v .:? "TestConwayHardForkAtVersion" + npcTestDijkstraHardForkAtEpoch <- v .:? "TestDijkstraHardForkAtEpoch" + npcTestDijkstraHardForkAtVersion <- v .:? "TestDijkstraHardForkAtVersion" + pure NodeHardForkProtocolConfiguration { npcExperimentalHardForksEnabled @@ -596,6 +608,9 @@ instance FromJSON PartialNodeConfiguration where , npcTestConwayHardForkAtEpoch , npcTestConwayHardForkAtVersion + + , npcTestDijkstraHardForkAtEpoch + , npcTestDijkstraHardForkAtVersion } parseCheckpoints v = do diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs index 8fff29fdad0..b77d2a7db2e 100644 --- a/cardano-node/src/Cardano/Node/Protocol.hs +++ b/cardano-node/src/Cardano/Node/Protocol.hs @@ -30,6 +30,7 @@ mkConsensusProtocol ncProtocolConfig mProtocolFiles = shelleyConfig alonzoConfig conwayConfig + dijkstraConfig hardForkConfig checkpointsConfig -> firstExceptT CardanoProtocolInstantiationError $ @@ -38,6 +39,7 @@ mkConsensusProtocol ncProtocolConfig mProtocolFiles = shelleyConfig alonzoConfig conwayConfig + dijkstraConfig hardForkConfig checkpointsConfig mProtocolFiles diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index d720c816d73..235347f3a3e 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -26,6 +26,7 @@ import qualified Cardano.Node.Protocol.Byron as Byron import Cardano.Node.Protocol.Checkpoints import qualified Cardano.Node.Protocol.Conway as Conway import qualified Cardano.Node.Protocol.Shelley as Shelley +import qualified Cardano.Node.Protocol.Dijkstra as Dijkstra import Cardano.Node.Protocol.Types import Cardano.Node.Types import Cardano.Tracing.OrphanInstances.Byron () @@ -60,6 +61,7 @@ mkSomeConsensusProtocolCardano -> NodeShelleyProtocolConfiguration -> NodeAlonzoProtocolConfiguration -> NodeConwayProtocolConfiguration + -> NodeDijkstraProtocolConfiguration -> NodeHardForkProtocolConfiguration -> NodeCheckpointsConfiguration -> Maybe ProtocolFilepaths @@ -85,7 +87,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcConwayGenesisFile, npcConwayGenesisFileHash } - npc@NodeHardForkProtocolConfiguration { + NodeDijkstraProtocolConfiguration { + npcDijkstraGenesisFile, + npcDijkstraGenesisFileHash + } + NodeHardForkProtocolConfiguration { -- During testing of the Alonzo era, we conditionally declared that we -- knew about the Alonzo era. We do so only when a config option for -- testing development/unstable eras is used. This lets us include @@ -96,7 +102,8 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcTestMaryHardForkAtEpoch, npcTestAlonzoHardForkAtEpoch, npcTestBabbageHardForkAtEpoch, - npcTestConwayHardForkAtEpoch + npcTestConwayHardForkAtEpoch, + npcTestDijkstraHardForkAtEpoch } checkpointsConfiguration files = do @@ -132,6 +139,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Conway.readGenesis npcConwayGenesisFile npcConwayGenesisFileHash + (dijkstraGenesis, _dijkstraGenesisHash) <- + firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $ + Dijkstra.readGenesis npcDijkstraGenesisFile + npcDijkstraGenesisFileHash + shelleyLeaderCredentials <- firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $ Shelley.readLeaderCredentials files @@ -178,6 +190,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { shelleyGenesis alonzoGenesis conwayGenesis + dijkstraGenesis , Consensus.cardanoHardForkTriggers = Consensus.CardanoHardForkTriggers' { triggerHardForkShelley = @@ -232,6 +245,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { maybe Consensus.CardanoTriggerHardForkAtDefaultVersion Consensus.CardanoTriggerHardForkAtEpoch + , triggerHardForkDijkstra = + npcTestDijkstraHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch } , Consensus.cardanoCheckpoints = checkpointsMap } @@ -258,6 +276,9 @@ data CardanoProtocolInstantiationError = | CardanoProtocolInstantiationConwayGenesisReadError Shelley.GenesisReadError + | CardanoProtocolInstantiationDijkstraGenesisReadError + Shelley.GenesisReadError + | CardanoProtocolInstantiationPraosLeaderCredentialsError Shelley.PraosLeaderCredentialsError @@ -277,6 +298,8 @@ instance Error CardanoProtocolInstantiationError where "Alonzo related: " <> prettyError err prettyError (CardanoProtocolInstantiationConwayGenesisReadError err) = "Conway related : " <> prettyError err + prettyError (CardanoProtocolInstantiationDijkstraGenesisReadError err) = + "Dijkstra related : " <> prettyError err prettyError (CardanoProtocolInstantiationPraosLeaderCredentialsError err) = prettyError err prettyError (CardanoProtocolInstantiationErrorAlonzo err) = diff --git a/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs new file mode 100644 index 00000000000..8551806565d --- /dev/null +++ b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Node.Protocol.Dijkstra + ( readGenesis + , readGenesisMaybe + ) where + +import Cardano.Api + +import qualified Cardano.Crypto.Hash.Class as Crypto +import Cardano.Ledger.BaseTypes +import qualified Cardano.Ledger.Binary as L +import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis (..)) +import qualified Cardano.Ledger.Dijkstra.Genesis as Dijkstra +import Cardano.Ledger.Dijkstra.PParams +import Cardano.Node.Orphans () +import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny) +import Cardano.Node.Types +import Cardano.Tracing.OrphanInstances.HardFork () +import Cardano.Tracing.OrphanInstances.Shelley () + +import qualified Data.ByteString.Lazy as LB + +import Data.Maybe (fromMaybe) + +readGenesisMaybe :: Maybe GenesisFile + -> Maybe GenesisHash + -> ExceptT GenesisReadError IO + (Dijkstra.DijkstraGenesis, GenesisHash) +readGenesisMaybe (Just genFp) mHash = readGenesis genFp mHash +readGenesisMaybe Nothing _ = do + let dijkstraGenesis = emptyDijkstraGenesis + genesisHash = GenesisHash (Crypto.hashWith id $ LB.toStrict $ L.serialize (L.natVersion @11) emptyDijkstraGenesis) + return (dijkstraGenesis, genesisHash) + +emptyDijkstraGenesis :: DijkstraGenesis +emptyDijkstraGenesis = + let upgradePParamsDef = UpgradeDijkstraPParams + { udppMaxRefScriptSizePerBlock = 1048576 + , udppMaxRefScriptSizePerTx = 204800 + , udppRefScriptCostStride = unsafeNonZero 25600 + , udppRefScriptCostMultiplier = fromMaybe (error "impossible") $ boundRational 1.2 + } + in DijkstraGenesis { dgUpgradePParams = upgradePParamsDef } + + +readGenesis :: GenesisFile + -> Maybe GenesisHash + -> ExceptT GenesisReadError IO + (Dijkstra.DijkstraGenesis, GenesisHash) +readGenesis = readGenesisAny diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 0d1850b1430..ad291082a41 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -210,7 +210,7 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do let DegenLedgerConfig cfgShelley = configLedger cfg in getSystemStartShelley cfgShelley Api.CardanoBlockType -> - let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = configLedger cfg + let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway cfgDijkstra = configLedger cfg in minimum [ getSystemStartByron , getSystemStartShelley cfgShelley , getSystemStartShelley cfgAllegra @@ -218,6 +218,7 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do , getSystemStartShelley cfgAlonzo , getSystemStartShelley cfgBabbage , getSystemStartShelley cfgConway + , getSystemStartShelley cfgDijkstra ] getSystemStartByron = WCT.getSystemStart . getSystemStart . configBlock $ cfg diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 740cc9fd764..38646c1264d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -85,14 +85,15 @@ getStartupInfo nc (SomeConsensusProtocol whichP pForInfo) fp = do in [getGenesisValues "Shelley" cfgShelley] Api.CardanoBlockType -> let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo - cfgBabbage cfgConway = Consensus.configLedger cfg + cfgBabbage cfgConway cfgDijkstra = Consensus.configLedger cfg in [ getGenesisValuesByron cfg cfgByron - , getGenesisValues "Shelley" cfgShelley - , getGenesisValues "Allegra" cfgAllegra - , getGenesisValues "Mary" cfgMary - , getGenesisValues "Alonzo" cfgAlonzo - , getGenesisValues "Babbage" cfgBabbage - , getGenesisValues "Conway" cfgConway + , getGenesisValues "Shelley" cfgShelley + , getGenesisValues "Allegra" cfgAllegra + , getGenesisValues "Mary" cfgMary + , getGenesisValues "Alonzo" cfgAlonzo + , getGenesisValues "Babbage" cfgBabbage + , getGenesisValues "Conway" cfgConway + , getGenesisValues "Dijkstra" cfgDijkstra ] pure (basicInfoCommon : protocolDependentItems) where diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index cd2efbffe75..01c6b66cd24 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -34,6 +34,7 @@ module Cardano.Node.Types , NodeShelleyProtocolConfiguration(..) , NodeAlonzoProtocolConfiguration(..) , NodeConwayProtocolConfiguration(..) + , NodeDijkstraProtocolConfiguration(..) , NodeCheckpointsConfiguration(..) , VRFPrivateKeyFilePermissionError(..) , renderVRFPrivateKeyFilePermissionError @@ -207,6 +208,7 @@ data NodeProtocolConfiguration = NodeShelleyProtocolConfiguration NodeAlonzoProtocolConfiguration NodeConwayProtocolConfiguration + NodeDijkstraProtocolConfiguration NodeHardForkProtocolConfiguration NodeCheckpointsConfiguration deriving (Eq, Show) @@ -235,6 +237,13 @@ data NodeConwayProtocolConfiguration = } deriving (Eq, Show) +data NodeDijkstraProtocolConfiguration = + NodeDijkstraProtocolConfiguration { + npcDijkstraGenesisFile :: !GenesisFile + , npcDijkstraGenesisFileHash :: !(Maybe GenesisHash) + } + deriving (Eq, Show) + data NodeByronProtocolConfiguration = NodeByronProtocolConfiguration { npcByronGenesisFile :: !GenesisFile @@ -357,6 +366,9 @@ data NodeHardForkProtocolConfiguration = , npcTestConwayHardForkAtEpoch :: Maybe EpochNo , npcTestConwayHardForkAtVersion :: Maybe Word + + , npcTestDijkstraHardForkAtEpoch :: Maybe EpochNo + , npcTestDijkstraHardForkAtVersion :: Maybe Word } deriving (Eq, Show) @@ -425,12 +437,13 @@ newtype TopologyFile = TopologyFile deriving newtype (Show, Eq) instance AdjustFilePaths NodeProtocolConfiguration where - adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pch pccp) = + adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pcd pch pccp) = NodeProtocolConfigurationCardano (adjustFilePaths f pcb) (adjustFilePaths f pcs) (adjustFilePaths f pca) (adjustFilePaths f pcc) + (adjustFilePaths f pcd) pch (adjustFilePaths f pccp) @@ -458,6 +471,12 @@ instance AdjustFilePaths NodeConwayProtocolConfiguration where } = x { npcConwayGenesisFile = adjustFilePaths f npcConwayGenesisFile } +instance AdjustFilePaths NodeDijkstraProtocolConfiguration where + adjustFilePaths f x@NodeDijkstraProtocolConfiguration { + npcDijkstraGenesisFile + } = + x { npcDijkstraGenesisFile = adjustFilePaths f npcDijkstraGenesisFile } + instance AdjustFilePaths NodeCheckpointsConfiguration where adjustFilePaths f x@NodeCheckpointsConfiguration { npcCheckpointsFile From 2ea395edbac5aca2ec3a2adb1465c04fc3341501 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:09:54 +0200 Subject: [PATCH 37/54] Fix Alonzo genesis parsing `decodeAlonzoGenesis` is now gone from cardano-api since c062448a357c3f1365b0105eae1dab4e93b20076 --- cardano-node/src/Cardano/Node/Protocol/Alonzo.hs | 14 +++----------- cardano-node/src/Cardano/Node/Protocol/Cardano.hs | 9 +-------- 2 files changed, 4 insertions(+), 19 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs b/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs index 9376f53a607..04c063471fc 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs @@ -12,28 +12,20 @@ import Cardano.Api import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo import Cardano.Node.Orphans () -import Cardano.Node.Protocol.Shelley (GenesisReadError (..), checkExpectedGenesisHash) +import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny) import Cardano.Node.Types import Cardano.Tracing.OrphanInstances.HardFork () import Cardano.Tracing.OrphanInstances.Shelley () -import qualified Data.ByteString.Lazy as LBS - - -- -- Alonzo genesis -- -readGenesis :: Maybe (CardanoEra era) - -> GenesisFile +readGenesis :: GenesisFile -> Maybe GenesisHash -> ExceptT GenesisReadError IO (Alonzo.AlonzoGenesis, GenesisHash) -readGenesis mEra (GenesisFile file) mGenesisHash = do - content <- handleIOExceptT (GenesisReadFileError file) $ LBS.readFile file - genesisHash <- checkExpectedGenesisHash (LBS.toStrict content) mGenesisHash - genesis <- modifyError (GenesisDecodeError file) $ decodeAlonzoGenesis mEra content - pure (genesis, genesisHash) +readGenesis = readGenesisAny validateGenesis :: Alonzo.AlonzoGenesis -> ExceptT AlonzoProtocolInstantiationError IO () diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 235347f3a3e..9483fa2d029 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -124,14 +124,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { (alonzoGenesis, _alonzoGenesisHash) <- firstExceptT CardanoProtocolInstantiationAlonzoGenesisReadError $ - case npcTestStartingEra npc of - Nothing -> - Alonzo.readGenesis Nothing - npcAlonzoGenesisFile - npcAlonzoGenesisFileHash - Just (AnyShelleyBasedEra sbe) -> do - Alonzo.readGenesis (Just $ toCardanoEra sbe) - npcAlonzoGenesisFile + Alonzo.readGenesis npcAlonzoGenesisFile npcAlonzoGenesisFileHash (conwayGenesis, _conwayGenesisHash) <- From 438dce955b8d8d7a8e3939d580af141cee5b6a0a Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:10:24 +0200 Subject: [PATCH 38/54] Provide initial Shelley credentials (unsound credentials) --- cardano-node/src/Cardano/Node/Protocol/Shelley.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index 91d067c5ba2..4cec1a0f8e3 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -39,7 +39,7 @@ import Cardano.Protocol.Crypto (StandardCrypto) import Cardano.Tracing.OrphanInstances.HardFork () import Cardano.Tracing.OrphanInstances.Shelley () import qualified Ouroboros.Consensus.Cardano as Consensus -import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..)) +import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..), PraosCredentialsSource (..)) import Ouroboros.Consensus.Shelley.Node (Nonce (..), ProtocolParamsShelleyBased (..), ShelleyLeaderCredentials (..)) @@ -261,8 +261,7 @@ mkPraosLeaderCredentials PraosCanBeLeader { praosCanBeLeaderColdVerKey = coerceKeyRole vkey, praosCanBeLeaderSignKeyVRF = vrfKey, - -- TODO: fix - praosCanBeLeaderCredentialsSource = undefined + praosCanBeLeaderCredentialsSource = PraosCredentialsUnsound opcert kesKey }, shelleyLeaderCredentialsLabel = "Shelley" } From 5be8ccaed8249c4e1d5a376de8d9279f01e002b1 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:10:51 +0200 Subject: [PATCH 39/54] Fix ledger queries to be usable in all eras --- cardano-node/src/Cardano/Node/Queries.hs | 117 ++++++++++++----------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 16286bf892a..8ac118ec7ff 100644 --- a/cardano-node/src/Cardano/Node/Queries.hs +++ b/cardano-node/src/Cardano/Node/Queries.hs @@ -47,7 +47,6 @@ 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 (..)) import Ouroboros.Consensus.Block (ForgeStateInfo, ForgeStateUpdateError) import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock) @@ -234,98 +233,104 @@ instance All GetKESInfo xs => GetKESInfo (HardForkBlock xs) where class LedgerQueries blk where ledgerUtxoSize :: LedgerState blk EmptyMK -> Int ledgerDelegMapSize :: LedgerState blk EmptyMK -> Int + +class LedgerConwayQueries blk where ledgerDRepCount :: LedgerState blk EmptyMK -> Int ledgerDRepMapSize :: LedgerState blk EmptyMK -> Int instance LedgerQueries Byron.ByronBlock where ledgerUtxoSize = Map.size . Byron.unUTxO . Byron.cvsUtxo . Byron.byronLedgerState ledgerDelegMapSize _ = 0 - ledgerDRepCount _ = 0 - ledgerDRepMapSize _ = 0 --- TODO should this be ConwayEraCertState constraint? Wouldn't this break queries for older eras? -instance Conway.ConwayEraCertState era => LedgerQueries (Shelley.ShelleyBlock protocol era) where +instance (Ledger.EraAccounts era, Shelley.EraCertState era) => LedgerQueries (Shelley.ShelleyBlock protocol era) where ledgerUtxoSize = - (\(Shelley.UTxO xs)-> Map.size xs) - . Shelley.utxosUtxo - . Shelley.lsUTxOState - . Shelley.esLState - . Shelley.nesEs + Map.size + . Ledger.unUTxO + . (^. Shelley.nesEsL + . Shelley.esLStateL + . Shelley.lsUTxOStateL + . Shelley.utxoL + ) . Shelley.shelleyLedgerState ledgerDelegMapSize = - UM.size - . UM.SPoolUView - . undefined -- TODO what should be here? - . (^. Conway.accountsMapL) - . Ledger.dsAccounts - . (^. Shelley.certDStateL) - . Shelley.lsCertState - . Shelley.esLState - . Shelley.nesEs + foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Ledger.stakePoolDelegationAccountStateL)) 0 + . (^. Shelley.nesEsL + . Shelley.esLStateL + . Shelley.lsCertStateL + . Shelley.certDStateL + . Ledger.accountsL + . Ledger.accountsMapL + ) . Shelley.shelleyLedgerState + +instance Conway.ConwayEraCertState era => LedgerConwayQueries (Shelley.ShelleyBlock protocol era) where ledgerDRepCount = Map.size - . Conway.vsDReps - . (^. Conway.certVStateL) - . Shelley.lsCertState - . Shelley.esLState - . Shelley.nesEs + . (^. Shelley.nesEsL + . Shelley.esLStateL + . Shelley.lsCertStateL + . Conway.certVStateL + . Conway.vsDRepsL + ) . Shelley.shelleyLedgerState ledgerDRepMapSize = - UM.size - . UM.DRepUView - . undefined -- TODO what should be here? - . Ledger.dsAccounts - . (^. Shelley.certDStateL) - . Shelley.lsCertState - . Shelley.esLState - . Shelley.nesEs + foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Conway.dRepDelegationAccountStateL)) 0 + . (^. Shelley.nesEsL + . Shelley.esLStateL + . Shelley.lsCertStateL + . Shelley.certDStateL + . Ledger.accountsL + . Ledger.accountsMapL + ) . Shelley.shelleyLedgerState instance (LedgerQueries x, NoHardForks x) => LedgerQueries (HardForkBlock '[x]) where ledgerUtxoSize = ledgerUtxoSize . unFlip . project . Flip ledgerDelegMapSize = ledgerDelegMapSize . unFlip . project . Flip + +instance (LedgerConwayQueries x, NoHardForks x) + => LedgerConwayQueries (HardForkBlock '[x]) where 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 -> 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.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.LedgerStateDijkstra ledgerDijkstra -> ledgerUtxoSize ledgerDijkstra ledgerDelegMapSize = \case Cardano.LedgerStateByron ledgerByron -> ledgerDelegMapSize 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.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.LedgerStateConway ledgerConway -> ledgerDelegMapSize ledgerConway Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDelegMapSize ledgerDijkstra + +instance LedgerConwayQueries (Cardano.CardanoBlock c) where ledgerDRepCount = \case - Cardano.LedgerStateByron ledgerByron -> ledgerDRepCount 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.LedgerStateByron _ledgerByron -> 0 + Cardano.LedgerStateShelley _ledgerShelley -> 0 + Cardano.LedgerStateAllegra _ledgerAllegra -> 0 + Cardano.LedgerStateMary _ledgerMary -> 0 + Cardano.LedgerStateAlonzo _ledgerAlonzo -> 0 + Cardano.LedgerStateBabbage _ledgerBabbage -> 0 Cardano.LedgerStateConway ledgerConway -> ledgerDRepCount ledgerConway Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDRepCount ledgerDijkstra ledgerDRepMapSize = \case - Cardano.LedgerStateByron ledgerByron -> ledgerDRepMapSize 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.LedgerStateByron _ledgerByron -> 0 + Cardano.LedgerStateShelley _ledgerShelley -> 0 + Cardano.LedgerStateAllegra _ledgerAllegra -> 0 + Cardano.LedgerStateMary _ledgerMary -> 0 + Cardano.LedgerStateAlonzo _ledgerAlonzo -> 0 + Cardano.LedgerStateBabbage _ledgerBabbage -> 0 Cardano.LedgerStateConway ledgerConway -> ledgerDRepMapSize ledgerConway Cardano.LedgerStateDijkstra ledgerDijkstra -> ledgerDRepMapSize ledgerDijkstra From eb1e77448dec99ee140265554fa55f00180d9892 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:11:50 +0200 Subject: [PATCH 40/54] Add tracing instances for `PraosTiebreakerView` --- cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs | 2 +- cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs | 9 +++++++++ .../src/Cardano/Tracing/OrphanInstances/Shelley.hs | 11 ++++++++++- 3 files changed, 20 insertions(+), 2 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs index 7942c57536e..7e528ba3c2f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs @@ -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 (ValidationErr, TiebreakerView(..), SelectView(..)) +import Ouroboros.Consensus.Protocol.Abstract (ValidationErr, TiebreakerView, SelectView(..)) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (Condense (..)) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 436b2fcb96f..1f4da2938f7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -58,6 +58,7 @@ 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 qualified Ouroboros.Consensus.Protocol.Praos.Common as Praos import Ouroboros.Consensus.Protocol.TPraos (TPraosCannotForge (..)) import Ouroboros.Consensus.Shelley.Ledger hiding (TxId) import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus @@ -1477,6 +1478,14 @@ instance -- TODO: fix Conway.ScriptIntegrityHashMismatch _ _ -> undefined +instance LogFormatting (Praos.PraosTiebreakerView crypto) where + forMachine _dtal (Praos.PraosTiebreakerView sl issuer issueNo vrf) = + mconcat [ "slotNo" .= condense sl + , "issuer" .= textShow issuer + , "issueNo" .= textShow issueNo + , "vrf" .= textShow vrf + ] + -------------------------------------------------------------------------------- -- Helper functions -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index fa52067f8a1..990ebd99ed0 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -63,6 +63,7 @@ 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 qualified Ouroboros.Consensus.Protocol.Praos.Common as Praos import Ouroboros.Consensus.Protocol.TPraos (TPraosCannotForge (..)) import Ouroboros.Consensus.Shelley.Ledger hiding (TxId) import Ouroboros.Consensus.Shelley.Ledger.Inspect @@ -423,7 +424,7 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe mconcat [ "kind" .= String "TreasuryWithdrawalReturnAccountsDoNotExist" , "invalidAccounts" .= accounts ] - toObject _ (Conway.UnelectedCommitteeVoters creds) = + toObject _ (Conway.UnelectedCommitteeVoters creds) = mconcat [ "kind" .= String "UnelectedCommitteeVoters" , "unelectedCommitteeVoters" .= creds ] @@ -1527,6 +1528,14 @@ instance -- TODO: fix Conway.ScriptIntegrityHashMismatch _ _ -> undefined +instance ToObject (Praos.PraosTiebreakerView crypto) where + toObject v (Praos.PraosTiebreakerView sl issuer issueNo vrf) = + mconcat [ "slotNo" .= toObject v sl + , "issuer" .= textShow issuer + , "issueNo" .= textShow issueNo + , "vrf" .= textShow vrf + ] + -------------------------------------------------------------------------------- -- Helper functions -------------------------------------------------------------------------------- From f029899ee9acf8cd40dc69ad7a7375f7e7ed2d5a Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:12:25 +0200 Subject: [PATCH 41/54] Add cases for tracing new NT* constructors --- cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 38646c1264d..0659587835e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -486,10 +486,13 @@ nodeToClientVersionToInt = \case NodeToClientV_18 -> 18 NodeToClientV_19 -> 19 NodeToClientV_20 -> 20 + NodeToClientV_21 -> 21 + NodeToClientV_22 -> 22 nodeToNodeVersionToInt :: NodeToNodeVersion -> Int nodeToNodeVersionToInt = \case NodeToNodeV_14 -> 14 + NodeToNodeV_15 -> 15 -- | Pretty print 'StartupInfoTrace' -- From f2009c964a21b5aa4843ee653b5e0df1d7812555 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:14:55 +0200 Subject: [PATCH 42/54] Add tracing instances for `KESAgentClientTrace` --- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 16 ++++++++++++++ cardano-node/src/Cardano/Tracing/Config.hs | 9 ++++++++ .../Tracing/OrphanInstances/Consensus.hs | 22 +++++++++++++++++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 2 ++ 4 files changed, 49 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 6f45d6225cc..f5557e6e774 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -55,6 +55,7 @@ import Ouroboros.Consensus.Node.GSM import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) import Ouroboros.Consensus.Node.Tracers import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey +import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Util.Enclose import qualified Ouroboros.Network.AnchoredFragment as AF import qualified Ouroboros.Network.AnchoredSeq as AS @@ -68,6 +69,7 @@ import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import Control.Exception import Control.Monad (guard) import Data.Aeson (ToJSON, Value (..), toJSON, (.=)) import qualified Data.Aeson as Aeson @@ -2299,3 +2301,17 @@ instance ( StandardHash blk ] forHuman = showT + +{------------------------------------------------------------------------------- + KES-agent +-------------------------------------------------------------------------------} + +instance LogFormatting KESAgentClientTrace where + forMachine _verb (KESAgentClientException exc) = + mconcat [ "kind" .= String "KESAgentClientException" + , "exception" .= String (Text.pack $ displayException exc) + ] + forMachine _verb (KESAgentClientTrace trc) = + mconcat [ "kind" .= String "KESAgentClientTrace" + , "trace" .= String (Text.pack $ show trc) + ] diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index cc9e6a3f3cb..f0dc4263ef7 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -185,6 +185,7 @@ type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TracePeerSharingProtocol = ("TracePeerSharingProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) type TraceCsj = ("TraceCsj" :: Symbol) +type TraceKesAgent = ("TraceKesAgent" :: Symbol) type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol) type TraceChurnMode = ("TraceChurnMode" :: Symbol) type TraceDNS = ("TraceDNS" :: Symbol) @@ -263,6 +264,7 @@ data TraceSelection , tracePeerSharingProtocol :: OnOff TracePeerSharingProtocol , traceGsm :: OnOff TraceGsm , traceCsj :: OnOff TraceCsj + , traceKesAgent :: OnOff TraceKesAgent , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch , traceChurnMode :: OnOff TraceChurnMode , traceDNS :: OnOff TraceDNS @@ -338,6 +340,7 @@ data PartialTraceSelection , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch) , pTraceChurnMode :: Last (OnOff TraceChurnMode) , pTraceDNS :: Last (OnOff TraceDNS) + , pTraceKesAgent :: Last (OnOff TraceKesAgent) } deriving (Eq, Generic, Show) @@ -411,6 +414,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceDevotedBlockFetch) v <*> parseTracer (Proxy @TraceChurnMode) v <*> parseTracer (Proxy @TraceDNS) v + <*> parseTracer (Proxy @TraceKesAgent) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -481,6 +485,7 @@ defaultPartialTraceConfiguration = , pTraceDevotedBlockFetch = pure $ OnOff True , pTraceChurnMode = pure $ OnOff True , pTraceDNS = pure $ OnOff True + , pTraceKesAgent = pure $ OnOff False } @@ -550,6 +555,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj + traceKesAgent <- proxyLastToEither (Proxy @TraceKesAgent) pTraceKesAgent traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch traceChurnMode <- proxyLastToEither (Proxy @TraceChurnMode) pTraceChurnMode traceDNS <- proxyLastToEither (Proxy @TraceDNS) pTraceDNS @@ -618,6 +624,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceDevotedBlockFetch = traceDevotedBlockFetch , traceChurnMode , traceDNS + , traceKesAgent = traceKesAgent } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -684,6 +691,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj + traceKesAgent <- proxyLastToEither (Proxy @TraceKesAgent) pTraceKesAgent traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch traceChurnMode <- proxyLastToEither (Proxy @TraceChurnMode) pTraceChurnMode traceDNS <- proxyLastToEither (Proxy @TraceDNS) pTraceDNS @@ -752,6 +760,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceDevotedBlockFetch = traceDevotedBlockFetch , traceChurnMode , traceDNS + , traceKesAgent = traceKesAgent } proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index ecd3889c233..821c3453f88 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -61,6 +61,7 @@ import qualified Ouroboros.Consensus.Node.Tracers as Consensus import Ouroboros.Consensus.Protocol.Abstract import qualified Ouroboros.Consensus.Protocol.BFT as BFT import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT +import Ouroboros.Consensus.Protocol.Praos.AgentClient import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..), @@ -81,6 +82,7 @@ import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Control.Monad (guard) +import Control.Exception import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson import Data.Foldable (Foldable (..)) @@ -1870,3 +1872,23 @@ instance ConvertRawHash blk => ToObject (Tip blk) where , "tipHash" .= renderHeaderHash (Proxy @blk) hash , "tipBlockNo" .= toJSON bNo ] + +instance ToObject KESAgentClientTrace where + toObject _verb (KESAgentClientException exc) = + mconcat [ "kind" .= String "KESAgentClientException" + , "exception" .= String (pack $ displayException exc) + ] + toObject _verb (KESAgentClientTrace trc) = + mconcat [ "kind" .= String "KESAgentClientTrace" + , "trace" .= String (pack $ show trc) + ] + +instance HasPrivacyAnnotation KESAgentClientTrace where + +instance HasSeverityAnnotation KESAgentClientTrace where + getSeverityAnnotation = \case + KESAgentClientException{} -> Error + KESAgentClientTrace{} -> Notice + +instance Transformable Text IO KESAgentClientTrace where + trTransformer = trStructured diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 549735a61f5..88d93162d1a 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -483,6 +483,7 @@ mkTracers _ _ _ _ _ = , Consensus.gsmTracer = nullTracer , Consensus.csjTracer = nullTracer , Consensus.dbfTracer = nullTracer + , Consensus.kesAgentTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -786,6 +787,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr , Consensus.csjTracer = tracerOnOff (traceCsj trSel) verb "CSJ" tr , Consensus.dbfTracer = tracerOnOff (traceDevotedBlockFetch trSel) verb "DevotedBlockFetch" tr + , Consensus.kesAgentTracer = tracerOnOff (traceKesAgent trSel) verb "kesAgent" tr } where mkForgeTracers :: IO ForgeTracers From e82ef329c1456a79078b500c2a803922fc524f38 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:16 +0200 Subject: [PATCH 43/54] Fill in tracing instances for some GSM constructors --- .../src/Cardano/Node/Tracing/Tracers/Consensus.hs | 5 ++--- .../src/Cardano/Tracing/OrphanInstances/Consensus.hs | 10 ++++------ 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index f5557e6e774..2a93e7f575b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -2099,9 +2099,8 @@ instance ( LogFormatting selection GsmEventLeaveCaughtUp {} -> [preSyncing] GsmEventPreSyncingToSyncing {} -> [syncing] GsmEventSyncingToPreSyncing {} -> [preSyncing] - -- TODO: fix - GsmEventInitializedInCaughtUp {} -> undefined - GsmEventInitializedInPreSyncing {} -> undefined + GsmEventInitializedInCaughtUp {} -> [caughtUp] + GsmEventInitializedInPreSyncing {} -> [preSyncing] where preSyncing = IntM "GSM.state" 0 syncing = IntM "GSM.state" 1 diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 821c3453f88..5fa67d023b2 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -1761,9 +1761,8 @@ instance HasSeverityAnnotation (TraceGsmEvent selection) where GsmEventLeaveCaughtUp{} -> Warning GsmEventPreSyncingToSyncing{} -> Notice GsmEventSyncingToPreSyncing{} -> Notice - -- TODO: fix - GsmEventInitializedInCaughtUp{} -> undefined - GsmEventInitializedInPreSyncing{} -> undefined + GsmEventInitializedInCaughtUp{} -> Notice + GsmEventInitializedInPreSyncing{} -> Notice instance ToObject selection => Transformable Text IO (TraceGsmEvent selection) where trTransformer = trStructured @@ -1789,16 +1788,15 @@ instance ToObject selection => ToObject (TraceGsmEvent selection) where mconcat [ "kind" .= String "GsmEventSyncingToPreSyncing" ] - toObject _verb (GsmEventInitializedInCaughtUp) = + toObject _verb GsmEventInitializedInCaughtUp = mconcat [ "kind" .= String "GsmEventInitializedInCaughtUp" ] - toObject _verb (GsmEventInitializedInPreSyncing) = + toObject _verb GsmEventInitializedInPreSyncing = mconcat [ "kind" .= String "GsmEventInitializedInPreSyncing" ] - instance HasPrivacyAnnotation (TraceGDDEvent peer blk) where instance HasSeverityAnnotation (TraceGDDEvent peer blk) where getSeverityAnnotation _ = Debug From 54d39120f4f9a5da08d07a8fe9a778298440c338 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:39 +0200 Subject: [PATCH 44/54] Use new constructor `IgnoreBlockOlderThanImmTip` --- cardano-node/src/Cardano/Tracing/Tracers.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 88d93162d1a..92bdb8c710c 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -223,7 +223,7 @@ instance ElidingTracer (WithSeverity (ChainDB.TraceEvent blk)) where doelide (WithSeverity _ (ChainDB.TraceLedgerDBEvent LedgerDB.LedgerDBFlavorImplEvent{})) = True doelide (WithSeverity _ (ChainDB.TraceGCEvent _)) = True - doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreBlockOlderThanK _))) = False + doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreBlockOlderThanImmTip _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreInvalidBlock _ _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.StoreButDontChange _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.TrySwitchToAFork _ _))) = False From 3442e730f0da83e51290e8b9235e2cd1ddd291a2 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:59 +0200 Subject: [PATCH 45/54] Update Consensus and remove KES-agent SRP --- cabal.project | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/cabal.project b/cabal.project index 0e488696ec7..c7bfa8d95d3 100644 --- a/cabal.project +++ b/cabal.project @@ -100,8 +100,8 @@ source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus -- latest master - tag: 71b02607c8a39ed4d8c983b281b05452ed8c01ce - --sha256: sha256-/vnZnAPsEuqQMzG5NGHaWk9vyefBWMft7/rKQ+yyYTQ= + tag: ac1a8db76f4c7a38a9a6b962a40fa722d5bd55a6 + --sha256: sha256-8MlAxCi1wXLc2p0csYTKZ4RW7+uqWvxOBs5IhISzwxk= subdir: ouroboros-consensus ouroboros-consensus-cardano @@ -109,11 +109,3 @@ source-repository-package 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 From 647c9043fe091d6fde344f6453e15ea36b24ac94 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 26 Sep 2025 17:01:58 +0300 Subject: [PATCH 46/54] Add missing qualifiers --- cardano-node/src/Cardano/Node/Queries.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 8ac118ec7ff..7bb1c364f3e 100644 --- a/cardano-node/src/Cardano/Node/Queries.hs +++ b/cardano-node/src/Cardano/Node/Queries.hs @@ -253,7 +253,7 @@ instance (Ledger.EraAccounts era, Shelley.EraCertState era) => LedgerQueries (Sh ) . Shelley.shelleyLedgerState ledgerDelegMapSize = - foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Ledger.stakePoolDelegationAccountStateL)) 0 + Map.foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Ledger.stakePoolDelegationAccountStateL)) 0 . (^. Shelley.nesEsL . Shelley.esLStateL . Shelley.lsCertStateL @@ -274,7 +274,7 @@ instance Conway.ConwayEraCertState era => LedgerConwayQueries (Shelley.ShelleyBl ) . Shelley.shelleyLedgerState ledgerDRepMapSize = - foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Conway.dRepDelegationAccountStateL)) 0 + Map.foldl' (\acc -> maybe acc (const $ 1 + acc) . (^. Conway.dRepDelegationAccountStateL)) 0 . (^. Shelley.nesEsL . Shelley.esLStateL . Shelley.lsCertStateL From 6cbfab92194ff5c53ae4be19e420ac47775271b1 Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Tue, 30 Sep 2025 12:55:08 +0300 Subject: [PATCH 47/54] Ledger changes; fix parsing errors Co-authored-by: Alexey Kuleshevich --- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 51 +++++++++++++++---- .../Tracing/OrphanInstances/Shelley.hs | 51 +++++++++++++++---- 2 files changed, 80 insertions(+), 22 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 1f4da2938f7..fbce024e3d0 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -183,9 +183,18 @@ instance LogFormatting (Conway.ConwayDelegPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "Delegated rep is not registered for provided stake key" ] - -- TODO: fix - Conway.DepositIncorrectDELEG _ -> undefined - Conway.RefundIncorrectDELEG _ -> undefined + Conway.DepositIncorrectDELEG Mismatch {mismatchSupplied, mismatchExpected} -> + [ "kind" .= String "DepositIncorrectDELEG" + , "givenRefund" .= mismatchSupplied + , "expectedRefund" .= mismatchExpected + , "error" .= String "Deposit mismatch" + ] + Conway.RefundIncorrectDELEG Mismatch {mismatchSupplied, mismatchExpected} -> + [ "kind" .= String "RefundIncorrectDELEG" + , "givenRefund" .= mismatchSupplied + , "expectedRefund" .= mismatchExpected + , "error" .= String "Refund mismatch" + ] instance ( ShelleyCompatible protocol era @@ -380,8 +389,16 @@ instance ] ) (Api.shelleyBasedEra :: Api.ShelleyBasedEra era) - -- TODO: fix - forMachine _ (ScriptIntegrityHashMismatch _ _) = undefined + forMachine _ (ScriptIntegrityHashMismatch Mismatch {mismatchSupplied, mismatchExpected} mBytes) = + mconcat [ "kind" .= String "ScriptIntegrityHashMismatch" + , "supplied" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "expected" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) + , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) + ] + +formatAsHex :: Maybe Crypto.ByteString -> String +formatAsHex Nothing = "" +formatAsHex (Just bs) = show bs instance ( Consensus.ShelleyBasedEra era @@ -718,8 +735,12 @@ instance LogFormatting (ShelleyPoolPredFailure era) where , "poolId" .= String (textShow poolId) , "error" .= String "Wrong network ID in pool registration certificate" ] - -- TODO: fix - forMachine _dtal (VRFKeyHashAlreadyRegistered _ _) = undefined + forMachine _dtal (VRFKeyHashAlreadyRegistered poolId vrfKeyHash) = + mconcat [ "kind" .= String "VRFKeyHashAlreadyRegistered" + , "poolId" .= String (textShow poolId) + , "vrfKeyHash" .= String (textShow vrfKeyHash) + , "error" .= String "Pool with the same VRF Key Hash is already registered" + ] instance LogFormatting TicknPredicateFailure where @@ -1024,8 +1045,12 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= s ] - -- TODO: fix - Babbage.ScriptIntegrityHashMismatch _ _ -> undefined + Babbage.ScriptIntegrityHashMismatch Mismatch {mismatchSupplied, mismatchExpected} mBytes -> + mconcat [ "kind" .= String "ScriptIntegrityHashMismatch" + , "supplied" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "expected" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) + , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) + ] -------------------------------------------------------------------------------- -- Conway related -------------------------------------------------------------------------------- @@ -1475,8 +1500,12 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= scripts ] - -- TODO: fix - Conway.ScriptIntegrityHashMismatch _ _ -> undefined + Conway.ScriptIntegrityHashMismatch Mismatch {mismatchSupplied, mismatchExpected} mBytes -> + mconcat [ "kind" .= String "ScriptIntegrityHashMismatch" + , "supplied" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "expected" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) + , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) + ] instance LogFormatting (Praos.PraosTiebreakerView crypto) where forMachine _dtal (Praos.PraosTiebreakerView sl issuer issueNo vrf) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 990ebd99ed0..0aa6cff870b 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -221,9 +221,18 @@ instance ToObject (Conway.ConwayDelegPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "Delegated rep is not registered for provided stake key" ] - -- TODO: fix - Conway.DepositIncorrectDELEG _ -> undefined - Conway.RefundIncorrectDELEG _ -> undefined + Conway.DepositIncorrectDELEG Mismatch {mismatchSupplied, mismatchExpected} -> + [ "kind" .= String "DepositIncorrectDELEG" + , "givenRefund" .= mismatchSupplied + , "expectedRefund" .= mismatchExpected + , "error" .= String "Deposit mismatch" + ] + Conway.RefundIncorrectDELEG Mismatch {mismatchSupplied, mismatchExpected} -> + [ "kind" .= String "RefundIncorrectDELEG" + , "givenRefund" .= mismatchSupplied + , "expectedRefund" .= mismatchExpected + , "error" .= String "Refund mismatch" + ] instance ToObject (Set (Credential 'Staking)) where toObject _verb creds = @@ -485,8 +494,12 @@ instance ] ) (Api.shelleyBasedEra :: Api.ShelleyBasedEra era) - -- TODO: fix - toObject _ _ = undefined + toObject _ (ScriptIntegrityHashMismatch poolId vrfKeyHash) = + mconcat [ "kind" .= String "VRFKeyHashAlreadyRegistered" + , "poolId" .= String (textShow poolId) + , "vrfKeyHash" .= String (textShow vrfKeyHash) + , "error" .= String "Pool with the same VRF Key Hash is already registered" + ] instance ( ToObject (PredicateFailure (Core.EraRule "UTXO" ledgerera)) @@ -815,8 +828,12 @@ instance ToObject (ShelleyPoolPredFailure era) where , "hashSize" .= String (textShow hashSize) , "error" .= String "The stake pool metadata hash is too large" ] - -- TODO: fix - toObject _verb (VRFKeyHashAlreadyRegistered _ _) = undefined + toObject _ (VRFKeyHashAlreadyRegistered poolId vrfKeyHash) = + mconcat [ "kind" .= String "VRFKeyHashAlreadyRegistered" + , "poolId" .= String (textShow poolId) + , "vrfKeyHash" .= String (textShow vrfKeyHash) + , "error" .= String "Pool with the same VRF Key Hash is already registered" + ] -- Apparently this should never happen according to the Shelley exec spec -- toObject _verb (WrongCertificateTypePOOL index) = @@ -1183,8 +1200,16 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= s ] - -- TODO: fix - Babbage.ScriptIntegrityHashMismatch _ _ -> undefined + Babbage.ScriptIntegrityHashMismatch Mismatch {mismatchSupplied, mismatchExpected} mBytes -> + mconcat [ "kind" .= String "ScriptIntegrityHashMismatch" + , "supplied" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "expected" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) + , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) + ] + +formatAsHex :: Maybe Crypto.ByteString -> String +formatAsHex Nothing = "" +formatAsHex (Just bs) = show bs instance Core.Crypto crypto => ToObject (Praos.PraosValidationErr crypto) where toObject _ err' = @@ -1525,8 +1550,12 @@ instance mconcat [ "kind" .= String "MalformedReferenceScripts" , "scripts" .= scripts ] - -- TODO: fix - Conway.ScriptIntegrityHashMismatch _ _ -> undefined + Conway.ScriptIntegrityHashMismatch Mismatch {mismatchSupplied, mismatchExpected} mBytes -> + mconcat [ "kind" .= String "ScriptIntegrityHashMismatch" + , "supplied" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "expected" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) + , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) + ] instance ToObject (Praos.PraosTiebreakerView crypto) where toObject v (Praos.PraosTiebreakerView sl issuer issueNo vrf) = From 03fe6b1a629814f6b33c55b6dce8ecd8842f307a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 2 Oct 2025 14:26:06 +0200 Subject: [PATCH 48/54] integrate o-n 0.22.3 --- cardano-node/src/Cardano/Node/Run.hs | 19 +- cardano-node/src/Cardano/Node/Tracing/API.hs | 6 +- .../src/Cardano/Node/Tracing/Consistency.hs | 16 + .../src/Cardano/Node/Tracing/Documentation.hs | 18 - .../src/Cardano/Node/Tracing/Tracers.hs | 44 +- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 583 +++++++++--------- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 9 + cardano-node/src/Cardano/Tracing/Config.hs | 42 +- .../Tracing/OrphanInstances/Network.hs | 51 +- cardano-node/src/Cardano/Tracing/Tracers.hs | 12 + 10 files changed, 421 insertions(+), 379 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 9f6cc1fec50..8440a793b5b 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -83,6 +83,7 @@ import Ouroboros.Consensus.Storage.LedgerDB.V2.Args import Ouroboros.Consensus.Util.Args import Ouroboros.Consensus.Util.Orphans () +import Cardano.Network.ConsensusMode import qualified Cardano.Network.Diffusion as Cardano.Diffusion import qualified Cardano.Network.Diffusion.Configuration as Configuration import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) @@ -426,7 +427,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do $ Proxy @blk )) - withShutdownHandling (ncShutdownConfig nc) (shutdownTracer tracers) $ + withShutdownHandling (ncShutdownConfig nc) (shutdownTracer tracers) $ do traceWith (startupTracer tracers) (StartupP2PInfo (ncDiffusionMode nc)) nt@TopologyP2P.RealNodeTopology @@ -494,6 +495,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do ledgerPeerSnapshotPathVar void $ updateLedgerPeerSnapshot (startupTracer tracers) + nc (readTVar ledgerPeerSnapshotPathVar) (readTVar useLedgerVar) (writeTVar ledgerPeerSnapshotVar) @@ -555,22 +557,17 @@ handleSimpleNode blockType runP tracers nc onKernel = do , srnEnableInDevelopmentVersions = ncExperimentalProtocolsEnabled nc , srnTraceChainDB = chainDBTracer tracers , srnMaybeMempoolCapacityOverride = ncMaybeMempoolCapacityOverride nc - , srnChainSyncTimeout = customizeChainSyncTimeout + , srnChainSyncIdleTimeout = customizeChainSyncTimeout , srnSnapshotPolicyArgs = snapshotPolicyArgs , srnQueryBatchSize = queryBatchSize , srnLdbFlavorArgs = selectorToArgs ldbBackend } where - customizeChainSyncTimeout :: Maybe (IO ChainSyncTimeout) + customizeChainSyncTimeout :: ChainSyncIdleTimeout customizeChainSyncTimeout = case ncChainSyncIdleTimeout nc of - NoTimeoutOverride -> Nothing - TimeoutOverride t -> Just $ do - cst <- Configuration.defaultChainSyncTimeout - pure $ case t of - 0 -> - cst { idleTimeout = Nothing } - _ -> - cst { idleTimeout = Just t } + NoTimeoutOverride -> Configuration.defaultChainSyncIdleTimeout + TimeoutOverride t | t == 0 -> ChainSyncNoIdleTimeout + | otherwise -> ChainSyncIdleTimeout t logStartupWarnings :: IO () logStartupWarnings = do diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index 5c51c592800..d18ee73e9f7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -10,7 +10,7 @@ module Cardano.Node.Tracing.API import Cardano.Logging hiding (traceWith) import Cardano.Logging.Prometheus.TCPServer (runPrometheusSimple) -import Cardano.Node.Configuration.NodeAddress (File (..), PortNumber) +import Cardano.Node.Configuration.NodeAddress (PortNumber) import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Protocol.Types import Cardano.Node.Queries @@ -109,7 +109,7 @@ initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do :: TraceConfig -> IO ( IO () , IO (Maybe String) - , Tracers RemoteAddress LocalAddress blk p2p Cardano.ExtraState Cardano.DebugPeerSelectionState PeerTrustable (Cardano.PublicRootPeers.ExtraPeers RemoteAddress) (Cardano.ExtraPeerSelectionSetsWithSizes RemoteAddress) IO + , Tracers RemoteAddress LocalAddress blk IO ) mkTracers trConfig = do ekgStore <- EKG.newStore @@ -127,7 +127,7 @@ initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do then do -- TODO: check if this is the correct way to use withIOManager (forwardSink, dpStore, kickoffForwarder) <- withIOManager $ \iomgr -> do - let tracerSocketMode :: Maybe (Net.HowToConnect, ForwarderMode) + let tracerSocketMode :: Maybe (HowToConnect, ForwarderMode) tracerSocketMode = ncTraceForwardSocket nc forwardingConf :: TraceOptionForwarder diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 89ca1b578eb..463d774f702 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -265,9 +265,21 @@ getAllNamespaces = dtMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote"]) (allNamespaces :: [Namespace (Mux.WithBearer (ConnectionId RemoteAddress) Mux.Trace)]) + dtMuxBearerNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote", "Bearer"]) + (allNamespaces :: [Namespace + (Mux.WithBearer (ConnectionId RemoteAddress) Mux.BearerTrace)]) + dtMuxChannelNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote", "Channel"]) + (allNamespaces :: [Namespace + (Mux.WithBearer (ConnectionId RemoteAddress) Mux.ChannelTrace)]) dtLocalMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Local"]) (allNamespaces :: [Namespace (Mux.WithBearer (ConnectionId LocalAddress) Mux.Trace)]) + dtLocalMuxBearerNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Local", "Bearer"]) + (allNamespaces :: [Namespace + (Mux.WithBearer (ConnectionId RemoteAddress) Mux.BearerTrace)]) + dtLocalMuxChannelNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Local", "Channel"]) + (allNamespaces :: [Namespace + (Mux.WithBearer (ConnectionId RemoteAddress) Mux.ChannelTrace)]) dtHandshakeNS = map (nsGetTuple . nsReplacePrefix ["Net", "Handshake", "Remote"]) (allNamespaces :: [Namespace @@ -412,7 +424,11 @@ getAllNamespaces = <> txSubmission2NS -- Diffusion <> dtMuxNS + <> dtMuxBearerNS + <> dtMuxChannelNS <> dtLocalMuxNS + <> dtLocalMuxBearerNS + <> dtLocalMuxChannelNS <> dtHandshakeNS <> dtLocalHandshakeNS <> dtDiffusionInitializationNS diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index a8dbe4f1c6f..2002b7c00f2 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -82,7 +82,6 @@ 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 (RemoteAddress) import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.Churn (ChurnCounters (..)) @@ -556,21 +555,6 @@ docTracersFirstPhase condConfigFileName = do dtLocalMuxTrDoc <- documentTracer (dtLocalMuxTr :: Logging.Trace IO (Mux.WithBearer (ConnectionId LocalAddress) Mux.Trace)) - dtHandshakeTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Handshake", "Remote"] - configureTracers configReflection trConfig [dtHandshakeTr] - dtHandshakeTrDoc <- documentTracer (dtHandshakeTr :: - Logging.Trace IO (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion)) - - dtLocalHandshakeTr <- mkCardanoTracer - trBase trForward mbTrEKG - ["Net", "Handshake", "Local"] - configureTracers configReflection trConfig [dtLocalHandshakeTr] - dtLocalHandshakeTrDoc <- documentTracer (dtLocalHandshakeTr :: - Logging.Trace IO - (NtC.HandshakeTr LocalAddress NtC.NodeToClientVersion)) - dtDiffusionInitializationTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup", "DiffusionInit"] @@ -768,8 +752,6 @@ docTracersFirstPhase condConfigFileName = do -- Diffusion <> dtMuxTrDoc <> dtLocalMuxTrDoc - <> dtHandshakeTrDoc - <> dtLocalHandshakeTrDoc <> dtDiffusionInitializationTrDoc <> dtLedgerPeersTrDoc -- DiffusionTracersExtra P2P diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index c8649de1512..14040878c5c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -510,20 +510,40 @@ mkDiffusionTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Net", "Mux", "Remote"] configureTracers configReflection trConfig [dtMuxTr] + !dtChannelTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["Net", "Mux", "Remote", "Channel"] + configureTracers configReflection trConfig [dtChannelTracer] + + !dtBearerTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["Net", "Mux", "Remote", "Bearer"] + configureTracers configReflection trConfig [dtBearerTracer] + + !dtHandshakeTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["Net", "Handshake", "Remote"] + configureTracers configReflection trConfig [dtHandshakeTracer] + !dtLocalMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Local"] configureTracers configReflection trConfig [dtLocalMuxTr] - !dtHandshakeTr <- mkCardanoTracer + !dtLocalChannelTracer <- mkCardanoTracer trBase trForward mbTrEKG - ["Net", "Handshake", "Remote"] - configureTracers configReflection trConfig [dtHandshakeTr] + ["Net", "Mux", "Local", "Channel"] + configureTracers configReflection trConfig [dtLocalChannelTracer] + + !dtLocalBearerTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["Net", "Mux", "Local", "Bearer"] + configureTracers configReflection trConfig [dtLocalBearerTracer] - !dtLocalHandshakeTr <- mkCardanoTracer + !dtLocalHandshakeTracer <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Local"] - configureTracers configReflection trConfig [dtLocalHandshakeTr] + configureTracers configReflection trConfig [dtLocalHandshakeTracer] !dtDiffusionInitializationTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -623,12 +643,20 @@ mkDiffusionTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf pure $ Diffusion.Tracers { Diffusion.dtMuxTracer = Tracer $ traceWith dtMuxTr + , Diffusion.dtChannelTracer = Tracer $ + traceWith dtChannelTracer + , Diffusion.dtBearerTracer = Tracer $ + traceWith dtBearerTracer + , Diffusion.dtHandshakeTracer = Tracer $ + traceWith dtHandshakeTracer , Diffusion.dtLocalMuxTracer = Tracer $ traceWith dtLocalMuxTr - , Diffusion.dtHandshakeTracer = Tracer $ - traceWith dtHandshakeTr + , Diffusion.dtLocalChannelTracer = Tracer $ + traceWith dtLocalChannelTracer + , Diffusion.dtLocalBearerTracer = Tracer $ + traceWith dtLocalBearerTracer , Diffusion.dtLocalHandshakeTracer = Tracer $ - traceWith dtLocalHandshakeTr + traceWith dtLocalHandshakeTracer , Diffusion.dtDiffusionTracer = Tracer $ traceWith dtDiffusionInitializationTr , Diffusion.dtTraceLocalRootPeersTracer = Tracer $ diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 7883dd70766..e022c1bf799 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -22,27 +22,27 @@ import Cardano.Node.Configuration.TopologyP2P () import Network.Mux.TCPInfo (StructTCPInfo (..)) #endif import qualified Ouroboros.Network.Diffusion.Types as Diff -import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.LedgerPeers (NumberOfPeers (..), PoolStake (..), TraceLedgerPeers (..)) import qualified Ouroboros.Network.Protocol.Handshake.Type as HS import qualified Network.Mux as Mux import Network.Mux.Types (SDUHeader (..), unRemoteClockModel) -import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) +import Network.TypedProtocol.Codec (AnyMessage (..)) import Data.Aeson (Value (String), (.=)) import qualified Data.List as List -import Data.Text (pack) +import Data.Text (Text, pack) +import Data.Typeable import Formatting -------------------------------------------------------------------------------- -- Mux Tracer -------------------------------------------------------------------------------- -instance (LogFormatting peer, LogFormatting Mux.Trace) => - LogFormatting (Mux.WithBearer peer Mux.Trace) where +instance (LogFormatting peer, LogFormatting tr, Typeable tr) => + LogFormatting (Mux.WithBearer peer tr) where forMachine dtal (Mux.WithBearer b ev) = - mconcat [ "kind" .= String "Mux.Trace" + mconcat [ "kind" .= (show . typeOf $ ev) , "bearer" .= forMachine dtal b , "event" .= forMachine dtal ev ] forHuman (Mux.WithBearer b ev) = "With mux bearer " <> forHumanOrMachine b @@ -63,7 +63,7 @@ instance MetaTrace tr => MetaTrace (Mux.WithBearer peer tr) where metricsDocFor ns = metricsDocFor (nsCast ns :: Namespace tr) allNamespaces = map nsCast (allNamespaces :: [Namespace tr]) -instance LogFormatting Mux.Trace where +instance LogFormatting Mux.BearerTrace where forMachine _dtal Mux.TraceRecvHeaderStart = mconcat [ "kind" .= String "Mux.TraceRecvHeaderStart" , "msg" .= String "Bearer Receive Header Start" @@ -122,75 +122,6 @@ instance LogFormatting Mux.Trace where [ "kind" .= String "Mux.TraceSendEnd" , "msg" .= String "Bearer Send End" ] - forMachine _dtal (Mux.TraceState new) = mconcat - [ "kind" .= String "Mux.TraceState" - , "msg" .= String "MuxState" - , "state" .= String (showT new) - ] - forMachine _dtal (Mux.TraceCleanExit mid dir) = mconcat - [ "kind" .= String "Mux.TraceCleanExit" - , "msg" .= String "Miniprotocol terminated cleanly" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal (Mux.TraceExceptionExit mid dir exc) = mconcat - [ "kind" .= String "Mux.TraceExceptionExit" - , "msg" .= String "Miniprotocol terminated with exception" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - , "exception" .= String (showT exc) - ] - forMachine _dtal (Mux.TraceChannelRecvStart mid) = mconcat - [ "kind" .= String "Mux.TraceChannelRecvStart" - , "msg" .= String "Channel Receive Start" - , "miniProtocolNum" .= String (showT mid) - ] - forMachine _dtal (Mux.TraceChannelRecvEnd mid len) = mconcat - [ "kind" .= String "Mux.TraceChannelRecvEnd" - , "msg" .= String "Channel Receive End" - , "miniProtocolNum" .= String (showT mid) - , "length" .= String (showT len) - ] - forMachine _dtal (Mux.TraceChannelSendStart mid len) = mconcat - [ "kind" .= String "Mux.TraceChannelSendStart" - , "msg" .= String "Channel Send Start" - , "miniProtocolNum" .= String (showT mid) - , "length" .= String (showT len) - ] - forMachine _dtal (Mux.TraceChannelSendEnd mid) = mconcat - [ "kind" .= String "Mux.TraceChannelSendEnd" - , "msg" .= String "Channel Send End" - , "miniProtocolNum" .= String (showT mid) - ] - forMachine _dtal Mux.TraceHandshakeStart = mconcat - [ "kind" .= String "Mux.TraceHandshakeStart" - , "msg" .= String "Handshake start" - ] - forMachine _dtal (Mux.TraceHandshakeClientEnd duration) = mconcat - [ "kind" .= String "Mux.TraceHandshakeClientEnd" - , "msg" .= String "Handshake Client end" - , "duration" .= String (showT duration) - ] - forMachine _dtal Mux.TraceHandshakeServerEnd = mconcat - [ "kind" .= String "Mux.TraceHandshakeServerEnd" - , "msg" .= String "Handshake Server end" - ] - forMachine dtal (Mux.TraceHandshakeClientError e duration) = mconcat - [ "kind" .= String "Mux.TraceHandshakeClientError" - , "msg" .= String "Handshake Client Error" - , "duration" .= String (showT duration) - -- Client Error can include an error string from the peer which could be very large. - , "error" .= if dtal >= DDetailed - then show e - else take 256 $ show e - ] - forMachine dtal (Mux.TraceHandshakeServerError e) = mconcat - [ "kind" .= String "Mux.TraceHandshakeServerError" - , "msg" .= String "Handshake Server Error" - , "error" .= if dtal >= DDetailed - then show e - else take 256 $ show e - ] forMachine _dtal Mux.TraceSDUReadTimeoutException = mconcat [ "kind" .= String "Mux.TraceSDUReadTimeoutException" , "msg" .= String "Timed out reading SDU" @@ -199,44 +130,7 @@ instance LogFormatting Mux.Trace where [ "kind" .= String "Mux.TraceSDUWriteTimeoutException" , "msg" .= String "Timed out writing SDU" ] - forMachine _dtal (Mux.TraceStartEagerly mid dir) = mconcat - [ "kind" .= String "Mux.TraceStartEagerly" - , "msg" .= String "Eagerly started" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal (Mux.TraceStartOnDemand mid dir) = mconcat - [ "kind" .= String "Mux.TraceStartOnDemand" - , "msg" .= String "Preparing to start" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal (Mux.TraceStartOnDemandAny mid dir) = mconcat - [ "kind" .= String "Mux.TraceStartOnDemandAny" - , "msg" .= String "Preparing to start" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal (Mux.TraceStartedOnDemand mid dir) = mconcat - [ "kind" .= String "Mux.TraceStartedOnDemand" - , "msg" .= String "Started on demand" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal (Mux.TraceTerminating mid dir) = mconcat - [ "kind" .= String "Mux.TraceTerminating" - , "msg" .= String "Terminating" - , "miniProtocolNum" .= String (showT mid) - , "miniProtocolDir" .= String (showT dir) - ] - forMachine _dtal Mux.TraceStopping = mconcat - [ "kind" .= String "Mux.TraceStopping" - , "msg" .= String "Mux stopping" - ] - forMachine _dtal Mux.TraceStopped = mconcat - [ "kind" .= String "Mux.TraceStopped" - , "msg" .= String "Mux stoppped" - ] + forMachine _dtal Mux.TraceEmitDeltaQ = mempty #ifdef linux_HOST_OS forMachine _dtal (Mux.TraceTCPInfo StructTCPInfo { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans @@ -285,50 +179,11 @@ instance LogFormatting Mux.Trace where (unRemoteClockModel mhTimestamp) mhNum mhDir mhLength forHuman Mux.TraceSendEnd = "Bearer Send End" - forHuman (Mux.TraceState new) = - sformat ("State: " % shown) new - forHuman (Mux.TraceCleanExit mid dir) = - sformat ("Miniprotocol (" % shown % ") " % shown % " terminated cleanly") - mid dir - forHuman (Mux.TraceExceptionExit mid dir e) = - sformat ("Miniprotocol (" % shown % ") " % shown % - " terminated with exception " % shown) mid dir e - forHuman (Mux.TraceChannelRecvStart mid) = - sformat ("Channel Receive Start on " % shown) mid - forHuman (Mux.TraceChannelRecvEnd mid len) = - sformat ("Channel Receive End on (" % shown % ") " % int) mid len - forHuman (Mux.TraceChannelSendStart mid len) = - sformat ("Channel Send Start on (" % shown % ") " % int) mid len - forHuman (Mux.TraceChannelSendEnd mid) = - sformat ("Channel Send End on " % shown) mid - forHuman Mux.TraceHandshakeStart = - "Handshake start" - forHuman (Mux.TraceHandshakeClientEnd duration) = - sformat ("Handshake Client end, duration " % shown) duration - forHuman Mux.TraceHandshakeServerEnd = - "Handshake Server end" - forHuman (Mux.TraceHandshakeClientError e duration) = - -- Client Error can include an error string from the peer which could be very large. - sformat ("Handshake Client Error " % string % " duration " % shown) - (take 256 $ show e) duration - forHuman (Mux.TraceHandshakeServerError e) = - sformat ("Handshake Server Error " % shown) e forHuman Mux.TraceSDUReadTimeoutException = "Timed out reading SDU" forHuman Mux.TraceSDUWriteTimeoutException = "Timed out writing SDU" - forHuman (Mux.TraceStartEagerly mid dir) = - sformat ("Eagerly started (" % shown % ") in " % shown) mid dir - forHuman (Mux.TraceStartOnDemand mid dir) = - sformat ("Preparing to start (" % shown % ") in " % shown) mid dir - forHuman (Mux.TraceStartOnDemandAny mid dir) = - sformat ("Preparing to start (" % shown % ") in " % shown) mid dir - forHuman (Mux.TraceStartedOnDemand mid dir) = - sformat ("Started on demand (" % shown % ") in " % shown) mid dir - forHuman (Mux.TraceTerminating mid dir) = - sformat ("Terminating (" % shown % ") in " % shown) mid dir - forHuman Mux.TraceStopping = "Mux stopping" - forHuman Mux.TraceStopped = "Mux stoppped" + forHuman Mux.TraceEmitDeltaQ = mempty #ifdef linux_HOST_OS forHuman (Mux.TraceTCPInfo StructTCPInfo { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans @@ -349,14 +204,14 @@ instance LogFormatting Mux.Trace where forHuman (Mux.TraceTCPInfo _ len) = sformat ("TCPInfo len " % int) len #endif -instance MetaTrace Mux.Trace where +instance MetaTrace Mux.BearerTrace where namespaceFor Mux.TraceRecvHeaderStart {} = Namespace [] ["RecvHeaderStart"] namespaceFor Mux.TraceRecvHeaderEnd {} = Namespace [] ["RecvHeaderEnd"] namespaceFor Mux.TraceRecvStart {} = Namespace [] ["RecvStart"] - namespaceFor Mux.TraceRecvRaw {} = + namespaceFor Mux.TraceRecvRaw {} = Namespace [] ["RecvRaw"] namespaceFor Mux.TraceRecvEnd {} = Namespace [] ["RecvEnd"] @@ -364,30 +219,6 @@ instance MetaTrace Mux.Trace where Namespace [] ["SendStart"] namespaceFor Mux.TraceSendEnd = Namespace [] ["SendEnd"] - namespaceFor Mux.TraceState {} = - Namespace [] ["State"] - namespaceFor Mux.TraceCleanExit {} = - Namespace [] ["CleanExit"] - namespaceFor Mux.TraceExceptionExit {} = - Namespace [] ["ExceptionExit"] - namespaceFor Mux.TraceChannelRecvStart {} = - Namespace [] ["ChannelRecvStart"] - namespaceFor Mux.TraceChannelRecvEnd {} = - Namespace [] ["ChannelRecvEnd"] - namespaceFor Mux.TraceChannelSendStart {} = - Namespace [] ["ChannelSendStart"] - namespaceFor Mux.TraceChannelSendEnd {} = - Namespace [] ["ChannelSendEnd"] - namespaceFor Mux.TraceHandshakeStart = - Namespace [] ["HandshakeStart"] - namespaceFor Mux.TraceHandshakeClientEnd {} = - Namespace [] ["HandshakeClientEnd"] - namespaceFor Mux.TraceHandshakeServerEnd = - Namespace [] ["HandshakeServerEnd"] - namespaceFor Mux.TraceHandshakeClientError {} = - Namespace [] ["HandshakeClientError"] - namespaceFor Mux.TraceHandshakeServerError {} = - Namespace [] ["HandshakeServerError"] namespaceFor Mux.TraceRecvDeltaQObservation {} = Namespace [] ["RecvDeltaQObservation"] namespaceFor Mux.TraceRecvDeltaQSample {} = @@ -396,20 +227,8 @@ instance MetaTrace Mux.Trace where Namespace [] ["SDUReadTimeoutException"] namespaceFor Mux.TraceSDUWriteTimeoutException = Namespace [] ["SDUWriteTimeoutException"] - namespaceFor Mux.TraceStartEagerly {} = - Namespace [] ["StartEagerly"] - namespaceFor Mux.TraceStartOnDemand {} = - Namespace [] ["StartOnDemand"] - namespaceFor Mux.TraceStartOnDemandAny {} = - Namespace [] ["StartOnDemandAny"] - namespaceFor Mux.TraceStartedOnDemand {} = - Namespace [] ["StartedOnDemand"] - namespaceFor Mux.TraceTerminating {} = - Namespace [] ["Terminating"] - namespaceFor Mux.TraceStopping = - Namespace [] ["Stopping"] - namespaceFor Mux.TraceStopped = - Namespace [] ["Stopped"] + namespaceFor Mux.TraceEmitDeltaQ = + Namespace [] ["TraceEmitDeltaQ"] namespaceFor Mux.TraceTCPInfo {} = Namespace [] ["TCPInfo"] @@ -420,32 +239,13 @@ instance MetaTrace Mux.Trace where severityFor (Namespace _ ["RecvEnd"]) _ = Just Debug severityFor (Namespace _ ["SendStart"]) _ = Just Debug severityFor (Namespace _ ["SendEnd"]) _ = Just Debug - severityFor (Namespace _ ["State"]) _ = Just Info - severityFor (Namespace _ ["CleanExit"]) _ = Just Notice - severityFor (Namespace _ ["ExceptionExit"]) _ = Just Notice - severityFor (Namespace _ ["ChannelRecvStart"]) _ = Just Debug - severityFor (Namespace _ ["ChannelRecvEnd"]) _ = Just Debug - severityFor (Namespace _ ["ChannelSendStart"]) _ = Just Debug - severityFor (Namespace _ ["ChannelSendEnd"]) _ = Just Debug - severityFor (Namespace _ ["HandshakeStart"]) _ = Just Debug - severityFor (Namespace _ ["HandshakeClientEnd"]) _ = Just Info - severityFor (Namespace _ ["HandshakeServerEnd"]) _ = Just Debug - severityFor (Namespace _ ["HandshakeClientError"]) _ = Just Error - severityFor (Namespace _ ["HandshakeServerError"]) _ = Just Error severityFor (Namespace _ ["RecvDeltaQObservation"]) _ = Just Debug severityFor (Namespace _ ["RecvDeltaQSample"]) _ = Just Debug severityFor (Namespace _ ["SDUReadTimeoutException"]) _ = Just Notice severityFor (Namespace _ ["SDUWriteTimeoutException"]) _ = Just Notice - severityFor (Namespace _ ["StartEagerly"]) _ = Just Debug - severityFor (Namespace _ ["StartOnDemand"]) _ = Just Debug - severityFor (Namespace _ ["StartOnDemandAny"]) _ = Just Debug - severityFor (Namespace _ ["StartedOnDemand"]) _ = Just Debug - severityFor (Namespace _ ["Terminating"]) _ = Just Debug - severityFor (Namespace _ ["Shutdown"]) _ = Just Debug - severityFor (Namespace _ ["Stopping"]) _ = Just Debug - severityFor (Namespace _ ["Stopped"]) _ = Just Debug severityFor (Namespace _ ["TCPInfo"]) _ = Just Debug - severityFor _ _ = Nothing + severityFor (Namespace _ ["TraceEmitDeltaQ"]) _ = Nothing + severityFor _ _ = Nothing documentFor (Namespace _ ["RecvHeaderStart"]) = Just "Bearer receive header start." @@ -461,30 +261,6 @@ instance MetaTrace Mux.Trace where "Bearer send start." documentFor (Namespace _ ["SendEnd"]) = Just "Bearer send end." - documentFor (Namespace _ ["State"]) = Just - "State." - documentFor (Namespace _ ["CleanExit"]) = Just - "Miniprotocol terminated cleanly." - documentFor (Namespace _ ["ExceptionExit"]) = Just - "Miniprotocol terminated with exception." - documentFor (Namespace _ ["ChannelRecvStart"]) = Just - "Channel receive start." - documentFor (Namespace _ ["ChannelRecvEnd"]) = Just - "Channel receive end." - documentFor (Namespace _ ["ChannelSendStart"]) = Just - "Channel send start." - documentFor (Namespace _ ["ChannelSendEnd"]) = Just - "Channel send end." - documentFor (Namespace _ ["HandshakeStart"]) = Just - "Handshake start." - documentFor (Namespace _ ["HandshakeClientEnd"]) = Just - "Handshake client end." - documentFor (Namespace _ ["HandshakeServerEnd"]) = Just - "Handshake server end." - documentFor (Namespace _ ["HandshakeClientError"]) = Just - "Handshake client error." - documentFor (Namespace _ ["HandshakeServerError"]) = Just - "Handshake server error." documentFor (Namespace _ ["RecvDeltaQObservation"]) = Just "Bearer DeltaQ observation." documentFor (Namespace _ ["RecvDeltaQSample"]) = Just @@ -493,6 +269,212 @@ instance MetaTrace Mux.Trace where "Timed out reading SDU." documentFor (Namespace _ ["SDUWriteTimeoutException"]) = Just "Timed out writing SDU." + documentFor (Namespace _ ["TraceEmitDeltaQ"]) = Nothing + documentFor (Namespace _ ["TCPInfo"]) = Just + "TCPInfo." + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["RecvHeaderStart"] + , Namespace [] ["RecvRaw"] + , Namespace [] ["RecvHeaderEnd"] + , Namespace [] ["RecvStart"] + , Namespace [] ["RecvEnd"] + , Namespace [] ["SendStart"] + , Namespace [] ["SendEnd"] + , Namespace [] ["RecvDeltaQObservation"] + , Namespace [] ["RecvDeltaQSample"] + , Namespace [] ["SDUReadTimeoutException"] + , Namespace [] ["SDUWriteTimeoutException"] + , Namespace [] ["TraceEmitDeltaQ"] + , Namespace [] ["TCPInfo"] + ] + +instance LogFormatting Mux.ChannelTrace where + forMachine _dtal (Mux.TraceChannelRecvStart mid) = mconcat + [ "kind" .= String "Mux.TraceChannelRecvStart" + , "msg" .= String "Channel Receive Start" + , "miniProtocolNum" .= String (showT mid) + ] + forMachine _dtal (Mux.TraceChannelRecvEnd mid len) = mconcat + [ "kind" .= String "Mux.TraceChannelRecvEnd" + , "msg" .= String "Channel Receive End" + , "miniProtocolNum" .= String (showT mid) + , "length" .= String (showT len) + ] + forMachine _dtal (Mux.TraceChannelSendStart mid len) = mconcat + [ "kind" .= String "Mux.TraceChannelSendStart" + , "msg" .= String "Channel Send Start" + , "miniProtocolNum" .= String (showT mid) + , "length" .= String (showT len) + ] + forMachine _dtal (Mux.TraceChannelSendEnd mid) = mconcat + [ "kind" .= String "Mux.TraceChannelSendEnd" + , "msg" .= String "Channel Send End" + , "miniProtocolNum" .= String (showT mid) + ] + + forHuman (Mux.TraceChannelRecvStart mid) = + sformat ("Channel Receive Start on " % shown) mid + forHuman (Mux.TraceChannelRecvEnd mid len) = + sformat ("Channel Receive End on (" % shown % ") " % int) mid len + forHuman (Mux.TraceChannelSendStart mid len) = + sformat ("Channel Send Start on (" % shown % ") " % int) mid len + forHuman (Mux.TraceChannelSendEnd mid) = + sformat ("Channel Send End on " % shown) mid + +instance MetaTrace Mux.ChannelTrace where + namespaceFor Mux.TraceChannelRecvStart {} = + Namespace [] ["ChannelRecvStart"] + namespaceFor Mux.TraceChannelRecvEnd {} = + Namespace [] ["ChannelRecvEnd"] + namespaceFor Mux.TraceChannelSendStart {} = + Namespace [] ["ChannelSendStart"] + namespaceFor Mux.TraceChannelSendEnd {} = + Namespace [] ["ChannelSendEnd"] + + severityFor (Namespace _ ["ChannelRecvStart"]) _ = Just Debug + severityFor (Namespace _ ["ChannelRecvEnd"]) _ = Just Debug + severityFor (Namespace _ ["ChannelSendStart"]) _ = Just Debug + severityFor (Namespace _ ["ChannelSendEnd"]) _ = Just Debug + severityFor _ _ = Nothing + + documentFor (Namespace _ ["ChannelRecvStart"]) = Just + "Channel receive start." + documentFor (Namespace _ ["ChannelRecvEnd"]) = Just + "Channel receive end." + documentFor (Namespace _ ["ChannelSendStart"]) = Just + "Channel send start." + documentFor (Namespace _ ["ChannelSendEnd"]) = Just + "Channel send end." + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["ChannelRecvStart"] + , Namespace [] ["ChannelRecvEnd"] + , Namespace [] ["ChannelSendStart"] + , Namespace [] ["ChannelSendEnd"] + ] + +instance LogFormatting Mux.Trace where + forMachine _dtal (Mux.TraceState new) = mconcat + [ "kind" .= String "Mux.TraceState" + , "msg" .= String "MuxState" + , "state" .= String (showT new) + ] + forMachine _dtal (Mux.TraceCleanExit mid dir) = mconcat + [ "kind" .= String "Mux.TraceCleanExit" + , "msg" .= String "Miniprotocol terminated cleanly" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal (Mux.TraceExceptionExit mid dir exc) = mconcat + [ "kind" .= String "Mux.TraceExceptionExit" + , "msg" .= String "Miniprotocol terminated with exception" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + , "exception" .= String (showT exc) + ] + forMachine _dtal (Mux.TraceStartEagerly mid dir) = mconcat + [ "kind" .= String "Mux.TraceStartEagerly" + , "msg" .= String "Eagerly started" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal (Mux.TraceStartOnDemand mid dir) = mconcat + [ "kind" .= String "Mux.TraceStartOnDemand" + , "msg" .= String "Preparing to start" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal (Mux.TraceStartOnDemandAny mid dir) = mconcat + [ "kind" .= String "Mux.TraceStartOnDemandAny" + , "msg" .= String "Preparing to start" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal (Mux.TraceStartedOnDemand mid dir) = mconcat + [ "kind" .= String "Mux.TraceStartedOnDemand" + , "msg" .= String "Started on demand" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal (Mux.TraceTerminating mid dir) = mconcat + [ "kind" .= String "Mux.TraceTerminating" + , "msg" .= String "Terminating" + , "miniProtocolNum" .= String (showT mid) + , "miniProtocolDir" .= String (showT dir) + ] + forMachine _dtal Mux.TraceStopping = mconcat + [ "kind" .= String "Mux.TraceStopping" + , "msg" .= String "Mux stopping" + ] + forMachine _dtal Mux.TraceStopped = mconcat + [ "kind" .= String "Mux.TraceStopped" + , "msg" .= String "Mux stoppped" + ] + + forHuman (Mux.TraceState new) = + sformat ("State: " % shown) new + forHuman (Mux.TraceCleanExit mid dir) = + sformat ("Miniprotocol (" % shown % ") " % shown % " terminated cleanly") + mid dir + forHuman (Mux.TraceExceptionExit mid dir e) = + sformat ("Miniprotocol (" % shown % ") " % shown % + " terminated with exception " % shown) mid dir e + forHuman (Mux.TraceStartEagerly mid dir) = + sformat ("Eagerly started (" % shown % ") in " % shown) mid dir + forHuman (Mux.TraceStartOnDemand mid dir) = + sformat ("Preparing to start (" % shown % ") in " % shown) mid dir + forHuman (Mux.TraceStartOnDemandAny mid dir) = + sformat ("Preparing to start (" % shown % ") in " % shown) mid dir + forHuman (Mux.TraceStartedOnDemand mid dir) = + sformat ("Started on demand (" % shown % ") in " % shown) mid dir + forHuman (Mux.TraceTerminating mid dir) = + sformat ("Terminating (" % shown % ") in " % shown) mid dir + forHuman Mux.TraceStopping = "Mux stopping" + forHuman Mux.TraceStopped = "Mux stoppped" + +instance MetaTrace Mux.Trace where + namespaceFor Mux.TraceState {} = + Namespace [] ["State"] + namespaceFor Mux.TraceCleanExit {} = + Namespace [] ["CleanExit"] + namespaceFor Mux.TraceExceptionExit {} = + Namespace [] ["ExceptionExit"] + namespaceFor Mux.TraceStartEagerly {} = + Namespace [] ["StartEagerly"] + namespaceFor Mux.TraceStartOnDemand {} = + Namespace [] ["StartOnDemand"] + namespaceFor Mux.TraceStartOnDemandAny {} = + Namespace [] ["StartOnDemandAny"] + namespaceFor Mux.TraceStartedOnDemand {} = + Namespace [] ["StartedOnDemand"] + namespaceFor Mux.TraceTerminating {} = + Namespace [] ["Terminating"] + namespaceFor Mux.TraceStopping = + Namespace [] ["Stopping"] + namespaceFor Mux.TraceStopped = + Namespace [] ["Stopped"] + + severityFor (Namespace _ ["State"]) _ = Just Info + severityFor (Namespace _ ["CleanExit"]) _ = Just Notice + severityFor (Namespace _ ["ExceptionExit"]) _ = Just Notice + severityFor (Namespace _ ["StartEagerly"]) _ = Just Debug + severityFor (Namespace _ ["StartOnDemand"]) _ = Just Debug + severityFor (Namespace _ ["StartOnDemandAny"]) _ = Just Debug + severityFor (Namespace _ ["StartedOnDemand"]) _ = Just Debug + severityFor (Namespace _ ["Terminating"]) _ = Just Debug + severityFor (Namespace _ ["Stopping"]) _ = Just Debug + severityFor (Namespace _ ["Stopped"]) _ = Just Debug + severityFor _ _ = Nothing + + documentFor (Namespace _ ["State"]) = Just + "State." + documentFor (Namespace _ ["CleanExit"]) = Just + "Miniprotocol terminated cleanly." + documentFor (Namespace _ ["ExceptionExit"]) = Just + "Miniprotocol terminated with exception." documentFor (Namespace _ ["StartEagerly"]) = Just "Eagerly started." documentFor (Namespace _ ["StartOnDemand"]) = Just @@ -507,36 +489,12 @@ instance MetaTrace Mux.Trace where "Mux shutdown." documentFor (Namespace _ ["Stopped"]) = Just "Mux shutdown." - documentFor (Namespace _ ["Shutdown"]) = Just - "Mux shutdown." - documentFor (Namespace _ ["TCPInfo"]) = Just - "TCPInfo." documentFor _ = Nothing allNamespaces = [ - Namespace [] ["RecvHeaderStart"] - , Namespace [] ["RecvRaw"] - , Namespace [] ["RecvHeaderEnd"] - , Namespace [] ["RecvStart"] - , Namespace [] ["RecvEnd"] - , Namespace [] ["SendStart"] - , Namespace [] ["SendEnd"] - , Namespace [] ["State"] + Namespace [] ["State"] , Namespace [] ["CleanExit"] , Namespace [] ["ExceptionExit"] - , Namespace [] ["ChannelRecvStart"] - , Namespace [] ["ChannelRecvEnd"] - , Namespace [] ["ChannelSendStart"] - , Namespace [] ["ChannelSendEnd"] - , Namespace [] ["HandshakeStart"] - , Namespace [] ["HandshakeClientEnd"] - , Namespace [] ["HandshakeServerEnd"] - , Namespace [] ["HandshakeClientError"] - , Namespace [] ["HandshakeServerError"] - , Namespace [] ["RecvDeltaQObservation"] - , Namespace [] ["RecvDeltaQSample"] - , Namespace [] ["SDUReadTimeoutException"] - , Namespace [] ["SDUWriteTimeoutException"] , Namespace [] ["StartEagerly"] , Namespace [] ["StartOnDemand"] , Namespace [] ["StartOnDemandAny"] @@ -544,70 +502,81 @@ instance MetaTrace Mux.Trace where , Namespace [] ["Terminating"] , Namespace [] ["Stopping"] , Namespace [] ["Stopped"] - , Namespace [] ["Shutdown"] - , Namespace [] ["TCPInfo"] ] + -------------------------------------------------------------------------------- -- Handshake Tracer -------------------------------------------------------------------------------- -instance (Show adr, Show ver) => LogFormatting (NtN.HandshakeTr adr ver) where - forMachine _dtal (Mux.WithBearer b ev) = - mconcat [ "kind" .= String "HandshakeTrace" - , "bearer" .= show b - , "event" .= show ev ] - forHuman (Mux.WithBearer b ev) = "With mux bearer " <> showT b - <> ". " <> showT ev - -instance MetaTrace (AnyMessage (HS.Handshake nt term)) where - namespaceFor (AnyMessageAndAgency _stok HS.MsgProposeVersions {}) = - Namespace [] ["ProposeVersions"] - namespaceFor (AnyMessageAndAgency _stok HS.MsgReplyVersions {}) = - Namespace [] ["ReplyVersions"] - namespaceFor (AnyMessageAndAgency _stok HS.MsgQueryReply {}) = - Namespace [] ["MsgQueryReply"] - namespaceFor (AnyMessageAndAgency _stok HS.MsgAcceptVersion {}) = - Namespace [] ["AcceptVersion"] - namespaceFor (AnyMessageAndAgency _stok HS.MsgRefuse {}) = - Namespace [] ["Refuse"] - - severityFor (Namespace _ ["ProposeVersions"]) _ = Just Info - severityFor (Namespace _ ["ReplyVersions"]) _ = Just Info - severityFor (Namespace _ ["MsgQueryReply"]) _ = Just Info - severityFor (Namespace _ ["AcceptVersion"]) _ = Just Info - severityFor (Namespace _ ["Refuse"]) _ = Just Info - severityFor _ _ = Nothing - - documentFor (Namespace _ ["ProposeVersions"]) = Just $ mconcat +instance (Show term, Show ntcVersion) => + LogFormatting (AnyMessage (HS.Handshake ntcVersion term)) where + forMachine _dtal (AnyMessageAndAgency stok msg) = + mconcat [ "kind" .= String kind + , "msg" .= (String . showT $ msg) + , "agency" .= String (pack $ show stok) + ] + where + kind = case msg of + HS.MsgProposeVersions {} -> "ProposeVersions" + HS.MsgReplyVersions {} -> "ReplyVersions" + HS.MsgQueryReply {} -> "QueryReply" + HS.MsgAcceptVersion {} -> "AcceptVersion" + HS.MsgRefuse {} -> "Refuse" + + forHuman (AnyMessageAndAgency stok msg) = + "Handshake (agency, message) = " <> "(" <> showT stok <> "," <> forHumanOrMachine (AnyMessage msg) <> ")" + +instance MetaTrace (AnyMessage (HS.Handshake a b)) where + namespaceFor (AnyMessage msg) = Namespace [] $ case msg of + HS.MsgProposeVersions {} -> ["ProposeVersions"] + HS.MsgReplyVersions {} -> ["ReplyVersions"] + HS.MsgQueryReply {} -> ["QueryReply"] + HS.MsgAcceptVersion {} -> ["AcceptVersion"] + HS.MsgRefuse {} -> ["Refuse"] + + severityFor (Namespace _ [sym]) _ = case sym of + "ProposeVersions" -> Just Info + "ReplyVersions" -> Just Info + "QueryReply" -> Just Info + "AcceptVersion" -> Just Info + "Refuse" -> Just Info + _otherwise -> Nothing + severityFor _ _ = Nothing + + documentFor (Namespace _ sym) = wrap . mconcat $ case sym of + ["ProposeVersions"] -> [ "Propose versions together with version parameters. It must be" , " encoded to a sorted list.." ] - documentFor (Namespace _ ["ReplyVersions"]) = Just $ mconcat + ["ReplyVersions"] -> [ "`MsgReplyVersions` received as a response to 'MsgProposeVersions'. It" , " is not supported to explicitly send this message. It can only be" , " received as a copy of 'MsgProposeVersions' in a simultaneous open" , " scenario." ] - documentFor (Namespace _ ["MsgQueryReply"]) = Just $ mconcat + ["QueryReply"] -> [ "`MsgQueryReply` received as a response to a handshake query in " , " 'MsgProposeVersions' and lists the supported versions." ] - documentFor (Namespace _ ["AcceptVersion"]) = Just $ mconcat + ["AcceptVersion"] -> [ "The remote end decides which version to use and sends chosen version." , "The server is allowed to modify version parameters." ] - documentFor (Namespace _ ["Refuse"]) = Just - "It refuses to run any version." - documentFor _ = Nothing + ["Refuse"] -> ["It refuses to run any version."] + _otherwise -> [] :: [Text] + where + wrap it = case it of + "" -> Nothing + it' -> Just it' - allNamespaces = [ - Namespace [] ["ProposeVersions"] - , Namespace [] ["ReplyVersions"] - , Namespace [] ["MsgQueryReply"] - , Namespace [] ["AcceptVersion"] - , Namespace [] ["Refuse"] - ] + allNamespaces = [ + Namespace [] ["ProposeVersions"] + , Namespace [] ["ReplyVersions"] + , Namespace [] ["QueryReply"] + , Namespace [] ["AcceptVersion"] + , Namespace [] ["Refuse"] + ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 6d5e77ef320..d53a977643c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -1226,6 +1226,10 @@ instance Show lAddr => LogFormatting (PeerSelectionActionsTrace SockAddr lAddr) mconcat [ "kind" .= String "AcquireConnectionError" , "error" .= displayException exception ] + forMachine _dtal (PeerHotDuration connId dt) = + mconcat [ "kind" .= String "PeerHotDuration" + , "connectionId" .= toJSON connId + , "time" .= show dt] forHuman = pack . show instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where @@ -1234,12 +1238,14 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where namespaceFor PeerMonitoringError {} = Namespace [] ["MonitoringError"] namespaceFor PeerMonitoringResult {} = Namespace [] ["MonitoringResult"] namespaceFor AcquireConnectionError {} = Namespace [] ["ConnectionError"] + namespaceFor PeerHotDuration {} = Namespace [] ["PeerHotDuration"] severityFor (Namespace _ ["StatusChanged"]) _ = Just Info severityFor (Namespace _ ["StatusChangeFailure"]) _ = Just Error severityFor (Namespace _ ["MonitoringError"]) _ = Just Error severityFor (Namespace _ ["MonitoringResult"]) _ = Just Debug severityFor (Namespace _ ["ConnectionError"]) _ = Just Error + severityFor (Namespace _ ["PeerHotDuration"]) _ = Just Info severityFor _ _ = Nothing documentFor (Namespace _ ["StatusChanged"]) = Just @@ -1252,6 +1258,8 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where "" documentFor (Namespace _ ["ConnectionError"]) = Just "" + documentFor (Namespace _ ["PeerHotDuration"]) = Just + "Reports how long the outbound connection was in hot state" documentFor _ = Nothing allNamespaces = [ @@ -1260,6 +1268,7 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where , Namespace [] ["MonitoringError"] , Namespace [] ["MonitoringResult"] , Namespace [] ["ConnectionError"] + , Namespace [] ["PeerHotDuration"] ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index f0dc4263ef7..43b7e1cb07e 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -60,7 +60,11 @@ module Cardano.Tracing.Config , TraceLocalTxSubmissionServer , TraceMempool , TraceMux + , TraceMuxBearer + , TraceMuxChannel , TraceLocalMux + , TraceLocalMuxBearer + , TraceLocalMuxChannel , TracePeerSelection , TracePeerSelectionCounters , TracePeerSelectionActions @@ -167,7 +171,11 @@ type TraceLocalTxSubmissionServer = ("TraceLocalTxSubmissionServer" :: Symbol) type TraceMempool = ("TraceMempool" :: Symbol) type TraceBackingStore = ("TraceBackingStore" :: Symbol) type TraceMux = ("TraceMux" :: Symbol) +type TraceMuxBearer = ("TraceMuxBearer" :: Symbol) +type TraceMuxChannel = ("TraceMuxChannel" :: Symbol) type TraceLocalMux = ("TraceLocalMux" :: Symbol) +type TraceLocalMuxBearer = ("TraceLocalMuxBearer" :: Symbol) +type TraceLocalMuxChannel = ("TraceLocalMuxChannel" :: Symbol) type TracePeerSelection = ("TracePeerSelection" :: Symbol) type TracePeerSelectionCounters = ("TracePeerSelectionCounters" :: Symbol) type TracePeerSelectionActions = ("TracePeerSelectionActions" :: Symbol) @@ -241,6 +249,8 @@ data TraceSelection , traceLocalHandshake :: OnOff TraceLocalHandshake , traceLocalInboundGovernor :: OnOff TraceLocalInboundGovernor , traceLocalMux :: OnOff TraceLocalMux + , traceLocalMuxBearer :: OnOff TraceLocalMuxBearer + , traceLocalMuxChannel :: OnOff TraceLocalMuxChannel , traceLocalRootPeers :: OnOff TraceLocalRootPeers , traceLocalServer :: OnOff TraceLocalServer , traceLocalStateQueryProtocol :: OnOff TraceLocalStateQueryProtocol @@ -250,6 +260,8 @@ data TraceSelection , traceMempool :: OnOff TraceMempool , traceBackingStore :: OnOff TraceBackingStore , traceMux :: OnOff TraceMux + , traceMuxBearer :: OnOff TraceMuxBearer + , traceMuxChannel :: OnOff TraceMuxChannel , tracePeerSelection :: OnOff TracePeerSelection , tracePeerSelectionCounters :: OnOff TracePeerSelectionCounters , tracePeerSelectionActions :: OnOff TracePeerSelectionActions @@ -314,6 +326,8 @@ data PartialTraceSelection , pTraceLocalHandshake :: Last (OnOff TraceLocalHandshake) , pTraceLocalInboundGovernor :: Last (OnOff TraceLocalInboundGovernor) , pTraceLocalMux :: Last (OnOff TraceLocalMux) + , pTraceLocalMuxBearer :: Last (OnOff TraceLocalMuxBearer) + , pTraceLocalMuxChannel :: Last (OnOff TraceLocalMuxChannel) , pTraceLocalRootPeers :: Last (OnOff TraceLocalRootPeers) , pTraceLocalServer :: Last (OnOff TraceLocalServer) , pTraceLocalStateQueryProtocol :: Last (OnOff TraceLocalStateQueryProtocol) @@ -323,6 +337,8 @@ data PartialTraceSelection , pTraceMempool :: Last (OnOff TraceMempool) , pTraceBackingStore :: Last (OnOff TraceBackingStore) , pTraceMux :: Last (OnOff TraceMux) + , pTraceMuxBearer :: Last (OnOff TraceMuxBearer) + , pTraceMuxChannel :: Last (OnOff TraceMuxChannel) , pTracePeerSelection :: Last (OnOff TracePeerSelection) , pTracePeerSelectionCounters :: Last (OnOff TracePeerSelectionCounters) , pTracePeerSelectionActions :: Last (OnOff TracePeerSelectionActions) @@ -388,6 +404,8 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceLocalHandshake) v <*> parseTracer (Proxy @TraceLocalInboundGovernor) v <*> parseTracer (Proxy @TraceLocalMux) v + <*> parseTracer (Proxy @TraceLocalMuxBearer) v + <*> parseTracer (Proxy @TraceLocalMuxChannel) v <*> parseTracer (Proxy @TraceLocalRootPeers) v <*> parseTracer (Proxy @TraceLocalServer) v <*> parseTracer (Proxy @TraceLocalStateQueryProtocol) v @@ -397,6 +415,8 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceMempool) v <*> parseTracer (Proxy @TraceBackingStore) v <*> parseTracer (Proxy @TraceMux) v + <*> parseTracer (Proxy @TraceMuxBearer) v + <*> parseTracer (Proxy @TraceMuxChannel) v <*> parseTracer (Proxy @TracePeerSelection) v <*> parseTracer (Proxy @TracePeerSelectionCounters) v <*> parseTracer (Proxy @TracePeerSelectionActions) v @@ -459,6 +479,8 @@ defaultPartialTraceConfiguration = , pTraceLocalHandshake = pure $ OnOff True , pTraceLocalInboundGovernor = pure $ OnOff True , pTraceLocalMux = pure $ OnOff False + , pTraceLocalMuxBearer = pure $ OnOff False + , pTraceLocalMuxChannel = pure $ OnOff False , pTraceLocalTxMonitorProtocol = pure $ OnOff False , pTraceLocalRootPeers = pure $ OnOff False , pTraceLocalServer = pure $ OnOff True @@ -467,7 +489,9 @@ defaultPartialTraceConfiguration = , pTraceLocalTxSubmissionServer = pure $ OnOff False , pTraceMempool = pure $ OnOff True , pTraceBackingStore = pure $ OnOff False - , pTraceMux = pure $ OnOff True + , pTraceMux = pure $ OnOff False + , pTraceMuxBearer = pure $ OnOff False + , pTraceMuxChannel = pure $ OnOff False , pTracePeerSelection = pure $ OnOff True , pTracePeerSelectionCounters = pure $ OnOff True , pTracePeerSelectionActions = pure $ OnOff True @@ -532,6 +556,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceLocalHandshake <- proxyLastToEither (Proxy @TraceLocalHandshake) pTraceLocalHandshake traceLocalInboundGovernor <- proxyLastToEither (Proxy @TraceLocalInboundGovernor) pTraceLocalInboundGovernor traceLocalMux <- proxyLastToEither (Proxy @TraceLocalMux) pTraceLocalMux + traceLocalMuxBearer <- proxyLastToEither (Proxy @TraceLocalMuxBearer) pTraceLocalMuxBearer + traceLocalMuxChannel <- proxyLastToEither (Proxy @TraceLocalMuxChannel) pTraceLocalMuxChannel traceLocalTxMonitorProtocol <- proxyLastToEither (Proxy @TraceLocalTxMonitorProtocol) pTraceLocalTxMonitorProtocol traceLocalRootPeers <- proxyLastToEither (Proxy @TraceLocalRootPeers) pTraceLocalRootPeers traceLocalServer <- proxyLastToEither (Proxy @TraceLocalServer) pTraceLocalServer @@ -541,6 +567,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceMempool <- proxyLastToEither (Proxy @TraceMempool) pTraceMempool traceBackingStore <- proxyLastToEither (Proxy @TraceBackingStore) pTraceBackingStore traceMux <- proxyLastToEither (Proxy @TraceMux) pTraceMux + traceMuxBearer <- proxyLastToEither (Proxy @TraceMuxBearer) pTraceMuxBearer + traceMuxChannel <- proxyLastToEither (Proxy @TraceMuxChannel) pTraceMuxChannel tracePeerSelection <- proxyLastToEither (Proxy @TracePeerSelection) pTracePeerSelection tracePeerSelectionCounters <- proxyLastToEither (Proxy @TracePeerSelectionCounters) pTracePeerSelectionCounters tracePeerSelectionActions <- proxyLastToEither (Proxy @TracePeerSelectionActions) pTracePeerSelectionActions @@ -598,6 +626,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceLocalHandshake = traceLocalHandshake , traceLocalInboundGovernor = traceLocalInboundGovernor , traceLocalMux = traceLocalMux + , traceLocalMuxBearer = traceLocalMuxBearer + , traceLocalMuxChannel = traceLocalMuxChannel , traceLocalTxMonitorProtocol = traceLocalTxMonitorProtocol , traceLocalRootPeers = traceLocalRootPeers , traceLocalServer = traceLocalServer @@ -607,6 +637,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceMempool = traceMempool , traceBackingStore = traceBackingStore , traceMux = traceMux + , traceMuxBearer = traceMuxBearer + , traceMuxChannel = traceMuxChannel , tracePeerSelection = tracePeerSelection , tracePeerSelectionCounters = tracePeerSelectionCounters , tracePeerSelectionActions = tracePeerSelectionActions @@ -668,6 +700,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceLocalHandshake <- proxyLastToEither (Proxy @TraceLocalHandshake) pTraceLocalHandshake traceLocalInboundGovernor <- proxyLastToEither (Proxy @TraceLocalInboundGovernor) pTraceLocalInboundGovernor traceLocalMux <- proxyLastToEither (Proxy @TraceLocalMux) pTraceLocalMux + traceLocalMuxBearer <- proxyLastToEither (Proxy @TraceLocalMuxBearer) pTraceLocalMuxBearer + traceLocalMuxChannel <- proxyLastToEither (Proxy @TraceLocalMuxChannel) pTraceLocalMuxChannel traceLocalRootPeers <- proxyLastToEither (Proxy @TraceLocalRootPeers) pTraceLocalRootPeers traceLocalServer <- proxyLastToEither (Proxy @TraceLocalServer) pTraceLocalServer traceLocalTxMonitorProtocol <- proxyLastToEither (Proxy @TraceLocalTxMonitorProtocol) pTraceLocalTxMonitorProtocol @@ -677,6 +711,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceMempool <- proxyLastToEither (Proxy @TraceMempool) pTraceMempool traceBackingStore <- proxyLastToEither (Proxy @TraceBackingStore) pTraceBackingStore traceMux <- proxyLastToEither (Proxy @TraceMux) pTraceMux + traceMuxBearer <- proxyLastToEither (Proxy @TraceMuxBearer) pTraceMuxBearer + traceMuxChannel <- proxyLastToEither (Proxy @TraceMuxChannel) pTraceMuxChannel tracePeerSelection <- proxyLastToEither (Proxy @TracePeerSelection) pTracePeerSelection tracePeerSelectionCounters <- proxyLastToEither (Proxy @TracePeerSelectionCounters) pTracePeerSelectionCounters tracePeerSelectionActions <- proxyLastToEither (Proxy @TracePeerSelectionActions) pTracePeerSelectionActions @@ -734,6 +770,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceLocalHandshake = traceLocalHandshake , traceLocalInboundGovernor = traceLocalInboundGovernor , traceLocalMux = traceLocalMux + , traceLocalMuxBearer = traceLocalMuxBearer + , traceLocalMuxChannel = traceLocalMuxChannel , traceLocalRootPeers = traceLocalRootPeers , traceLocalServer = traceLocalServer , traceLocalStateQueryProtocol = traceLocalStateQueryProtocol @@ -743,6 +781,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceMempool = traceMempool , traceBackingStore = traceBackingStore , traceMux = traceMux + , traceMuxBearer = traceMuxBearer + , traceMuxChannel = traceMuxChannel , tracePeerSelection = tracePeerSelection , tracePeerSelectionCounters = tracePeerSelectionCounters , tracePeerSelectionActions = tracePeerSelectionActions diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index d464a8dd0d2..2c0f2755234 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -101,12 +101,12 @@ import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (listValue) import Data.Bifunctor (Bifunctor (first)) -import Data.Data (Proxy (..)) 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 (Text, pack) +import Data.Typeable import qualified Network.Mux as Mux import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) @@ -256,6 +256,14 @@ instance HasSeverityAnnotation (Mux.WithBearer peer Mux.Trace) where Mux.TraceStopping -> Debug Mux.TraceStopped -> Debug +instance HasPrivacyAnnotation (Mux.WithBearer peer Mux.ChannelTrace) +instance HasSeverityAnnotation (Mux.WithBearer peer Mux.ChannelTrace) where + getSeverityAnnotation (Mux.WithBearer _ ev) = case ev of + Mux.TraceChannelRecvStart {} -> Debug + Mux.TraceChannelRecvEnd {} -> Debug + Mux.TraceChannelSendStart {} -> Debug + Mux.TraceChannelSendEnd {} -> Debug + instance HasPrivacyAnnotation (Mux.WithBearer peer Mux.BearerTrace) instance HasSeverityAnnotation (Mux.WithBearer peer Mux.BearerTrace) where getSeverityAnnotation (Mux.WithBearer _ ev) = case ev of @@ -466,17 +474,6 @@ instance Transformable Text IO (Diffusion.DiffusionTracer RemoteAddress LocalAdd instance HasTextFormatter (Diffusion.DiffusionTracer RemoteAddress LocalAddress) where formatText a _ = pack (show a) -instance Transformable Text IO (NtN.HandshakeTr RemoteAddress NodeToNodeVersion) where - trTransformer = trStructuredText -instance HasTextFormatter (NtN.HandshakeTr RemoteAddress NodeToNodeVersion) where - formatText a _ = pack (show a) - - -instance Transformable Text IO (NtC.HandshakeTr LocalAddress NodeToClientVersion) where - trTransformer = trStructuredText -instance HasTextFormatter (NtC.HandshakeTr LocalAddress NodeToClientVersion) where - formatText a _ = pack (show a) - instance Transformable Text IO NtN.AcceptConnectionsPolicyTrace where trTransformer = trStructuredText @@ -591,11 +588,15 @@ instance HasTextFormatter TraceLedgerPeers where formatText _ = pack . show . toList -instance (Show peer, ToObject peer) - => Transformable Text IO (Mux.WithBearer peer Mux.Trace) where +instance ( Show peer + , Show tr + , HasPrivacyAnnotation (Mux.WithBearer peer tr) + , HasSeverityAnnotation (Mux.WithBearer peer tr) + , ToObject (Mux.WithBearer peer tr)) + => Transformable Text IO (Mux.WithBearer peer tr) where trTransformer = trStructuredText -instance (Show peer) - => HasTextFormatter (Mux.WithBearer peer Mux.Trace) where +instance (Show peer, Show tr) + => HasTextFormatter (Mux.WithBearer peer tr) where formatText (Mux.WithBearer peer ev) _o = "Bearer on " <> pack (show peer) <> " event: " <> pack (show ev) @@ -1042,18 +1043,6 @@ instance (Show ntnAddr, Show ntcAddr) => ToObject (Diffusion.DiffusionTracer ntn , "message" .= String (pack (show config)) ] -instance ToObject (NtC.HandshakeTr LocalAddress NodeToClientVersion) where - toObject _verb (Mux.WithBearer b ev) = - mconcat [ "kind" .= String "LocalHandshakeTrace" - , "bearer" .= show b - , "event" .= show ev ] - - -instance ToObject (NtN.HandshakeTr RemoteAddress NodeToNodeVersion) where - toObject _verb (Mux.WithBearer b ev) = - mconcat [ "kind" .= String "HandshakeTrace" - , "bearer" .= show b - , "event" .= show ev ] instance ToObject NtN.AcceptConnectionsPolicyTrace where toObject _verb (NtN.ServerTraceAcceptConnectionRateLimiting delay numOfConnections) = @@ -1391,9 +1380,9 @@ instance ToObject TraceLedgerPeers where ] -instance ToObject peer => ToObject (Mux.WithBearer peer Mux.Trace) where +instance (Typeable tr, ToObject peer, Show tr) => ToObject (Mux.WithBearer peer tr) where toObject verb (Mux.WithBearer b ev) = - mconcat [ "kind" .= String "Mux.Trace" + mconcat [ "kind" .= (show . typeOf $ ev) , "bearer" .= toObject verb b , "event" .= show ev ] @@ -2307,4 +2296,4 @@ instance ToObject DNSTrace where mconcat [ "kind" .= String "SRVLookupError" , "peerKind" .= String (pack . show $ peerKind) , "domain" .= String (pack . show $ domain) - ] \ No newline at end of file + ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 92bdb8c710c..8300aa9db8c 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -376,8 +376,12 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect = do diffusionTracers :: Cardano.Diffusion.CardanoTracers IO diffusionTracers = Cardano.Diffusion.Tracers { Diffusion.dtMuxTracer = muxTracer + , Diffusion.dtChannelTracer = channelTracer + , Diffusion.dtBearerTracer = bearerTracer , Diffusion.dtHandshakeTracer = handshakeTracer , Diffusion.dtLocalMuxTracer = localMuxTracer + , Diffusion.dtLocalChannelTracer = localChannelTracer + , Diffusion.dtLocalBearerTracer = localBearerTracer , Diffusion.dtLocalHandshakeTracer = localHandshakeTracer , Diffusion.dtDiffusionTracer = initializationTracer , Diffusion.dtTraceLocalRootPeersTracer = @@ -449,8 +453,16 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect = do verb = traceVerbosity trSel muxTracer = tracerOnOff (traceMux trSel) verb "Mux" tr + channelTracer = + tracerOnOff (traceMux trSel) verb "MuxChannel" tr + bearerTracer = + tracerOnOff (traceMux trSel) verb "MuxBearerTracer" tr localMuxTracer = tracerOnOff (traceLocalMux trSel) verb "MuxLocal" tr + localChannelTracer = + tracerOnOff (traceMux trSel) verb "LocalMuxChannel" tr + localBearerTracer = + tracerOnOff (traceMux trSel) verb "LocalMuxBearerTracer" tr localHandshakeTracer = tracerOnOff (traceLocalHandshake trSel) verb "LocalHandshake" tr handshakeTracer = From 34612ccc508cec73aade71f3de27cd076643b6e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 2 Oct 2025 19:53:33 +0200 Subject: [PATCH 49/54] Configure deadline peer selection targets --- .../src/Cardano/Node/Configuration/POM.hs | 62 ++++++++++--------- 1 file changed, 33 insertions(+), 29 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index e397d356145..b37e58c43ad 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -661,13 +661,14 @@ defaultPartialNodeConfiguration = -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultAcceptedConnectionsLimit , pncChainSyncIdleTimeout = mempty - , pncDeadlineTargetOfRootPeers = Last (Just $ targetNumberOfRootPeers (Ouroboros.defaultDeadlineTargets _)) - , pncDeadlineTargetOfKnownPeers = Last (Just $ targetNumberOfKnownPeers Ouroboros.defaultDeadlineTargets) - , pncDeadlineTargetOfEstablishedPeers = Last (Just $ targetNumberOfEstablishedPeers Ouroboros.defaultDeadlineTargets) - , pncDeadlineTargetOfActivePeers = Last (Just $ targetNumberOfActivePeers Ouroboros.defaultDeadlineTargets) - , pncDeadlineTargetOfKnownBigLedgerPeers = Last (Just $ targetNumberOfKnownBigLedgerPeers Ouroboros.defaultDeadlineTargets) - , pncDeadlineTargetOfEstablishedBigLedgerPeers = Last (Just $ targetNumberOfEstablishedBigLedgerPeers Ouroboros.defaultDeadlineTargets) - , pncDeadlineTargetOfActiveBigLedgerPeers = Last (Just $ targetNumberOfActiveBigLedgerPeers Ouroboros.defaultDeadlineTargets) + -- these targets are set properly in makeNodeConfiguration below + , pncDeadlineTargetOfRootPeers = mempty + , pncDeadlineTargetOfKnownPeers = mempty + , pncDeadlineTargetOfEstablishedPeers = mempty + , pncDeadlineTargetOfActivePeers = mempty + , pncDeadlineTargetOfKnownBigLedgerPeers = mempty + , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty + , pncDeadlineTargetOfActiveBigLedgerPeers = mempty -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultDeadlineTargets , pncSyncTargetOfRootPeers = Last (Just $ targetNumberOfRootPeers Cardano.defaultSyncTargets) @@ -675,7 +676,7 @@ defaultPartialNodeConfiguration = , pncSyncTargetOfEstablishedPeers = Last (Just $ targetNumberOfEstablishedPeers Cardano.defaultSyncTargets) , pncSyncTargetOfActivePeers = Last (Just $ targetNumberOfActivePeers Cardano.defaultSyncTargets) , pncSyncTargetOfKnownBigLedgerPeers = Last (Just $ targetNumberOfKnownBigLedgerPeers Cardano.defaultSyncTargets) - , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just $ targetNumberOfEstablishedBigLedgerPeers Cardano.defaultSyncTargets) + , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just $ targetNumberOfEstablishedBigLedgerPeers Cardano.defaultSyncTargets) , pncSyncTargetOfActiveBigLedgerPeers = Last (Just $ targetNumberOfActiveBigLedgerPeers Cardano.defaultSyncTargets) -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/cardano-diffusion/Cardano-Network-Diffusion-Configuration.html#v:defaultSyncTargets @@ -709,27 +710,30 @@ makeNodeConfiguration pnc = do shutdownConfig <- lastToEither "Missing ShutdownConfig" $ pncShutdownConfig pnc socketConfig <- lastToEither "Missing SocketConfig" $ pncSocketConfig pnc - ncDeadlineTargetOfRootPeers <- - lastToEither "Missing TargetNumberOfRootPeers" - $ pncDeadlineTargetOfRootPeers pnc - ncDeadlineTargetOfKnownPeers <- - lastToEither "Missing TargetNumberOfKnownPeers" - $ pncDeadlineTargetOfKnownPeers pnc - ncDeadlineTargetOfEstablishedPeers <- - lastToEither "Missing TargetNumberOfEstablishedPeers" - $ pncDeadlineTargetOfEstablishedPeers pnc - ncDeadlineTargetOfActivePeers <- - lastToEither "Missing TargetNumberOfActivePeers" - $ pncDeadlineTargetOfActivePeers pnc - ncDeadlineTargetOfKnownBigLedgerPeers <- - lastToEither "Missing TargetNumberOfKnownBigLedgerPeers" - $ pncDeadlineTargetOfKnownBigLedgerPeers pnc - ncDeadlineTargetOfEstablishedBigLedgerPeers <- - lastToEither "Missing TargetNumberOfEstablishedBigLedgerPeers" - $ pncDeadlineTargetOfEstablishedBigLedgerPeers pnc - ncDeadlineTargetOfActiveBigLedgerPeers <- - lastToEither "Missing TargetNumberOfActiveBigLedgerPeers" - $ pncDeadlineTargetOfActiveBigLedgerPeers pnc + let PeerSelectionTargets { + targetNumberOfRootPeers, targetNumberOfKnownPeers, + targetNumberOfEstablishedPeers, targetNumberOfActivePeers, + targetNumberOfKnownBigLedgerPeers, targetNumberOfEstablishedBigLedgerPeers, + targetNumberOfActiveBigLedgerPeers + } = Ouroboros.defaultDeadlineTargets $ if hasProtocolFile protocolFiles + then BlockProducer else Relay + (<>!) defaults override = fromJust . getLast $ pure defaults <> override + + ncDeadlineTargetOfRootPeers = + targetNumberOfRootPeers <>! pncDeadlineTargetOfRootPeers pnc + ncDeadlineTargetOfKnownPeers = + targetNumberOfKnownPeers <>! pncDeadlineTargetOfKnownPeers pnc + ncDeadlineTargetOfEstablishedPeers = + targetNumberOfEstablishedPeers <>! pncDeadlineTargetOfEstablishedPeers pnc + ncDeadlineTargetOfActivePeers = + targetNumberOfActivePeers <>! pncDeadlineTargetOfActivePeers pnc + ncDeadlineTargetOfKnownBigLedgerPeers = + targetNumberOfKnownBigLedgerPeers <>! pncDeadlineTargetOfKnownBigLedgerPeers pnc + ncDeadlineTargetOfEstablishedBigLedgerPeers = + targetNumberOfEstablishedBigLedgerPeers <>! pncDeadlineTargetOfEstablishedBigLedgerPeers pnc + ncDeadlineTargetOfActiveBigLedgerPeers = + targetNumberOfActiveBigLedgerPeers <>! pncDeadlineTargetOfActiveBigLedgerPeers pnc + ncSyncTargetOfRootPeers <- lastToEither "Missing SyncTargetNumberOfRootPeers" $ pncSyncTargetOfRootPeers pnc From c6f48e83d3a247dff6368918a6057fc3e290971a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 2 Oct 2025 15:49:44 +0200 Subject: [PATCH 50/54] TODO fix --- cardano-node/src/Cardano/Node/Run.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 8440a793b5b..131e2ae509e 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -241,6 +241,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do (getLast (pncConfigFile cmdPc)) case ncTraceConfig nc of TraceDispatcher{} -> do + -- TODO fix blockForging <- snd (Api.protocolInfo runP) tracers <- initTraceDispatcher @@ -248,6 +249,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do p networkMagic nodeKernelData + -- TODO fix (null blockForging) startupInfo <- getStartupInfo nc p fp @@ -255,6 +257,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do traceNodeStartupInfo (nodeStartupInfoTracer tracers) startupInfo -- sends initial BlockForgingUpdate let isNonProducing = ncStartAsNonProducingNode nc + -- TODO fix traceWith (startupTracer tracers) (BlockForgingUpdate (if isNonProducing || null blockForging then DisabledBlockForging @@ -298,6 +301,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do traceWith (nodeVersionTracer tracers) getNodeVersion let isNonProducing = ncStartAsNonProducingNode nc + -- TODO fix blockForging <- snd (Api.protocolInfo runP) traceWith (startupTracer tracers) (BlockForgingUpdate (if isNonProducing || null blockForging @@ -468,6 +472,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do , rnProtocolInfo = pInfo , rnNodeKernelHook = \registry nodeKernel -> do -- set the initial block forging + -- TODO fix blockForging <- snd (Api.protocolInfo runP) unless (ncStartAsNonProducingNode nc) $ @@ -688,6 +693,7 @@ updateBlockForging startupTracer blockType nodeKernel nc = do case Api.reflBlockType blockType blockType' of Just Refl -> do -- TODO: check if runP' has changed + -- TODO fix blockForging <- snd (Api.protocolInfo runP') traceWith startupTracer (BlockForgingUpdate (if null blockForging From e87b98409c80518e39948b474a28d3df11bbca2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Sat, 4 Oct 2025 19:59:49 +0200 Subject: [PATCH 51/54] WIP cardano-tracer: integrate o-n 0.22 see commit msg Use ForwardingV_1 or V_2??? --- .../src/Cardano/Tracer/Acceptors/Server.hs | 86 ++++++++++++------- .../test/Cardano/Tracer/Test/Forwarder.hs | 21 +++-- 2 files changed, 65 insertions(+), 42 deletions(-) diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index 2e58c655c9a..e30de1fd18b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -15,17 +15,19 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler) import Cardano.Tracer.MetaTrace import Cardano.Tracer.Utils (connIdToNodeId) -import Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..)) +import Ouroboros.Network.Context (ResponderContext (..)) import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) import Ouroboros.Network.IOManager (withIOManager) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), MiniProtocolNum (..), OuroborosApplication (..), - RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) + OuroborosApplicationWithMinimalCtx, 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) + localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer, + socketSnocket) import Ouroboros.Network.Socket (ConnectionId (..), SomeResponderApplication (..)) import qualified Ouroboros.Network.Server.Simple as Server @@ -33,6 +35,8 @@ import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) 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) @@ -60,19 +64,36 @@ runAcceptorsServer -> IO () runAcceptorsServer tracerEnv tracerEnvRTView howToConnect ( ekgConfig, tfConfig, dpfConfig) = withIOManager \iocp -> do - 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) - ] + traceWith (teTracer tracerEnv) $ TracerSockListen (Net.howToConnectString howToConnect) + case howToConnect of + Net.LocalPipe p -> + doListenToForwarderLocal + (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) + ] + + 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) + Handshake.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) + ] where appResponder protocolsWithNums = OuroborosApplication @@ -97,12 +118,9 @@ doListenToForwarderLocal -> LocalAddress -> Word32 -> ProtocolTimeLimits (Handshake ForwardingVersion Term) - -> OuroborosApplication 'Mux.ResponderMode - (MinimalInitiatorContext LocalAddress) - (ResponderContext LocalAddress) - LBS.ByteString IO Void () + -> OuroborosApplicationWithMinimalCtx Mux.ResponderMode LocalAddress LBS.ByteString IO Void () -> IO () -doListenToForwarder snocket address netMagic timeLimits app = +doListenToForwarderLocal snocket address netMagic timeLimits app = do void $ Server.with snocket makeLocalBearer @@ -110,6 +128,7 @@ doListenToForwarder snocket address netMagic timeLimits app = address HandshakeArguments { haHandshakeTracer = nullTracer, + haBearerTracer = nullTracer, haHandshakeCodec = Handshake.codecHandshake forwardingVersionCodec, haVersionDataCodec = Handshake.cborTermVersionDataCodec forwardingCodecCBORTerm, haAcceptVersion = Handshake.acceptableVersion, @@ -123,6 +142,7 @@ doListenToForwarder snocket address netMagic timeLimits app = ) $ \_ serverAsync -> wait serverAsync -- Block until async exception. + doListenToForwarderSocket :: Snocket IO Socket.Socket Socket.SockAddr -> Socket.SockAddr @@ -131,28 +151,28 @@ doListenToForwarderSocket -> OuroborosApplicationWithMinimalCtx Mux.ResponderMode Socket.SockAddr LBS.ByteString IO Void () -> IO () doListenToForwarderSocket snocket address netMagic timeLimits app = do - networkState <- newNetworkMutableState - race_ (cleanNetworkMutableState networkState) do - withServerNode + void $ Server.with snocket makeSocketBearer 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, + haBearerTracer = 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. + runEKGAcceptor :: Show addr => TracerEnv diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index 329fe0e02dd..244a01cbf19 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -27,16 +27,15 @@ 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) import Ouroboros.Network.Protocol.Handshake (Handshake, HandshakeArguments (..)) import qualified Ouroboros.Network.Protocol.Handshake as Handshake -import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, - makeLocalBearer) -import Ouroboros.Network.Socket (ConnectToArgs (..), - HandshakeCallbacks (..), SomeResponderApplication (..), - connectToNode, nullNetworkConnectTracers) +import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, + codecHandshake, noTimeLimitsHandshake) import qualified Ouroboros.Network.Server.Simple as Server +import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, + makeLocalBearer, makeSocketBearer, socketSnocket) +import Ouroboros.Network.Socket (ConnectToArgs (..), HandshakeCallbacks (..), + SomeResponderApplication (..), connectToNode, nullNetworkConnectTracers) import Codec.CBOR.Term (Term) import Control.Concurrent (threadDelay) @@ -48,6 +47,8 @@ import "contra-tracer" Control.Tracer (contramap, nullTracer, stdoutTr import Data.Aeson (FromJSON, ToJSON) import qualified Data.ByteString.Lazy as LBS import Data.Functor (void) +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.Text as Text import Data.Time.Clock (getCurrentTime) import Data.Void (Void, absurd) import Data.Word (Word16) @@ -69,6 +70,7 @@ import Trace.Forward.Utils.TraceObject import Trace.Forward.Utils.Version (ForwardingVersion (..), ForwardingVersionData (..), forwardingCodecCBORTerm, forwardingVersionCodec) + data ForwardersMode = Initiator | Responder data TestDataPoint = TestDataPoint @@ -118,7 +120,7 @@ launchForwardersSimple' ts iomgr mode howToConnect connSize disconnSize = (socketSnocket iomgr) makeSocketBearer (Socket.addrAddress listenAddress) - timeLimitsHandshake + Handshake.timeLimitsHandshake (ekgConfig, tfConfig, dpfConfig) do \(exception :: SomeException) -> do logTrace $ "launchForwardersSimple': doConnectToAcceptor failure: " ++ show exception @@ -137,7 +139,7 @@ launchForwardersSimple' ts iomgr mode howToConnect connSize disconnSize = (socketSnocket iomgr) makeSocketBearer (Socket.addrAddress listenAddress) - timeLimitsHandshake + Handshake.timeLimitsHandshake (ekgConfig, tfConfig, dpfConfig) do \(exception :: SomeException) -> do logTrace $ "launchForwardersSimple': doListenToAcceptor failure: " ++ show exception @@ -274,6 +276,7 @@ doListenToAcceptor TestSetup{..} address HandshakeArguments { haHandshakeTracer = nullTracer, + haBearerTracer = nullTracer, haHandshakeCodec = codecHandshake forwardingVersionCodec, haVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, haAcceptVersion = Handshake.acceptableVersion, From 59b41d38f661d297197d61331d4f188fd73377f5 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:29 +0200 Subject: [PATCH 52/54] Bump consensus version --- cabal.project | 20 +-- cardano-node/cardano-node.cabal | 7 +- cardano-node/src/Cardano/Node/Run.hs | 27 ++-- .../src/Cardano/Node/Tracing/Tracers.hs | 7 + .../Cardano/Node/Tracing/Tracers/Consensus.hs | 141 ++++++++++++++++-- .../Tracing/OrphanInstances/Consensus.hs | 51 ++++++- flake.lock | 6 +- 7 files changed, 209 insertions(+), 50 deletions(-) diff --git a/cabal.project b/cabal.project index c7bfa8d95d3..0b25d053e75 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2025-09-24T20:00:55Z - , cardano-haskell-packages 2025-09-24T15:29:30Z + , cardano-haskell-packages 2025-09-30T09:59:24Z packages: cardano-node @@ -91,21 +91,7 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: 7388805c2a56e2f628ca46924c648268cc61bbd2 - --sha256: sha256-YdFyulwmlwLDjVd6Bk+8IxQAdBSRCpacL5HzW3aCb7c= + tag: cee9b20505a407b55f3b7b335e857d61d71ae196 + --sha256: sha256-ijMOji6MNupx6eewRJcWpuoxitp4rw8nnccr/Ay+tTo= subdir: cardano-api - -source-repository-package - type: git - location: https://github.com/IntersectMBO/ouroboros-consensus - -- latest master - tag: ac1a8db76f4c7a38a9a6b962a40fa722d5bd55a6 - --sha256: sha256-8MlAxCi1wXLc2p0csYTKZ4RW7+uqWvxOBs5IhISzwxk= - subdir: - ouroboros-consensus - ouroboros-consensus-cardano - ouroboros-consensus-diffusion - ouroboros-consensus-protocol - sop-extras - strict-sop-core diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 3a82bf3d035..54687e64b95 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -175,6 +175,7 @@ library , hostname , io-classes:{io-classes,strict-stm,si-timers} >= 1.5 , iohk-monitoring ^>= 0.2 + , kes-agent ^>=0.2 , microlens , mmap , network-mux @@ -188,9 +189,9 @@ library , network-mux >= 0.8 , nothunks , optparse-applicative-fork >= 0.18.1 - , ouroboros-consensus ^>= 0.27 - , ouroboros-consensus-cardano ^>= 0.25 - , ouroboros-consensus-diffusion ^>= 0.23 + , ouroboros-consensus ^>= 0.28 + , ouroboros-consensus-cardano ^>= 0.26 + , ouroboros-consensus-diffusion ^>= 0.24 , ouroboros-consensus-protocol , ouroboros-network-api ^>= 0.16 , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22.3 diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 131e2ae509e..673febb234b 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -70,6 +70,7 @@ import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) import Ouroboros.Consensus.Node (SnapshotPolicyArgs (..), NodeDatabasePaths (..), RunNodeArgs (..), StdRunNodeArgs (..)) +import Ouroboros.Consensus.Protocol.Praos.AgentClient (KESAgentClientTrace) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Ouroboros.Consensus.Node (RunNodeArgs (..), SnapshotPolicyArgs (..), StdRunNodeArgs (..)) @@ -241,15 +242,13 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do (getLast (pncConfigFile cmdPc)) case ncTraceConfig nc of TraceDispatcher{} -> do - -- TODO fix - blockForging <- snd (Api.protocolInfo runP) + blockForging <- snd (Api.protocolInfo runP) nullTracer tracers <- initTraceDispatcher nc p networkMagic nodeKernelData - -- TODO fix (null blockForging) startupInfo <- getStartupInfo nc p fp @@ -257,7 +256,6 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do traceNodeStartupInfo (nodeStartupInfoTracer tracers) startupInfo -- sends initial BlockForgingUpdate let isNonProducing = ncStartAsNonProducingNode nc - -- TODO fix traceWith (startupTracer tracers) (BlockForgingUpdate (if isNonProducing || null blockForging then DisabledBlockForging @@ -301,8 +299,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do traceWith (nodeVersionTracer tracers) getNodeVersion let isNonProducing = ncStartAsNonProducingNode nc - -- TODO fix - blockForging <- snd (Api.protocolInfo runP) + blockForging <- snd (Api.protocolInfo runP) nullTracer traceWith (startupTracer tracers) (BlockForgingUpdate (if isNonProducing || null blockForging then DisabledBlockForging @@ -472,8 +469,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do , rnProtocolInfo = pInfo , rnNodeKernelHook = \registry nodeKernel -> do -- set the initial block forging - -- TODO fix - blockForging <- snd (Api.protocolInfo runP) + blockForging <- snd (Api.protocolInfo runP) (Consensus.kesAgentTracer $ consensusTracers tracers) unless (ncStartAsNonProducingNode nc) $ setBlockForging nodeKernel blockForging @@ -546,7 +542,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do nodeArgs { rnNodeKernelHook = \registry nodeKernel -> do -- reinstall `SIGHUP` handler - installSigHUPHandler (startupTracer tracers) blockType nc nodeKernel + installSigHUPHandler (startupTracer tracers) (Consensus.kesAgentTracer $ consensusTracers tracers) blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar rnNodeKernelHook nodeArgs registry nodeKernel @@ -639,6 +635,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do -- | The P2P SIGHUP handler can update block forging & reconfigure network topology. -- installSigHUPHandler :: Tracer IO (StartupTrace blk) + -> Tracer IO KESAgentClientTrace -> Api.BlockType blk -> NodeConfiguration -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk @@ -650,14 +647,14 @@ installSigHUPHandler :: Tracer IO (StartupTrace blk) -> StrictTVar IO (Maybe LedgerPeerSnapshot) -> IO () #ifndef UNIX -installSigHUPHandler _ _ _ _ _ _ _ _ _ _ = return () +installSigHUPHandler _ _ _ _ _ _ _ _ _ _ _ = return () #else -installSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar +installSigHUPHandler startupTracer kesAgentTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar = void $ Signals.installHandler Signals.sigHUP (Signals.Catch $ do - updateBlockForging startupTracer blockType nodeKernel nc + updateBlockForging startupTracer kesAgentTracer blockType nodeKernel nc updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar void $ updateLedgerPeerSnapshot @@ -673,11 +670,12 @@ installSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicR #ifdef UNIX updateBlockForging :: Tracer IO (StartupTrace blk) + -> Tracer IO KESAgentClientTrace -> Api.BlockType blk -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk -> NodeConfiguration -> IO () -updateBlockForging startupTracer blockType nodeKernel nc = do +updateBlockForging startupTracer kesAgentTracer blockType nodeKernel nc = do eitherSomeProtocol <- runExceptT $ mkConsensusProtocol (ncProtocolConfig nc) (Just (ncProtocolFiles nc)) @@ -693,8 +691,7 @@ updateBlockForging startupTracer blockType nodeKernel nc = do case Api.reflBlockType blockType blockType' of Just Refl -> do -- TODO: check if runP' has changed - -- TODO fix - blockForging <- snd (Api.protocolInfo runP') + blockForging <- snd (Api.protocolInfo runP') kesAgentTracer traceWith startupTracer (BlockForgingUpdate (if null blockForging then DisabledBlockForging diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 14040878c5c..12736ccda66 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -333,6 +333,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "CSJ"] configureTracers configReflection trConfig [consensusCsjTr] + !consensusKesAgentTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "KESAgent"] + configureTracers configReflection trConfig [consensusKesAgentTr] + !consensusDbfTr <- mkCardanoTracer trBase trForward mbTrEKG ["Consensus", "DevotedBlockFetch"] @@ -384,6 +389,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusCsjTr , Consensus.dbfTracer = Tracer $ traceWith consensusDbfTr + , Consensus.kesAgentTracer = Tracer $ + traceWith consensusKesAgentTr } mkNodeToClientTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 2a93e7f575b..0eb35e400e6 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -68,8 +68,8 @@ import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import qualified Cardano.KESAgent.Processes.ServiceClient as Agent -import Control.Exception import Control.Monad (guard) import Data.Aeson (ToJSON, Value (..), toJSON, (.=)) import qualified Data.Aeson as Aeson @@ -2305,12 +2305,135 @@ instance ( StandardHash blk KES-agent -------------------------------------------------------------------------------} +-------------------------------------------------------------------------------- +-- KES Agent tracer +-------------------------------------------------------------------------------- + +instance LogFormatting Agent.ServiceClientTrace where + forMachine _dtal = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeTrace" ] + Agent.ServiceClientVersionHandshakeFailed -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeFailed" ] + Agent.ServiceClientDriverTrace _sdt -> + mconcat [ "kind" .= String "ServiceClientDriverTrace" ] + Agent.ServiceClientSocketClosed -> + mconcat [ "kind" .= String "ServiceClientSocketClosed" ] + Agent.ServiceClientConnected _s -> + mconcat [ "kind" .= String "ServiceClientConnected" ] + Agent.ServiceClientAttemptReconnect{} -> + mconcat [ "kind" .= String "ServiceClientAttemptReconnect" ] + Agent.ServiceClientReceivedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientReceivedKey" ] + Agent.ServiceClientDeclinedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientDeclinedKey" ] + Agent.ServiceClientDroppedKey -> + mconcat [ "kind" .= String "ServiceClientDroppedKey" ] + Agent.ServiceClientOpCertNumberCheck _ _ -> + mconcat [ "kind" .= String "ServiceClientOpCertNumberCheck" ] + Agent.ServiceClientAbnormalTermination _s -> + mconcat [ "kind" .= String "ServiceClientAbnormalTermination" ] + Agent.ServiceClientStopped -> + mconcat [ "kind" .= String "ServiceClientStopped" ] + + forHuman = showT + +instance MetaTrace Agent.ServiceClientTrace where + namespaceFor = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + Namespace [] ["ServiceClientVersionHandshakeTrace"] + Agent.ServiceClientVersionHandshakeFailed -> + Namespace [] ["ServiceClientVersionHandshakeFailed"] + Agent.ServiceClientDriverTrace _sdt -> + Namespace [] ["ServiceClientDriverTrace"] + Agent.ServiceClientSocketClosed -> + Namespace [] ["ServiceClientSocketClosed"] + Agent.ServiceClientConnected _s -> + Namespace [] ["ServiceClientConnected"] + Agent.ServiceClientAttemptReconnect{} -> + Namespace [] ["ServiceClientAttemptReconnect"] + Agent.ServiceClientReceivedKey _tbt -> + Namespace [] ["ServiceClientReceivedKey"] + Agent.ServiceClientDeclinedKey _tbt -> + Namespace [] ["ServiceClientDeclinedKey"] + Agent.ServiceClientDroppedKey -> + Namespace [] ["ServiceClientDroppedKey"] + Agent.ServiceClientOpCertNumberCheck _ _ -> + Namespace [] ["ServiceClientOpCertNumberCheck"] + Agent.ServiceClientAbnormalTermination _s -> + Namespace [] ["ServiceClientAbnormalTermination"] + Agent.ServiceClientStopped -> + Namespace [] ["ServiceClientStopped"] + + severityFor ns _ = case ns of + Namespace [] ["ServiceClientVersionHandshakeTrace"] -> + Just Debug + Namespace [] ["ServiceClientVersionHandshakeFailed"] -> + Just Error + Namespace [] ["ServiceClientDriverTrace"] -> + Just Debug + Namespace [] ["ServiceClientSocketClosed"] -> + Just Info + Namespace [] ["ServiceClientConnected"] -> + Just Info + Namespace [] ["ServiceClientAttemptReconnect"] -> + Just Info + Namespace [] ["ServiceClientReceivedKey"] -> + Just Info + Namespace [] ["ServiceClientDeclinedKey"] -> + Just Info + Namespace [] ["ServiceClientDroppedKey"] -> + Just Info + Namespace [] ["ServiceClientOpCertNumberCheck"] -> + Just Debug + Namespace [] ["ServiceClientAbnormalTermination"] -> + Just Error + Namespace [] ["ServiceClientStopped"] -> + Just Info + Namespace _ _ -> Nothing + + documentFor _ = Nothing + allNamespaces = + [ Namespace [] ["ServiceClientVersionHandshakeTrace"] + , Namespace [] ["ServiceClientVersionHandshakeFailed"] + , Namespace [] ["ServiceClientDriverTrace"] + , Namespace [] ["ServiceClientSocketClosed"] + , Namespace [] ["ServiceClientConnected"] + , Namespace [] ["ServiceClientAttemptReconnect"] + , Namespace [] ["ServiceClientReceivedKey"] + , Namespace [] ["ServiceClientDeclinedKey"] + , Namespace [] ["ServiceClientDroppedKey"] + , Namespace [] ["ServiceClientOpCertNumberCheck"] + , Namespace [] ["ServiceClientAbnormalTermination"] + , Namespace [] ["ServiceClientStopped"] + ] + instance LogFormatting KESAgentClientTrace where - forMachine _verb (KESAgentClientException exc) = - mconcat [ "kind" .= String "KESAgentClientException" - , "exception" .= String (Text.pack $ displayException exc) - ] - forMachine _verb (KESAgentClientTrace trc) = - mconcat [ "kind" .= String "KESAgentClientTrace" - , "trace" .= String (Text.pack $ show trc) - ] + forMachine dtal = \case + KESAgentClientException ex -> mconcat + [ "kind" .= String "KESAgentClientException" + , "exception" .= String (Text.pack $ show ex) + ] + KESAgentClientTrace t -> mconcat + [ "kind" .= String "KESAgentClientTrace" + , "trace" .= forMachine dtal t + ] + + forHuman = showT + + +instance MetaTrace KESAgentClientTrace where + namespaceFor = \case + KESAgentClientException _ -> + Namespace [] ["KESAgentClientException"] + KESAgentClientTrace t -> nsCast $ namespaceFor t + + severityFor (Namespace [] ["KESAgentClientException"]) _ = Just Error + severityFor (Namespace [] ["KESAgentClientTrace"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor _ = Nothing + + allNamespaces = + Namespace [] ["KESAgentClientException"] : + fmap nsCast (allNamespaces :: [Namespace Agent.ServiceClientTrace]) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 5fa67d023b2..e22cf83c3b7 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -95,6 +95,7 @@ import Data.Word (Word32) import GHC.Generics (Generic) import Network.TypedProtocol.Core import Numeric (showFFloat) +import qualified Cardano.KESAgent.Processes.ServiceClient as Agent {- HLINT ignore "Use const" -} @@ -1876,9 +1877,9 @@ instance ToObject KESAgentClientTrace where mconcat [ "kind" .= String "KESAgentClientException" , "exception" .= String (pack $ displayException exc) ] - toObject _verb (KESAgentClientTrace trc) = + toObject verb (KESAgentClientTrace trc) = mconcat [ "kind" .= String "KESAgentClientTrace" - , "trace" .= String (pack $ show trc) + , "trace" .= toObject verb trc ] instance HasPrivacyAnnotation KESAgentClientTrace where @@ -1886,7 +1887,51 @@ instance HasPrivacyAnnotation KESAgentClientTrace where instance HasSeverityAnnotation KESAgentClientTrace where getSeverityAnnotation = \case KESAgentClientException{} -> Error - KESAgentClientTrace{} -> Notice + KESAgentClientTrace{} -> Info instance Transformable Text IO KESAgentClientTrace where trTransformer = trStructured + +instance ToObject Agent.ServiceClientTrace where + toObject _dtal = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeTrace" ] + Agent.ServiceClientVersionHandshakeFailed -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeFailed" ] + Agent.ServiceClientDriverTrace _sdt -> + mconcat [ "kind" .= String "ServiceClientDriverTrace" ] + Agent.ServiceClientSocketClosed -> + mconcat [ "kind" .= String "ServiceClientSocketClosed" ] + Agent.ServiceClientConnected _s -> + mconcat [ "kind" .= String "ServiceClientConnected" ] + Agent.ServiceClientAttemptReconnect _ _ _ _ -> + mconcat [ "kind" .= String "ServiceClientAttemptReconnect" ] + Agent.ServiceClientReceivedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientReceivedKey" ] + Agent.ServiceClientDeclinedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientDeclinedKey" ] + Agent.ServiceClientDroppedKey -> + mconcat [ "kind" .= String "ServiceClientDroppedKey" ] + Agent.ServiceClientOpCertNumberCheck _ _ -> + mconcat [ "kind" .= String "ServiceClientOpCertNumberCheck" ] + Agent.ServiceClientAbnormalTermination _s -> + mconcat [ "kind" .= String "ServiceClientAbnormalTermination" ] + Agent.ServiceClientStopped -> + mconcat [ "kind" .= String "ServiceClientStopped" ] + +instance HasPrivacyAnnotation Agent.ServiceClientTrace where + +instance HasSeverityAnnotation Agent.ServiceClientTrace where + getSeverityAnnotation = \case + Agent.ServiceClientVersionHandshakeTrace{} -> Debug + Agent.ServiceClientVersionHandshakeFailed{} -> Error + Agent.ServiceClientDriverTrace{} -> Debug + Agent.ServiceClientSocketClosed{} -> Info + Agent.ServiceClientConnected{} -> Info + Agent.ServiceClientAttemptReconnect{} -> Info + Agent.ServiceClientReceivedKey{} -> Info + Agent.ServiceClientDeclinedKey{} -> Info + Agent.ServiceClientDroppedKey{} -> Info + Agent.ServiceClientOpCertNumberCheck{} -> Debug + Agent.ServiceClientAbnormalTermination{} -> Error + Agent.ServiceClientStopped{} -> Info diff --git a/flake.lock b/flake.lock index ca3f3309682..f7a7699fea4 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758727647, - "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", + "lastModified": 1759339316, + "narHash": "sha256-SW/K9yfhNLNCDAl2ZC8ol0w8X+AwyLin0XOvnn50468=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", + "rev": "aa50d6dffede91c8fdfcef94c71641a00214522a", "type": "github" }, "original": { From eeb0a0d8c99600e5add006d291467156b197b943 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:45 +0200 Subject: [PATCH 53/54] Make Dijkstra genesis parsing dependent on ExperimentalHardForksEnabled --- .../src/Cardano/Node/Configuration/POM.hs | 12 +++++++----- .../src/Cardano/Node/Protocol/Cardano.hs | 19 ++++++++++--------- .../src/Cardano/Node/Protocol/Dijkstra.hs | 1 + cardano-node/src/Cardano/Node/Types.hs | 4 ++-- 4 files changed, 20 insertions(+), 16 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index b37e58c43ad..9b68bf0514d 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -325,15 +325,16 @@ instance FromJSON PartialNodeConfiguration where protocol <- v .:? "Protocol" .!= CardanoProtocol pncProtocolConfig <- case protocol of - CardanoProtocol -> + CardanoProtocol -> do + hfp <- parseHardForkProtocol v fmap (Last . Just) $ NodeProtocolConfigurationCardano <$> parseByronProtocol v <*> parseShelleyProtocol v <*> parseAlonzoProtocol v <*> parseConwayProtocol v - <*> parseDijkstraProtocol v - <*> parseHardForkProtocol v + <*> (if npcExperimentalHardForksEnabled hfp then Just <$> parseDijkstraProtocol v else pure Nothing) + <*> pure hfp <*> parseCheckpoints v pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v @@ -585,8 +586,9 @@ instance FromJSON PartialNodeConfiguration where npcTestConwayHardForkAtEpoch <- v .:? "TestConwayHardForkAtEpoch" npcTestConwayHardForkAtVersion <- v .:? "TestConwayHardForkAtVersion" - npcTestDijkstraHardForkAtEpoch <- v .:? "TestDijkstraHardForkAtEpoch" - npcTestDijkstraHardForkAtVersion <- v .:? "TestDijkstraHardForkAtVersion" + (npcTestDijkstraHardForkAtEpoch, npcTestDijkstraHardForkAtVersion) <- if npcExperimentalHardForksEnabled + then (,) <$> v .:? "TestConwayHardForkAtEpoch" <*> v .:? "TestConwayHardForkAtVersion" + else pure (Nothing, Nothing) pure NodeHardForkProtocolConfiguration { npcExperimentalHardForksEnabled diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 9483fa2d029..d5bfa546fd9 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -61,7 +61,7 @@ mkSomeConsensusProtocolCardano -> NodeShelleyProtocolConfiguration -> NodeAlonzoProtocolConfiguration -> NodeConwayProtocolConfiguration - -> NodeDijkstraProtocolConfiguration + -> Maybe NodeDijkstraProtocolConfiguration -> NodeHardForkProtocolConfiguration -> NodeCheckpointsConfiguration -> Maybe ProtocolFilepaths @@ -87,10 +87,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcConwayGenesisFile, npcConwayGenesisFileHash } - NodeDijkstraProtocolConfiguration { - npcDijkstraGenesisFile, - npcDijkstraGenesisFileHash - } + ndpc NodeHardForkProtocolConfiguration { -- During testing of the Alonzo era, we conditionally declared that we -- knew about the Alonzo era. We do so only when a config option for @@ -132,10 +129,14 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Conway.readGenesis npcConwayGenesisFile npcConwayGenesisFileHash - (dijkstraGenesis, _dijkstraGenesisHash) <- - firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $ - Dijkstra.readGenesis npcDijkstraGenesisFile - npcDijkstraGenesisFileHash + dijkstraGenesis <- + case ndpc of + Nothing -> pure Dijkstra.emptyDijkstraGenesis + Just (NodeDijkstraProtocolConfiguration npcDijkstraGenesisFile npcDijkstraGenesisFileHash) -> do + (dijkstraGenesis, _dijkstraGenesisHash) <- firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $ + Dijkstra.readGenesis npcDijkstraGenesisFile + npcDijkstraGenesisFileHash + pure dijkstraGenesis shelleyLeaderCredentials <- firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $ diff --git a/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs index 8551806565d..7650371bc8a 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs @@ -6,6 +6,7 @@ module Cardano.Node.Protocol.Dijkstra ( readGenesis , readGenesisMaybe + , emptyDijkstraGenesis ) where import Cardano.Api diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index 01c6b66cd24..b3c9109cb4c 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -208,7 +208,7 @@ data NodeProtocolConfiguration = NodeShelleyProtocolConfiguration NodeAlonzoProtocolConfiguration NodeConwayProtocolConfiguration - NodeDijkstraProtocolConfiguration + (Maybe NodeDijkstraProtocolConfiguration) NodeHardForkProtocolConfiguration NodeCheckpointsConfiguration deriving (Eq, Show) @@ -443,7 +443,7 @@ instance AdjustFilePaths NodeProtocolConfiguration where (adjustFilePaths f pcs) (adjustFilePaths f pca) (adjustFilePaths f pcc) - (adjustFilePaths f pcd) + (adjustFilePaths f <$> pcd) pch (adjustFilePaths f pccp) From b6a1c306223b36f42fc4cbae9796e7bdbaf44f4d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Wed, 8 Oct 2025 16:01:05 +0200 Subject: [PATCH 54/54] Make `PraosTiebreakerView` tracing nicer --- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 23 ++++++++++++----- .../Tracing/OrphanInstances/Shelley.hs | 25 +++++++++++++------ 2 files changed, 35 insertions(+), 13 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index fbce024e3d0..0f76c298ab1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -22,6 +22,7 @@ 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 @@ -69,10 +70,12 @@ 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 :" -} @@ -1508,12 +1511,20 @@ instance ] instance LogFormatting (Praos.PraosTiebreakerView crypto) where - forMachine _dtal (Praos.PraosTiebreakerView sl issuer issueNo vrf) = - mconcat [ "slotNo" .= condense sl - , "issuer" .= textShow issuer - , "issueNo" .= textShow issueNo - , "vrf" .= textShow vrf - ] + forMachine _dtal Praos.PraosTiebreakerView { + ptvSlotNo + , ptvIssuer + , ptvIssueNo + , ptvTieBreakVRF + } = + mconcat [ "kind" .= String "PraosTiebreakerView" + , "slotNo" .= ptvSlotNo + , "issuerHash" .= hashKey ptvIssuer + , "issueNo" .= ptvIssueNo + , "tieBreakVRF" .= renderVRF ptvTieBreakVRF + ] + where + renderVRF = Text.decodeUtf8 . B16.encode . Crypto.getOutputVRFBytes -------------------------------------------------------------------------------- -- Helper functions diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 0aa6cff870b..d8645b49170 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -23,6 +23,7 @@ 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 @@ -74,11 +75,13 @@ 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 :" -} @@ -1557,13 +1560,21 @@ instance , "hashHexPreimage" .= formatAsHex (strictMaybeToMaybe mBytes) ] -instance ToObject (Praos.PraosTiebreakerView crypto) where - toObject v (Praos.PraosTiebreakerView sl issuer issueNo vrf) = - mconcat [ "slotNo" .= toObject v sl - , "issuer" .= textShow issuer - , "issueNo" .= textShow issueNo - , "vrf" .= textShow vrf - ] +instance Core.Crypto c => ToObject (Praos.PraosTiebreakerView c) where + toObject _v Praos.PraosTiebreakerView { + ptvSlotNo + , ptvIssuer + , ptvIssueNo + , ptvTieBreakVRF + } = + mconcat [ "kind" .= String "PraosTiebreakerView" + , "slotNo" .= ptvSlotNo + , "issuerHash" .= hashKey ptvIssuer + , "issueNo" .= ptvIssueNo + , "tieBreakVRF" .= renderVRF ptvTieBreakVRF + ] + where + renderVRF = Text.decodeUtf8 . B16.encode . Crypto.getOutputVRFBytes -------------------------------------------------------------------------------- -- Helper functions