From 180cb552f038728c9f462989c8b4af498f810d86 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 24 Jul 2025 15:26:21 -0400 Subject: [PATCH 01/69] Propagate changes from cardano-cli --- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 5 ++- cardano-testnet/src/Parsers/Cardano.hs | 38 ++++++++++++++++++- .../Cardano/Testnet/Test/Cli/Query.hs | 1 + 3 files changed, 41 insertions(+), 3 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index e07a895c10b..172d466b539 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -20,6 +20,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) @@ -72,8 +73,8 @@ readPlutusScript (Left s) doLoad fp = second (second (const $ ResolvedToFallback asFileName)) <$> readPlutusScript (Right fp) readPlutusScript (Right fp) = runExceptT $ do - script <- firstExceptT (ApiError @ScriptDecodeError) $ - 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-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index f9c5e184fa4..dfff4baa542 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -7,12 +7,19 @@ module Parsers.Cardano import Cardano.Api (AnyShelleyBasedEra(..)) import Cardano.CLI.EraBased.Common.Option (bounded, command') +import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), Eon(..) + , forEraInEonMaybe, convert, ShelleyBasedEra(..), AnyCardanoEra(..)) + +import Cardano.CLI.Environment +import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) + import Prelude import Control.Applicative((<|>), optional) import Data.Default.Class (def) 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 @@ -74,6 +81,35 @@ pCardanoTestnetCliOptions = CardanoTestnetOptions <> OA.metavar "DIRECTORY" ))) +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 d1e10d11df7..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 @@ -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 (()) From 18306605273afec3e782608f7b5ef1a6d5eca523 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 24 Jul 2025 15:31:07 -0400 Subject: [PATCH 02/69] REMOVE ME: Srps --- cabal.project | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 25874410b4e..b825bb84f0a 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2025-06-24T21:06:59Z - , cardano-haskell-packages 2025-09-18T12:21:32Z + , hackage.haskell.org 2025-07-14T17:31:29Z + , cardano-haskell-packages 2025-07-01T09:22:51Z packages: cardano-node @@ -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 fc173334a8051a9ab1839ce64fa53ac7ee772609 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Sat, 9 Aug 2025 11:17:55 -0400 Subject: [PATCH 03/69] 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 13f42124d15..3927f70b749 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.18 - , 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 e4618effea2..9292c3d9640 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 bd81e49751793f9319ee1cdf571698251895f55f Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 14 Aug 2025 17:26:29 +0200 Subject: [PATCH 04/69] 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 3927f70b749..5501cf2645e 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.18 , 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 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 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 22cd7bdeb4a..1f317fe5cad 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 9292c3d9640..33ed4a6e39e 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 5453d438669..b3639664a1b 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 d81890ce526..6b43ce604b9 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 77e57b8df64b941114fd7f40f96b08585d2bc296 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 18 Aug 2025 13:11:15 +0200 Subject: [PATCH 05/69] 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 33ed4a6e39e..95710655fda 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 088771904d5..25c2c8ca715 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 5746d9c0e2d8856fb1e599826fb2eb202aa2d734 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 12 Jun 2025 15:16:47 +0200 Subject: [PATCH 06/69] 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 95710655fda..304b62d854c 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 b3639664a1b..0509f28e7f5 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 11124ddddcc76b2d9b6fecbb45c7c9acf2172f36 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Mon, 16 Jun 2025 16:36:18 +0200 Subject: [PATCH 07/69] 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 fd9b7d345c2a80b0cd8b968a5d2aed5fcc856006 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Mon, 16 Jun 2025 17:19:08 +0200 Subject: [PATCH 08/69] 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 9c94ec935bfdb26ea27f02d0f4da190aafa046eb Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 19 Aug 2025 18:48:08 +0200 Subject: [PATCH 09/69] 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 304b62d854c..58509e409da 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 56ad0b9ac07cf7e7235c4aa2e4ad6eed044b7003 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Aug 2025 17:18:01 +0200 Subject: [PATCH 10/69] Update SRPs and flake.lock --- cabal.project | 17 ++++++++--------- flake.lock | 24 ++++++++++++------------ 2 files changed, 20 insertions(+), 21 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 25c2c8ca715..1a6fbb78aa6 100644 --- a/flake.lock +++ b/flake.lock @@ -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 bb556ca04617d777f1a9763b4315d1df11a10689 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Aug 2025 17:29:34 +0200 Subject: [PATCH 11/69] 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 abc0b6b9036..1454f10ac57 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -352,8 +352,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 f5563807acb57916e978e3de805b9b12b5522f40 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 09:57:39 +0200 Subject: [PATCH 12/69] 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 8f850e66fe704466adf63dc88e74924d8d857c01 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:08:26 +0200 Subject: [PATCH 13/69] 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 a819390366ee3841e4201187744b0ee787006c14 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:32:11 +0200 Subject: [PATCH 14/69] 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 3004e35a70adb872d0c9c26f801ae799d3fb1cb4 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:32:27 +0200 Subject: [PATCH 15/69] 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 2940e3de68bcc1f05384f64e8582a052ef0190e4 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 10:39:26 +0200 Subject: [PATCH 16/69] 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 9f765a911e63ce7b8dea8cf8fc1ae20a1675f1a6 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 11:02:14 +0200 Subject: [PATCH 17/69] 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 f6e01939f53dee7d9e99a08ea11aa49af5142d2b Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 25 Aug 2025 14:18:01 +0200 Subject: [PATCH 18/69] 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 a6c1840d7b3708f22a81c562ae3985eaa44fef2d Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 24 Sep 2025 20:16:30 +0200 Subject: [PATCH 19/69] Bump cardano-api & cardano-cli --- bench/locli/locli.cabal | 2 +- cardano-node-chairman/cardano-node-chairman.cabal | 2 +- cardano-node/cardano-node.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 2 +- cardano-tracer/cardano-tracer.cabal | 2 +- trace-forward/trace-forward.cabal | 2 +- 6 files changed, 6 insertions(+), 6 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/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 1f317fe5cad..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 diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 58509e409da..58f6d333c7c 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -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-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 6b43ce604b9..f6ae63afdff 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -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 73ec06d62bbd739afe1c857f48c8b7e73c300b35 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 12:14:47 +0300 Subject: [PATCH 20/69] Update project and flake --- cabal.project | 66 +++++++++++++-------------------------------------- flake.lock | 6 ++--- 2 files changed, 20 insertions(+), 52 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 1a6fbb78aa6..ca3f3309682 100644 --- a/flake.lock +++ b/flake.lock @@ -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 38de4f0267cd688beb4f8e0b14358bff102468e7 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 20:29:57 +0200 Subject: [PATCH 21/69] Fix compilation errors --- cardano-testnet/src/Parsers/Cardano.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index dfff4baa542..f74e89b7feb 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -12,14 +12,12 @@ import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) - import Prelude import Control.Applicative((<|>), optional) import Data.Default.Class (def) 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 @@ -28,6 +26,8 @@ import Testnet.Defaults (defaultEra) import Testnet.Start.Cardano import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) +import qualified Options.Applicative as Opt +import Cardano.Prelude (Typeable) optsTestnet :: Parser CardanoTestnetCliOptions From 3cede0e6cc768671743e1b4e6c538237aa4b043d Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 23 Sep 2025 19:29:17 +0300 Subject: [PATCH 22/69] 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 ccb7cfa052dd6ac571bc4ada48d893144162570f Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:04:14 +0300 Subject: [PATCH 23/69] 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 84f977b453a55f3d2cd1084d9cbfcaa68a2b4642 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:07:50 +0300 Subject: [PATCH 24/69] 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 5a292fc3cb40b38c32e7adc072dec0e6b73b55aa Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 17 Sep 2025 20:29:57 +0200 Subject: [PATCH 25/69] Fix compilation errors --- cardano-testnet/src/Parsers/Cardano.hs | 30 +------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index f74e89b7feb..9cc98dbc7aa 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -9,6 +9,7 @@ import Cardano.Api (AnyShelleyBasedEra(..)) import Cardano.CLI.EraBased.Common.Option (bounded, command') import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), Eon(..) , forEraInEonMaybe, convert, ShelleyBasedEra(..), AnyCardanoEra(..)) +import Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), ShelleyBasedEra (..), Convert (..), Eon, AnyCardanoEra (..), forEraInEonMaybe) import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) @@ -81,35 +82,6 @@ pCardanoTestnetCliOptions = CardanoTestnetOptions <> OA.metavar "DIRECTORY" ))) -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 []`. From 2ab3d88c03649066147d05d9d9c22820231de40c Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:04:14 +0300 Subject: [PATCH 26/69] WIP: fix dependencies --- cabal.project | 6 ++++++ 1 file changed, 6 insertions(+) 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= From f3add2bdaf8e79862ea0529dc3b0ca2f7f8c60e0 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 24 Sep 2025 15:07:50 +0300 Subject: [PATCH 27/69] 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 ab6ee9dbce793ddc2bb947722e1b8a5cdfd2653d Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 15:46:41 +0300 Subject: [PATCH 28/69] 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 fccee6e987c3feeb004d2b05287c6fd0769cd6e3 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 29/69] 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 baba8cec836bfa8d4e172c5c9b632f9e64c4bd45 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 25 Sep 2025 17:01:21 +0300 Subject: [PATCH 30/69] 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 fadd763137b9b24ff34866a4f15b34149256c5b4 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:08:59 +0200 Subject: [PATCH 31/69] 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 be9c6571ffeb3031cc6d8ba6ef3b6f1b14aa4cf0 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:09:54 +0200 Subject: [PATCH 32/69] 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 e00b4347bb5a00e44a99b2aec2902fc58164b50b Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:10:24 +0200 Subject: [PATCH 33/69] 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 f589dc7fd130df64eec7715aa32e8b910b9ef6ea Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:10:51 +0200 Subject: [PATCH 34/69] 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 b42e2c8b5b5164c371d9ac26436a1c8cd23993bd Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:11:50 +0200 Subject: [PATCH 35/69] 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 331f8a8cad9f00a9883824936d619375bdd7f3d1 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:12:25 +0200 Subject: [PATCH 36/69] 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 8569bb055fe91db0430861b39a6b69eaffdd0884 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:14:55 +0200 Subject: [PATCH 37/69] 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 4057180caac9033c8a43f2c9745422d17bbe0965 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:16 +0200 Subject: [PATCH 38/69] 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 4e4a220c48f8551962bd3e6bd5529a2d5b60946d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:39 +0200 Subject: [PATCH 39/69] 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 a412257ce7784ceed0a5451fe897eee148d57889 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 26 Sep 2025 15:15:59 +0200 Subject: [PATCH 40/69] 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 19155923773..72f0f502592 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 d9bf2e2f2a2dc7c706c1a777b5060318fc497bca Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 26 Sep 2025 17:01:58 +0300 Subject: [PATCH 41/69] 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 52750afd3fdc9a5dd81f6ced27548259bcdfd2f0 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 42/69] 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 84c5224834b127c8948a7c07de5a465e386a012c 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 43/69] 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 adf9a105619725cce2bb5105315a17f819318d59 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 44/69] 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 121fae60ef6043cdeb084e11c0c61aaebab02b14 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 45/69] 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 63d645ea7c6c4461e6dcf78c1926f8a8450bbc2d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:29 +0200 Subject: [PATCH 46/69] 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 72f0f502592..94b6a4907aa 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 9fdd9af97575bc3726d12365b03428e6846e627e Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:45 +0200 Subject: [PATCH 47/69] 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 9bb36c0461343a468476d15242985aa4ae1050a2 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 3 Oct 2025 14:09:29 +0300 Subject: [PATCH 48/69] Make cardano-node-chairman build --- cardano-node-chairman/cardano-node-chairman.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 5e9458c92bd..49b8af7ce41 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -49,7 +49,7 @@ executable cardano-node-chairman , cardano-prelude , containers , contra-tracer - , io-classes + , io-classes:{io-classes, strict-stm, si-timers} , optparse-applicative-fork , ouroboros-consensus , ouroboros-consensus-cardano From fc25c9863276e54516aaefaa98808e6f621f1979 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 3 Oct 2025 14:12:38 +0300 Subject: [PATCH 49/69] Make cardano-submit-api build --- cardano-submit-api/cardano-submit-api.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 0986cbc43b3..7262aa4afbe 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -49,7 +49,6 @@ library , network , optparse-applicative-fork , ouroboros-consensus-cardano - , ouroboros-network ^>= 0.22.3 , ouroboros-network-protocols , prometheus >= 2.2.4 , safe-exceptions From da824c2b291b25ff4846d6c230a82edd577d1c39 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 3 Oct 2025 15:54:28 +0300 Subject: [PATCH 50/69] Make bench/tx-generator compile; NEEDS CAREFUL REVIEW --- .../Benchmarking/GeneratorTx/NodeToNode.hs | 2 +- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 15 +++++++++------ .../GeneratorTx/SubmissionClient.hs | 2 +- .../Cardano/Benchmarking/OuroborosImports.hs | 3 +-- .../src/Cardano/Benchmarking/Script/Core.hs | 16 +++++++++------- .../Cardano/TxGenerator/ProtocolParameters.hs | 17 +++++++++++------ .../src/Cardano/TxGenerator/Setup/NodeConfig.hs | 6 +++--- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 1 - .../src/Cardano/TxGenerator/Utils.hs | 15 ++++++++------- bench/tx-generator/tx-generator.cabal | 2 +- 10 files changed, 44 insertions(+), 35 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs index b17e44eefdf..d15da29a231 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs @@ -89,7 +89,7 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec done <- NtN.connectTo (socketSnocket envIOManager) NetworkConnectTracers { - nctMuxTracer = mempty, + nctMuxTracers = Mux.nullTracers, nctHandshakeTracer = handshakeTracer } peerMultiplex diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index 1def6769604..e6dcd021d35 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -69,6 +69,8 @@ assumeMapCosts _proxy = stepFunction [ ShelleyBasedEraAlonzo -> 42 ShelleyBasedEraBabbage -> 42 ShelleyBasedEraConway -> 42 + -- TODO: check if this is correct! + ShelleyBasedEraDijkstra -> 42 -- Bytestring costs are not LINEAR !! -- Costs are piecewise linear for payload sizes [0..23] and [24..64]. @@ -141,12 +143,13 @@ mkMetadata size else Right $ metadataInEra $ Just metadata where minSize = case shelleyBasedEra @era of - ShelleyBasedEraShelley -> 37 - ShelleyBasedEraAllegra -> 39 - ShelleyBasedEraMary -> 39 - ShelleyBasedEraAlonzo -> 39 -- TODO: check minSize for Alonzo - ShelleyBasedEraBabbage -> 39 -- TODO: check minSize for Babbage - ShelleyBasedEraConway -> 39 -- TODO: check minSize for Conway + ShelleyBasedEraShelley -> 37 + ShelleyBasedEraAllegra -> 39 + ShelleyBasedEraMary -> 39 + ShelleyBasedEraAlonzo -> 39 -- TODO: check minSize for Alonzo + ShelleyBasedEraBabbage -> 39 -- TODO: check minSize for Babbage + ShelleyBasedEraConway -> 39 -- TODO: check minSize for Conway + ShelleyBasedEraDijkstra -> 39 -- TODO: check minSize for Dijkstra nettoSize = size - minSize -- At 24 the CBOR representation changes. diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 1dd655b6ee9..b7bf32fd6ba 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -181,7 +181,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = where getTxSize :: Tx era -> Integer getTxSize (ShelleyTx sbe tx) = - shelleyBasedEraConstraints sbe $ tx ^. Ledger.sizeTxF + shelleyBasedEraConstraints sbe $ toInteger (tx ^. Ledger.sizeTxF) toGenTx :: Tx era -> GenTx CardanoBlock toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx diff --git a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs index 05205c07292..38bbb53d0cf 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs @@ -12,7 +12,6 @@ module Cardano.Benchmarking.OuroborosImports , ShelleyGenesis , SigningKey , SigningKeyFile - , StandardShelley , NetworkId -- , getGenesis , makeLocalConnectInfo @@ -35,7 +34,7 @@ import qualified Ouroboros.Consensus.Cardano as Consensus import Ouroboros.Consensus.Config (TopLevelConfig, configBlock, configCodec) import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..), getNetworkMagic) import Ouroboros.Consensus.Node (ProtocolInfo (..)) -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto, StandardShelley) +import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..)) import Prelude diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 8a452ff07a9..e364d2529f8 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -70,13 +70,15 @@ liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall) withEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ActionM x) -> ActionM x withEra era action = do case era of - AnyCardanoEra ConwayEra -> action AsConwayEra - AnyCardanoEra BabbageEra -> action AsBabbageEra - AnyCardanoEra AlonzoEra -> action AsAlonzoEra - AnyCardanoEra MaryEra -> action AsMaryEra - AnyCardanoEra AllegraEra -> action AsAllegraEra - AnyCardanoEra ShelleyEra -> action AsShelleyEra - AnyCardanoEra ByronEra -> error "byron not supported" + AnyCardanoEra ConwayEra -> action AsConwayEra + AnyCardanoEra BabbageEra -> action AsBabbageEra + AnyCardanoEra AlonzoEra -> action AsAlonzoEra + AnyCardanoEra MaryEra -> action AsMaryEra + AnyCardanoEra AllegraEra -> action AsAllegraEra + AnyCardanoEra ShelleyEra -> action AsShelleyEra + AnyCardanoEra ByronEra -> error "byron not supported" + -- TODO: is this correct? + AnyCardanoEra DijkstraEra -> error "Dijkstra not supported" setProtocolParameters :: ProtocolParametersSource -> ActionM () setProtocolParameters s = case s of diff --git a/bench/tx-generator/src/Cardano/TxGenerator/ProtocolParameters.hs b/bench/tx-generator/src/Cardano/TxGenerator/ProtocolParameters.hs index b307f4913bc..e6bf406940e 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/ProtocolParameters.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/ProtocolParameters.hs @@ -2,6 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-- Due to the changes to "cardano-api" listed below it was decided to move @@ -32,9 +33,9 @@ where import Cardano.Api (AnyPlutusScriptVersion (..), CostModel, ExecutionUnitPrices (..), ExecutionUnits, LedgerProtocolParameters (..), - PlutusScriptVersion (PlutusScriptV1, PlutusScriptV2, PlutusScriptV3), PraosNonce, + PlutusScriptVersion (PlutusScriptV1, PlutusScriptV2, PlutusScriptV3, PlutusScriptV4), PraosNonce, ProtocolParametersConversionError (..), - ShelleyBasedEra (ShelleyBasedEraAllegra, ShelleyBasedEraAlonzo, ShelleyBasedEraBabbage, ShelleyBasedEraConway, ShelleyBasedEraMary, ShelleyBasedEraShelley), + ShelleyBasedEra (ShelleyBasedEraAllegra, ShelleyBasedEraAlonzo, ShelleyBasedEraBabbage, ShelleyBasedEraConway, ShelleyBasedEraMary, ShelleyBasedEraShelley, ShelleyBasedEraDijkstra), ShelleyLedgerEra, fromAlonzoCostModels, fromAlonzoExUnits, fromAlonzoPrices, makePraosNonce, toAlonzoCostModels, toAlonzoExUnits, toAlonzoPrices, toLedgerNonce) @@ -242,6 +243,7 @@ fromPlutusLanguageName :: Plutus.Language -> AnyPlutusScriptVersion fromPlutusLanguageName Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromPlutusLanguageName Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromPlutusLanguageName Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromPlutusLanguageName Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV4 instance Aeson.ToJSON ProtocolParameters where toJSON ProtocolParameters{..} = @@ -296,6 +298,7 @@ toPlutusLanguageName :: AnyPlutusScriptVersion -> Plutus.Language toPlutusLanguageName (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 toPlutusLanguageName (AnyPlutusScriptVersion PlutusScriptV2) = Plutus.PlutusV2 toPlutusLanguageName (AnyPlutusScriptVersion PlutusScriptV3) = Plutus.PlutusV3 +toPlutusLanguageName (AnyPlutusScriptVersion PlutusScriptV4) = Plutus.PlutusV4 -- Praos nonce. -------------------------------------------------------------------------------- @@ -348,6 +351,7 @@ toLedgerPParams ShelleyBasedEraMary = toShelleyPParams toLedgerPParams ShelleyBasedEraAlonzo = toAlonzoPParams toLedgerPParams ShelleyBasedEraBabbage = toBabbagePParams toLedgerPParams ShelleyBasedEraConway = toConwayPParams +toLedgerPParams ShelleyBasedEraDijkstra = toConwayPParams -- Was removed in "cardano-api" module "Cardano.Api.Internal.ProtocolParameters" toShelleyCommonPParams @@ -396,8 +400,8 @@ toShelleyCommonPParams -- Was removed in "cardano-api" module "Cardano.Api.Internal.ProtocolParameters" toShelleyPParams :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera + , Ledger.AtMostEra "Mary" ledgerera + , Ledger.AtMostEra "Alonzo" ledgerera ) => ProtocolParameters -> Either ProtocolParametersConversionError (PParams ledgerera) @@ -517,6 +521,7 @@ fromLedgerPParams ShelleyBasedEraMary = fromShelleyPParams fromLedgerPParams ShelleyBasedEraAlonzo = fromExactlyAlonzoPParams fromLedgerPParams ShelleyBasedEraBabbage = fromBabbagePParams fromLedgerPParams ShelleyBasedEraConway = fromConwayPParams +fromLedgerPParams ShelleyBasedEraDijkstra = fromConwayPParams -- TODO: Use the ledger's PParams (from module Cardano.Api.Ledger) type instead. fromShelleyCommonPParams @@ -556,8 +561,8 @@ fromShelleyCommonPParams pp = -- TODO: Use the ledger's PParams (from module Cardano.Api.Ledger) type instead. fromShelleyPParams :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera + , Ledger.AtMostEra "Mary" ledgerera + , Ledger.AtMostEra "Alonzo" ledgerera ) => PParams ledgerera -> ProtocolParameters diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs index ee62e2aa914..bb1e80d8751 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs @@ -42,15 +42,15 @@ getGenesis (SomeConsensusProtocol CardanoBlockType proto) getGenesisPath :: NodeConfiguration -> Maybe GenesisFile getGenesisPath nodeConfig = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ _ -> + NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol) mkConsensusProtocol nodeConfig = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig checkpointsConfig -> + NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig dijkstraConfig hardforkConfig checkpointsConfig -> first ProtocolError - <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig checkpointsConfig Nothing) + <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig dijkstraConfig hardforkConfig checkpointsConfig Nothing) -- | Creates a NodeConfiguration from a config file; -- the result is devoid of any keys/credentials diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index 172d466b539..0fc86e43bb2 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -20,7 +20,6 @@ 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) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index 8ff31f546ad..a739808bccd 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -26,13 +26,14 @@ import GHC.Stack -- regardless of which particular era. liftAnyEra :: ( forall era. IsCardanoEra era => f1 era -> f2 era ) -> InAnyCardanoEra f1 -> InAnyCardanoEra f2 liftAnyEra f x = case x of - InAnyCardanoEra ByronEra a -> InAnyCardanoEra ByronEra $ f a - InAnyCardanoEra ShelleyEra a -> InAnyCardanoEra ShelleyEra $ f a - InAnyCardanoEra AllegraEra a -> InAnyCardanoEra AllegraEra $ f a - InAnyCardanoEra MaryEra a -> InAnyCardanoEra MaryEra $ f a - InAnyCardanoEra AlonzoEra a -> InAnyCardanoEra AlonzoEra $ f a - InAnyCardanoEra BabbageEra a -> InAnyCardanoEra BabbageEra $ f a - InAnyCardanoEra ConwayEra a -> InAnyCardanoEra ConwayEra $ f a + InAnyCardanoEra ByronEra a -> InAnyCardanoEra ByronEra $ f a + InAnyCardanoEra ShelleyEra a -> InAnyCardanoEra ShelleyEra $ f a + InAnyCardanoEra AllegraEra a -> InAnyCardanoEra AllegraEra $ f a + InAnyCardanoEra MaryEra a -> InAnyCardanoEra MaryEra $ f a + InAnyCardanoEra AlonzoEra a -> InAnyCardanoEra AlonzoEra $ f a + InAnyCardanoEra BabbageEra a -> InAnyCardanoEra BabbageEra $ f a + InAnyCardanoEra ConwayEra a -> InAnyCardanoEra ConwayEra $ f a + InAnyCardanoEra DijkstraEra a -> InAnyCardanoEra DijkstraEra $ f a -- | `keyAddress` determines an address for the relevant era. keyAddress :: forall era. IsShelleyBasedEra era => NetworkId -> SigningKey PaymentKey -> AddressInEra era diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index d619749983e..a1081dfaae4 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -136,7 +136,7 @@ library , formatting , generic-monoid , ghc-prim - , io-classes + , io-classes:{io-classes, strict-stm} , microlens , mtl , network From 86f88f67995f0d61df6c7d32070da1c64ddde06d Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 3 Oct 2025 14:15:26 +0300 Subject: [PATCH 51/69] cardano-testnet: fix dependencies, DOES NOT COMPILE --- cardano-testnet/cardano-testnet.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 976804a2829..55fc2204e3e 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -72,6 +72,7 @@ library , hedgehog , hedgehog-extras ^>= 0.10 , http-conduit + , io-classes:{si-timers} , lens-aeson , microlens , monad-control From f71cc733fa2b7a35b8528ef22098e8e3e23a3661 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 3 Oct 2025 19:35:31 +0300 Subject: [PATCH 52/69] Temp: wip make cardano-testnet compile --- cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Testnet/Blockfrost.hs | 3 ++- .../src/Testnet/Components/Configuration.hs | 9 +++---- .../src/Testnet/Components/Query.hs | 12 ++++----- cardano-testnet/src/Testnet/Defaults.hs | 25 ++++++++++++++----- cardano-testnet/src/Testnet/Ping.hs | 6 ++--- cardano-testnet/src/Testnet/Types.hs | 2 +- 7 files changed, 35 insertions(+), 23 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 55fc2204e3e..af8ba681ac0 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -89,6 +89,7 @@ library , retry , safe-exceptions , scientific + , stm , tasty ^>= 1.5 , tasty-expected-failure , tasty-hedgehog diff --git a/cardano-testnet/src/Testnet/Blockfrost.hs b/cardano-testnet/src/Testnet/Blockfrost.hs index 642838d102c..99705f851e4 100644 --- a/cardano-testnet/src/Testnet/Blockfrost.hs +++ b/cardano-testnet/src/Testnet/Blockfrost.hs @@ -14,6 +14,7 @@ import Cardano.Ledger.BaseTypes (EpochInterval, Nonce, NonNegativeInte UnitInterval, ProtVer(..), Version) import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Core (PParams(..)) +import Cardano.Ledger.Compactible (toCompactPartial) import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis(..)) import Cardano.Ledger.Shelley.PParams (ShelleyPParams(..)) import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis(..)) @@ -248,7 +249,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost , sppMaxTxSize = bfgMaxTxSize , sppMaxBHSize = bfgMaxBlockHeaderSize , sppKeyDeposit = bfgKeyDeposit - , sppPoolDeposit = bfgPoolDeposit + , sppPoolDeposit = toCompactPartial bfgPoolDeposit , sppEMax = bfgEMax , sppNOpt = bfgNOpt , sppA0 = bfgA0 diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 200e67138b7..a3aae9162e1 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -146,10 +146,9 @@ getDefaultShelleyGenesis asbe maxSupply opts = do getDefaultAlonzoGenesis :: () => HasCallStack => MonadTest m - => ShelleyBasedEra era - -> m AlonzoGenesis -getDefaultAlonzoGenesis sbe = - H.evalEither $ first prettyError (Defaults.defaultAlonzoGenesis sbe) + => m AlonzoGenesis +getDefaultAlonzoGenesis = + H.evalEither $ first prettyError Defaults.defaultAlonzoGenesis numSeededUTxOKeys :: Int numSeededUTxOKeys = 3 @@ -181,7 +180,7 @@ createSPOGenesisAndFiles { sgSecurityParam = unsafeNonZero 5 , sgUpdateQuorum = 2 } - alonzoGenesis' <- getDefaultAlonzoGenesis sbe + alonzoGenesis' <- getDefaultAlonzoGenesis let conwayGenesis' = Defaults.defaultConwayGenesis (alonzoGenesis, conwayGenesis, shelleyGenesis) <- resolveOnChainParams onChainParams diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index d3c75246318..c992a6e912c 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -54,6 +54,8 @@ import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Conway.PParams as L import qualified Cardano.Ledger.Shelley.LedgerState as L import qualified Cardano.Ledger.UMap as L +import qualified Cardano.Ledger.Api.State.Query as SQ +import qualified Data.Set as Set import Prelude @@ -409,12 +411,9 @@ checkDRepState epochStateView@EpochStateView{nodeConfigPath, socketPath} sbe f = result <- H.evalIO . runExceptT $ foldEpochState nodeConfigPath socketPath QuickValidation terminationEpoch Nothing $ \(AnyNewEpochState actualEra newEpochState _) _slotNumber _blockNumber -> do Refl <- either error pure $ assertErasEqual sbe actualEra - let dreps = shelleyBasedEraConstraints sbe newEpochState - ^. L.nesEsL - . L.esLStateL - . L.lsCertStateL - . L.certVStateL - . L.vsDRepsL + let dreps = + shelleyBasedEraConstraints sbe + $ SQ.queryDRepState newEpochState Set.empty case f dreps of Nothing -> pure ConditionNotMet Just a -> do put $ Just a @@ -602,7 +601,6 @@ getDelegationState epochStateView = do . L.esLStateL . L.lsCertStateL . L.certDStateL - . L.dsUnifiedL pure $ L.toStakeCredentials pools diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index d8e74829c58..799b8237f36 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -42,7 +42,7 @@ module Testnet.Defaults ) where import Cardano.Api (AnyShelleyBasedEra (..), CardanoEra (..), File (..), - ShelleyBasedEra (..), pshow, toCardanoEra, unsafeBoundedRational) + ShelleyBasedEra (..), pshow, unsafeBoundedRational) import qualified Cardano.Api as Api import Cardano.Ledger.Alonzo.Core (PParams (..)) @@ -107,9 +107,9 @@ newtype AlonzoGenesisError = AlonzoGenErrTooMuchPrecision Rational deriving Show -defaultAlonzoGenesis :: ShelleyBasedEra era -> Either AlonzoGenesisError AlonzoGenesis -defaultAlonzoGenesis sbe = do - let genesis = Api.alonzoGenesisDefaults (toCardanoEra sbe) +defaultAlonzoGenesis :: Either AlonzoGenesisError AlonzoGenesis +defaultAlonzoGenesis = do + let genesis = Api.alonzoGenesisDefaults prices = Ledger.agPrices genesis -- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api @@ -197,6 +197,7 @@ defaultYamlHardforkViaConfig sbe = ShelleyBasedEraAlonzo -> ("LastKnownBlockVersion-Major", Aeson.Number 5) ShelleyBasedEraBabbage -> ("LastKnownBlockVersion-Major", Aeson.Number 8) ShelleyBasedEraConway -> ("LastKnownBlockVersion-Major", Aeson.Number 9) + ShelleyBasedEraDijkstra -> ("LastKnownBlockVersion-Major", Aeson.Number 10) , ("LastKnownBlockVersion-Minor", Aeson.Number 0) , ("LastKnownBlockVersion-Alt", Aeson.Number 0) ] @@ -241,7 +242,17 @@ defaultYamlHardforkViaConfig sbe = , ("TestAlonzoHardForkAtEpoch", Aeson.Number 0) , ("TestBabbageHardForkAtEpoch", Aeson.Number 0) , ("TestConwayHardForkAtEpoch", Aeson.Number 0) - ]) + ] + ShelleyBasedEraDijkstra -> + [ ("TestShelleyHardForkAtEpoch", Aeson.Number 0) + , ("TestAllegraHardForkAtEpoch", Aeson.Number 0) + , ("TestMaryHardForkAtEpoch", Aeson.Number 0) + , ("TestAlonzoHardForkAtEpoch", Aeson.Number 0) + , ("TestBabbageHardForkAtEpoch", Aeson.Number 0) + , ("TestConwayHardForkAtEpoch", Aeson.Number 0) + , ("TestDijkstraHardForkAtEpoch", Aeson.Number 0) + ] + ) -- | Various tracers we can turn on or off tracers :: Aeson.KeyMap Aeson.Value tracers = Aeson.fromList $ map (bimap Aeson.fromText Aeson.Bool) @@ -434,6 +445,8 @@ eraToProtocolVersion = AnyShelleyBasedEra ShelleyBasedEraBabbage -> mkProtVer (8, 0) -- By default start after bootstrap (which is PV9) AnyShelleyBasedEra ShelleyBasedEraConway -> mkProtVer (10, 0) + -- TODO: is this correct? + AnyShelleyBasedEra ShelleyBasedEraDijkstra -> mkProtVer (11, 0) -- TODO: Expose from cardano-api mkProtVer :: (Natural, Natural) -> ProtVer @@ -443,7 +456,7 @@ mkProtVer (majorProtVer, minorProtVer) = Nothing -> error "mkProtVer: invalid protocol version" ppProtocolVersionL' :: Lens' (PParams Ledger.ShelleyEra) ProtVer -ppProtocolVersionL' = Ledger.ppLens . Ledger.hkdProtocolVersionL @Ledger.ShelleyEra @Identity +ppProtocolVersionL' = Ledger.ppLensHKD . Ledger.hkdProtocolVersionL @Ledger.ShelleyEra @Identity defaultMainnetTopology :: Topology.NetworkTopology RemoteAddress defaultMainnetTopology = diff --git a/cardano-testnet/src/Testnet/Ping.hs b/cardano-testnet/src/Testnet/Ping.hs index 5f54fb62e5a..331e04f9606 100644 --- a/cardano-testnet/src/Testnet/Ping.hs +++ b/cardano-testnet/src/Testnet/Ping.hs @@ -80,10 +80,10 @@ pingNode networkMagic sprocket = liftIO $ bracket Socket.connect sd (Socket.addrAddress peer) peerStr <- peerString - bearer <- getBearer makeSocketBearer sduTimeout nullTracer sd Nothing + bearer <- getBearer makeSocketBearer sduTimeout sd Nothing let versions = supportedNodeToClientVersions networkMagic - !_ <- Mux.write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery) + !_ <- Mux.write bearer nullTracer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery) (msg, !_) <- nextMsg bearer timeoutfn handshakeNum pure $ case CBOR.deserialiseFromBytes handshakeDec msg of @@ -130,7 +130,7 @@ pingNode networkMagic sprocket = liftIO $ bracket -> MiniProtocolNum -- ^ handshake protocol number -> IO (LBS.ByteString, Time) -- ^ raw message and timestamp nextMsg bearer timeoutfn ptclNum = do - (sdu, t_e) <- Mux.read bearer timeoutfn + (sdu, t_e) <- Mux.read bearer nullTracer timeoutfn if mhNum (msHeader sdu) == ptclNum then pure (msBlob sdu, t_e) else nextMsg bearer timeoutfn ptclNum diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index 1330b2e3dcb..700be30a088 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -209,7 +209,7 @@ getStartTime getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do byronGenesisFile <- decodeNodeConfiguration configurationFile >>= \case - NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ -> + NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ _ -> pure $ unGenesisFile npcByronGenesisFile let byronGenesisFilePath = tempRootPath byronGenesisFile SystemStart . G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath From 858235a8fb7cfd565feef9851805dcb17b10e41e Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 3 Oct 2025 22:44:09 +0200 Subject: [PATCH 53/69] Fix testnet queries --- cardano-testnet/src/Parsers/Cardano.hs | 14 ++-- .../src/Testnet/Components/Query.hs | 36 +++++----- .../src/Testnet/Process/Cli/SPO.hs | 65 ++++++++++++++----- 3 files changed, 70 insertions(+), 45 deletions(-) diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index 9cc98dbc7aa..51572e3f6bd 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -5,20 +5,16 @@ module Parsers.Cardano , cmdCreateEnv ) where -import Cardano.Api (AnyShelleyBasedEra(..)) -import Cardano.CLI.EraBased.Common.Option (bounded, command') -import Cardano.Api ( AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), Eon(..) - , forEraInEonMaybe, convert, ShelleyBasedEra(..), AnyCardanoEra(..)) -import Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), ShelleyBasedEra (..), Convert (..), Eon, AnyCardanoEra (..), forEraInEonMaybe) +import Cardano.Api (AnyShelleyBasedEra (..)) -import Cardano.CLI.Environment import Cardano.CLI.EraBased.Common.Option hiding (pNetworkId) + import Prelude -import Control.Applicative((<|>), optional) +import Control.Applicative (optional, (<|>)) import Data.Default.Class (def) import qualified Data.List as L -import Data.Maybe (fromMaybe, maybeToList) +import Data.Maybe import Data.Word (Word64) import Options.Applicative (CommandFields, Mod, Parser) import qualified Options.Applicative as OA @@ -27,8 +23,6 @@ import Testnet.Defaults (defaultEra) import Testnet.Start.Cardano import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) -import qualified Options.Applicative as Opt -import Cardano.Prelude (Typeable) optsTestnet :: Parser CardanoTestnetCliOptions diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index c992a6e912c..005e99ac7f1 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -39,7 +39,7 @@ module Testnet.Components.Query , getProtocolParams , getGovActionLifetime , getKeyDeposit - , getDelegationState + , getAccountsStates , getTxIx ) where @@ -50,12 +50,11 @@ import qualified Cardano.Api.UTxO as Utxo import Cardano.Ledger.Api (ConwayGovState) import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Api.State.Query as SQ import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Conway.PParams as L import qualified Cardano.Ledger.Shelley.LedgerState as L -import qualified Cardano.Ledger.UMap as L -import qualified Cardano.Ledger.Api.State.Query as SQ -import qualified Data.Set as Set +import qualified Cardano.Ledger.State as L import Prelude @@ -69,6 +68,7 @@ import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Maybe import Data.Ord (Down (..)) +import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Type.Equality @@ -412,7 +412,7 @@ checkDRepState epochStateView@EpochStateView{nodeConfigPath, socketPath} sbe f = $ \(AnyNewEpochState actualEra newEpochState _) _slotNumber _blockNumber -> do Refl <- either error pure $ assertErasEqual sbe actualEra let dreps = - shelleyBasedEraConstraints sbe + shelleyBasedEraConstraints sbe $ SQ.queryDRepState newEpochState Set.empty case f dreps of Nothing -> pure ConditionNotMet @@ -467,7 +467,7 @@ getTreasuryValue -> m L.Coin -- ^ The current value of the treasury getTreasuryValue epochStateView = withFrozenCallStack $ do AnyNewEpochState _ newEpochState _ <- getEpochState epochStateView - pure $ newEpochState ^. L.nesEpochStateL . L.epochStateTreasuryL + pure $ newEpochState ^. L.nesEpochStateL . L.treasuryL -- | Obtain minimum deposit amount for governance action from node getMinGovActionDeposit @@ -590,19 +590,21 @@ getKeyDeposit epochStateView ceo = conwayEraOnwardsConstraints ceo $ do . L.ppKeyDepositL --- | Returns delegation state from the epoch state. -getDelegationState :: (H.MonadAssertion m, MonadTest m, MonadIO m) +-- | Returns staking accounts state +getAccountsStates :: (H.MonadAssertion m, MonadTest m, MonadIO m) => EpochStateView - -> m L.StakeCredentials -getDelegationState epochStateView = do + -> ShelleyBasedEra era + -> m (Map (L.Credential L.Staking) (L.AccountState (ShelleyLedgerEra era))) +getAccountsStates epochStateView sbe' = shelleyBasedEraConstraints sbe' $ do AnyNewEpochState sbe newEpochState _ <- getEpochState epochStateView - let pools = shelleyBasedEraConstraints sbe $ newEpochState - ^. L.nesEsL - . L.esLStateL - . L.lsCertStateL - . L.certDStateL - - pure $ L.toStakeCredentials pools + Refl <- H.nothingFail $ testEquality sbe sbe' + pure $ newEpochState + ^. L.nesEsL + . L.esLStateL + . L.lsCertStateL + . L.certDStateL + . L.accountsL + . L.accountsMapL -- | Returns the transaction index of a transaction with a given amount and ID. getTxIx :: forall m era. HasCallStack diff --git a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs index fa96f010bd3..70a7e8b5ae1 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs @@ -18,8 +18,8 @@ module Testnet.Process.Cli.SPO import Cardano.Api hiding (cardanoEra) import qualified Cardano.Api.Ledger as L -import qualified Cardano.Ledger.Api.State.Query as L import qualified Cardano.Ledger.Shelley.LedgerState as L +import qualified Cardano.Ledger.State as L import qualified Cardano.Ledger.UMap as L import Control.Monad @@ -130,30 +130,59 @@ checkStakeKeyRegistered tempAbsP nodeConfigFile sPath terminationEpoch execConfi ] where handler :: StakeAddress -> AnyNewEpochState -> SlotNo -> BlockNo -> StateT DelegationsAndRewards IO ConditionResult - handler (StakeAddress network sCred) (AnyNewEpochState sbe newEpochState _) _ _ = - let umap = shelleyBasedEraConstraints sbe $ newEpochState ^. L.nesEsL . L.epochStateUMapL - dag = L.filterStakePoolDelegsAndRewards umap $ Set.singleton sCred - allStakeCredentials = umap ^. L.umElemsL -- This does not include pointer addresses - delegsAndRewards = shelleyBasedEraConstraints sbe $ toDelegationsAndRewards network sbe dag - in case Map.lookup sCred allStakeCredentials of - Nothing -> return ConditionNotMet - Just _ -> StateT.put delegsAndRewards >> return ConditionMet + handler (StakeAddress network sCred) (AnyNewEpochState sbe newEpochState _) _ _ = shelleyBasedEraConstraints sbe $ do + let accountsMap = newEpochState + ^. L.nesEsL + . L.esLStateL + . L.lsCertStateL + . L.certDStateL + . L.accountsL + . L.accountsMapL + + + -- let umap = shelleyBasedEraConstraints sbe $ newEpochState ^. L.nesEsL . L.epochStateUMapL + -- dag = L.filterStakePoolDelegsAndRewards umap $ Set.singleton sCred + -- allStakeCredentials = umap ^. L.umElemsL -- This does not include pointer addresses + -- delegsAndRewards = shelleyBasedEraConstraints sbe $ toDelegationsAndRewards network sbe dag + + case Map.lookup sCred accountsMap of + Nothing -> pure ConditionNotMet + Just _ -> do + StateT.put $ toDelegationsAndRewards sbe network accountsMap + pure ConditionMet toDelegationsAndRewards - :: L.Network - -> ShelleyBasedEra era - -> (Map (L.Credential L.Staking) (L.KeyHash L.StakePool), Map (L.Credential 'L.Staking) L.Coin) + :: ShelleyBasedEra era + -> L.Network + -> Map (L.Credential L.Staking) (L.AccountState (ShelleyLedgerEra era)) -> DelegationsAndRewards - toDelegationsAndRewards n _ (delegationMap, rewardsMap) = - let apiDelegationMap = Map.map toApiPoolId $ Map.mapKeys (toApiStakeAddress n) delegationMap - apiRewardsMap = Map.mapKeys (toApiStakeAddress n) rewardsMap - in DelegationsAndRewards (apiRewardsMap, apiDelegationMap) + toDelegationsAndRewards sbe n accountsMap = do + let accountsMap' = Map.mapKeys (toApiStakeAddress n) accountsMap + let apiDelegationMap = Map.mapMaybe (toApiPoolId sbe) accountsMap' + apiRewardsMap = Map.map (toBalance sbe) accountsMap' + DelegationsAndRewards (apiRewardsMap, apiDelegationMap) + + -- toApiPoolId :: L.KeyHash L.StakePool -> PoolId + toApiPoolId :: ShelleyBasedEra era + -> L.AccountState (ShelleyLedgerEra era) + -> Maybe PoolId + toApiPoolId sbe accountState = + fmap StakePoolKeyHash $ + shelleyBasedEraConstraints sbe $ + accountState ^. L.stakePoolDelegationAccountStateL + + + toBalance :: ShelleyBasedEra era + -> L.AccountState (ShelleyLedgerEra era) + -> L.Coin + toBalance sbe accountState = + shelleyBasedEraConstraints sbe $ + accountState ^. L.balanceAccountStateL . to L.fromCompact + toApiStakeAddress :: L.Network -> L.Credential 'L.Staking -> StakeAddress toApiStakeAddress = StakeAddress -toApiPoolId :: L.KeyHash L.StakePool -> PoolId -toApiPoolId = StakePoolKeyHash createStakeDelegationCertificate :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) From e34f5dab30ac98a8a010682aa2875f0b6b17af3b Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 6 Oct 2025 18:46:25 +0200 Subject: [PATCH 54/69] Make testnet tests compile --- .../RegisterDeregisterStakeAddress.hs | 23 ++++++++++++++----- .../Cardano/Testnet/Test/Gov/DRepDeposit.hs | 3 ++- .../Cardano/Testnet/Test/Node/Shutdown.hs | 2 +- 3 files changed, 20 insertions(+), 8 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs index 7d3367772da..7ad850ce7a8 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs @@ -19,6 +19,7 @@ import Prelude import Control.Monad import Data.Default.Class import qualified Data.Map as M +import Data.Maybe import qualified Data.Text as Text import System.FilePath (()) @@ -119,9 +120,12 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere ] H.note_ "Check that stake address isn't registered yet" - getDelegationState epochStateView >>= + getAccountsStates epochStateView sbe >>= flip H.assertWith - (M.notMember stakeKeyHash . L.scDeposits) + (\accountsStates -> isJust $ do + state <- M.lookup stakeKeyHash accountsStates + pure () -- should I check for balance? + ) void $ execCli' execConfig [ eraName, "transaction", "submit" @@ -132,9 +136,12 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere _ <- waitForBlocks epochStateView 1 H.note_ "Check that stake address is registered" - getDelegationState epochStateView >>= + getAccountsStates epochStateView sbe >>= flip H.assertWith - (M.member stakeKeyHash . L.scDeposits) + (\accountsStates -> isJust $ do + state <- M.lookup stakeKeyHash accountsStates + pure () -- should I check for balance? + ) -- deregister stake address createStakeKeyDeregistrationCertificate @@ -173,7 +180,11 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere _ <- waitForBlocks epochStateView 1 H.note_ "Check that stake address is deregistered" - getDelegationState epochStateView >>= + getAccountsStates epochStateView sbe >>= flip H.assertWith - (M.notMember stakeKeyHash . L.scDeposits) + (\accountsStates -> isJust $ do + state <- M.lookup stakeKeyHash accountsStates + pure () -- should I check for balance? + ) + -- (M.notMember stakeKeyHash . L.scDeposits) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs index 127c8697ca9..d2fcf8e2d84 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs @@ -8,6 +8,7 @@ import Cardano.Api import Cardano.Api.Experimental (Some (..)) import qualified Cardano.Api.Ledger as L +import qualified Cardano.Ledger.Compactible as L import Cardano.Testnet import Prelude @@ -94,7 +95,7 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp void $ registerDRep execConfig epochStateView ceo work "drep2" wallet1 checkDRepState epochStateView sbe $ \m -> - if map L.drepDeposit (Map.elems m) == [L.Coin minDRepDeposit] + if map (L.fromCompact . L.drepDeposit) (Map.elems m) == [L.Coin minDRepDeposit] then Just () else Nothing diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs index 3a3416820b6..76210b477a9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs @@ -106,7 +106,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H -- 2. Create Alonzo genesis alonzoBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' shelleyDir "genesis.alonzo.spec.json" - gen <- Testnet.getDefaultAlonzoGenesis sbe + gen <- Testnet.getDefaultAlonzoGenesis H.evalIO $ LBS.writeFile alonzoBabbageTestGenesisJsonTargetFile $ encode gen -- 2. Create Conway genesis From dd9a2bbf68ffa6307defa7c64f84fa44ca004e91 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 6 Oct 2025 22:08:55 +0200 Subject: [PATCH 55/69] cardano-testnet | Fix cost models in genesis generation --- cabal.project | 2 +- cardano-testnet/src/Testnet/Blockfrost.hs | 43 ++++++++++++++--------- cardano-testnet/src/Testnet/Defaults.hs | 20 ++++++----- 3 files changed, 40 insertions(+), 25 deletions(-) diff --git a/cabal.project b/cabal.project index 94b6a4907aa..0bd5b9c2829 100644 --- a/cabal.project +++ b/cabal.project @@ -91,7 +91,7 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: cee9b20505a407b55f3b7b335e857d61d71ae196 + tag: 02a2274c7b1fd1c4d4d380328b87b3e81fa537de --sha256: sha256-ijMOji6MNupx6eewRJcWpuoxitp4rw8nnccr/Ay+tTo= subdir: cardano-api diff --git a/cardano-testnet/src/Testnet/Blockfrost.hs b/cardano-testnet/src/Testnet/Blockfrost.hs index 99705f851e4..e50fab3befd 100644 --- a/cardano-testnet/src/Testnet/Blockfrost.hs +++ b/cardano-testnet/src/Testnet/Blockfrost.hs @@ -10,31 +10,31 @@ module Testnet.Blockfrost , blockfrostToGenesis ) where -import Cardano.Ledger.BaseTypes (EpochInterval, Nonce, NonNegativeInterval, - UnitInterval, ProtVer(..), Version) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.PParams (CoinPerWord) +import Cardano.Ledger.BaseTypes (EpochInterval, NonNegativeInterval, Nonce, ProtVer (..), + UnitInterval, Version) import Cardano.Ledger.Coin (Coin) -import Cardano.Ledger.Core (PParams(..)) import Cardano.Ledger.Compactible (toCompactPartial) -import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis(..)) -import Cardano.Ledger.Shelley.PParams (ShelleyPParams(..)) -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis(..)) -import Cardano.Ledger.Alonzo.PParams (CoinPerWord) -import Cardano.Ledger.Conway.Genesis (ConwayGenesis(..)) -import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams(..), - PoolVotingThresholds(..), DRepVotingThresholds(..)) -import Cardano.Ledger.Plutus (CostModel, CostModels, ExUnits(..), - Language(..), Prices(..)) +import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) +import Cardano.Ledger.Conway.PParams (DRepVotingThresholds (..), + PoolVotingThresholds (..), UpgradeConwayPParams (..)) +import Cardano.Ledger.Core (PParams (..)) +import Cardano.Ledger.Plutus (CostModel, CostModels, ExUnits (..), Language (..), + Prices (..)) import qualified Cardano.Ledger.Plutus.CostModels as CostModels +import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis (..)) +import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..)) import Control.Applicative ((<|>)) +import Data.Aeson (FromJSON (..), withObject, (.:)) import qualified Data.Aeson as Aeson -import Data.Aeson (FromJSON(..), (.:), withObject) import qualified Data.Aeson.Types as Aeson import qualified Data.Map.Strict as Map -import Text.Read (readMaybe) import Data.Scientific (Scientific) import Data.Word (Word16, Word32) import Numeric.Natural (Natural) +import Text.Read (readMaybe) data BlockfrostParams = BlockfrostParams { -- Alonzo parameters @@ -206,7 +206,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost { prMem = bfgPriceMem , prSteps = bfgPriceSteps } - , agCostModels = bfgAlonzoCostModels + , agCostModels = {- TODO trimCostModelToInitial PlutusV2 -} bfgAlonzoCostModels } -- Conway Params @@ -237,7 +237,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost , ucppDRepDeposit = bfgDRepDeposit , ucppDRepActivity = bfgDRepActivity , ucppMinFeeRefScriptCostPerByte = bfgMinFeeRevScriptCostPerByte - , ucppPlutusV3CostModel = bfgConwayCostModel + , ucppPlutusV3CostModel = trimCostModelToInitial PlutusV3 bfgConwayCostModel } conwayGenesis = conwayGenesis'{cgUpgradePParams=conwayParams} @@ -265,3 +265,14 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost , sppMinPoolCost = bfgMinPoolCost } shelleyGenesis = shelleyGenesis'{sgProtocolParams=shelleyParams} + +-- | Trims cost model to the initial number of parameters. The cost models in geneses can't +-- have more parameters than the initial number. +trimCostModelToInitial :: Language -> CostModel -> CostModel +trimCostModelToInitial lang cm = do + let paramsCount = CostModels.costModelInitParamCount lang + either (error . ("Testnet.Blockfrost: Cost model trimming failure: " <>) . show) id + . CostModels.mkCostModel lang + . take paramsCount + $ CostModels.getCostModelParams cm + diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 799b8237f36..2fea0072ec9 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -53,19 +53,22 @@ import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Binary.Version () import Cardano.Ledger.Coin import Cardano.Ledger.Conway.Genesis +import qualified Cardano.Ledger.Conway.Genesis as Ledger import Cardano.Ledger.Conway.PParams +import qualified Cardano.Ledger.Conway.PParams as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Plutus as Ledger +import qualified Cardano.Ledger.Plutus.CostModels as Ledger import qualified Cardano.Ledger.Shelley as Ledger import Cardano.Ledger.Shelley.Genesis import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) +import Cardano.Node.Configuration.Topology (RemoteAddress (..)) import qualified Cardano.Node.Configuration.Topology as Topology -import Cardano.Node.Configuration.Topology (RemoteAddress(..)) -import qualified Cardano.Node.Configuration.TopologyP2P as P2P -import Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroups (..), - LocalRootPeersGroup (..), NetworkTopology(..), PublicRootPeers (..), +import Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroup (..), + LocalRootPeersGroups (..), NetworkTopology (..), PublicRootPeers (..), RootConfig (..)) +import qualified Cardano.Node.Configuration.TopologyP2P as P2P import Cardano.Tracing.Config import Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..)) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..)) @@ -95,7 +98,6 @@ import Numeric.Natural import System.FilePath (()) import Test.Cardano.Ledger.Core.Rational -import Test.Cardano.Ledger.Plutus (testingCostModelV3) import Testnet.Start.Types import Testnet.Types @@ -126,7 +128,9 @@ defaultAlonzoGenesis = do Just s -> return s defaultConwayGenesis :: ConwayGenesis -defaultConwayGenesis = +defaultConwayGenesis = do + -- use the cost model from cardano-api, which is trimmed to the correct number of parameters + let ucppPlutusV3CostModel = Ledger.ucppPlutusV3CostModel $ Ledger.cgUpgradePParams Api.conwayGenesisDefaults let upPParams :: UpgradeConwayPParams Identity upPParams = UpgradeConwayPParams { ucppPoolVotingThresholds = poolVotingThresholds @@ -138,7 +142,7 @@ defaultConwayGenesis = , ucppDRepDeposit = Coin 1_000_000 , ucppDRepActivity = EpochInterval 100 , ucppMinFeeRefScriptCostPerByte = 0 %! 1 -- FIXME GARBAGE VALUE - , ucppPlutusV3CostModel = testingCostModelV3 + , ucppPlutusV3CostModel } drepVotingThresholds = DRepVotingThresholds { dvtMotionNoConfidence = 0 %! 1 @@ -159,7 +163,7 @@ defaultConwayGenesis = , pvtHardForkInitiation = 1 %! 2 , pvtPPSecurityGroup = 1 %! 2 } - in ConwayGenesis + ConwayGenesis { cgUpgradePParams = upPParams , cgConstitution = DefaultClass.def , cgCommittee = DefaultClass.def From cefeb1d0ed44cad05be1d3fa107a48f547fea12b 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 56/69] cardano-tracer: integrate o-n 0.22 --- .../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 93f474015ee61f7b9a8ebccbbc3cfcd7fa07024e Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 7 Oct 2025 18:43:27 +0300 Subject: [PATCH 57/69] Update SRPs for api and cli --- cabal.project | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index 0bd5b9c2829..46ff4e6e433 100644 --- a/cabal.project +++ b/cabal.project @@ -83,8 +83,8 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/intersectmbo/cardano-cli.git - tag: 801b1d7cce99c6d5afbe6af7d7ad1d7a2cde087c - --sha256: sha256-s6SvoDHCFXfMC5bNBFoDgxMDZuMhnE1ZZwx1L15yjL0= + tag: 7ca2411e27948b679c21f8d8c3978224fb84e05c + --sha256: sha256-1MvNJ2y2TPPHY3fMnjyhi+Nriguwk2PMNJzksxIuhN0= subdir: cardano-cli @@ -92,6 +92,6 @@ source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api tag: 02a2274c7b1fd1c4d4d380328b87b3e81fa537de - --sha256: sha256-ijMOji6MNupx6eewRJcWpuoxitp4rw8nnccr/Ay+tTo= + --sha256: sha256-g8TfF1TxhvyVOxhLSMwjV7X/owY2ZFID0F/fwJvCjoM= subdir: cardano-api From 84b653e8503e89f053fbc1821b7e4fcfc096a347 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 7 Oct 2025 21:03:44 +0300 Subject: [PATCH 58/69] Remove redundant imports --- bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs | 2 +- cardano-testnet/src/Parsers/Cardano.hs | 3 --- cardano-testnet/src/Testnet/Defaults.hs | 1 - 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index 172d466b539..2163f4c3f83 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -25,7 +25,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra import Control.Monad.Writer (runWriter) -import Cardano.CLI.Read (readFileScriptInAnyLang, ScriptDecodeError) +import Cardano.CLI.Read (readFileScriptInAnyLang) import Cardano.Api import Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits) diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index 0f8f782ed42..efed0f17f49 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -23,9 +23,6 @@ import Testnet.Defaults (defaultEra) import Testnet.Start.Cardano import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) -import qualified Options.Applicative as Opt -import Cardano.Prelude (Typeable) - optsTestnet :: Parser CardanoTestnetCliOptions optsTestnet = CardanoTestnetCliOptions diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 2fea0072ec9..394f1cdf65e 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -58,7 +58,6 @@ import Cardano.Ledger.Conway.PParams import qualified Cardano.Ledger.Conway.PParams as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Plutus as Ledger -import qualified Cardano.Ledger.Plutus.CostModels as Ledger import qualified Cardano.Ledger.Shelley as Ledger import Cardano.Ledger.Shelley.Genesis import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) From 51d98ce0d1fcc18c1c2c518a1cae924ed2466e6f Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 7 Oct 2025 21:20:34 +0300 Subject: [PATCH 59/69] Remove allow-newer for quickcheck --- cabal.project | 8 -------- 1 file changed, 8 deletions(-) diff --git a/cabal.project b/cabal.project index 46ff4e6e433..622b3ddb555 100644 --- a/cabal.project +++ b/cabal.project @@ -61,13 +61,6 @@ 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 @@ -87,7 +80,6 @@ source-repository-package --sha256: sha256-1MvNJ2y2TPPHY3fMnjyhi+Nriguwk2PMNJzksxIuhN0= subdir: cardano-cli - source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api From 0007d4733ebfb549f934fe51236c9832b2a3b0a8 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 7 Oct 2025 21:25:23 +0200 Subject: [PATCH 60/69] Add dijkstra genesis support to cardano-testnet - wip --- .../src/Cardano/TxGenerator/Setup/Plutus.hs | 3 +-- cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Testnet/Blockfrost.hs | 14 +++++++---- .../src/Testnet/Components/Configuration.hs | 23 +++++++++++-------- cardano-testnet/src/Testnet/Defaults.hs | 1 + .../Testnet/Test/Api/TxReferenceInputDatum.hs | 6 ++--- .../Cardano/Testnet/Test/Cli/Query.hs | 4 ++-- .../RegisterDeregisterStakeAddress.hs | 1 - 8 files changed, 31 insertions(+), 22 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index 2163f4c3f83..369e6646881 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -3,7 +3,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-| Module : Cardano.TxGenerator.Setup.Plutus @@ -40,7 +39,7 @@ import Cardano.TxGenerator.Types (TxGenError (..), TxGenPlutusResolved #ifdef WITH_LIBRARY import Cardano.Benchmarking.PlutusScripts (findPlutusScript) #endif -import Control.Exception (SomeException (..), try) +import Control.Exception (SomeException (..), displayException, try) import System.FilePath ((<.>), ()) import Paths_tx_generator diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index af8ba681ac0..d6b030952b7 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -53,6 +53,7 @@ library , cardano-ledger-api , cardano-ledger-conway , cardano-ledger-core:{cardano-ledger-core, testlib} + , cardano-ledger-dijkstra , cardano-ledger-shelley , cardano-node , cardano-ping ^>= 0.9 diff --git a/cardano-testnet/src/Testnet/Blockfrost.hs b/cardano-testnet/src/Testnet/Blockfrost.hs index e50fab3befd..be8093d13f6 100644 --- a/cardano-testnet/src/Testnet/Blockfrost.hs +++ b/cardano-testnet/src/Testnet/Blockfrost.hs @@ -20,6 +20,7 @@ import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Conway.PParams (DRepVotingThresholds (..), PoolVotingThresholds (..), UpgradeConwayPParams (..)) import Cardano.Ledger.Core (PParams (..)) +import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis) import Cardano.Ledger.Plutus (CostModel, CostModels, ExUnits (..), Language (..), Prices (..)) import qualified Cardano.Ledger.Plutus.CostModels as CostModels @@ -182,11 +183,11 @@ instance FromJSON BlockfrostParams where -- Edit a set of Genesis files with data from Blockfrost parameters blockfrostToGenesis :: () - => (AlonzoGenesis, ConwayGenesis, ShelleyGenesis) + => (ShelleyGenesis, AlonzoGenesis, ConwayGenesis, DijkstraGenesis) -> BlockfrostParams - -> (AlonzoGenesis, ConwayGenesis, ShelleyGenesis) -blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') BlockfrostParams{..} = - (alonzoGenesis, conwayGenesis, shelleyGenesis) + -> (ShelleyGenesis, AlonzoGenesis, ConwayGenesis, DijkstraGenesis) +blockfrostToGenesis (shelleyGenesis', alonzoGenesis', conwayGenesis', dijkstraGenesis') BlockfrostParams{..} = + (shelleyGenesis, alonzoGenesis, conwayGenesis, dijkstraGenesis) where -- Alonzo params alonzoGenesis = alonzoGenesis' @@ -206,7 +207,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost { prMem = bfgPriceMem , prSteps = bfgPriceSteps } - , agCostModels = {- TODO trimCostModelToInitial PlutusV2 -} bfgAlonzoCostModels + , agCostModels = CostModels.mkCostModels . Map.mapWithKey trimCostModelToInitial $ CostModels.costModelsValid bfgAlonzoCostModels } -- Conway Params @@ -266,6 +267,9 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost } shelleyGenesis = shelleyGenesis'{sgProtocolParams=shelleyParams} + -- TODO dijkstra: there are no dijkstra params on blockfrost + dijkstraGenesis = dijkstraGenesis' + -- | Trims cost model to the initial number of parameters. The cost models in geneses can't -- have more parameters than the initial number. trimCostModelToInitial :: Language -> CostModel -> CostModel diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index a3aae9162e1..232d550c651 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -29,6 +29,7 @@ import Cardano.Chain.Genesis (GenesisHash (unGenesisHash), readGenesis import qualified Cardano.Crypto.Hash.Blake2b as Crypto import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Ledger.BaseTypes (unsafeNonZero) +import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis) import Cardano.Network.PeerSelection.Bootstrap import Cardano.Network.PeerSelection.PeerTrustable import qualified Cardano.Node.Configuration.Topology as NonP2P @@ -84,12 +85,14 @@ createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ d shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash" alonzoGenesisHash <- getHash AlonzoEra "AlonzoGenesisHash" conwayGenesisHash <- getHash ConwayEra "ConwayGenesisHash" + dijkstraGenesisHash <- getHash ConwayEra "DijkstraGenesisHash" pure $ mconcat [ byronGenesisHash , shelleyGenesisHash , alonzoGenesisHash , conwayGenesisHash + , dijkstraGenesisHash , Defaults.defaultYamlHardforkViaConfig sbe ] where @@ -180,17 +183,18 @@ createSPOGenesisAndFiles { sgSecurityParam = unsafeNonZero 5 , sgUpdateQuorum = 2 } - alonzoGenesis' <- getDefaultAlonzoGenesis + alonzoGenesis' <- getDefaultAlonzoGenesis let conwayGenesis' = Defaults.defaultConwayGenesis + dijkstraGenesis' = dijkstraGenesisDefaults - (alonzoGenesis, conwayGenesis, shelleyGenesis) <- resolveOnChainParams onChainParams - (alonzoGenesis', conwayGenesis', shelleyGenesis') + (shelleyGenesis, alonzoGenesis, conwayGenesis, dijkstraGenesis) <- resolveOnChainParams onChainParams + (shelleyGenesis', alonzoGenesis', conwayGenesis', dijkstraGenesis') -- Write Genesis files to disk, so they can be picked up by create-testnet-data - H.evalIO $ do - LBS.writeFile inputGenesisAlonzoFp $ A.encodePretty alonzoGenesis - LBS.writeFile inputGenesisConwayFp $ A.encodePretty conwayGenesis - LBS.writeFile inputGenesisShelleyFp $ A.encodePretty shelleyGenesis + H.lbsWriteFile inputGenesisAlonzoFp $ A.encodePretty alonzoGenesis + H.lbsWriteFile inputGenesisConwayFp $ A.encodePretty conwayGenesis + H.lbsWriteFile inputGenesisShelleyFp $ A.encodePretty shelleyGenesis + H.lbsWriteFile inputGenesisDijkstraFp $ A.encodePretty dijkstraGenesis H.note_ $ "Number of pools: " <> show nPoolNodes H.note_ $ "Number of stake delegators: " <> show numStakeDelegators @@ -232,6 +236,7 @@ createSPOGenesisAndFiles inputGenesisShelleyFp = genesisInputFilepath ShelleyEra inputGenesisAlonzoFp = genesisInputFilepath AlonzoEra inputGenesisConwayFp = genesisInputFilepath ConwayEra + inputGenesisDijkstraFp = genesisInputFilepath DijkstraEra nPoolNodes = cardanoNumPools testnetOptions CardanoTestnetOptions{cardanoNodeEra, cardanoMaxSupply, cardanoNumDReps} = testnetOptions genesisInputFilepath :: Pretty (eon era) => eon era -> FilePath @@ -292,8 +297,8 @@ resolveOnChainParams :: () => (MonadTest m, MonadIO m) => HasCallStack => TestnetOnChainParams - -> (AlonzoGenesis, ConwayGenesis, ShelleyGenesis) - -> m (AlonzoGenesis, ConwayGenesis, ShelleyGenesis) + -> (ShelleyGenesis, AlonzoGenesis, ConwayGenesis, DijkstraGenesis) + -> m (ShelleyGenesis, AlonzoGenesis, ConwayGenesis, DijkstraGenesis) resolveOnChainParams onChainParams geneses = case onChainParams of DefaultParams -> pure geneses diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 394f1cdf65e..ca0a071f0ec 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -327,6 +327,7 @@ defaultYamlConfig = , ("ShelleyGenesisFile", genesisPath ShelleyEra) , ("AlonzoGenesisFile", genesisPath AlonzoEra) , ("ConwayGenesisFile", genesisPath ConwayEra) + , ("DijkstraGenesisFile", genesisPath DijkstraEra) -- See: https://github.com/input-output-hk/cardano-ledger/blob/master/eras/byron/ledger/impl/doc/network-magic.md , ("RequiresNetworkMagic", "RequiresMagic") diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Api/TxReferenceInputDatum.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Api/TxReferenceInputDatum.hs index 6b937ec4cf3..3aa0e5b1a3b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Api/TxReferenceInputDatum.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Api/TxReferenceInputDatum.hs @@ -131,7 +131,7 @@ hprop_tx_refin_datum = integrationRetryWorkspace 2 "api-tx-refin-dat" $ \tempAbs utxo <- findAllUtxos epochStateView sbe - BalancedTxBody _ txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) _ fee <- + BalancedTxBody _ txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats datums) _) _ _) _ fee <- H.leftFail $ makeTransactionBodyAutoBalance sbe @@ -210,7 +210,7 @@ hprop_tx_refin_datum = integrationRetryWorkspace 2 "api-tx-refin-dat" $ \tempAbs & setTxOuts [txOut] & setTxProtocolParams (pure $ pure pparams) - txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) <- + txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats datums) _) _ _) <- H.leftFail $ createTransactionBody sbe content let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData @@ -257,7 +257,7 @@ hprop_tx_refin_datum = integrationRetryWorkspace 2 "api-tx-refin-dat" $ \tempAbs & setTxOuts [txOut] & setTxProtocolParams (pure $ pure pparams) - txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) <- + txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats datums) _) _ _) <- H.leftFail $ createTransactionBody sbe content let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData 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 3d013966327..7bde9dedec7 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,7 +48,6 @@ 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 (()) @@ -63,13 +62,14 @@ 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 import Hedgehog.Extras (MonadAssertion, readJsonFile) import qualified Hedgehog.Extras as H +import RIO (runRIO) + -- | Test CLI queries -- Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/CliQueries/"'@ diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs index 7ad850ce7a8..0d29b4f3141 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs @@ -11,7 +11,6 @@ module Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress import Cardano.Api as Api import Cardano.CLI.Type.Key (SomeSigningKey (AStakeSigningKey)) -import qualified Cardano.Ledger.UMap as L import Cardano.Testnet import Prelude From d27548b00b71d0b57874af45e12eb171a7f6bff0 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 8 Oct 2025 14:22:56 +0200 Subject: [PATCH 61/69] cardano-testnet | Remove non-p2p topology, use only p2p --- .../Cardano/Node/Configuration/TopologyP2P.hs | 3 ++- cardano-testnet/src/Parsers/Cardano.hs | 8 ------ .../src/Testnet/Components/Configuration.hs | 2 +- cardano-testnet/src/Testnet/Defaults.hs | 4 +-- .../src/Testnet/Property/Assert.hs | 12 +++++---- cardano-testnet/src/Testnet/Start/Cardano.hs | 25 ++++++------------- cardano-testnet/src/Testnet/Start/Types.hs | 18 +++---------- .../Cardano/Testnet/Test/P2PTopology.hs | 10 ++++---- 8 files changed, 27 insertions(+), 55 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs index 99bce93c958..ddc2eca1742 100644 --- a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs +++ b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs @@ -232,7 +232,8 @@ instance ToJSON adr => ToJSON (NetworkTopology adr) where -- | Read the `NetworkTopology` configuration from the specified file. readTopologyFile :: () => forall adr. FromJSON adr - => NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text (NetworkTopology adr)) + => NodeConfiguration + -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text (NetworkTopology adr)) readTopologyFile NodeConfiguration{ncTopologyFile=TopologyFile topologyFilePath, ncConsensusMode, ncProtocolFiles} tracer = runExceptT $ do bs <- handleIOExceptionsLiftWith handler $ BS.readFile topologyFilePath topology@RealNodeTopology{ntUseLedgerPeers, ntUseBootstrapPeers, ntPeerSnapshotPath} <- diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index efed0f17f49..607b5889759 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -43,7 +43,6 @@ optsCreateTestnet = CardanoTestnetCreateEnvOptions pCreateEnvOptions :: Parser CreateEnvOptions pCreateEnvOptions = CreateEnvOptions <$> pOnChainParams - <*> pTopologyType pCardanoTestnetCliOptions :: Parser CardanoTestnetOptions pCardanoTestnetCliOptions = CardanoTestnetOptions @@ -113,13 +112,6 @@ pMainnetParams = OA.flag' OnChainParamsMainnet <> OA.help "Use mainnet on-chain parameters" ) -pTopologyType :: Parser TopologyType -pTopologyType = OA.flag DirectTopology P2PTopology - ( OA.long "p2p-topology" - <> OA.help "Use P2P topology files instead of \"direct\" topology files" - <> OA.showDefault - ) - pUpdateTimestamps :: Parser UpdateTimestamps pUpdateTimestamps = OA.flag DontUpdateTimestamps UpdateTimestamps ( OA.long "update-time" diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 232d550c651..93f24de3eb9 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -85,7 +85,7 @@ createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ d shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash" alonzoGenesisHash <- getHash AlonzoEra "AlonzoGenesisHash" conwayGenesisHash <- getHash ConwayEra "ConwayGenesisHash" - dijkstraGenesisHash <- getHash ConwayEra "DijkstraGenesisHash" + dijkstraGenesisHash <- getHash DijkstraEra "DijkstraGenesisHash" pure $ mconcat [ byronGenesisHash diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index ca0a071f0ec..8fc8f6470fe 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -332,8 +332,8 @@ defaultYamlConfig = -- See: https://github.com/input-output-hk/cardano-ledger/blob/master/eras/byron/ledger/impl/doc/network-magic.md , ("RequiresNetworkMagic", "RequiresMagic") - -- Enable peer to peer discovery - , ("EnableP2P", Aeson.Bool False) + -- Enable P2P, non-P2P is gone + , ("EnableP2P", Aeson.Bool True) -- Logging related , ("setupScribes", setupScribes) diff --git a/cardano-testnet/src/Testnet/Property/Assert.hs b/cardano-testnet/src/Testnet/Property/Assert.hs index 37095dcb008..d0afb649daf 100644 --- a/cardano-testnet/src/Testnet/Property/Assert.hs +++ b/cardano-testnet/src/Testnet/Property/Assert.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -42,6 +43,7 @@ import GHC.Stack as GHC import Testnet.Process.Run import Testnet.Start.Types +import Testnet.Types import Hedgehog (MonadTest) import qualified Hedgehog as H @@ -110,13 +112,13 @@ assertChainExtended => MonadIO m => DTC.UTCTime -> NodeLoggingFormat - -> FilePath + -> TestnetNode -> m () -assertChainExtended deadline nodeLoggingFormat nodeStdoutFile = withFrozenCallStack $ - assertByDeadlineIOCustom "Chain not extended" deadline $ do +assertChainExtended deadline nodeLoggingFormat TestnetNode{nodeName, nodeStdout} = withFrozenCallStack $ + assertByDeadlineIOCustom ("Chain not extended in " <> nodeName) deadline $ do case nodeLoggingFormat of - NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdoutFile - NodeLoggingFormatAsJson -> fileJsonGrep nodeStdoutFile $ \v -> + NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdout + NodeLoggingFormatAsJson -> fileJsonGrep nodeStdout $ \v -> Aeson.parseMaybe (Aeson.parseJSON @(LogEntry Kind)) v == Just (LogEntry (Kind "AddedToCurrentChain")) newtype LogEntry a = LogEntry diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index bb3ddea34c9..832e430f927 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -30,11 +30,11 @@ import Cardano.Api import Cardano.Api.Byron (GenesisData (..)) import qualified Cardano.Api.Byron as Byron -import Cardano.Node.Configuration.Topology (RemoteAddress(..)) +import Cardano.Node.Configuration.Topology (RemoteAddress (..)) import qualified Cardano.Node.Configuration.Topology as Direct import qualified Cardano.Node.Configuration.TopologyP2P as P2P import Cardano.Prelude (canonicalEncodePretty) -import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint(..)) +import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Prelude hiding (lines) @@ -42,7 +42,6 @@ import Control.Concurrent (threadDelay) import Control.Monad import Data.Aeson import qualified Data.Aeson.Encode.Pretty as A -import qualified Data.Aeson.KeyMap as A import qualified Data.ByteString.Lazy as LBS import Data.Default.Class (def) import Data.Either @@ -98,7 +97,6 @@ createTestnetEnv genesisOptions CreateEnvOptions { ceoOnChainParams=onChainParams - , ceoTopologyType=topologyType } Conf { genesisHashesPolicy @@ -114,14 +112,10 @@ createTestnetEnv configurationFile <- H.noteShow $ tmpAbsPath "configuration.yaml" -- Add Byron, Shelley and Alonzo genesis hashes to node configuration - config' <- case genesisHashesPolicy of + config <- case genesisHashesPolicy of WithHashes -> createConfigJson (TmpAbsolutePath tmpAbsPath) sbe WithoutHashes -> pure $ createConfigJsonNoHash sbe -- Setup P2P configuration value - let config = A.insert - "EnableP2P" - (Bool $ topologyType == P2PTopology) - config' H.evalIO $ LBS.writeFile configurationFile $ A.encodePretty $ Object config -- Create network topology, with abstract IDs in lieu of addresses @@ -131,13 +125,8 @@ createTestnetEnv H.evalIO $ IO.createDirectoryIfMissing True nodeDataDir let producers = NodeId <$> filter (/= i) nodeIds - case topologyType of - DirectTopology -> - let topology = Direct.RealNodeTopology producers - in H.lbsWriteFile (nodeDataDir "topology.json") $ A.encodePretty topology - P2PTopology -> - let topology = Defaults.defaultP2PTopology producers - in H.lbsWriteFile (nodeDataDir "topology.json") $ A.encodePretty topology + topology = Defaults.defaultP2PTopology producers + H.lbsWriteFile (nodeDataDir "topology.json") $ A.encodePretty topology -- | Starts a number of nodes, as configured by the value of the 'cardanoNodes' -- field in the 'CardanoTestnetOptions' argument. Regarding this field, you can either: @@ -364,8 +353,8 @@ cardanoTestnet -- FIXME: use foldEpochState waiting for chain extensions now <- H.noteShowIO DTC.getCurrentTime deadline <- H.noteShow $ DTC.addUTCTime 45 now - forM_ (map nodeStdout testnetNodes') $ \nodeStdoutFile -> do - assertChainExtended deadline nodeLoggingFormat nodeStdoutFile + forM_ testnetNodes' $ \node -> do + assertChainExtended deadline nodeLoggingFormat node H.noteShowIO_ DTC.getCurrentTime diff --git a/cardano-testnet/src/Testnet/Start/Types.hs b/cardano-testnet/src/Testnet/Start/Types.hs index b9e557be742..38e10048787 100644 --- a/cardano-testnet/src/Testnet/Start/Types.hs +++ b/cardano-testnet/src/Testnet/Start/Types.hs @@ -30,7 +30,6 @@ module Testnet.Start.Types , isRelayNodeOptions , cardanoDefaultTestnetNodeOptions , GenesisOptions(..) - , TopologyType(..) , UserProvidedData(..) , UserProvidedEnv(..) , UserProvidedGeneses(..) @@ -44,6 +43,7 @@ module Testnet.Start.Types ) where import Cardano.Api hiding (cardanoEra) + import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import Cardano.Ledger.Conway.Genesis (ConwayGenesis) @@ -96,30 +96,18 @@ data UserProvidedEnv instance Default UserProvidedEnv where def = NoUserProvidedEnv -data TopologyType - = DirectTopology - | P2PTopology - deriving (Eq, Show) - -instance Default TopologyType where - def = DirectTopology - data UpdateTimestamps = UpdateTimestamps | DontUpdateTimestamps deriving (Eq, Show) instance Default UpdateTimestamps where def = DontUpdateTimestamps -data CreateEnvOptions = CreateEnvOptions +newtype CreateEnvOptions = CreateEnvOptions { ceoOnChainParams :: TestnetOnChainParams - , ceoTopologyType :: TopologyType } deriving (Eq, Show) instance Default CreateEnvOptions where - def = CreateEnvOptions - { ceoOnChainParams = def - , ceoTopologyType = def - } + def = CreateEnvOptions { ceoOnChainParams = def } data TestnetOnChainParams = DefaultParams diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/P2PTopology.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/P2PTopology.hs index 236eaa3556c..ed120262f7d 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/P2PTopology.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/P2PTopology.hs @@ -7,8 +7,8 @@ module Cardano.Testnet.Test.P2PTopology ) where import qualified Cardano.Node.Configuration.TopologyP2P as P2P -import Cardano.Testnet (CardanoTestnetOptions (..), cardanoTestnet, - createTestnetEnv, mkConf) +import Cardano.Testnet (CardanoTestnetOptions (..), cardanoTestnet, createTestnetEnv, + mkConf) import Cardano.Testnet.Test.Utils (nodesProduceBlocks) import Prelude @@ -17,12 +17,12 @@ import Data.Default.Class (def) import System.FilePath (()) import Testnet.Property.Util (integrationRetryWorkspace) -import Testnet.Start.Types (CreateEnvOptions (..), GenesisOptions (..), NodeId, - UserProvidedEnv (..), TopologyType (..)) +import Testnet.Start.Types (GenesisOptions (..), NodeId, UserProvidedEnv (..)) import qualified Hedgehog as H import qualified Hedgehog.Extras as H +-- TODO we're not supporting non-p2p topology, does this test make any sense now? -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Can be started with P2P topology file/"'@ @@ -31,7 +31,7 @@ hprop_p2p_topology = integrationRetryWorkspace 2 "p2p-topology" $ \tmpDir -> H.r let testnetOptions = def { cardanoOutputDir = UserProvidedEnv tmpDir } genesisOptions = def { genesisEpochLength = 200 } - createEnvOptions = def { ceoTopologyType = P2PTopology } + createEnvOptions = def someTopologyFile = tmpDir "node-data" "node1" "topology.json" -- Generate the sandbox From 7503c64c0c63ef971b4d974f9a6b22e981150e73 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 8 Oct 2025 16:32:12 +0200 Subject: [PATCH 62/69] Disable cardano-testnet tests, update srps --- cabal.project | 8 ++--- cardano-node/test/Test/Cardano/Node/POM.hs | 29 ++++++++++--------- .../files/golden/help.cli | 1 - .../files/golden/help/create-env.cli | 3 -- .../files/golden/node_default_config.json | 3 +- .../RegisterDeregisterStakeAddress.hs | 12 ++++---- .../Testnet/Test/Gov/TreasuryGrowth.hs | 3 +- .../Cardano/Testnet/Test/Utils.hs | 13 +++++---- .../cardano-testnet-test.hs | 10 ++++--- 9 files changed, 43 insertions(+), 39 deletions(-) diff --git a/cabal.project b/cabal.project index 622b3ddb555..fe7ab15d1ea 100644 --- a/cabal.project +++ b/cabal.project @@ -76,14 +76,14 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/intersectmbo/cardano-cli.git - tag: 7ca2411e27948b679c21f8d8c3978224fb84e05c - --sha256: sha256-1MvNJ2y2TPPHY3fMnjyhi+Nriguwk2PMNJzksxIuhN0= + tag: b5b7b3abbe137db9700279faf2032026c3130239 + --sha256: sha256-cjJ/A+lzlI5+OjJxcCI5nFvlkc+ywcie5lkuG9I8y8k= subdir: cardano-cli source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: 02a2274c7b1fd1c4d4d380328b87b3e81fa537de - --sha256: sha256-g8TfF1TxhvyVOxhLSMwjV7X/owY2ZFID0F/fwJvCjoM= + tag: bcb16bfd5c2273c9c59e471708448308a007ad67 + --sha256: sha256-sk03XkS5SKj+aprZGjts2FLBWJNDqBJ0N71ASq7yebk= subdir: cardano-api diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index f4b165ffeac..cfe7fd8be2a 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -88,19 +88,21 @@ testNodeConwayProtocolConfiguration = testNodeHardForkProtocolConfiguration :: NodeHardForkProtocolConfiguration testNodeHardForkProtocolConfiguration = NodeHardForkProtocolConfiguration - { npcExperimentalHardForksEnabled = True - , npcTestShelleyHardForkAtEpoch = Nothing - , npcTestShelleyHardForkAtVersion = Nothing - , npcTestAllegraHardForkAtEpoch = Nothing - , npcTestAllegraHardForkAtVersion = Nothing - , npcTestMaryHardForkAtEpoch = Nothing - , npcTestMaryHardForkAtVersion = Nothing - , npcTestAlonzoHardForkAtEpoch = Nothing - , npcTestAlonzoHardForkAtVersion = Nothing - , npcTestBabbageHardForkAtEpoch = Nothing - , npcTestBabbageHardForkAtVersion = Nothing - , npcTestConwayHardForkAtEpoch = Nothing - , npcTestConwayHardForkAtVersion = Nothing + { npcExperimentalHardForksEnabled = True + , npcTestShelleyHardForkAtEpoch = Nothing + , npcTestShelleyHardForkAtVersion = Nothing + , npcTestAllegraHardForkAtEpoch = Nothing + , npcTestAllegraHardForkAtVersion = Nothing + , npcTestMaryHardForkAtEpoch = Nothing + , npcTestMaryHardForkAtVersion = Nothing + , npcTestAlonzoHardForkAtEpoch = Nothing + , npcTestAlonzoHardForkAtVersion = Nothing + , npcTestBabbageHardForkAtEpoch = Nothing + , npcTestBabbageHardForkAtVersion = Nothing + , npcTestConwayHardForkAtEpoch = Nothing + , npcTestConwayHardForkAtVersion = Nothing + , npcTestDijkstraHardForkAtEpoch = Nothing + , npcTestDijkstraHardForkAtVersion = Nothing } testNodeCheckpointsConfiguration :: NodeCheckpointsConfiguration @@ -117,6 +119,7 @@ testNodeProtocolConfiguration = testNodeShelleyProtocolConfiguration testNodeAlonzoProtocolConfiguration testNodeConwayProtocolConfiguration + Nothing -- Dijkstra configuration testNodeHardForkProtocolConfiguration testNodeCheckpointsConfiguration diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli b/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli index 860ba57b619..3df7e1f1741 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli @@ -27,7 +27,6 @@ Usage: cardano-testnet create-env [--num-pool-nodes COUNT] [--active-slots-coeff DOUBLE] --output DIRECTORY [--params-file FILEPATH | --params-mainnet] - [--p2p-topology] Create a sandbox for Cardano testnet diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/help/create-env.cli b/cardano-testnet/test/cardano-testnet-golden/files/golden/help/create-env.cli index 312f6c5e18c..19b49cfa444 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/help/create-env.cli +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/help/create-env.cli @@ -10,7 +10,6 @@ Usage: cardano-testnet create-env [--num-pool-nodes COUNT] [--active-slots-coeff DOUBLE] --output DIRECTORY [--params-file FILEPATH | --params-mainnet] - [--p2p-topology] Create a sandbox for Cardano testnet @@ -46,6 +45,4 @@ Available options: Blockfrost format: https://docs.blockfrost.io/#tag/cardano--epochs/GET/epochs/latest/parameters --params-mainnet Use mainnet on-chain parameters - --p2p-topology Use P2P topology files instead of "direct" topology - files -h,--help Show this help text diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/node_default_config.json index 6da59b1b9e5..31d4903d9f6 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/node_default_config.json @@ -2,9 +2,10 @@ "AlonzoGenesisFile": "alonzo-genesis.json", "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", + "DijkstraGenesisFile": "dijkstra-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, - "EnableP2P": false, + "EnableP2P": true, "ExperimentalHardForksEnabled": true, "ExperimentalProtocolsEnabled": true, "LastKnownBlockVersion-Alt": 0, diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs index 0d29b4f3141..dfdba63b31b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs @@ -122,8 +122,8 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere getAccountsStates epochStateView sbe >>= flip H.assertWith (\accountsStates -> isJust $ do - state <- M.lookup stakeKeyHash accountsStates - pure () -- should I check for balance? + _state <- M.lookup stakeKeyHash accountsStates + pure () -- TODO should we check for balance? ) void $ execCli' execConfig @@ -138,8 +138,8 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere getAccountsStates epochStateView sbe >>= flip H.assertWith (\accountsStates -> isJust $ do - state <- M.lookup stakeKeyHash accountsStates - pure () -- should I check for balance? + _state <- M.lookup stakeKeyHash accountsStates + pure () -- TODO: should we check for balance? ) -- deregister stake address @@ -182,8 +182,8 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere getAccountsStates epochStateView sbe >>= flip H.assertWith (\accountsStates -> isJust $ do - state <- M.lookup stakeKeyHash accountsStates - pure () -- should I check for balance? + _state <- M.lookup stakeKeyHash accountsStates + pure () -- TODO: should we check for balance? ) -- (M.notMember stakeKeyHash . L.scDeposits) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs index 781ecaea1c0..45513002dfa 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs @@ -9,6 +9,7 @@ import Cardano.Api hiding (cardanoEra) import qualified Cardano.Api as Api import qualified Cardano.Ledger.Shelley.LedgerState as L +import qualified Cardano.Ledger.State as L import Cardano.Testnet as TN import Prelude @@ -77,7 +78,7 @@ prop_check_if_treasury_is_growing = integrationRetryWorkspace 2 "growing-treasur where handler :: AnyNewEpochState -> SlotNo -> BlockNo -> StateT (Map EpochNo Integer) IO ConditionResult handler (AnyNewEpochState _ newEpochState _) _slotNo _blockNo = do - let (Coin coin) = newEpochState ^. L.nesEsL . L.esAccountStateL . L.asTreasuryL + let (Coin coin) = newEpochState ^. L.nesEsL . L.chainAccountStateL . L.casTreasuryL epochNo = newEpochState ^. L.nesELL -- handler is executed multiple times per epoch, so we keep only the latest treasury value modify $ M.insert epochNo coin diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Utils.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Utils.hs index a9338d2d47b..9e38632d2e1 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Utils.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Utils.hs @@ -8,6 +8,7 @@ module Cardano.Testnet.Test.Utils ) where import Cardano.Api (BlockNo (..), ChainTip (..), MonadIO) + import Cardano.CLI.Type.Output (QueryTipLocalStateOutput (..)) import Prelude @@ -20,7 +21,7 @@ import System.Exit (ExitCode (..)) import qualified System.Process as IO import Testnet.Process.Run (execCli', mkExecConfig) -import Testnet.Types (TestnetNode(..), TestnetRuntime (..), isTestnetNodeSpo) +import Testnet.Types (TestnetNode (..), TestnetRuntime (..), isTestnetNodeSpo) import Hedgehog ((===)) import qualified Hedgehog as H @@ -42,11 +43,11 @@ nodesProduceBlocks envDir TestnetRuntime{testnetNodes, testnetMagic} = do TestnetNode { nodeProcessHandle , nodeSprocket - } <- case testnetNodes of - [spoNode, _relayNode1, _relayNode2] -> do - (isTestnetNodeSpo <$> testnetNodes) === [True, False, False] - pure spoNode - _ -> H.failure + } <- case filter isTestnetNodeSpo testnetNodes of + [spoNode] -> pure spoNode + spoNodes -> do + H.note_ $ "Number of SPO nodes different than 1. SPO nodes: " <> show (nodeName <$> spoNodes) + H.failure -- Check that blocks have been produced on the chain after 2 minutes at most H.byDurationM 5 120 "Expected blocks to be minted" $ do diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index fb74ff0ff81..ce9abf2d13d 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -26,8 +26,8 @@ import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov import qualified Cardano.Testnet.Test.Gov.Transaction.HashMismatch as WrongHash import qualified Cardano.Testnet.Test.Gov.TreasuryDonation as Gov import qualified Cardano.Testnet.Test.Gov.TreasuryWithdrawal as Gov -import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.MainnetParams +import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.P2PTopology import qualified Cardano.Testnet.Test.RunTestnet import qualified Cardano.Testnet.Test.SanityCheck as LedgerEvents @@ -50,8 +50,8 @@ import Test.Tasty (TestTree) -- import qualified Cardano.Testnet.Test.Cli.LeadershipSchedule -- import qualified Cardano.Testnet.Test.Gov.TreasuryGrowth as Gov -tests :: IO TestTree -tests = do +_tests :: IO TestTree +_tests = do pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" [ T.testGroup "Ledger Events" @@ -133,5 +133,7 @@ main = do hSetBuffering stdout LineBuffering hSetEncoding stdout utf8 args <- E.getArgs + let disabledTests = pure $ T.testGroup "tests disabled" [] - E.withArgs args $ tests >>= T.defaultMainWithIngredients T.defaultIngredients + -- TODO: fix testnet tests and reenable here + E.withArgs args $ disabledTests >>= T.defaultMainWithIngredients T.defaultIngredients From fc8ecae9fee3f751266a3bc895ef81d7d4e13508 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 9 Oct 2025 17:23:00 +0200 Subject: [PATCH 63/69] Make tracing tests compile --- .../test/Test/Cardano/Tracing/OrphanInstances/HardFork.hs | 4 ++++ .../Tracing/OrphanInstances/data/ntc_HFV3_ByronV1.json | 2 +- .../OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8.json | 2 +- .../data/ntc_HFV3_ByronV1_ShelleyV8_ConwayV2.json | 2 +- .../Tracing/OrphanInstances/data/ntc_HFV3_allDisabled.json | 2 +- 5 files changed, 8 insertions(+), 4 deletions(-) diff --git a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/HardFork.hs index ff08f84509f..e85ba34cfe4 100644 --- a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -73,6 +73,7 @@ ntc_HFV3_allDisabled = :* Consensus.EraNodeToClientDisabled -- Alonzo :* Consensus.EraNodeToClientDisabled -- Babbage :* Consensus.EraNodeToClientDisabled -- Conway + :* Consensus.EraNodeToClientDisabled -- Dijkstra :* Nil ) @@ -89,6 +90,7 @@ ntc_HFV3_ByronV1 = :* Consensus.EraNodeToClientDisabled -- Alonzo :* Consensus.EraNodeToClientDisabled -- Babbage :* Consensus.EraNodeToClientDisabled -- Conway + :* Consensus.EraNodeToClientDisabled -- Dijkstra :* Nil ) @@ -105,6 +107,7 @@ ntc_HFV3_ByronV1_ShelleyV8 = :* Consensus.EraNodeToClientDisabled -- Alonzo :* Consensus.EraNodeToClientDisabled -- Babbage :* Consensus.EraNodeToClientDisabled -- Conway + :* Consensus.EraNodeToClientDisabled -- Dijkstra :* Nil ) @@ -121,6 +124,7 @@ ntc_HFV3_ByronV1_ShelleyV8_ConwayV2 = :* Consensus.EraNodeToClientDisabled -- Alonzo :* Consensus.EraNodeToClientDisabled -- Babbage :* Consensus.EraNodeToClientEnabled Consensus.Cardano.ShelleyNodeToClientVersion8 -- Conway + :* Consensus.EraNodeToClientEnabled Consensus.Cardano.ShelleyNodeToClientVersion8 -- Dijkstra :* Nil ) diff --git a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1.json b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1.json index eb74a30a9ac..ff309c6899f 100644 --- a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1.json +++ b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1.json @@ -1 +1 @@ -{"eraNodeToClientVersions":["ByronNodeToClientVersion1","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file +{"eraNodeToClientVersions":["ByronNodeToClientVersion1","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file diff --git a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8.json b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8.json index e1b5a3dd005..398c7ce89b1 100644 --- a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8.json +++ b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8.json @@ -1 +1 @@ -{"eraNodeToClientVersions":["ByronNodeToClientVersion1","ShelleyNodeToClientVersion8","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file +{"eraNodeToClientVersions":["ByronNodeToClientVersion1","ShelleyNodeToClientVersion8","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file diff --git a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8_ConwayV2.json b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8_ConwayV2.json index d95d2ecf1b0..7d41fd3fd9c 100644 --- a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8_ConwayV2.json +++ b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_ByronV1_ShelleyV8_ConwayV2.json @@ -1 +1 @@ -{"eraNodeToClientVersions":["ByronNodeToClientVersion1","ShelleyNodeToClientVersion8","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","ShelleyNodeToClientVersion8"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file +{"eraNodeToClientVersions":["ByronNodeToClientVersion1","ShelleyNodeToClientVersion8","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","ShelleyNodeToClientVersion8","ShelleyNodeToClientVersion8"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file diff --git a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_allDisabled.json b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_allDisabled.json index d4093da0173..5795a2479aa 100644 --- a/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_allDisabled.json +++ b/cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/ntc_HFV3_allDisabled.json @@ -1 +1 @@ -{"eraNodeToClientVersions":["EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file +{"eraNodeToClientVersions":["EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled","EraNodeToClientDisabled"],"hardForkSpecificNodeToClientVersion":"HardForkSpecificNodeToClientVersion3","tag":"HardForkNodeToClientEnabled"} \ No newline at end of file From d2cdf44008bec9111214ed25ad1a6db02341be9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 10 Oct 2025 11:56:52 +0200 Subject: [PATCH 64/69] Fix for PreSyncingToSyncing and SyncingToPreSyncing --- cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 0eb35e400e6..01f33ff0593 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -21,6 +21,7 @@ module Cardano.Node.Tracing.Tracers.Consensus ) where +import qualified Cardano.KESAgent.Processes.ServiceClient as Agent import Cardano.Logging import Cardano.Node.Queries (HasKESInfo (..)) import Cardano.Node.Tracing.Era.Byron () @@ -68,7 +69,6 @@ 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.Monad (guard) import Data.Aeson (ToJSON, Value (..), toJSON, (.=)) @@ -2122,8 +2122,8 @@ instance MetaTrace (TraceGsmEvent selection) where Namespace _ ["InitializedInPreSyncing"] -> Just Info Namespace _ ["EnterCaughtUp"] -> Just Info Namespace _ ["LeaveCaughtUp"] -> Just Info - Namespace _ ["GsmEventPreSyncingToSyncing"] -> Just Info - Namespace _ ["GsmEventSyncingToPreSyncing"] -> Just Info + Namespace _ ["PreSyncingToSyncing"] -> Just Info + Namespace _ ["SyncingToPreSyncing"] -> Just Info Namespace _ _ -> Nothing documentFor = \case From dfca48fa596fbcdaef5c05391f49ecd53288de73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 10 Oct 2025 12:06:08 +0200 Subject: [PATCH 65/69] Remove unused config values from mainnet-config.json --- configuration/cardano/mainnet-config.json | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/configuration/cardano/mainnet-config.json b/configuration/cardano/mainnet-config.json index eeb676748ab..2e019e45aaa 100644 --- a/configuration/cardano/mainnet-config.json +++ b/configuration/cardano/mainnet-config.json @@ -86,12 +86,6 @@ "Mempool.AttemptAdd": { "severity": "Silence" }, - "Mempool.LedgerFound": { - "severity": "Silence" - }, - "Mempool.LedgerNotFound": { - "severity": "Silence" - }, "Mempool.SyncNotNeeded": { "severity": "Silence" }, @@ -101,12 +95,6 @@ "Net.ConnectionManager.Remote.ConnectionManagerCounters": { "severity": "Silence" }, - "Net.ErrorPolicy": { - "severity": "Info" - }, - "Net.ErrorPolicy.Local": { - "severity": "Info" - }, "Net.InboundGovernor": { "severity": "Warning" }, @@ -119,12 +107,6 @@ "Net.PeerSelection": { "severity": "Silence" }, - "Net.Subscription.DNS": { - "severity": "Info" - }, - "Net.Subscription.IP": { - "severity": "Info" - }, "Resources": { "severity": "Silence" }, From 20b4fc03091dffe2784b8dcf8746c59e9be9715e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 10 Oct 2025 12:23:42 +0200 Subject: [PATCH 66/69] Make the yaml version equal the json --- configuration/cardano/mainnet-config.yaml | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index 11bab7f5f06..a8c6e5695d2 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -216,12 +216,6 @@ TraceOptions: Net.ConnectionManager.Remote.ConnectionManagerCounters: severity: Silence - Net.ErrorPolicy: - severity: Info - - Net.ErrorPolicy.Local: - severity: Info - Net.InboundGovernor: severity: Warning @@ -234,12 +228,6 @@ TraceOptions: Net.PeerSelection: severity: Silence - Net.Subscription.DNS: - severity: Info - - Net.Subscription.IP: - severity: Info - Resources: severity: Silence @@ -257,12 +245,6 @@ TraceOptions: Mempool.AttemptAdd: severity: Silence - Mempool.LedgerFound: - severity: Silence - - Mempool.LedgerNotFound: - severity: Silence - Mempool.SyncNotNeeded: severity: Silence From e60f74a129d59226e3ffb0f37789eec6d627eb29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 10 Oct 2025 12:24:32 +0200 Subject: [PATCH 67/69] Fix 'LedgerTablesHandleCreate' --- cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 11371a80571..686de13271f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -2260,18 +2260,18 @@ instance MetaTrace V2.FlavorImplSpecificTrace where severityFor _ _ = Nothing -- suspicious - privacyFor (Namespace _ ["TraceLedgerTablesHandleCreate"]) _ = Just Public + privacyFor (Namespace _ ["LedgerTablesHandleCreate"]) _ = Just Public privacyFor (Namespace _ ["LedgerTablesHandleClose"]) _ = Just Public privacyFor _ _ = Just Public - documentFor (Namespace _ ["TraceLedgerTablesHandleCreate"]) = + documentFor (Namespace _ ["LedgerTablesHandleCreate"]) = Just "An in-memory backing store event" documentFor (Namespace _ ["LedgerTablesHandleClose"]) = Just "An on-disk backing store event" documentFor _ = Nothing allNamespaces = - [ Namespace [] ["TraceLedgerTablesHandleCreate"] + [ Namespace [] ["LedgerTablesHandleCreate"] , Namespace [] ["LedgerTablesHandleClose"] ] From 559b2502d62c07f6945a0050b9bd879eeb6b6324 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 10 Oct 2025 14:18:37 +0300 Subject: [PATCH 68/69] Fix redundant import --- bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index 369e6646881..9b3cd01aa0c 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -39,7 +39,7 @@ import Cardano.TxGenerator.Types (TxGenError (..), TxGenPlutusResolved #ifdef WITH_LIBRARY import Cardano.Benchmarking.PlutusScripts (findPlutusScript) #endif -import Control.Exception (SomeException (..), displayException, try) +import Control.Exception (SomeException (..), try) import System.FilePath ((<.>), ()) import Paths_tx_generator From 564f557a9ae930689be54221e7d6b20cb3c17d30 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 10 Oct 2025 16:13:55 +0300 Subject: [PATCH 69/69] Address review comments; update SRPs --- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 39 ++++++++++--------- .../src/Cardano/Benchmarking/Script/Core.hs | 3 +- cabal.project | 8 ++-- cardano-tracer/cardano-tracer.cabal | 2 +- trace-forward/src/Trace/Forward/Forwarding.hs | 3 +- 5 files changed, 27 insertions(+), 28 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index e6dcd021d35..84f3f74bb4b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -40,18 +40,20 @@ assume_cbor_properties -- The cost of map entries in metadata follows a step function. -- This assumes the map indices are [0..n]. -prop_mapCostsShelley :: Bool -prop_mapCostsAllegra :: Bool -prop_mapCostsMary :: Bool -prop_mapCostsAlonzo :: Bool -prop_mapCostsBabbage :: Bool -prop_mapCostsConway :: Bool -prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra -prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra -prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryEra -prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra -prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra -prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra +prop_mapCostsShelley :: Bool +prop_mapCostsAllegra :: Bool +prop_mapCostsMary :: Bool +prop_mapCostsAlonzo :: Bool +prop_mapCostsBabbage :: Bool +prop_mapCostsConway :: Bool +prop_mapCostsDijkstra :: Bool +prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra +prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra +prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryEra +prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra +prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra +prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra +prop_mapCostsDijkstra = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int] assumeMapCosts _proxy = stepFunction [ @@ -63,13 +65,12 @@ assumeMapCosts _proxy = stepFunction [ ] where firstEntry = case shelleyBasedEra @era of - ShelleyBasedEraShelley -> 37 - ShelleyBasedEraAllegra -> 39 - ShelleyBasedEraMary -> 39 - ShelleyBasedEraAlonzo -> 42 - ShelleyBasedEraBabbage -> 42 - ShelleyBasedEraConway -> 42 - -- TODO: check if this is correct! + ShelleyBasedEraShelley -> 37 + ShelleyBasedEraAllegra -> 39 + ShelleyBasedEraMary -> 39 + ShelleyBasedEraAlonzo -> 42 + ShelleyBasedEraBabbage -> 42 + ShelleyBasedEraConway -> 42 ShelleyBasedEraDijkstra -> 42 -- Bytestring costs are not LINEAR !! diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index e364d2529f8..291be5f4b85 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -77,8 +77,7 @@ withEra era action = do AnyCardanoEra AllegraEra -> action AsAllegraEra AnyCardanoEra ShelleyEra -> action AsShelleyEra AnyCardanoEra ByronEra -> error "byron not supported" - -- TODO: is this correct? - AnyCardanoEra DijkstraEra -> error "Dijkstra not supported" + AnyCardanoEra DijkstraEra -> action AsDijkstraEra setProtocolParameters :: ProtocolParametersSource -> ActionM () setProtocolParameters s = case s of diff --git a/cabal.project b/cabal.project index fe7ab15d1ea..0a41e4ff339 100644 --- a/cabal.project +++ b/cabal.project @@ -76,14 +76,14 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/intersectmbo/cardano-cli.git - tag: b5b7b3abbe137db9700279faf2032026c3130239 - --sha256: sha256-cjJ/A+lzlI5+OjJxcCI5nFvlkc+ywcie5lkuG9I8y8k= + tag: e660e5f592ed0f10ef950c8a15fa78d8bacf6450 + --sha256: sha256-QlJhgEeRTr9qeC+MFaGDOGhmeOC73TxRZdix7I9Jcm8= subdir: cardano-cli source-repository-package type: git location: https://github.com/IntersectMBO/cardano-api - tag: bcb16bfd5c2273c9c59e471708448308a007ad67 - --sha256: sha256-sk03XkS5SKj+aprZGjts2FLBWJNDqBJ0N71ASq7yebk= + tag: 845b761ba38c65c7d4ad4c2c14c4c034598fba23 + --sha256: sha256-EAAFJ5yyeblUTNl1usk3ZVwFW6YL9pOLkIQpd0CDIcs= subdir: cardano-api diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index d538b5ca1c3..5d0a4bcb7f8 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: Enab2.3e RTView. False by default. Enable with `-f +rtview`. + description: Enable RTView. False by default. Enable with `-f +rtview`. default: False manual: True diff --git a/trace-forward/src/Trace/Forward/Forwarding.hs b/trace-forward/src/Trace/Forward/Forwarding.hs index 5a8ec774a6a..0c7bbc6cf4a 100644 --- a/trace-forward/src/Trace/Forward/Forwarding.hs +++ b/trace-forward/src/Trace/Forward/Forwarding.hs @@ -34,9 +34,8 @@ import Ouroboros.Network.Socket (ConnectToArgs (..), import qualified Ouroboros.Network.Server.Simple as Server import Codec.CBOR.Term (Term) -import Control.Concurrent.Async (async) +import Control.Concurrent.Async (async, wait) import Control.Exception (throwIO) -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