From 41a963abe9502b45022d38df06ae906dcb173074 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Mon, 6 Jan 2025 12:33:39 -0700 Subject: [PATCH 01/79] Increase protocol minor version This enables tracking of peers that have upgraded, but makes no other difference --- cardano-node/src/Cardano/Node/Protocol/Cardano.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index caa24132d04..84f312ea522 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -171,7 +171,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { shelleyGenesisHash, shelleyBasedLeaderCredentials = shelleyLeaderCredentials } - , Consensus.cardanoProtocolVersion = ProtVer (natVersion @10) 0 + , Consensus.cardanoProtocolVersion = ProtVer (natVersion @10) 2 -- The remaining arguments specify the parameters needed to transition between two eras , Consensus.cardanoLedgerTransitionConfig = Ledger.mkLatestTransitionConfig From d594cd0728ee9866321679b253280c2126f7f5b9 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 11:48:19 -0700 Subject: [PATCH 02/79] Update Hackage and CHaP indexes and flake inputs --- cabal.project | 4 ++-- flake.lock | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index 817384d15f2..6b24d84d3c6 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 2024-10-10T00:52:24Z - , cardano-haskell-packages 2025-01-04T13:50:25Z + , hackage.haskell.org 2025-01-01T23:24:19Z + , cardano-haskell-packages 2025-01-16T11:44:54Z packages: cardano-node diff --git a/flake.lock b/flake.lock index eb6ac3d3599..030b6061b50 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1735999756, - "narHash": "sha256-fJeEZoyPrHi4ylsCm4CXypicNf2mfPbtvUfJuFcOllM=", + "lastModified": 1737030073, + "narHash": "sha256-Mdf9GfcJG2ehJM4yFkZKjTnOWCbutjAe7s+Z27fusA8=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "db6a4bdb6b83af17711a23e45266ab031894d788", + "rev": "1013daa305ed2a6e5f50edf8141d4edce94c06bc", "type": "github" }, "original": { @@ -526,11 +526,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1729039425, - "narHash": "sha256-sIglYcw8Dacj4n0bRlUWo+NLkDMcVi6vtmKvUyG+ZrQ=", + "lastModified": 1736987292, + "narHash": "sha256-ZK4gWwsTWIP6j+SIHy7f2BLPcs8Q1yO8bP18thkIHLQ=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6dc43e5e01f113ce151056a8f94bce7bb2f13eb9", + "rev": "28b6ddfbfad7274f33ad99939e19afb29ee5adf6", "type": "github" }, "original": { From 3c2360a880b4b597d6d882944ab1bfad09b76879 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 9 Jan 2025 14:37:01 -0700 Subject: [PATCH 03/79] Use a newer Hackage index-state for for build tools Avoid build plan failures with newer ghc's --- nix/pkgs.nix | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/pkgs.nix b/nix/pkgs.nix index 95105eac31f..63dd1685d28 100644 --- a/nix/pkgs.nix +++ b/nix/pkgs.nix @@ -44,12 +44,12 @@ in with final; ghc927 = "3.5"; ghc928 = "3.5"; }.${config.compiler-nix-name} or "3.6.1"; - index-state = "2023-08-05T00:00:00Z"; + index-state = "2024-12-24T12:56:48Z"; }); ghcid = haskell-nix.tool compiler-nix-name "ghcid" { version = "0.8.7"; - index-state = "2023-08-05T00:00:00Z"; + index-state = "2024-12-24T12:56:48Z"; }; # The ghc-hls point release compatibility table is documented at @@ -71,7 +71,7 @@ in with final; haskellBuildUtils = prev.haskellBuildUtils.override { inherit compiler-nix-name; - index-state = "2023-08-05T00:00:00Z"; + index-state = "2024-12-24T12:56:48Z"; }; profiteur = haskell-nix.tool compiler-nix-name "profiteur" { From ed13ca3d1378cd90964c33fc1a174eb3a608d2ed Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 17 Jan 2025 15:34:32 -0700 Subject: [PATCH 04/79] Remove redundant project constraints --- cabal.project | 4 ---- 1 file changed, 4 deletions(-) diff --git a/cabal.project b/cabal.project index 6b24d84d3c6..de569fdc0d1 100644 --- a/cabal.project +++ b/cabal.project @@ -57,10 +57,6 @@ package bitvec package plutus-scripts-bench haddock-options: "--optghc=-fplugin-opt PlutusTx.Plugin:defer-errors" -constraints: - , wai-extra < 3.1.15 - , Cabal < 3.14 - allow-newer: , katip:Win32 , ekg-wai:time From 268156da10b9ee8e7bd3524fdfe333ff77ead94d Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Mon, 21 Oct 2024 16:31:25 +0200 Subject: [PATCH 05/79] switch to ekg-wai backend from ekg --- cardano-node/cardano-node.cabal | 6 +++--- cardano-node/src/Cardano/Node/Configuration/Logging.hs | 2 +- cardano-node/src/Cardano/Tracing/Tracers.hs | 2 +- trace-dispatcher/bench/trace-dispatcher-bench.hs | 2 +- trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs | 2 +- trace-dispatcher/trace-dispatcher.cabal | 5 ++--- 6 files changed, 9 insertions(+), 10 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index de9617d7365..a57043612e6 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -169,17 +169,17 @@ library , deepseq , directory , dns - , ekg + , ekg-wai , ekg-core , filepath , formatting , generic-data , hostname , io-classes >= 1.4 - , iohk-monitoring < 0.2 + , iohk-monitoring ^>= 0.2 , iproute , lobemo-backend-aggregation - , lobemo-backend-ekg < 0.2 + , lobemo-backend-ekg ^>= 0.2 , lobemo-backend-monitoring , lobemo-backend-trace-forwarder , mtl diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs index cad45ea0495..caf41dbb8db 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Logging.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Logging.hs @@ -48,7 +48,7 @@ import Data.Version (showVersion) import System.Metrics.Counter (Counter) import System.Metrics.Gauge (Gauge) import System.Metrics.Label (Label) -import qualified System.Remote.Monitoring as EKG +import qualified System.Remote.Monitoring.Wai as EKG import Cardano.BM.Backend.Aggregation (plugin) import Cardano.BM.Backend.EKGView (plugin) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 78ea014e3e5..8f4636ac6e1 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -135,7 +135,7 @@ import GHC.TypeLits (KnownNat, Nat, natVal) import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Gauge as Gauge import qualified System.Metrics.Label as Label -import qualified System.Remote.Monitoring as EKG +import qualified System.Remote.Monitoring.Wai as EKG {-# OPTIONS_GHC -Wno-redundant-constraints #-} diff --git a/trace-dispatcher/bench/trace-dispatcher-bench.hs b/trace-dispatcher/bench/trace-dispatcher-bench.hs index b8425e2af4c..89d25a53304 100644 --- a/trace-dispatcher/bench/trace-dispatcher-bench.hs +++ b/trace-dispatcher/bench/trace-dispatcher-bench.hs @@ -6,7 +6,7 @@ import Cardano.Logging.Test.Tracer import Cardano.Logging.Test.Types import Data.IORef -import System.Remote.Monitoring (forkServer) +import System.Remote.Monitoring.Wai (forkServer) import Criterion.Main diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs index ba2060e34bf..c5f64226502 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs @@ -19,7 +19,7 @@ import qualified System.Metrics as Metrics import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Gauge as Gauge import qualified System.Metrics.Label as Label -import System.Remote.Monitoring (Server, getCounter, getGauge, getLabel) +import System.Remote.Monitoring.Wai (Server, getCounter, getGauge, getLabel) -- | It is mandatory to construct only one standard tracer in any application! diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 09f155b25c6..ffa0faad9b2 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -54,7 +54,7 @@ library , containers , contra-tracer , deepseq - , ekg + , ekg-wai , ekg-core , ekg-forward >= 0.5 , hostname @@ -116,7 +116,6 @@ test-suite trace-dispatcher-test , cardano-prelude , containers , deepseq - , ekg , ekg-core , generic-data , hostname @@ -164,7 +163,7 @@ benchmark trace-dispatcher-bench , aeson , containers , criterion - , ekg + , ekg-wai , text , time , trace-dispatcher From 286bc03e027a0f2e121fbc7d6230ebc9ab83381a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Wed, 30 Oct 2024 09:00:00 +0000 Subject: [PATCH 06/79] trace-forward: update to typed-protocols-0.3 --- cardano-node/cardano-node.cabal | 2 +- trace-forward/CHANGELOG.md | 4 ++ .../Forward/Protocol/DataPoint/Acceptor.hs | 16 ++--- .../Trace/Forward/Protocol/DataPoint/Codec.hs | 42 +++++------ .../Forward/Protocol/DataPoint/Forwarder.hs | 14 ++-- .../Trace/Forward/Protocol/DataPoint/Type.hs | 58 ++++++++------- .../Forward/Protocol/TraceObject/Acceptor.hs | 24 ++++--- .../Forward/Protocol/TraceObject/Codec.hs | 46 ++++++------ .../Forward/Protocol/TraceObject/Forwarder.hs | 45 +++++++----- .../Forward/Protocol/TraceObject/Type.hs | 71 ++++++++++--------- .../Trace/Forward/Protocol/DataPoint/Codec.hs | 10 +-- .../Trace/Forward/Protocol/DataPoint/Tests.hs | 8 +-- .../Forward/Protocol/TraceObject/Codec.hs | 12 ++-- .../Forward/Protocol/TraceObject/Tests.hs | 8 +-- trace-forward/trace-forward.cabal | 7 +- 15 files changed, 196 insertions(+), 171 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index a57043612e6..ea3dc4d9a85 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -213,7 +213,7 @@ library , tracer-transformers , transformers , transformers-except - , typed-protocols >= 0.1 + , typed-protocols >= 0.3 , yaml executable cardano-node diff --git a/trace-forward/CHANGELOG.md b/trace-forward/CHANGELOG.md index 17819411f08..ff76eda49a7 100644 --- a/trace-forward/CHANGELOG.md +++ b/trace-forward/CHANGELOG.md @@ -1,5 +1,9 @@ # ChangeLog +## NEXT + +* Updated to `typed-protocols-0.3`. + ## 2.2.8 - Oct 2024 * Bump for version bound diff --git a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Acceptor.hs b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Acceptor.hs index db5cf3e7fe0..7e5849af735 100644 --- a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Acceptor.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -14,8 +15,7 @@ module Trace.Forward.Protocol.DataPoint.Acceptor , dataPointAcceptorPeer ) where -import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..)) - +import Network.TypedProtocol.Peer.Client import Trace.Forward.Protocol.DataPoint.Type data DataPointAcceptor m a where @@ -33,22 +33,22 @@ data DataPointAcceptor m a where dataPointAcceptorPeer :: Monad m => DataPointAcceptor m a - -> Peer DataPointForward 'AsClient 'StIdle m a + -> Client DataPointForward 'NonPipelined 'StIdle m a dataPointAcceptorPeer = \case SendMsgDataPointsRequest request next -> -- Send our message (request for new 'DataPoint's from the forwarder). - Yield (ClientAgency TokIdle) (MsgDataPointsRequest request) $ + Yield (MsgDataPointsRequest request) do -- We're now into the 'StBusy' state, and now we'll wait for a reply -- from the forwarder. It is assuming that the forwarder will reply -- immediately (even there are no 'DataPoint's). - Await (ServerAgency TokBusy) $ \(MsgDataPointsReply reply) -> - Effect $ + Await \(MsgDataPointsReply reply) -> + Effect do dataPointAcceptorPeer <$> next reply SendMsgDone getResult -> -- We do an actual transition using 'yield', to go from the 'StIdle' to -- 'StDone' state. Once in the 'StDone' state we can actually stop using -- 'done', with a return value. - Effect $ - Yield (ClientAgency TokIdle) MsgDone . Done TokDone + Effect do + Yield MsgDone . Done <$> getResult diff --git a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Codec.hs b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Codec.hs index b339c3f989b..c6ba7808cb6 100644 --- a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Codec.hs +++ b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Codec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} @@ -13,8 +14,7 @@ import qualified Codec.CBOR.Encoding as CBOR import Codec.CBOR.Read (DeserialiseFailure) import Control.Monad.Class.MonadST (MonadST) import qualified Data.ByteString.Lazy as LBS -import Network.TypedProtocol.Codec (Codec, PeerHasAgency (..), PeerRole (..), - SomeMessage (..)) +import Network.TypedProtocol.Codec import Network.TypedProtocol.Codec.CBOR (mkCodecCborLazyBS) import Text.Printf (printf) @@ -31,52 +31,52 @@ codecDataPointForward DeserialiseFailure m LBS.ByteString codecDataPointForward encodeRequest decodeRequest encodeReplyList decodeReplyList = - mkCodecCborLazyBS encode decode + mkCodecCborLazyBS encode' decode' where -- Encode messages. - encode - :: forall (pr :: PeerRole) - (st :: DataPointForward) + encode' + :: forall (st :: DataPointForward) (st' :: DataPointForward). - PeerHasAgency pr st - -> Message DataPointForward st st' + Message DataPointForward st st' -> CBOR.Encoding - encode (ClientAgency TokIdle) (MsgDataPointsRequest request) = + encode' (MsgDataPointsRequest request) = CBOR.encodeListLen 2 <> CBOR.encodeWord 1 <> encodeRequest request - encode (ClientAgency TokIdle) MsgDone = + encode' MsgDone = CBOR.encodeListLen 1 <> CBOR.encodeWord 2 - encode (ServerAgency TokBusy) (MsgDataPointsReply reply) = + encode' (MsgDataPointsReply reply) = CBOR.encodeListLen 2 <> CBOR.encodeWord 3 <> encodeReplyList reply -- Decode messages - decode - :: forall (pr :: PeerRole) - (st :: DataPointForward) s. - PeerHasAgency pr st + decode' + :: forall (st :: DataPointForward) s. + ActiveState st + => StateToken st -> CBOR.Decoder s (SomeMessage st) - decode stok = do + decode' stok = do len <- CBOR.decodeListLen key <- CBOR.decodeWord case (key, len, stok) of - (1, 2, ClientAgency TokIdle) -> + (1, 2, SingIdle) -> SomeMessage . MsgDataPointsRequest <$> decodeRequest - (2, 1, ClientAgency TokIdle) -> + (2, 1, SingIdle) -> return $ SomeMessage MsgDone - (3, 2, ServerAgency TokBusy) -> + (3, 2, SingBusy) -> SomeMessage . MsgDataPointsReply <$> decodeReplyList -- Failures per protocol state - (_, _, ClientAgency TokIdle) -> + (_, _, SingIdle) -> fail (printf "codecDataPointForward (%s) unexpected key (%d, %d)" (show stok) key len) - (_, _, ServerAgency TokBusy) -> + (_, _, SingBusy) -> fail (printf "codecDataPointForward (%s) unexpected key (%d, %d)" (show stok) key len) + + (_, _, SingDone) -> notActiveState stok diff --git a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Forwarder.hs b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Forwarder.hs index b4b8e34f6df..84cad1da407 100644 --- a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Forwarder.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -9,7 +10,7 @@ module Trace.Forward.Protocol.DataPoint.Forwarder , dataPointForwarderPeer ) where -import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..)) +import Network.TypedProtocol.Peer.Server import Trace.Forward.Protocol.DataPoint.Type @@ -29,22 +30,21 @@ data DataPointForwarder m a = DataPointForwarder dataPointForwarderPeer :: Monad m => DataPointForwarder m a - -> Peer DataPointForward 'AsServer 'StIdle m a + -> Server DataPointForward 'NonPipelined 'StIdle m a dataPointForwarderPeer DataPointForwarder{recvMsgDataPointsRequest, recvMsgDone} = go where go = -- In the 'StIdle' state the forwarder is awaiting a request message -- from the acceptor. - Await (ClientAgency TokIdle) $ \case + Await \case -- The acceptor sent us a request for new 'DataPoint's, so now we're -- in the 'StBusy' state which means it's the forwarder's turn to send -- a reply. - MsgDataPointsRequest request -> Effect $ do + MsgDataPointsRequest request -> Effect do reply <- recvMsgDataPointsRequest request - return $ Yield (ServerAgency TokBusy) - (MsgDataPointsReply reply) + return $ Yield (MsgDataPointsReply reply) go -- The acceptor sent the done transition, so we're in the 'StDone' state -- so all we can do is stop using 'done', with a return value. - MsgDone -> Effect $ Done TokDone <$> recvMsgDone + MsgDone -> Effect $ Done <$> recvMsgDone diff --git a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Type.hs b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Type.hs index c3d493222bd..d0cb538e964 100644 --- a/trace-forward/src/Trace/Forward/Protocol/DataPoint/Type.hs +++ b/trace-forward/src/Trace/Forward/Protocol/DataPoint/Type.hs @@ -1,8 +1,9 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeFamilies #-} -- | The type of the 'DataPoint' forwarding/accepting protocol. @@ -14,16 +15,16 @@ module Trace.Forward.Protocol.DataPoint.Type , DataPointValues , DataPointForward (..) , Message (..) - , ClientHasAgency (..) - , ServerHasAgency (..) - , NobodyHasAgency (..) + , SingDataPointForward (..) ) where +import Data.Singletons +import Network.TypedProtocol.Core import Ouroboros.Network.Util.ShowProxy (ShowProxy (..)) import qualified Data.ByteString.Lazy as LBS +import Data.Kind (Type) import Data.Text (Text) -import Network.TypedProtocol.Core (Protocol (..)) -- | A kind to identify our protocol, and the types of the states in the state -- transition diagram of the protocol. @@ -62,6 +63,25 @@ data DataPointForward where instance ShowProxy DataPointForward where showProxy _ = "DataPointForward" +-- | Singleton type of DataPointForward. Same as: +-- +-- @ +-- type SingDataPointForward :: DataPointForward -> Type +-- type SingDataPointForward = TypeRep +-- @ +type SingDataPointForward :: DataPointForward -> Type +data SingDataPointForward dataPoint where + SingIdle :: SingDataPointForward 'StIdle + SingBusy :: SingDataPointForward 'StBusy + SingDone :: SingDataPointForward 'StDone + +type instance Sing = SingDataPointForward + +deriving instance Show (SingDataPointForward st) +instance StateTokenI 'StIdle where stateToken = SingIdle +instance StateTokenI 'StBusy where stateToken = SingBusy +instance StateTokenI 'StDone where stateToken = SingDone + instance Protocol DataPointForward where -- | The messages in the trace forwarding/accepting protocol. @@ -95,27 +115,11 @@ instance Protocol DataPointForward where -- 1. ClientHasAgency (from 'Network.TypedProtocol.Core') corresponds to acceptor's agency. -- 3. ServerHasAgency (from 'Network.TypedProtocol.Core') corresponds to forwarder's agency. -- - data ClientHasAgency st where - TokIdle :: ClientHasAgency 'StIdle - - data ServerHasAgency st where - TokBusy :: ServerHasAgency 'StBusy - - data NobodyHasAgency st where - TokDone :: NobodyHasAgency 'StDone - - -- | Impossible cases. - exclusionLemma_ClientAndServerHaveAgency TokIdle tok = case tok of {} - exclusionLemma_NobodyAndClientHaveAgency TokDone tok = case tok of {} - exclusionLemma_NobodyAndServerHaveAgency TokDone tok = case tok of {} - -instance Show (Message DataPointForward from to) where - show MsgDataPointsRequest{} = "MsgDataPointsRequest" - show MsgDataPointsReply{} = "MsgDataPointsReply" - show MsgDone{} = "MsgDone" + type StateAgency 'StIdle = 'ClientAgency + type StateAgency 'StBusy = 'ServerAgency + type StateAgency 'StDone = 'NobodyAgency -instance Show (ClientHasAgency (st :: DataPointForward)) where - show TokIdle = "TokIdle" + type StateToken = SingDataPointForward -instance Show (ServerHasAgency (st :: DataPointForward)) where - show TokBusy{} = "TokBusy" +deriving + instance Show (Message DataPointForward from to) diff --git a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Acceptor.hs b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Acceptor.hs index 16b9ccddd36..4e5f567eede 100644 --- a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Acceptor.hs @@ -1,8 +1,10 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} -- | A view of the trace forwarding/accepting protocol -- from the point of view of the client. @@ -14,10 +16,12 @@ module Trace.Forward.Protocol.TraceObject.Acceptor , traceObjectAcceptorPeer ) where -import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..)) +import Data.Kind (Type) +import Network.TypedProtocol.Peer.Client import Trace.Forward.Protocol.TraceObject.Type +type TraceObjectAcceptor :: Type -> (Type -> Type) -> Type -> Type data TraceObjectAcceptor lo m a where SendMsgTraceObjectsRequest :: TokBlockingStyle blocking @@ -34,31 +38,31 @@ data TraceObjectAcceptor lo m a where traceObjectAcceptorPeer :: Monad m => TraceObjectAcceptor lo m a - -> Peer (TraceObjectForward lo) 'AsClient 'StIdle m a + -> Client (TraceObjectForward lo) 'NonPipelined 'StIdle m a traceObjectAcceptorPeer = \case SendMsgTraceObjectsRequest TokBlocking request next -> -- Send our message (request for new 'TraceObject's from the forwarder). - Yield (ClientAgency TokIdle) (MsgTraceObjectsRequest TokBlocking request) $ + Yield (MsgTraceObjectsRequest TokBlocking request) do -- We're now into the 'StBusy' state, and now we'll wait for a reply -- from the forwarder. - Await (ServerAgency (TokBusy TokBlocking)) $ \(MsgTraceObjectsReply reply) -> - Effect $ + Await \(MsgTraceObjectsReply reply) -> + Effect do traceObjectAcceptorPeer <$> next reply SendMsgTraceObjectsRequest TokNonBlocking request next -> -- Send our message (request for new 'TraceObject's from the forwarder). - Yield (ClientAgency TokIdle) (MsgTraceObjectsRequest TokNonBlocking request) $ + Yield (MsgTraceObjectsRequest TokNonBlocking request) do -- We're now into the 'StBusy' state, and now we'll wait for a reply -- from the forwarder. It is assuming that the forwarder will reply -- immediately (even there are no 'TraceObject's). - Await (ServerAgency (TokBusy TokNonBlocking)) $ \(MsgTraceObjectsReply reply) -> - Effect $ + Await \(MsgTraceObjectsReply reply) -> + Effect do traceObjectAcceptorPeer <$> next reply SendMsgDone getResult -> -- We do an actual transition using 'yield', to go from the 'StIdle' to -- 'StDone' state. Once in the 'StDone' state we can actually stop using -- 'done', with a return value. - Effect $ - Yield (ClientAgency TokIdle) MsgDone . Done TokDone + Effect do + Yield MsgDone . Done <$> getResult diff --git a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Codec.hs b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Codec.hs index 31fc7edea91..5af9b9be92d 100644 --- a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Codec.hs +++ b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Codec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} @@ -14,8 +15,7 @@ import Codec.CBOR.Read (DeserialiseFailure) import Control.Monad.Class.MonadST (MonadST) import qualified Data.ByteString.Lazy as LBS import qualified Data.List.NonEmpty as NE -import Network.TypedProtocol.Codec (Codec, PeerHasAgency (..), PeerRole (..), - SomeMessage (..)) +import Network.TypedProtocol.Codec (Codec, ActiveState, StateToken, notActiveState, SomeMessage (..)) import Network.TypedProtocol.Codec.CBOR (mkCodecCborLazyBS) import Text.Printf (printf) @@ -36,14 +36,13 @@ codecTraceObjectForward encodeRequest decodeRequest where -- Encode messages. encode - :: forall (pr :: PeerRole) - (st :: TraceObjectForward lo) + :: forall (st :: TraceObjectForward lo) (st' :: TraceObjectForward lo). - PeerHasAgency pr st - -> Message (TraceObjectForward lo) st st' + Message (TraceObjectForward lo) st st' -> CBOR.Encoding - encode (ClientAgency TokIdle) (MsgTraceObjectsRequest blocking request) = + + encode (MsgTraceObjectsRequest blocking request) = CBOR.encodeListLen 3 <> CBOR.encodeWord 1 <> CBOR.encodeBool (case blocking of @@ -51,11 +50,11 @@ codecTraceObjectForward encodeRequest decodeRequest TokNonBlocking -> False) <> encodeRequest request - encode (ClientAgency TokIdle) MsgDone = + encode MsgDone = CBOR.encodeListLen 1 <> CBOR.encodeWord 2 - encode (ServerAgency (TokBusy _)) (MsgTraceObjectsReply reply) = + encode (MsgTraceObjectsReply reply) = CBOR.encodeListLen 2 <> CBOR.encodeWord 3 <> encodeReplyList replyList @@ -67,15 +66,15 @@ codecTraceObjectForward encodeRequest decodeRequest -- Decode messages decode - :: forall (pr :: PeerRole) - (st :: TraceObjectForward lo) s. - PeerHasAgency pr st + :: forall (st :: TraceObjectForward lo) s. + ActiveState st + => StateToken st -> CBOR.Decoder s (SomeMessage st) - decode stok = do + decode stateToken = do len <- CBOR.decodeListLen key <- CBOR.decodeWord - case (key, len, stok) of - (1, 3, ClientAgency TokIdle) -> do + case (key, len, stateToken) of + (1, 3, SingIdle) -> do blocking <- CBOR.decodeBool request <- decodeRequest return $! @@ -84,10 +83,10 @@ codecTraceObjectForward encodeRequest decodeRequest else SomeMessage $ MsgTraceObjectsRequest TokNonBlocking request - (2, 1, ClientAgency TokIdle) -> + (2, 1, SingIdle) -> return $ SomeMessage MsgDone - (3, 2, ServerAgency (TokBusy blocking)) -> do + (3, 2, SingBusy blocking) -> do replyList <- decodeReplyList case (blocking, replyList) of (TokBlocking, x:xs) -> @@ -100,9 +99,10 @@ codecTraceObjectForward encodeRequest decodeRequest fail "codecTraceObjectForward: MsgTraceObjectsReply: empty list not permitted" -- Failures per protocol state - (_, _, ClientAgency TokIdle) -> - fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stok) key len) - (_, _, ServerAgency (TokBusy TokBlocking)) -> - fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stok) key len) - (_, _, ServerAgency (TokBusy TokNonBlocking)) -> - fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stok) key len) + (_, _, SingIdle) -> + fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stateToken) key len) + (_, _, SingBusy TokBlocking) -> + fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stateToken) key len) + (_, _, SingBusy TokNonBlocking) -> + fail (printf "codecTraceObjectForward (%s) unexpected key (%d, %d)" (show stateToken) key len) + (_, _, SingDone) -> notActiveState stateToken diff --git a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Forwarder.hs b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Forwarder.hs index 5e951308c6d..b003cac8a7a 100644 --- a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Forwarder.hs @@ -1,15 +1,19 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Trace.Forward.Protocol.TraceObject.Forwarder ( TraceObjectForwarder (..) , traceObjectForwarderPeer ) where -import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..)) +import Data.Singletons +import Network.TypedProtocol.Peer.Server +-- import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..)) import Trace.Forward.Protocol.TraceObject.Type @@ -30,24 +34,27 @@ data TraceObjectForwarder lo m a = TraceObjectForwarder -- | Interpret a particular action sequence into the server side of the protocol. -- traceObjectForwarderPeer - :: Monad m + :: forall m lo a + . Monad m => TraceObjectForwarder lo m a - -> Peer (TraceObjectForward lo) 'AsServer 'StIdle m a + -> Server (TraceObjectForward lo) 'NonPipelined 'StIdle m a traceObjectForwarderPeer TraceObjectForwarder{recvMsgTraceObjectsRequest, recvMsgDone} = go where - go = - -- In the 'StIdle' state the forwarder is awaiting a request message - -- from the acceptor. - Await (ClientAgency TokIdle) $ \case - -- The acceptor sent us a request for new 'TraceObject's, so now we're - -- in the 'StBusy' state which means it's the forwarder's turn to send - -- a reply. - MsgTraceObjectsRequest blocking request -> Effect $ do - reply <- recvMsgTraceObjectsRequest blocking request - return $ Yield (ServerAgency (TokBusy blocking)) - (MsgTraceObjectsReply reply) - go - - -- The acceptor sent the done transition, so we're in the 'StDone' state - -- so all we can do is stop using 'done', with a return value. - MsgDone -> Effect $ Done TokDone <$> recvMsgDone + go :: Server (TraceObjectForward lo) 'NonPipelined StIdle m a + go = + -- In the 'StIdle' state the forwarder is awaiting a request message + -- from the acceptor. + Await \case + -- The acceptor sent us a request for new 'TraceObject's, so now we're + -- in the 'StBusy' state which means it's the forwarder's turn to send + -- a reply. + MsgTraceObjectsRequest blocking request -> Effect do + reply <- recvMsgTraceObjectsRequest blocking request + pure do + withSingI blocking do + Yield (MsgTraceObjectsReply reply) go + + -- The acceptor sent the done transition, so we're in the 'StDone' state + -- so all we can do is stop using 'done', with a return value. + MsgDone -> Effect do + Done <$> recvMsgDone diff --git a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Type.hs b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Type.hs index 0419f268dcf..224996e8d29 100644 --- a/trace-forward/src/Trace/Forward/Protocol/TraceObject/Type.hs +++ b/trace-forward/src/Trace/Forward/Protocol/TraceObject/Type.hs @@ -1,11 +1,13 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeFamilies #-} -- | The type of the trace forwarding/accepting protocol. @@ -13,23 +15,23 @@ module Trace.Forward.Protocol.TraceObject.Type ( TraceObjectForward (..) + , SingTraceObjectForward(..) , TokBlockingStyle (..) , Message (..) - , ClientHasAgency (..) - , ServerHasAgency (..) - , NobodyHasAgency (..) , NumberOfTraceObjects (..) , BlockingReplyList (..) + , StBlockingStyle(..) ) where import Ouroboros.Network.Util.ShowProxy (ShowProxy (..)) +import Data.Kind (Type) +import Data.Singletons import Codec.Serialise (Serialise (..)) import Data.List.NonEmpty (NonEmpty) -import Data.Proxy (Proxy (..)) import Data.Word (Word16) import GHC.Generics (Generic) -import Network.TypedProtocol.Core (Protocol (..)) +import Network.TypedProtocol.Core -- (Protocol (..)) -- | A kind to identify our protocol, and the types of the states in the state -- transition diagram of the protocol. @@ -49,10 +51,11 @@ import Network.TypedProtocol.Core (Protocol (..)) -- | The acceptor will send this request to the forwarder. newtype NumberOfTraceObjects = NumberOfTraceObjects { nTraceObjects :: Word16 - } deriving (Eq, Generic, Show) - -instance ShowProxy NumberOfTraceObjects -instance Serialise NumberOfTraceObjects + } + deriving stock + (Eq, Generic, Show) + deriving anyclass + (ShowProxy, Serialise) data TraceObjectForward lo where @@ -84,6 +87,13 @@ instance (ShowProxy lo) , ")" ] +-- | Singleton type of TraceObjectForward. +type SingTraceObjectForward :: TraceObjectForward lo -> Type +data SingTraceObjectForward traceObj where + SingIdle :: SingTraceObjectForward 'StIdle + SingBusy :: TokBlockingStyle blockStyle -> SingTraceObjectForward ('StBusy blockStyle) + SingDone :: SingTraceObjectForward 'StDone + data StBlockingStyle where -- | In this sub-state the reply need not be prompt. There is no timeout. StBlocking :: StBlockingStyle @@ -101,6 +111,18 @@ data TokBlockingStyle (k :: StBlockingStyle) where deriving instance Eq (TokBlockingStyle b) deriving instance Show (TokBlockingStyle b) +type instance Sing = SingTraceObjectForward +type instance Sing = TokBlockingStyle + +deriving stock + instance Show (SingTraceObjectForward traceObj) +instance StateTokenI 'StIdle where stateToken = SingIdle +instance StateTokenI 'StDone where stateToken = SingDone +instance SingI blockStyle => StateTokenI ('StBusy blockStyle) where stateToken = SingBusy sing + +instance SingI 'StBlocking where sing = TokBlocking +instance SingI 'StNonBlocking where sing = TokNonBlocking + -- | We have requests for lists of things. In the blocking case the -- corresponding reply must be non-empty, whereas in the non-blocking case -- an empty reply is fine. @@ -154,28 +176,11 @@ instance Protocol (TraceObjectForward lo) where -- 1. ClientHasAgency (from 'Network.TypedProtocol.Core') corresponds to acceptor's agency. -- 3. ServerHasAgency (from 'Network.TypedProtocol.Core') corresponds to forwarder's agency. -- - data ClientHasAgency st where - TokIdle :: ClientHasAgency 'StIdle - - data ServerHasAgency st where - TokBusy :: TokBlockingStyle blocking -> ServerHasAgency ('StBusy blocking) - - data NobodyHasAgency st where - TokDone :: NobodyHasAgency 'StDone - - -- | Impossible cases. - exclusionLemma_ClientAndServerHaveAgency TokIdle tok = case tok of {} - exclusionLemma_NobodyAndClientHaveAgency TokDone tok = case tok of {} - exclusionLemma_NobodyAndServerHaveAgency TokDone tok = case tok of {} - -instance Show lo - => Show (Message (TraceObjectForward lo) from to) where - show MsgTraceObjectsRequest{} = "MsgTraceObjectsRequest" - show MsgTraceObjectsReply{} = "MsgTraceObjectsReply" - show MsgDone{} = "MsgDone" + type StateAgency 'StIdle = 'ClientAgency + type StateAgency ('StBusy blocking) = 'ServerAgency + type StateAgency 'StDone = 'NobodyAgency -instance Show (ClientHasAgency (st :: TraceObjectForward lo)) where - show TokIdle = "TokIdle" + type StateToken = SingTraceObjectForward -instance Show (ServerHasAgency (st :: TraceObjectForward lo)) where - show TokBusy{} = "TokBusy" +deriving stock + instance Show lo => Show (Message (TraceObjectForward lo) from to) diff --git a/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Codec.hs b/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Codec.hs index 7162a7c4d3f..30c0af3491a 100644 --- a/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Codec.hs +++ b/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Codec.hs @@ -12,12 +12,12 @@ import Test.Trace.Forward.Protocol.DataPoint.Item import Trace.Forward.Protocol.DataPoint.Type -instance Arbitrary (AnyMessageAndAgency DataPointForward) where +instance Arbitrary (AnyMessage DataPointForward) where arbitrary = oneof - [ pure $ AnyMessageAndAgency (ClientAgency TokIdle) (MsgDataPointsRequest ["NodeInfo"]) - , pure $ AnyMessageAndAgency (ServerAgency TokBusy) (MsgDataPointsReply [("NodeInfo", Nothing)]) - , pure $ AnyMessageAndAgency (ServerAgency TokBusy) (MsgDataPointsReply [("NodeInfo", Just ni)]) - , pure $ AnyMessageAndAgency (ClientAgency TokIdle) MsgDone + [ pure $ AnyMessage (MsgDataPointsRequest ["NodeInfo"]) + , pure $ AnyMessage (MsgDataPointsReply [("NodeInfo", Nothing)]) + , pure $ AnyMessage (MsgDataPointsReply [("NodeInfo", Just ni)]) + , pure $ AnyMessage MsgDone ] where ni = A.encode $ TestNodeInfo diff --git a/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Tests.hs b/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Tests.hs index 386ec12b607..59d8b9ad487 100644 --- a/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Tests.hs +++ b/trace-forward/test/Test/Trace/Forward/Protocol/DataPoint/Tests.hs @@ -44,7 +44,7 @@ tests = testGroup "Trace.Forward.Protocol.DataPoint" ] prop_codec_DataPointForward - :: AnyMessageAndAgency DataPointForward + :: AnyMessage DataPointForward -> Bool prop_codec_DataPointForward msg = runST $ prop_codecM @@ -53,7 +53,7 @@ prop_codec_DataPointForward msg = runST $ msg prop_codec_splits2_DataPointForward - :: AnyMessageAndAgency DataPointForward + :: AnyMessage DataPointForward -> Bool prop_codec_splits2_DataPointForward msg = runST $ prop_codec_splitsM @@ -64,7 +64,7 @@ prop_codec_splits2_DataPointForward msg = runST $ prop_codec_splits3_DataPointForward - :: AnyMessageAndAgency DataPointForward + :: AnyMessage DataPointForward -> Bool prop_codec_splits3_DataPointForward msg = runST $ prop_codec_splitsM @@ -108,7 +108,7 @@ prop_connect f n = do forwarder <- dataPointForwarderPeer <$> dataPointForwarderCount result <- connect forwarder (dataPointAcceptorPeer $ dataPointAcceptorApply f 0 n) case result of - (s, c, TerminalStates TokDone TokDone) -> + (s, c, TerminalStates SingDone SingDone) -> pure $ (s, c) == (n, foldr ($) 0 (replicate n f)) prop_channel diff --git a/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Codec.hs b/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Codec.hs index c5d4176dfbe..fb3aeaa8e25 100644 --- a/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Codec.hs +++ b/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Codec.hs @@ -17,13 +17,13 @@ instance Arbitrary NumberOfTraceObjects where , pure $ NumberOfTraceObjects 100 ] -instance Arbitrary (AnyMessageAndAgency (TraceObjectForward TraceItem)) where +instance Arbitrary (AnyMessage (TraceObjectForward TraceItem)) where arbitrary = oneof - [ AnyMessageAndAgency (ClientAgency TokIdle) . MsgTraceObjectsRequest TokBlocking <$> arbitrary - , AnyMessageAndAgency (ClientAgency TokIdle) . MsgTraceObjectsRequest TokNonBlocking <$> arbitrary - , AnyMessageAndAgency (ServerAgency (TokBusy TokBlocking)) . MsgTraceObjectsReply . BlockingReply <$> arbitrary - , AnyMessageAndAgency (ServerAgency (TokBusy TokNonBlocking)) . MsgTraceObjectsReply . NonBlockingReply <$> arbitrary - , pure $ AnyMessageAndAgency (ClientAgency TokIdle) MsgDone + [ AnyMessage . MsgTraceObjectsRequest TokBlocking <$> arbitrary + , AnyMessage . MsgTraceObjectsRequest TokNonBlocking <$> arbitrary + , AnyMessage . MsgTraceObjectsReply . BlockingReply <$> arbitrary + , AnyMessage . MsgTraceObjectsReply . NonBlockingReply <$> arbitrary + , pure $ AnyMessage MsgDone ] instance Eq (AnyMessage (TraceObjectForward TraceItem)) where diff --git a/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Tests.hs b/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Tests.hs index 40a315d75e3..67ecbe9741f 100644 --- a/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Tests.hs +++ b/trace-forward/test/Test/Trace/Forward/Protocol/TraceObject/Tests.hs @@ -43,7 +43,7 @@ tests = testGroup "Trace.Forward.Protocol.TraceObject" , testProperty "channel IO" prop_channel_IO_TraceObjectForward ] -prop_codec_TraceObjectForward :: AnyMessageAndAgency (TraceObjectForward TraceItem) -> Bool +prop_codec_TraceObjectForward :: AnyMessage (TraceObjectForward TraceItem) -> Bool prop_codec_TraceObjectForward msg = runST $ prop_codecM (codecTraceObjectForward CBOR.encode CBOR.decode @@ -51,7 +51,7 @@ prop_codec_TraceObjectForward msg = runST $ msg prop_codec_splits2_TraceObjectForward - :: AnyMessageAndAgency (TraceObjectForward TraceItem) + :: AnyMessage (TraceObjectForward TraceItem) -> Bool prop_codec_splits2_TraceObjectForward msg = runST $ prop_codec_splitsM @@ -61,7 +61,7 @@ prop_codec_splits2_TraceObjectForward msg = runST $ msg prop_codec_splits3_TraceObjectForward - :: AnyMessageAndAgency (TraceObjectForward TraceItem) + :: AnyMessage (TraceObjectForward TraceItem) -> Bool prop_codec_splits3_TraceObjectForward msg = runST $ prop_codec_splitsM @@ -105,7 +105,7 @@ prop_connect f n = do forwarder <- traceObjectForwarderPeer <$> traceObjectForwarderCount result <- connect forwarder (traceObjectAcceptorPeer $ traceObjectAcceptorApply f 0 n) case result of - (s, c, TerminalStates TokDone TokDone) -> + (s, c, TerminalStates SingDone SingDone) -> pure $ (s, c) == (n, foldr ($) 0 (replicate n f)) prop_channel diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index fbce68d6d9a..311e14ca8d9 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -64,12 +64,13 @@ library , deepseq , extra , io-classes - , ouroboros-network-api ^>= 0.10 - , ouroboros-network-framework + , ouroboros-network-api + , singletons ^>= 3.0 + , ouroboros-network-framework ^>= 0.14 , serialise , stm , text - , typed-protocols ^>= 0.1 + , typed-protocols ^>= 0.3 , typed-protocols-cborg test-suite test From ad069aab6f474cc787db14295a802d75f373ee0e Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 15:52:23 -0700 Subject: [PATCH 07/79] trace-resources: update version bound in cardano-node --- cardano-node/cardano-node.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index ea3dc4d9a85..5b8460efa04 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -209,7 +209,7 @@ library , time , trace-dispatcher ^>= 2.7.0 , trace-forward ^>= 2.2.8 - , trace-resources ^>= 0.2.2 + , trace-resources ^>= 0.2.3 , tracer-transformers , transformers , transformers-except From 4e01a8536d4e6a98aa1690a9ef51e78f6113e74d Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 08:23:06 -0700 Subject: [PATCH 08/79] plutus upgrade: use emptyMintValue instead of mempty --- 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 e2f8f25acbd..9a2d1bad7c2 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -259,7 +259,7 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri { PlutusV3.txInfoInputs = [] , PlutusV3.txInfoOutputs = [] , PlutusV3.txInfoFee = 0 - , PlutusV3.txInfoMint = mempty + , PlutusV3.txInfoMint = PlutusV3.emptyMintValue , PlutusV3.txInfoTxCerts = [] , PlutusV3.txInfoWdrl = PlutusV3.unsafeFromList [] , PlutusV3.txInfoValidRange = PlutusV3.always From 11578e23704afe85c36a9f05325320697dea294d Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 09:40:43 -0700 Subject: [PATCH 09/79] plutus upgrade: increase plutus version bounds to 1.37 --- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index b548ac79948..ad0fa7a099f 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.1 - , plutus-ledger-api ^>=1.36 - , plutus-tx ^>=1.36 - , plutus-tx-plugin ^>=1.36 + , plutus-ledger-api ^>=1.37 + , plutus-tx ^>=1.37 + , plutus-tx-plugin ^>=1.37 ------------------------ -- Non-IOG dependencies From 3390c1c217e2955ba4ff4462ac78130c8ced5e2d Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 16:15:15 -0700 Subject: [PATCH 10/79] cardano-ledger upgrade: remove temporary version bounds --- cardano-node/cardano-node.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 5b8460efa04..22982e77212 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -155,8 +155,7 @@ library , cardano-ledger-babbage , cardano-ledger-binary , cardano-ledger-byron - -- TODO: remove constraint at next ledger bump - , cardano-ledger-conway ^>= 1.17.4 + , cardano-ledger-conway , cardano-ledger-core , cardano-ledger-shelley , cardano-prelude From d7b109a1a978e58fbf2428f998faa5288cf617cd Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 16:20:29 -0700 Subject: [PATCH 11/79] cardano-ledger upgrade: adjust to removed constructors --- cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs | 5 ----- cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs | 5 ----- 2 files changed, 10 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index b00ebe1c2d1..139df0daead 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -625,11 +625,6 @@ instance , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential already registered" ] - forMachine _dtal (StakeKeyInRewardsDELEG alreadyRegistered) = - mconcat [ "kind" .= String "StakeKeyInRewardsDELEG" - , "credential" .= String (textShow alreadyRegistered) - , "error" .= String "Staking credential registered in rewards map" - ] forMachine _dtal (StakeKeyNotRegisteredDELEG notRegistered) = mconcat [ "kind" .= String "StakeKeyNotRegisteredDELEG" , "credential" .= String (textShow notRegistered) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 4d93eaea489..ac310d88f11 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -723,11 +723,6 @@ instance Ledger.Era era => ToObject (ShelleyDelegPredFailure era) where , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential already registered" ] - toObject _verb (StakeKeyInRewardsDELEG alreadyRegistered) = - mconcat [ "kind" .= String "StakeKeyInRewardsDELEG" - , "credential" .= String (textShow alreadyRegistered) - , "error" .= String "Staking credential registered in rewards map" - ] toObject _verb (StakeKeyNotRegisteredDELEG notRegistered) = mconcat [ "kind" .= String "StakeKeyNotRegisteredDELEG" , "credential" .= String (textShow notRegistered) From e0786fdec7215837118fe638c7603576b32a5980 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 17:04:37 -0700 Subject: [PATCH 12/79] cardano-ledger upgrade: adjust to use of Mismatch in predicate failures --- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 182 +++++++++--------- .../Tracing/OrphanInstances/Shelley.hs | 182 +++++++++--------- 2 files changed, 182 insertions(+), 182 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 139df0daead..c78efb0ec04 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -131,10 +131,10 @@ instance LogFormatting (Conway.ConwayGovCertPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "DRep is not registered" ] - Conway.ConwayDRepIncorrectDeposit givenCoin expectedCoin -> + Conway.ConwayDRepIncorrectDeposit Mismatch {mismatchSupplied, mismatchExpected} -> [ "kind" .= String "ConwayDRepIncorrectDeposit" - , "givenCoin" .= givenCoin - , "expectedCoin" .= expectedCoin + , "givenCoin" .= mismatchSupplied + , "expectedCoin" .= mismatchExpected , "error" .= String "DRep delegation has incorrect deposit" ] Conway.ConwayCommitteeHasPreviouslyResigned coldCred -> @@ -147,10 +147,10 @@ instance LogFormatting (Conway.ConwayGovCertPredFailure era) where , "credential" .= String (textShow coldCred) , "error" .= String "Committee is Unknown" ] - Conway.ConwayDRepIncorrectRefund givenRefund expectedRefund -> + Conway.ConwayDRepIncorrectRefund Mismatch {mismatchSupplied, mismatchExpected} -> [ "kind" .= String "ConwayDRepIncorrectRefund" - , "givenRefund" .= givenRefund - , "expectedRefund" .= expectedRefund + , "givenRefund" .= mismatchSupplied + , "expectedRefund" .= mismatchExpected , "error" .= String "Refunds mismatch" ] @@ -360,10 +360,10 @@ instance , "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList received) ] - forMachine _ (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) = + forMachine _ (PPViewHashesDontMatch Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "PPViewHashesDontMatch" - , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) - , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) + , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] forMachine _ (MissingRequiredSigners missingKeyWitnesses) = mconcat [ "kind" .= String "MissingRequiredSigners" @@ -448,10 +448,10 @@ instance , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] - forMachine _dtal (ExpiredUTxO ttl slot) = + forMachine _dtal (ExpiredUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ExpiredUTxO" - , "ttl" .= ttl - , "slot" .= slot ] + , "ttl" .= mismatchSupplied + , "slot" .= mismatchExpected ] forMachine _dtal (MaxTxSizeUTxO (Mismatch { mismatchSupplied = txsize , mismatchExpected = maxtxsize })) = mconcat [ "kind" .= String "MaxTxSizeUTxO" @@ -481,11 +481,11 @@ instance mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] - forMachine _dtal (ValueNotConservedUTxO consumed produced) = + forMachine _dtal (ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] forMachine dtal (UpdateFailure f) = forMachine dtal f @@ -514,21 +514,21 @@ instance mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validityInterval , "slot" .= slot ] - forMachine _dtal (Allegra.MaxTxSizeUTxO txsize maxtxsize) = + forMachine _dtal (Allegra.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize ] + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] forMachine _dtal Allegra.InputSetEmptyUTxO = mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - forMachine _dtal (Allegra.FeeTooSmallUTxO minfee txfee) = + forMachine _dtal (Allegra.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= txfee ] - forMachine _dtal (Allegra.ValueNotConservedUTxO consumed produced) = + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] + forMachine _dtal (Allegra.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] forMachine _dtal (Allegra.WrongNetwork network addrs) = mconcat [ "kind" .= String "WrongNetwork" @@ -651,18 +651,18 @@ instance , "duplicateKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key has already been delegated to" ] - forMachine _dtal (InsufficientForInstantaneousRewardsDELEG mirpot neededMirAmount reserves) = + forMachine _dtal (InsufficientForInstantaneousRewardsDELEG mirpot Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") - , "neededAmount" .= neededMirAmount - , "reserves" .= reserves + , "neededAmount" .= mismatchSupplied + , "reserves" .= mismatchExpected ] - forMachine _dtal (MIRCertificateTooLateinEpochDELEG currSlot boundSlotNo) = + forMachine _dtal (MIRCertificateTooLateinEpochDELEG Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" - , "currentSlotNo" .= currSlot - , "mustBeSubmittedBeforeSlotNo" .= boundSlotNo + , "currentSlotNo" .= mismatchSupplied + , "mustBeSubmittedBeforeSlotNo" .= mismatchExpected ] forMachine _dtal (DuplicateGenesisVRFDELEG vrfKeyHash) = mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" @@ -674,13 +674,13 @@ instance forMachine _dtal MIRNegativesNotCurrentlyAllowed = mconcat [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" ] - forMachine _dtal (InsufficientForTransferDELEG mirpot attempted available) = + forMachine _dtal (InsufficientForTransferDELEG mirpot Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") - , "attempted" .= attempted - , "available" .= available + , "attempted" .= mismatchSupplied + , "available" .= mismatchExpected ] forMachine _dtal MIRProducesNegativeUpdate = mconcat [ "kind" .= String "MIRProducesNegativeUpdate" @@ -914,23 +914,23 @@ instance , "validityInterval" .= validtyInterval , "slot" .= slot ] - forMachine _dtal (Alonzo.MaxTxSizeUTxO txsize maxtxsize) = + forMachine _dtal (Alonzo.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] forMachine _dtal Alonzo.InputSetEmptyUTxO = mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - forMachine _dtal (Alonzo.FeeTooSmallUTxO minfee currentFee) = + forMachine _dtal (Alonzo.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= currentFee + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] - forMachine _dtal (Alonzo.ValueNotConservedUTxO consumed produced) = + forMachine _dtal (Alonzo.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] forMachine _dtal (Alonzo.WrongNetwork network addrs) = mconcat [ "kind" .= String "WrongNetwork" @@ -975,28 +975,28 @@ instance mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] - forMachine _dtal (Alonzo.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits) = + forMachine _dtal (Alonzo.ExUnitsTooBigUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ExUnitsTooBigUTxO" - , "maxexunits" .= pParamsMaxExUnits - , "exunits" .= suppliedExUnits + , "maxexunits" .= mismatchExpected + , "exunits" .= mismatchSupplied ] forMachine _dtal (Alonzo.CollateralContainsNonADA inputs) = mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] - forMachine _dtal (Alonzo.WrongNetworkInTxBody actualNetworkId netIdInTxBody) = + forMachine _dtal (Alonzo.WrongNetworkInTxBody Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "WrongNetworkInTxBody" - , "networkid" .= actualNetworkId - , "txbodyNetworkId" .= netIdInTxBody + , "networkid" .= mismatchExpected + , "txbodyNetworkId" .= mismatchSupplied ] forMachine _dtal (Alonzo.OutsideForecast slotNum) = mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] - forMachine _dtal (Alonzo.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs) = + forMachine _dtal (Alonzo.TooManyCollateralInputs Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "TooManyCollateralInputs" - , "max" .= maxCollateralInputs - , "inputs" .= numberCollateralInputs + , "max" .= mismatchExpected + , "inputs" .= mismatchSupplied ] forMachine _dtal Alonzo.NoCollateralInputs = mconcat [ "kind" .= String "NoCollateralInputs" ] @@ -1101,18 +1101,18 @@ instance , LogFormatting (NonEmpty.NonEmpty (KeyHash 'Staking (Ledger.EraCrypto era))) ) => LogFormatting (Conway.ConwayLedgerPredFailure era) where forMachine v (Conway.ConwayUtxowFailure f) = forMachine v f - forMachine _ (Conway.ConwayTxRefScriptsSizeTooBig actual limit) = + forMachine _ (Conway.ConwayTxRefScriptsSizeTooBig Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ConwayTxRefScriptsSizeTooBig" - , "actual" .= actual - , "limit" .= limit + , "actual" .= mismatchSupplied + , "limit" .= mismatchExpected ] forMachine v (Conway.ConwayCertsFailure f) = forMachine v f forMachine v (Conway.ConwayGovFailure f) = forMachine v f forMachine v (Conway.ConwayWdrlNotDelegatedToDRep f) = forMachine v f - forMachine _ (Conway.ConwayTreasuryValueMismatch actual inTx) = + forMachine _ (Conway.ConwayTreasuryValueMismatch Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ConwayTreasuryValueMismatch" - , "actual" .= actual - , "submittedInTx" .= inTx + , "actual" .= mismatchExpected + , "submittedInTx" .= mismatchSupplied ] forMachine _ (Conway.ConwayMempoolFailure message) = mconcat [ "kind" .= String "ConwayMempoolFailure" @@ -1140,10 +1140,10 @@ instance , "rewardAccounts" .= toJSON rewardAcnts , "expectedNetworkId" .= toJSON network ] - forMachine _ (Conway.ProposalDepositIncorrect deposit expectedDeposit) = + forMachine _ (Conway.ProposalDepositIncorrect Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ProposalDepositIncorrect" - , "deposit" .= deposit - , "expectedDeposit" .= expectedDeposit + , "deposit" .= mismatchSupplied + , "expectedDeposit" .= mismatchExpected ] forMachine _ (Conway.DisallowedVoters govActionIdToVoter) = mconcat [ "kind" .= String "DisallowedVoters" @@ -1169,11 +1169,11 @@ instance mconcat [ "kind" .= String "VotingOnExpiredGovAction" , "action" .= actions ] - forMachine _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) = + forMachine _ (Conway.ProposalCantFollow prevGovActionId Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ProposalCantFollow" , "prevGovActionId" .= prevGovActionId - , "protVer" .= protVer - , "prevProtVer" .= prevProtVer + , "protVer" .= mismatchSupplied + , "prevProtVer" .= mismatchExpected ] forMachine _ (Conway.InvalidPolicyHash actualPolicyHash expectedPolicyHash) = mconcat [ "kind" .= String "InvalidPolicyHash" @@ -1361,23 +1361,23 @@ instance , "validityInterval" .= validityInterval , "slot" .= slot ] - Conway.MaxTxSizeUTxO txsize maxtxsize -> + Conway.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] Conway.InputSetEmptyUTxO -> mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - Conway.FeeTooSmallUTxO minfee txfee -> + Conway.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= txfee + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] - Conway.ValueNotConservedUTxO consumed produced -> + Conway.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] Conway.WrongNetwork network addrs -> mconcat [ "kind" .= String "WrongNetwork" @@ -1418,28 +1418,28 @@ instance mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] - Conway.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits -> + Conway.ExUnitsTooBigUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ExUnitsTooBigUTxO" - , "maxexunits" .= pParamsMaxExUnits - , "exunits" .= suppliedExUnits + , "maxexunits" .= mismatchExpected + , "exunits" .= mismatchSupplied ] Conway.CollateralContainsNonADA inputs -> mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] - Conway.WrongNetworkInTxBody actualNetworkId netIdInTxBody -> + Conway.WrongNetworkInTxBody Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "WrongNetworkInTxBody" - , "networkid" .= actualNetworkId - , "txbodyNetworkId" .= netIdInTxBody + , "networkid" .= mismatchExpected + , "txbodyNetworkId" .= mismatchSupplied ] Conway.OutsideForecast slotNum -> mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] - Conway.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs -> + Conway.TooManyCollateralInputs Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "TooManyCollateralInputs" - , "max" .= maxCollateralInputs - , "inputs" .= numberCollateralInputs + , "max" .= mismatchExpected + , "inputs" .= mismatchSupplied ] Conway.NoCollateralInputs -> mconcat [ "kind" .= String "NoCollateralInputs" ] @@ -1490,10 +1490,10 @@ instance mconcat [ "kind" .= String "MissingTxMetadata" , "txBodyMetadataHash" .= hash ] - Conway.ConflictingMetadataHash txBodyMetadataHash fullMetadataHash -> + Conway.ConflictingMetadataHash Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ConflictingMetadataHash" - , "txBodyMetadataHash" .= txBodyMetadataHash - , "fullMetadataHash" .= fullMetadataHash + , "txBodyMetadataHash" .= mismatchSupplied + , "fullMetadataHash" .= mismatchExpected ] Conway.InvalidMetadata -> mconcat [ "kind" .= String "InvalidMetadata" @@ -1518,10 +1518,10 @@ instance , "disallowed" .= Set.toList disallowed , "acceptable" .= Set.toList acceptable ] - Conway.PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams -> + Conway.PPViewHashesDontMatch Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "PPViewHashesDontMatch" - , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) - , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) + , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] Conway.UnspendableUTxONoDatumHash ins -> mconcat [ "kind" .= String "MissingRequiredSigners" diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index ac310d88f11..d16ce30d5f5 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -170,10 +170,10 @@ instance ToObject (Conway.ConwayGovCertPredFailure era) where , "credential" .= String (textShow credential) , "error" .= String "DRep is not registered" ] - Conway.ConwayDRepIncorrectDeposit givenCoin expectedCoin -> + Conway.ConwayDRepIncorrectDeposit Mismatch {mismatchSupplied, mismatchExpected} -> [ "kind" .= String "ConwayDRepIncorrectDeposit" - , "givenCoin" .= givenCoin - , "expectedCoin" .= expectedCoin + , "givenCoin" .= mismatchSupplied + , "expectedCoin" .= mismatchExpected , "error" .= String "DRep delegation has incorrect deposit" ] Conway.ConwayCommitteeHasPreviouslyResigned kHash -> @@ -186,10 +186,10 @@ instance ToObject (Conway.ConwayGovCertPredFailure era) where , "credential" .= String (textShow kHash) , "error" .= String "Committee is Unknown" ] - Conway.ConwayDRepIncorrectRefund givenRefund expectedRefund -> + Conway.ConwayDRepIncorrectRefund Mismatch {mismatchSupplied, mismatchExpected} -> [ "kind" .= String "ConwayDRepIncorrectRefund" - , "givenRefund" .= String (textShow givenRefund) - , "expectedRefund" .= String (textShow expectedRefund) + , "givenRefund" .= String (textShow mismatchSupplied) + , "expectedRefund" .= String (textShow mismatchExpected) , "error" .= String "Refund given does not match the expected one" ] @@ -325,18 +325,18 @@ instance , ToObject (NonEmpty.NonEmpty (KeyHash 'Staking (Consensus.EraCrypto ledgerera))) ) => ToObject (Conway.ConwayLedgerPredFailure ledgerera) where toObject verb (Conway.ConwayUtxowFailure f) = toObject verb f - toObject _ (Conway.ConwayTxRefScriptsSizeTooBig actual limit) = + toObject _ (Conway.ConwayTxRefScriptsSizeTooBig Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ConwayTxRefScriptsSizeTooBig" - , "actual" .= actual - , "limit" .= limit + , "actual" .= mismatchSupplied + , "limit" .= mismatchExpected ] toObject verb (Conway.ConwayCertsFailure f) = toObject verb f toObject verb (Conway.ConwayGovFailure f) = toObject verb f toObject verb (Conway.ConwayWdrlNotDelegatedToDRep f) = toObject verb f - toObject _ (Conway.ConwayTreasuryValueMismatch actual inTx) = + toObject _ (Conway.ConwayTreasuryValueMismatch Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ConwayTreasuryValueMismatch" - , "actual" .= actual - , "submittedInTx" .= inTx + , "actual" .= mismatchExpected + , "submittedInTx" .= mismatchSupplied ] toObject _ (Conway.ConwayMempoolFailure msg) = mconcat [ "kind" .= String "ConwayMempoolFailure" @@ -363,10 +363,10 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe , "rewardAccounts" .= toJSON rewardAcnts , "expectedNetworkId" .= toJSON network ] - toObject _ (Conway.ProposalDepositIncorrect deposit expectedDeposit) = + toObject _ (Conway.ProposalDepositIncorrect Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ProposalDepositIncorrect" - , "deposit" .= deposit - , "expectedDeposit" .= expectedDeposit + , "deposit" .= mismatchSupplied + , "expectedDeposit" .= mismatchExpected ] toObject _ (Conway.DisallowedVoters govActionIdToVoter) = mconcat [ "kind" .= String "DisallowedVoters" @@ -392,11 +392,11 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe mconcat [ "kind" .= String "VotingOnExpiredGovAction" , "action" .= actions ] - toObject _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) = + toObject _ (Conway.ProposalCantFollow prevGovActionId Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ProposalCantFollow" , "prevGovActionId" .= prevGovActionId - , "protVer" .= protVer - , "prevProtVer" .= prevProtVer + , "protVer" .= mismatchSupplied + , "prevProtVer" .= mismatchExpected ] toObject _ (Conway.InvalidPolicyHash actualPolicyHash expectedPolicyHash) = mconcat [ "kind" .= String "InvalidPolicyHash" @@ -461,10 +461,10 @@ instance , "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList received) ] - toObject _ (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) = + toObject _ (PPViewHashesDontMatch Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "PPViewHashesDontMatch" - , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) - , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) + , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] toObject _ (MissingRequiredSigners missingKeyWitnesses) = mconcat [ "kind" .= String "MissingRequiredSigners" @@ -551,10 +551,10 @@ instance , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] - toObject _verb (ExpiredUTxO ttl slot) = + toObject _verb (ExpiredUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ExpiredUTxO" - , "ttl" .= ttl - , "slot" .= slot ] + , "ttl" .= mismatchSupplied + , "slot" .= mismatchExpected ] toObject _verb (MaxTxSizeUTxO (Mismatch { mismatchSupplied = txsize , mismatchExpected = maxtxsize })) = mconcat [ "kind" .= String "MaxTxSizeUTxO" @@ -583,11 +583,11 @@ instance mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] - toObject _verb (ValueNotConservedUTxO consumed produced) = + toObject _verb (ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] toObject verb (UpdateFailure f) = toObject verb f @@ -618,21 +618,21 @@ instance mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validityInterval , "slot" .= slot ] - toObject _verb (Allegra.MaxTxSizeUTxO txsize maxtxsize) = + toObject _verb (Allegra.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize ] + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] toObject _verb Allegra.InputSetEmptyUTxO = mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - toObject _verb (Allegra.FeeTooSmallUTxO minfee txfee) = + toObject _verb (Allegra.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= txfee ] - toObject _verb (Allegra.ValueNotConservedUTxO consumed produced) = + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] + toObject _verb (Allegra.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] toObject _verb (Allegra.WrongNetwork network addrs) = mconcat [ "kind" .= String "WrongNetwork" @@ -749,18 +749,18 @@ instance Ledger.Era era => ToObject (ShelleyDelegPredFailure era) where , "duplicateKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key has already been delegated to" ] - toObject _verb (InsufficientForInstantaneousRewardsDELEG mirpot neededMirAmount reserves) = + toObject _verb (InsufficientForInstantaneousRewardsDELEG mirpot Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") - , "neededAmount" .= neededMirAmount - , "reserves" .= reserves + , "neededAmount" .= mismatchSupplied + , "reserves" .= mismatchExpected ] - toObject _verb (MIRCertificateTooLateinEpochDELEG currSlot boundSlotNo) = + toObject _verb (MIRCertificateTooLateinEpochDELEG Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" - , "currentSlotNo" .= currSlot - , "mustBeSubmittedBeforeSlotNo" .= boundSlotNo + , "currentSlotNo" .= mismatchSupplied + , "mustBeSubmittedBeforeSlotNo" .= mismatchExpected ] toObject _verb (DuplicateGenesisVRFDELEG vrfKeyHash) = mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" @@ -772,13 +772,13 @@ instance Ledger.Era era => ToObject (ShelleyDelegPredFailure era) where toObject _verb MIRNegativesNotCurrentlyAllowed = mconcat [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" ] - toObject _verb (InsufficientForTransferDELEG mirpot attempted available) = + toObject _verb (InsufficientForTransferDELEG mirpot Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") - , "attempted" .= attempted - , "available" .= available + , "attempted" .= mismatchSupplied + , "available" .= mismatchExpected ] toObject _verb MIRProducesNegativeUpdate = mconcat [ "kind" .= String "MIRProducesNegativeUpdate" @@ -1066,23 +1066,23 @@ instance , "validityInterval" .= validtyInterval , "slot" .= slot ] - toObject _verb (Alonzo.MaxTxSizeUTxO txsize maxtxsize) = + toObject _verb (Alonzo.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] toObject _verb Alonzo.InputSetEmptyUTxO = mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - toObject _verb (Alonzo.FeeTooSmallUTxO minfee currentFee) = + toObject _verb (Alonzo.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= currentFee + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] - toObject _verb (Alonzo.ValueNotConservedUTxO consumed produced) = + toObject _verb (Alonzo.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] toObject _verb (Alonzo.WrongNetwork network addrs) = mconcat [ "kind" .= String "WrongNetwork" @@ -1127,28 +1127,28 @@ instance mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] - toObject _verb (Alonzo.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits) = + toObject _verb (Alonzo.ExUnitsTooBigUTxO Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "ExUnitsTooBigUTxO" - , "maxexunits" .= pParamsMaxExUnits - , "exunits" .= suppliedExUnits + , "maxexunits" .= mismatchExpected + , "exunits" .= mismatchSupplied ] toObject _verb (Alonzo.CollateralContainsNonADA inputs) = mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] - toObject _verb (Alonzo.WrongNetworkInTxBody actualNetworkId netIdInTxBody) = + toObject _verb (Alonzo.WrongNetworkInTxBody Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "WrongNetworkInTxBody" - , "networkid" .= actualNetworkId - , "txbodyNetworkId" .= netIdInTxBody + , "networkid" .= mismatchExpected + , "txbodyNetworkId" .= mismatchSupplied ] toObject _verb (Alonzo.OutsideForecast slotNum) = mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] - toObject _verb (Alonzo.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs) = + toObject _verb (Alonzo.TooManyCollateralInputs Mismatch {mismatchSupplied, mismatchExpected}) = mconcat [ "kind" .= String "TooManyCollateralInputs" - , "max" .= maxCollateralInputs - , "inputs" .= numberCollateralInputs + , "max" .= mismatchExpected + , "inputs" .= mismatchSupplied ] toObject _verb Alonzo.NoCollateralInputs = mconcat [ "kind" .= String "NoCollateralInputs" ] @@ -1411,23 +1411,23 @@ instance , "validityInterval" .= validityInterval , "slot" .= slot ] - Conway.MaxTxSizeUTxO txsize maxtxsize -> + Conway.MaxTxSizeUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "MaxTxSizeUTxO" - , "size" .= txsize - , "maxSize" .= maxtxsize + , "size" .= mismatchSupplied + , "maxSize" .= mismatchExpected ] Conway.InputSetEmptyUTxO -> mconcat [ "kind" .= String "InputSetEmptyUTxO" ] - Conway.FeeTooSmallUTxO minfee txfee -> + Conway.FeeTooSmallUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "FeeTooSmallUTxO" - , "minimum" .= minfee - , "fee" .= txfee + , "minimum" .= mismatchExpected + , "fee" .= mismatchSupplied ] - Conway.ValueNotConservedUTxO consumed produced -> + Conway.ValueNotConservedUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ValueNotConservedUTxO" - , "consumed" .= consumed - , "produced" .= produced - , "error" .= renderValueNotConservedErr consumed produced + , "consumed" .= mismatchSupplied + , "produced" .= mismatchExpected + , "error" .= renderValueNotConservedErr mismatchSupplied mismatchExpected ] Conway.WrongNetwork network addrs -> mconcat [ "kind" .= String "WrongNetwork" @@ -1468,28 +1468,28 @@ instance mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] - Conway.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits -> + Conway.ExUnitsTooBigUTxO Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ExUnitsTooBigUTxO" - , "maxexunits" .= pParamsMaxExUnits - , "exunits" .= suppliedExUnits + , "maxexunits" .= mismatchExpected + , "exunits" .= mismatchSupplied ] Conway.CollateralContainsNonADA inputs -> mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] - Conway.WrongNetworkInTxBody actualNetworkId netIdInTxBody -> + Conway.WrongNetworkInTxBody Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "WrongNetworkInTxBody" - , "networkid" .= actualNetworkId - , "txbodyNetworkId" .= netIdInTxBody + , "networkid" .= mismatchExpected + , "txbodyNetworkId" .= mismatchSupplied ] Conway.OutsideForecast slotNum -> mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] - Conway.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs -> + Conway.TooManyCollateralInputs Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "TooManyCollateralInputs" - , "max" .= maxCollateralInputs - , "inputs" .= numberCollateralInputs + , "max" .= mismatchExpected + , "inputs" .= mismatchSupplied ] Conway.NoCollateralInputs -> mconcat [ "kind" .= String "NoCollateralInputs" ] @@ -1543,10 +1543,10 @@ instance mconcat [ "kind" .= String "MissingTxMetadata" , "txBodyMetadataHash" .= hash ] - Conway.ConflictingMetadataHash txBodyMetadataHash fullMetadataHash -> + Conway.ConflictingMetadataHash Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "ConflictingMetadataHash" - , "txBodyMetadataHash" .= txBodyMetadataHash - , "fullMetadataHash" .= fullMetadataHash + , "txBodyMetadataHash" .= mismatchSupplied + , "fullMetadataHash" .= mismatchExpected ] Conway.InvalidMetadata -> mconcat [ "kind" .= String "InvalidMetadata" @@ -1571,10 +1571,10 @@ instance , "disallowed" .= Set.toList disallowed , "acceptable" .= Set.toList acceptable ] - Conway.PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams -> + Conway.PPViewHashesDontMatch Mismatch {mismatchSupplied, mismatchExpected} -> mconcat [ "kind" .= String "PPViewHashesDontMatch" - , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) - , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) + , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchSupplied) + , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe mismatchExpected) ] Conway.UnspendableUTxONoDatumHash ins -> mconcat [ "kind" .= String "MissingRequiredSigners" From 1919e39d267fd6c755c4a9b5e28c96a155fffafb Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 17:53:18 -0700 Subject: [PATCH 13/79] cardano-ledger upgrade: accommodate the new VRFVerKeyHash type --- cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index c78efb0ec04..1dd16d81ad0 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -18,6 +18,7 @@ module Cardano.Node.Tracing.Era.Shelley () where import Cardano.Api (textShow) +import Cardano.Api.Ledger (fromVRFVerKeyHash) import qualified Cardano.Api.Shelley as Api import qualified Cardano.Crypto.Hash.Class as Crypto @@ -666,7 +667,7 @@ instance ] forMachine _dtal (DuplicateGenesisVRFDELEG vrfKeyHash) = mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" - , "keyHash" .= vrfKeyHash + , "keyHash" .= fromVRFVerKeyHash vrfKeyHash ] forMachine _dtal MIRTransferNotCurrentlyAllowed = mconcat [ "kind" .= String "MIRTransferNotCurrentlyAllowed" From 2db664a943b531d460374f82dfc70c81e893982b Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 16:16:22 -0700 Subject: [PATCH 14/79] ouroboros-network upgrade: increase version bounds --- bench/locli/locli.cabal | 2 +- cardano-node/cardano-node.cabal | 6 +++--- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 4 ++-- cardano-tracer/cardano-tracer.cabal | 2 +- trace-dispatcher/trace-dispatcher.cabal | 2 +- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 5d2ee1aa961..d63619ad50e 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -119,7 +119,7 @@ library , hashable , optparse-applicative-fork >= 0.18.1 , ouroboros-consensus - , ouroboros-network-api ^>= 0.10 + , ouroboros-network-api ^>= 0.11 , sop-core , split , sqlite-easy >= 1.1.0.1 diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 22982e77212..048a4a8cc0f 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -190,10 +190,10 @@ library , ouroboros-consensus-cardano ^>= 0.20 , ouroboros-consensus-diffusion ^>= 0.18 , ouroboros-consensus-protocol - , ouroboros-network-api ^>= 0.10 - , ouroboros-network ^>= 0.17 + , ouroboros-network-api ^>= 0.11 + , ouroboros-network ^>= 0.18 , ouroboros-network-framework - , ouroboros-network-protocols ^>= 0.11 + , ouroboros-network-protocols ^>= 0.12 , prettyprinter , prettyprinter-ansi-terminal , psqueues diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index c5032f24142..17b3dc2e75d 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.17 + , ouroboros-network ^>= 0.18 , ouroboros-network-protocols , prometheus >= 2.2.4 , servant diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 65dc8812e7e..19b3df840fb 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -49,7 +49,7 @@ library , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley , cardano-node - , cardano-ping ^>= 0.5 + , cardano-ping ^>= 0.6 , contra-tracer , containers , data-default-class @@ -70,7 +70,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.17 + , ouroboros-network ^>= 0.18 , ouroboros-network-api , prettyprinter , process diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 7f6efc072d3..6b630dcbed7 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -177,7 +177,7 @@ library , http-types , mime-mail , optparse-applicative - , ouroboros-network ^>= 0.17 + , ouroboros-network ^>= 0.18 , ouroboros-network-api , ouroboros-network-framework , signal diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index ffa0faad9b2..837fe9a1d20 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -60,7 +60,7 @@ library , hostname , network , optparse-applicative-fork - , ouroboros-network ^>= 0.17 + , ouroboros-network ^>= 0.18 , ouroboros-network-api , ouroboros-network-framework , serialise From a4ced5caef2686a079a7663d96419e41bb27e6b6 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 20:25:42 -0700 Subject: [PATCH 15/79] ouroboros-network upgrade: use the new namespace for Network.Mux types --- .../Benchmarking/GeneratorTx/NodeToNode.hs | 3 ++- .../src/Cardano/Benchmarking/LogTypes.hs | 4 ++-- cardano-testnet/src/Testnet/Ping.hs | 17 +++++++++-------- cardano-tracer/cardano-tracer.cabal | 4 ++++ .../src/Cardano/Tracer/Acceptors/Client.hs | 11 ++++++----- .../src/Cardano/Tracer/Acceptors/Server.hs | 11 ++++++----- .../test/Cardano/Tracer/Test/Forwarder.hs | 11 ++++++----- .../src/Cardano/Logging/Forwarding.hs | 11 ++++++----- trace-dispatcher/trace-dispatcher.cabal | 1 + .../src/Trace/Forward/Run/DataPoint/Acceptor.hs | 7 ++++--- .../Trace/Forward/Run/DataPoint/Forwarder.hs | 7 ++++--- .../Trace/Forward/Run/TraceObject/Acceptor.hs | 7 ++++--- .../Trace/Forward/Run/TraceObject/Forwarder.hs | 7 ++++--- trace-forward/trace-forward.cabal | 1 + 14 files changed, 59 insertions(+), 43 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs index d17ca92c4e6..358d621dc92 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs @@ -26,6 +26,7 @@ import Data.Foldable (fold) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) import Data.Void (Void) +import qualified Network.Mux as Mux import Network.Socket (AddrInfo (..)) import System.Random (newStdGen) @@ -114,7 +115,7 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec peerMultiplex :: NtN.Versions NodeToNodeVersion NtN.NodeToNodeVersionData (OuroborosApplication - 'InitiatorMode + 'Mux.InitiatorMode (MinimalInitiatorContext NtN.RemoteAddress) (ResponderContext NtN.RemoteAddress) ByteString IO () Void) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs b/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs index e20db4daa5a..4ca580ed717 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs @@ -51,7 +51,7 @@ import qualified Control.Concurrent.STM as STM (TVar) import Data.Text import Data.Time.Clock (DiffTime, NominalDiffTime) import GHC.Generics -import Network.Mux (WithMuxBearer (..)) +import qualified Network.Mux as Mux data AsyncBenchmarkControl = AsyncBenchmarkControl @@ -149,7 +149,7 @@ data NodeToNodeSubmissionTrace type SendRecvTxSubmission2 = TraceSendRecv (TxSubmission2 (GenTxId CardanoBlock) (GenTx CardanoBlock)) -type SendRecvConnect = WithMuxBearer +type SendRecvConnect = Mux.WithBearer RemoteConnectionId (TraceSendRecv (Handshake NodeToNodeVersion diff --git a/cardano-testnet/src/Testnet/Ping.hs b/cardano-testnet/src/Testnet/Ping.hs index 7e0242bb741..c92a9704e82 100644 --- a/cardano-testnet/src/Testnet/Ping.hs +++ b/cardano-testnet/src/Testnet/Ping.hs @@ -36,8 +36,9 @@ import Data.Word (Word32) import Network.Mux.Bearer (MakeBearer (..), makeSocketBearer) import Network.Mux.Timeout (TimeoutFn, withTimeoutSerial) import Network.Mux.Types (MiniProtocolDir (InitiatorDir), MiniProtocolNum (..), - MuxBearer (read, write), MuxSDU (..), MuxSDUHeader (..), - RemoteClockModel (RemoteClockModel)) + RemoteClockModel (RemoteClockModel), SDU (..), SDUHeader (..)) +import qualified Network.Mux as Mux +import qualified Network.Mux.Types as Mux import Network.Socket (AddrInfo (..), PortNumber, StructLinger (..)) import qualified Network.Socket as Socket import Prettyprinter @@ -82,7 +83,7 @@ pingNode networkMagic sprocket = liftIO $ bracket bearer <- getBearer makeSocketBearer sduTimeout nullTracer sd let versions = supportedNodeToClientVersions networkMagic - !_ <- write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery) + !_ <- Mux.write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery) (msg, !_) <- nextMsg bearer timeoutfn handshakeNum pure $ case CBOR.deserialiseFromBytes handshakeDec msg of @@ -96,9 +97,9 @@ pingNode networkMagic sprocket = liftIO $ bracket peer = sprocketToAddrInfo sprocket :: AddrInfo -- | Wrap a message in a mux service data unit. - wrap :: MiniProtocolNum -> MiniProtocolDir -> LBS.ByteString -> MuxSDU - wrap mhNum mhDir msBlob = MuxSDU - { msHeader = MuxSDUHeader + wrap :: MiniProtocolNum -> MiniProtocolDir -> LBS.ByteString -> SDU + wrap mhNum mhDir msBlob = SDU + { msHeader = SDUHeader { mhTimestamp = RemoteClockModel 0 , mhNum , mhDir @@ -124,12 +125,12 @@ pingNode networkMagic sprocket = liftIO $ bracket pure $ host <> ":" <> port -- | Fetch next message from mux bearer. Ignores messages not matching handshake protocol number. - nextMsg :: MuxBearer IO -- ^ a mux bearer + nextMsg :: Mux.Bearer IO -- ^ a mux bearer -> TimeoutFn IO -- ^ timeout function, for reading messages -> MiniProtocolNum -- ^ handshake protocol number -> IO (LBS.ByteString, Time) -- ^ raw message and timestamp nextMsg bearer timeoutfn ptclNum = do - (sdu, t_e) <- Network.Mux.Types.read bearer timeoutfn + (sdu, t_e) <- Mux.read bearer timeoutfn if mhNum (msHeader sdu) == ptclNum then pure (msBlob sdu, t_e) else nextMsg bearer timeoutfn ptclNum diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 6b630dcbed7..c505b64dbe0 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -176,6 +176,7 @@ library , filepath , http-types , mime-mail + , network-mux , optparse-applicative , ouroboros-network ^>= 0.18 , ouroboros-network-api @@ -246,6 +247,7 @@ library demo-forwarder-lib , extra , filepath , generic-data + , network-mux , optparse-applicative-fork , ouroboros-network-api , ouroboros-network-framework @@ -347,6 +349,7 @@ test-suite cardano-tracer-test , extra , filepath , generic-data + , network-mux , optparse-applicative-fork , ouroboros-network-api , ouroboros-network-framework @@ -405,6 +408,7 @@ test-suite cardano-tracer-test-ext , filepath , generic-data , Glob + , network-mux , optparse-applicative-fork , ouroboros-network , ouroboros-network-api diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs index deff7407fd1..e7a7a85eb3c 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs @@ -19,12 +19,13 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler) import Cardano.Tracer.MetaTrace import Cardano.Tracer.Utils (connIdToNodeId) +import qualified Network.Mux as Mux import Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..)) import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) import Ouroboros.Network.IOManager (withIOManager) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), - MiniProtocolNum (..), MuxMode (..), OuroborosApplication (..), + MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, codecHandshake, noTimeLimitsHandshake) @@ -93,7 +94,7 @@ doConnectToForwarder -> LocalAddress -> Word32 -> ProtocolTimeLimits (Handshake ForwardingVersion Term) - -> OuroborosApplication 'InitiatorMode + -> OuroborosApplication 'Mux.InitiatorMode (MinimalInitiatorContext LocalAddress) (ResponderContext LocalAddress) LBS.ByteString IO () Void @@ -120,7 +121,7 @@ runEKGAcceptorInit :: TracerEnv -> EKGF.AcceptorConfiguration -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'InitiatorMode + -> RunMiniProtocol 'Mux.InitiatorMode (MinimalInitiatorContext LocalAddress) respoinderCtx LBS.ByteString IO () Void @@ -135,7 +136,7 @@ runTraceObjectsAcceptorInit -> TracerEnvRTView -> TF.AcceptorConfiguration TraceObject -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'InitiatorMode + -> RunMiniProtocol 'Mux.InitiatorMode (MinimalInitiatorContext LocalAddress) responderCtx LBS.ByteString IO () Void @@ -149,7 +150,7 @@ runDataPointsAcceptorInit :: TracerEnv -> DPF.AcceptorConfiguration -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'InitiatorMode + -> RunMiniProtocol 'Mux.InitiatorMode (MinimalInitiatorContext LocalAddress) responderCtx LBS.ByteString IO () Void diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index efd81ab65c2..b44f4f46b7c 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -21,13 +21,14 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler) import Cardano.Tracer.MetaTrace import Cardano.Tracer.Utils (connIdToNodeId) +import qualified Network.Mux as Mux 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 (..), MuxMode (..), OuroborosApplication (..), + MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, codecHandshake, noTimeLimitsHandshake) @@ -99,7 +100,7 @@ doListenToForwarder -> LocalAddress -> Word32 -> ProtocolTimeLimits (Handshake ForwardingVersion Term) - -> OuroborosApplication 'ResponderMode + -> OuroborosApplication 'Mux.ResponderMode (MinimalInitiatorContext LocalAddress) (ResponderContext LocalAddress) LBS.ByteString IO Void () @@ -131,7 +132,7 @@ runEKGAcceptor :: TracerEnv -> EKGF.AcceptorConfiguration -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () runEKGAcceptor tracerEnv ekgConfig errorHandler = acceptEKGMetricsResp ekgConfig @@ -143,7 +144,7 @@ runTraceObjectsAcceptor -> TracerEnvRTView -> TF.AcceptorConfiguration TraceObject -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'ResponderMode + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () @@ -159,7 +160,7 @@ runDataPointsAcceptor :: TracerEnv -> DPF.AcceptorConfiguration -> (ConnectionId LocalAddress -> IO ()) - -> RunMiniProtocol 'ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () runDataPointsAcceptor tracerEnv dpfConfig errorHandler = acceptDataPointsResp dpfConfig diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index 661816863cf..9f2e073a6c6 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -20,11 +20,12 @@ import Cardano.Tracer.Configuration (Verbosity (..)) import Cardano.Tracer.Test.TestSetup import Cardano.Tracer.Test.Utils import Cardano.Tracer.Utils +import qualified Network.Mux as Mux import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits) import Ouroboros.Network.ErrorPolicy (nullErrorPolicies) import Ouroboros.Network.IOManager (IOManager, withIOManager) import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..), - MiniProtocolNum (..), MuxMode (..), OuroborosApplication (..), + MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, codecHandshake, noTimeLimitsHandshake) @@ -179,8 +180,8 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi address where forwarderApp - :: [(RunMiniProtocol 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)] - -> OuroborosApplication 'InitiatorMode initCtx respCtx LBS.ByteString IO () Void + :: [(RunMiniProtocol 'Mux.InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)] + -> OuroborosApplication 'Mux.InitiatorMode initCtx respCtx LBS.ByteString IO () Void forwarderApp protocols = OuroborosApplication [ MiniProtocol @@ -240,8 +241,8 @@ doListenToAcceptor TestSetup{..} $ \_ serverAsync -> wait serverAsync -- Block until async exception. where forwarderApp - :: [(RunMiniProtocol 'ResponderMode initCtx respCtx LBS.ByteString IO Void (), Word16)] - -> OuroborosApplication 'ResponderMode initCtx respCtx LBS.ByteString IO Void () + :: [(RunMiniProtocol 'Mux.ResponderMode initCtx respCtx LBS.ByteString IO Void (), Word16)] + -> OuroborosApplication 'Mux.ResponderMode initCtx respCtx LBS.ByteString IO Void () forwarderApp protocols = OuroborosApplication [ MiniProtocol diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index f23a8e7917e..a27c172b65f 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -17,12 +17,13 @@ module Cardano.Logging.Forwarding import Cardano.Logging.Types import Cardano.Logging.Utils (runInLoop) import Cardano.Logging.Version +import qualified Network.Mux as Mux 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 (..), MuxMode (..), OuroborosApplication (..), + MiniProtocolNum (..), OuroborosApplication (..), RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun) import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec, codecHandshake, noTimeLimitsHandshake) @@ -218,8 +219,8 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits address where forwarderApp - :: [(RunMiniProtocol 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void, Word16)] - -> OuroborosApplication 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void + :: [(RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void, Word16)] + -> OuroborosApplication 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void forwarderApp protocols = OuroborosApplication [ MiniProtocol @@ -281,8 +282,8 @@ doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits wait serverAsync -- Block until async exception. where forwarderApp - :: [(RunMiniProtocol 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void (), Word16)] - -> OuroborosApplication 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () + :: [(RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void (), Word16)] + -> OuroborosApplication 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () forwarderApp protocols = OuroborosApplication [ MiniProtocol diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 837fe9a1d20..968074f642f 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -59,6 +59,7 @@ library , ekg-forward >= 0.5 , hostname , network + , network-mux , optparse-applicative-fork , ouroboros-network ^>= 0.18 , ouroboros-network-api diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs index 16237daa7b9..5131d36efed 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs @@ -6,8 +6,9 @@ module Trace.Forward.Run.DataPoint.Acceptor , acceptDataPointsResp ) where +import qualified Network.Mux as Mux import Ouroboros.Network.Driver.Simple (runPeer) -import Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..), RunMiniProtocol (..)) +import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..)) import qualified Codec.Serialise as CBOR import Control.Concurrent.STM.TMVar (putTMVar) @@ -29,7 +30,7 @@ acceptDataPointsInit :: AcceptorConfiguration -> (initiatorCtx -> IO DataPointRequestor) -> (initiatorCtx -> IO ()) - -> RunMiniProtocol 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void + -> RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void acceptDataPointsInit config mkDPRequestor peerErrorHandler = InitiatorProtocolOnly $ runPeerWithRequestor config mkDPRequestor peerErrorHandler @@ -37,7 +38,7 @@ acceptDataPointsResp :: AcceptorConfiguration -> (responderCtx -> IO DataPointRequestor) -> (responderCtx -> IO ()) - -> RunMiniProtocol 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () acceptDataPointsResp config mkDPRequestor peerErrorHandler = ResponderProtocolOnly $ runPeerWithRequestor config mkDPRequestor peerErrorHandler diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs index bbffc9c58fd..3a8537540f3 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs @@ -5,8 +5,9 @@ module Trace.Forward.Run.DataPoint.Forwarder , forwardDataPointsResp ) where +import qualified Network.Mux as Mux import Ouroboros.Network.Driver.Simple (runPeer) -import Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..), RunMiniProtocol (..)) +import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..)) import qualified Codec.Serialise as CBOR import qualified Data.ByteString.Lazy as LBS @@ -20,14 +21,14 @@ import Trace.Forward.Utils.DataPoint forwardDataPointsInit :: ForwarderConfiguration -> DataPointStore - -> RunMiniProtocol 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void + -> RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void forwardDataPointsInit config dpStore = InitiatorProtocolOnly $ runPeerWithDPStore config dpStore forwardDataPointsResp :: ForwarderConfiguration -> DataPointStore - -> RunMiniProtocol 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () forwardDataPointsResp config dpStore = ResponderProtocolOnly $ runPeerWithDPStore config dpStore diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs index 5acf265a0db..df161659551 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs @@ -8,8 +8,9 @@ module Trace.Forward.Run.TraceObject.Acceptor , acceptTraceObjectsResp ) where +import qualified Network.Mux as Mux import Ouroboros.Network.Driver.Simple (runPeer) -import Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..), RunMiniProtocol (..)) +import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..)) import Ouroboros.Network.Util.ShowProxy (ShowProxy (..)) import qualified Codec.Serialise as CBOR @@ -35,7 +36,7 @@ acceptTraceObjectsInit => AcceptorConfiguration lo -- ^ Acceptor's configuration. -> (initiatorCtx -> [lo] -> IO ()) -- ^ The handler for accepted 'TraceObject's. -> (initiatorCtx -> IO ()) -- ^ The handler for exceptions from 'runPeer'. - -> RunMiniProtocol 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void + -> RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void acceptTraceObjectsInit config loHandler peerErrorHandler = InitiatorProtocolOnly $ runPeerWithHandler config loHandler peerErrorHandler @@ -46,7 +47,7 @@ acceptTraceObjectsResp => AcceptorConfiguration lo -- ^ Acceptor's configuration. -> (responderCtx -> [lo] -> IO ()) -- ^ The handler for accepted 'TraceObject's. -> (responderCtx -> IO ()) -- ^ The handler for exceptions from 'runPeer'. - -> RunMiniProtocol 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () acceptTraceObjectsResp config loHandler peerErrorHandler = do ResponderProtocolOnly $ runPeerWithHandler config loHandler peerErrorHandler diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs index 8d9308c0f2a..bd460ba36c7 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs @@ -5,8 +5,9 @@ module Trace.Forward.Run.TraceObject.Forwarder , forwardTraceObjectsResp ) where +import qualified Network.Mux as Mux import Ouroboros.Network.Driver.Simple (runPeer) -import Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..), RunMiniProtocol (..)) +import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..)) import Ouroboros.Network.Util.ShowProxy (ShowProxy (..)) import qualified Codec.Serialise as CBOR @@ -23,7 +24,7 @@ forwardTraceObjectsInit ShowProxy lo) => ForwarderConfiguration lo -> ForwardSink lo - -> RunMiniProtocol 'InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void + -> RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void forwardTraceObjectsInit config sink = InitiatorProtocolOnly $ runPeerWithSink config sink @@ -32,7 +33,7 @@ forwardTraceObjectsResp ShowProxy lo) => ForwarderConfiguration lo -> ForwardSink lo - -> RunMiniProtocol 'ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () + -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx responderCtx LBS.ByteString IO Void () forwardTraceObjectsResp config sink = ResponderProtocolOnly $ runPeerWithSink config sink diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 311e14ca8d9..5edc9a0e647 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -64,6 +64,7 @@ library , deepseq , extra , io-classes + , network-mux , ouroboros-network-api , singletons ^>= 3.0 , ouroboros-network-framework ^>= 0.14 From 239f6f0155dc05b83eacc3e86b79278a5f8b2283 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 5 Dec 2024 12:48:43 +0100 Subject: [PATCH 16/79] ouroboros-network upgrade: connectToNode changes --- .../Benchmarking/GeneratorTx/NodeToNode.hs | 15 ++++++--- .../src/Cardano/Tracer/Acceptors/Client.hs | 29 +++++++++++------ .../test/Cardano/Tracer/Test/Forwarder.hs | 31 ++++++++++++------- .../src/Cardano/Logging/Forwarding.hs | 30 +++++++++++------- 4 files changed, 68 insertions(+), 37 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs index 358d621dc92..1b65bec2129 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs @@ -13,7 +13,7 @@ module Cardano.Benchmarking.GeneratorTx.NodeToNode , benchmarkConnectTxSubmit ) where -import Cardano.Prelude (forever, liftIO) +import Cardano.Prelude (forever, liftIO, throwIO) import Prelude import "contra-tracer" Control.Tracer (Tracer (..)) @@ -25,7 +25,7 @@ import Data.ByteString.Lazy (ByteString) import Data.Foldable (fold) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) -import Data.Void (Void) +import Data.Void (Void, absurd) import qualified Network.Mux as Mux import Network.Socket (AddrInfo (..)) import System.Random (newStdGen) @@ -46,7 +46,7 @@ import Ouroboros.Network.DeltaQ (defaultGSV) import Ouroboros.Network.Driver (runPeer, runPeerWithLimits) import Ouroboros.Network.KeepAlive import Ouroboros.Network.Magic -import Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..), +import Ouroboros.Network.Mux (MiniProtocolCb (..), OuroborosApplication (..), OuroborosBundle, RunMiniProtocol (..)) import Ouroboros.Network.NodeToClient (chainSyncPeerNull) import Ouroboros.Network.NodeToNode (NetworkConnectTracers (..)) @@ -85,8 +85,8 @@ benchmarkConnectTxSubmit -- ^ the particular txSubmission peer -> IO () -benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codecConfig networkMagic remoteAddr myTxSubClient = - NtN.connectTo +benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codecConfig networkMagic remoteAddr myTxSubClient = do + done <- NtN.connectTo (socketSnocket envIOManager) NetworkConnectTracers { nctMuxTracer = mempty, @@ -95,6 +95,11 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec peerMultiplex (addrAddress <$> Nothing) (addrAddress remoteAddr) + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void where ownPeerSharing = PeerSharingDisabled mkApp :: OuroborosBundle mode initiatorCtx responderCtx bs m a b diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs index e7a7a85eb3c..505f5373b55 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs @@ -34,12 +34,13 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion simpleSingletonVersions) import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, localAddressFromPath, localSnocket, makeLocalBearer) -import Ouroboros.Network.Socket (ConnectionId (..), HandshakeCallbacks (..), - connectToNode, nullNetworkConnectTracers) +import Ouroboros.Network.Socket (ConnectionId (..), ConnectToArgs (..), + HandshakeCallbacks (..), connectToNode, nullNetworkConnectTracers) import Codec.CBOR.Term (Term) +import Control.Exception (throwIO) import qualified Data.ByteString.Lazy as LBS -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word32) import qualified System.Metrics.Configuration as EKGF import System.Metrics.Network.Acceptor (acceptEKGMetricsInit) @@ -99,16 +100,12 @@ doConnectToForwarder (ResponderContext LocalAddress) LBS.ByteString IO () Void -> IO () -doConnectToForwarder snocket address netMagic timeLimits app = - connectToNode +doConnectToForwarder snocket address netMagic timeLimits app = do + done <- connectToNode snocket makeLocalBearer + args mempty -- LocalSocket does not require to be configured - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ NetworkMagic netMagic) @@ -116,6 +113,18 @@ doConnectToForwarder snocket address netMagic timeLimits app = ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void + where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } runEKGAcceptorInit :: TracerEnv diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index 9f2e073a6c6..fd33054e4cb 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -34,21 +34,22 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion simpleSingletonVersions) import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, makeLocalBearer) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), HandshakeCallbacks (..), - SomeResponderApplication (..), cleanNetworkMutableState, connectToNode, - newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers, - withServerNode) +import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, + connectToNode, newNetworkMutableState, nullNetworkConnectTracers, + nullNetworkServerTracers, withServerNode) import Codec.CBOR.Term (Term) import Control.Concurrent (threadDelay) import Control.Concurrent.Async import Control.DeepSeq (NFData) +import Control.Exception (throwIO) 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.Time.Clock (getCurrentTime) -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word16) import GHC.Generics import System.Directory @@ -158,15 +159,11 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi dpStore <- initDataPointStore writeToStore dpStore "test.data.point" $ DataPoint mkTestDataPoint withAsync (traceObjectsWriter sink) $ \_ -> do - connectToNode + done <- connectToNode snocket muxBearer + args mempty - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData $ unI tsNetworkMagic) @@ -178,7 +175,19 @@ doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfi ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right void -> absurd void where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } + forwarderApp :: [(RunMiniProtocol 'Mux.InitiatorMode initCtx respCtx LBS.ByteString IO () Void, Word16)] -> OuroborosApplication 'Mux.InitiatorMode initCtx respCtx LBS.ByteString IO () Void diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index a27c172b65f..22927406140 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -32,18 +32,19 @@ import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion simpleSingletonVersions) import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket, makeLocalBearer) -import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), HandshakeCallbacks (..), - SomeResponderApplication (..), cleanNetworkMutableState, connectToNode, - newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers, - withServerNode) +import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..), + HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState, + connectToNode, newNetworkMutableState, nullNetworkConnectTracers, + nullNetworkServerTracers, withServerNode) import Codec.CBOR.Term (Term) import Control.Concurrent.Async (async, race_, wait) import Control.Monad (void) +import Control.Exception (throwIO) import Control.Monad.IO.Class import "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer) import qualified Data.ByteString.Lazy as LBS -import Data.Void (Void) +import Data.Void (Void, absurd) import Data.Word (Word16) import System.IO (hPutStrLn, stderr) import qualified System.Metrics as EKG @@ -197,15 +198,11 @@ doConnectToAcceptor -> IO () doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do - connectToNode + done <- connectToNode snocket makeBearer + args configureSocket - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - nullNetworkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) (simpleSingletonVersions ForwardingV_1 (ForwardingVersionData magic) @@ -217,7 +214,18 @@ doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ) Nothing address + case done of + Left err -> throwIO err + Right choice -> case choice of + Left () -> return () + Right v -> absurd v where + args = ConnectToArgs { + ctaHandshakeCodec = codecHandshake forwardingVersionCodec, + ctaHandshakeTimeLimits = timeLimits, + ctaVersionDataCodec = cborTermVersionDataCodec forwardingCodecCBORTerm, + ctaConnectTracers = nullNetworkConnectTracers, + ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion } forwarderApp :: [(RunMiniProtocol 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void, Word16)] -> OuroborosApplication 'Mux.InitiatorMode initiatorCtx responderCtx LBS.ByteString IO () Void From a02359c8d13a729b8347d817dbc5921ef68bc7f8 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 15:19:42 -0700 Subject: [PATCH 17/79] ouroboros-network upgrade: update NodeToClient versions --- .../src/Cardano/Node/Tracing/Tracers/Startup.hs | 8 +------- .../Cardano/Tracing/OrphanInstances/Network.hs | 16 ++-------------- .../Cardano/Tracing/OrphanInstances/Shelley.hs | 1 + 3 files changed, 4 insertions(+), 21 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 65e82a1d844..dddbe63f8d0 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -433,16 +433,10 @@ instance MetaTrace (StartupTrace blk) where nodeToClientVersionToInt :: NodeToClientVersion -> Int nodeToClientVersionToInt = \case - NodeToClientV_9 -> 9 - NodeToClientV_10 -> 10 - NodeToClientV_11 -> 11 - NodeToClientV_12 -> 12 - NodeToClientV_13 -> 13 - NodeToClientV_14 -> 14 - NodeToClientV_15 -> 15 NodeToClientV_16 -> 16 NodeToClientV_17 -> 17 NodeToClientV_18 -> 18 + NodeToClientV_19 -> 19 nodeToNodeVersionToInt :: NodeToNodeVersion -> Int nodeToNodeVersionToInt = \case diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 5ca65ab077a..ac455950ac4 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -2181,29 +2181,17 @@ instance FromJSON NodeToNodeVersion where parseJSON x = fail ("FromJSON.NodeToNodeVersion: error parsing NodeToNodeVersion: " ++ show x) instance ToJSON NodeToClientVersion where - toJSON NodeToClientV_9 = Number 9 - toJSON NodeToClientV_10 = Number 10 - toJSON NodeToClientV_11 = Number 11 - toJSON NodeToClientV_12 = Number 12 - toJSON NodeToClientV_13 = Number 13 - toJSON NodeToClientV_14 = Number 14 - toJSON NodeToClientV_15 = Number 15 toJSON NodeToClientV_16 = Number 16 toJSON NodeToClientV_17 = Number 17 toJSON NodeToClientV_18 = Number 18 + toJSON NodeToClientV_19 = Number 19 -- NB: When adding a new version here, update FromJSON below as well! instance FromJSON NodeToClientVersion where - parseJSON (Number 9) = return NodeToClientV_9 - parseJSON (Number 10) = return NodeToClientV_10 - parseJSON (Number 11) = return NodeToClientV_11 - parseJSON (Number 12) = return NodeToClientV_12 - parseJSON (Number 13) = return NodeToClientV_13 - parseJSON (Number 14) = return NodeToClientV_14 - parseJSON (Number 15) = return NodeToClientV_15 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) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index d16ce30d5f5..a1349d310db 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -1341,6 +1341,7 @@ instance ToJSON ShelleyNodeToClientVersion where toJSON ShelleyNodeToClientVersion8 = String "ShelleyNodeToClientVersion8" toJSON ShelleyNodeToClientVersion9 = String "ShelleyNodeToClientVersion9" toJSON ShelleyNodeToClientVersion10 = String "ShelleyNodeToClientVersion10" + toJSON ShelleyNodeToClientVersion11 = String "ShelleyNodeToClientVersion11" instance Ledger.Crypto c => ToObject (PraosChainSelectView c) where toObject _ PraosChainSelectView { From 7b94a606a3d9f667c959e815a88f41bd8ca8b674 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 10:48:15 -0700 Subject: [PATCH 18/79] ouroboros-network-upgrade: AnyMessage changes --- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 4 +- .../Node/Tracing/Tracers/NodeToClient.hs | 44 +++++++++---------- .../Node/Tracing/Tracers/NodeToNode.hs | 12 ++--- .../Tracing/OrphanInstances/Network.hs | 18 ++++---- 4 files changed, 39 insertions(+), 39 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 72d69e6a1f6..72b957128ee 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 Data.Text (pack) import Formatting import Network.Mux (MuxTrace (..), WithMuxBearer (..)) import Network.Mux.Types -import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) +import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) import qualified Data.List as List import qualified Ouroboros.Network.Diffusion as ND @@ -527,7 +527,7 @@ instance (Show adr, Show ver) => LogFormatting (NtN.HandshakeTr adr ver) where forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b <> ". " <> showT ev -instance MetaTrace (AnyMessageAndAgency (HS.Handshake nt term)) where +instance MetaTrace (AnyMessage (HS.Handshake nt term)) where namespaceFor (AnyMessageAndAgency _stok HS.MsgProposeVersions {}) = Namespace [] ["ProposeVersions"] namespaceFor (AnyMessageAndAgency _stok HS.MsgReplyVersions {}) = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs index 870de3235ca..26c046689da 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs @@ -20,12 +20,12 @@ import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS import Data.Aeson (Value (String), (.=)) import Data.Text (Text, pack) -import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) +import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-} -instance LogFormatting (AnyMessageAndAgency ps) +instance LogFormatting (AnyMessage ps) => LogFormatting (TraceSendRecv ps) where forMachine dtal (TraceSendMsg m) = mconcat [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] @@ -38,7 +38,7 @@ instance LogFormatting (AnyMessageAndAgency ps) asMetrics (TraceSendMsg m) = asMetrics m asMetrics (TraceRecvMsg m) = asMetrics m -instance MetaTrace (AnyMessageAndAgency ps) => +instance MetaTrace (AnyMessage ps) => MetaTrace (TraceSendRecv ps) where namespaceFor (TraceSendMsg msg) = nsPrependInner "Send" (namespaceFor msg) @@ -48,47 +48,47 @@ instance MetaTrace (AnyMessageAndAgency ps) => severityFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Send" : tl)) Nothing = - severityFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + severityFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing severityFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Receive" : tl)) Nothing = - severityFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + severityFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing severityFor _ _ = Nothing privacyFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Send" : tl)) Nothing = - privacyFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + privacyFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing privacyFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Receive" : tl)) Nothing = - privacyFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + privacyFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing privacyFor _ _ = Nothing detailsFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Send" : tl)) Nothing = - detailsFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + detailsFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing detailsFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Receive" : tl)) Nothing = - detailsFor (Namespace out tl :: Namespace (AnyMessageAndAgency ps)) Nothing + detailsFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing detailsFor _ _ = Nothing metricsDocFor (Namespace out ("Send" : tl)) = - metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessageAndAgency ps)) + metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) metricsDocFor (Namespace out ("Receive" : tl)) = - metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessageAndAgency ps)) + metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) metricsDocFor _ = [] documentFor (Namespace out ("Send" : tl)) = - documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessageAndAgency ps)) + documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) documentFor (Namespace out ("Receive" : tl)) = - documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessageAndAgency ps)) + documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) documentFor _ = Nothing allNamespaces = - let cn = allNamespaces :: [Namespace (AnyMessageAndAgency ps)] + let cn = allNamespaces :: [Namespace (AnyMessage ps)] in fmap (nsPrependInner "Send") cn ++ fmap (nsPrependInner "Receive") cn @@ -96,7 +96,7 @@ instance MetaTrace (AnyMessageAndAgency ps) => -- -- TChainSync Tracer -- -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessageAndAgency (ChainSync blk pt tip)) where +instance LogFormatting (AnyMessage (ChainSync blk pt tip)) where forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = mconcat [ "kind" .= String "MsgRequestNext" , "agency" .= String (pack $ show stok) @@ -130,7 +130,7 @@ instance LogFormatting (AnyMessageAndAgency (ChainSync blk pt tip)) where , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessageAndAgency (ChainSync blk pt tip)) where +instance MetaTrace (AnyMessage (ChainSync blk pt tip)) where namespaceFor (AnyMessageAndAgency _agency (MsgRequestNext {})) = Namespace [] ["RequestNext"] namespaceFor (AnyMessageAndAgency _agency (MsgAwaitReply {})) = @@ -220,7 +220,7 @@ instance MetaTrace (AnyMessageAndAgency (ChainSync blk pt tip)) where -- LocalTxMonitor Tracer -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessageAndAgency (LTM.LocalTxMonitor txid tx slotNo)) where +instance LogFormatting (AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAcquire {}) = mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) @@ -266,7 +266,7 @@ instance LogFormatting (AnyMessageAndAgency (LTM.LocalTxMonitor txid tx slotNo)) , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessageAndAgency (LTM.LocalTxMonitor txid tx slotNo)) where +instance MetaTrace (AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where namespaceFor (AnyMessageAndAgency _agency LTM.MsgAcquire {}) = Namespace [] ["Acquire"] namespaceFor (AnyMessageAndAgency _agency LTM.MsgAcquired {}) = @@ -344,7 +344,7 @@ instance MetaTrace (AnyMessageAndAgency (LTM.LocalTxMonitor txid tx slotNo)) whe -- LocalTxSubmission Tracer -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessageAndAgency (LTS.LocalTxSubmission tx err)) where +instance LogFormatting (AnyMessage (LTS.LocalTxSubmission tx err)) where forMachine _dtal (AnyMessageAndAgency stok LTS.MsgSubmitTx{}) = mconcat [ "kind" .= String "MsgSubmitTx" , "agency" .= String (pack $ show stok) @@ -362,7 +362,7 @@ instance LogFormatting (AnyMessageAndAgency (LTS.LocalTxSubmission tx err)) wher , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessageAndAgency (LTS.LocalTxSubmission tx err)) where +instance MetaTrace (AnyMessage (LTS.LocalTxSubmission tx err)) where namespaceFor (AnyMessageAndAgency _agency LTS.MsgSubmitTx{}) = Namespace [] ["SubmitTx"] namespaceFor (AnyMessageAndAgency _agency LTS.MsgAcceptTx{}) = @@ -401,7 +401,7 @@ instance MetaTrace (AnyMessageAndAgency (LTS.LocalTxSubmission tx err)) where -------------------------------------------------------------------------------- instance (forall result. Show (Query blk result)) - => LogFormatting (AnyMessageAndAgency (LSQ.LocalStateQuery blk pt (Query blk))) where + => LogFormatting (AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgAcquire{}) = mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) @@ -435,7 +435,7 @@ instance (forall result. Show (Query blk result)) , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessageAndAgency (LSQ.LocalStateQuery blk pt (Query blk))) where +instance MetaTrace (AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where namespaceFor (AnyMessageAndAgency _agency LSQ.MsgAcquire{}) = Namespace [] ["Acquire"] namespaceFor (AnyMessageAndAgency _agency LSQ.MsgAcquired{}) = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index d8157a26750..f646eee74c8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -27,7 +27,7 @@ import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Data.Aeson (ToJSON (..), Value (String), (.=)) import Data.Proxy (Proxy (..)) import Data.Text (pack) -import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) +import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) -------------------------------------------------------------------------------- -- BlockFetch Tracer @@ -40,7 +40,7 @@ instance ( ConvertTxId blk , HasTxs blk , LedgerSupportsMempool blk ) - => LogFormatting (AnyMessageAndAgency (BlockFetch blk (Point blk))) where + => LogFormatting (AnyMessage (BlockFetch blk (Point blk))) where forMachine DMinimal (AnyMessageAndAgency stok (MsgBlock blk)) = mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) @@ -84,7 +84,7 @@ instance ( ConvertTxId blk instance ToJSON SizeInBytes where toJSON (SizeInBytes s) = toJSON s -instance MetaTrace (AnyMessageAndAgency (BlockFetch blk1 (Point blk2))) where +instance MetaTrace (AnyMessage (BlockFetch blk1 (Point blk2))) where namespaceFor (AnyMessageAndAgency _stok MsgRequestRange{}) = Namespace [] ["RequestRange"] namespaceFor (AnyMessageAndAgency _stok MsgStartBatch{}) = @@ -140,7 +140,7 @@ instance ( ConvertTxId blk , HasTxs blk , HasTxId (GenTx blk) ) - => LogFormatting (AnyMessageAndAgency (BlockFetch (Serialised blk) (Point blk))) where + => LogFormatting (AnyMessage (BlockFetch (Serialised blk) (Point blk))) where forMachine _dtal (AnyMessageAndAgency stok (MsgBlock blk')) = mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) @@ -175,7 +175,7 @@ instance ( ConvertTxId blk -------------------------------------------------------------------------------- instance (Show txid, Show tx) - => LogFormatting (AnyMessageAndAgency (STX.TxSubmission2 txid tx)) where + => LogFormatting (AnyMessage (STX.TxSubmission2 txid tx)) where forMachine _dtal (AnyMessageAndAgency stok STX.MsgInit) = mconcat [ "kind" .= String "MsgInit" @@ -209,7 +209,7 @@ instance (Show txid, Show tx) , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessageAndAgency (STX.TxSubmission2 txid tx)) where +instance MetaTrace (AnyMessage (STX.TxSubmission2 txid tx)) where namespaceFor (AnyMessageAndAgency _stok STX.MsgInit {}) = Namespace [] ["MsgInit"] namespaceFor (AnyMessageAndAgency _stok STX.MsgRequestTxs {}) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index ac455950ac4..d4870456ab8 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -124,7 +124,7 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Network.Mux (MiniProtocolNum (..), MuxTrace (..), WithMuxBearer (..)) import Network.Socket (SockAddr (..)) -import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) +import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) import Network.TypedProtocol.Core (PeerHasAgency (..)) {- HLINT ignore "Use record patterns" -} @@ -628,7 +628,7 @@ instance (Show peer, StandardHash blk, Show (Header blk)) => HasTextFormatter (TraceLabelPeer peer (NtN.TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))) where formatText a _ = pack (show a) -instance (ToObject peer, ToObject (AnyMessageAndAgency (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))) +instance (ToObject peer, ToObject (AnyMessage (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))) => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))) where trTransformer = trStructured @@ -808,7 +808,7 @@ instance ( ConvertTxId blk , RunNode blk , HasTxs blk ) - => ToObject (AnyMessageAndAgency (BlockFetch blk (Point blk))) where + => ToObject (AnyMessage (BlockFetch blk (Point blk))) where toObject MinimalVerbosity (AnyMessageAndAgency stok (MsgBlock blk)) = mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) @@ -849,7 +849,7 @@ instance ( ConvertTxId blk ] instance (forall result. Show (query result)) - => ToObject (AnyMessageAndAgency (LocalStateQuery blk pt query)) where + => ToObject (AnyMessage (LocalStateQuery blk pt query)) where toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgAcquire{}) = mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) @@ -883,7 +883,7 @@ instance (forall result. Show (query result)) , "agency" .= String (pack $ show stok) ] -instance ToObject (AnyMessageAndAgency (LocalTxMonitor txid tx slotno)) where +instance ToObject (AnyMessage (LocalTxMonitor txid tx slotno)) where toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgAcquire {}) = mconcat [ "kind" .= String "MsgAcuire" , "agency" .= String (pack $ show stok) @@ -929,7 +929,7 @@ instance ToObject (AnyMessageAndAgency (LocalTxMonitor txid tx slotno)) where , "agency" .= String (pack $ show stok) ] -instance ToObject (AnyMessageAndAgency (LocalTxSubmission tx err)) where +instance ToObject (AnyMessage (LocalTxSubmission tx err)) where toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgSubmitTx{}) = mconcat [ "kind" .= String "MsgSubmitTx" , "agency" .= String (pack $ show stok) @@ -947,7 +947,7 @@ instance ToObject (AnyMessageAndAgency (LocalTxSubmission tx err)) where , "agency" .= String (pack $ show stok) ] -instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where +instance ToObject (AnyMessage (ChainSync blk pt tip)) where toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = mconcat [ "kind" .= String "MsgRequestNext" , "agency" .= String (pack $ show stok) @@ -982,7 +982,7 @@ instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where ] instance (Show txid, Show tx) - => ToObject (AnyMessageAndAgency (TxSubmission2 txid tx)) where + => ToObject (AnyMessage (TxSubmission2 txid tx)) where toObject _verb (AnyMessageAndAgency stok MsgInit) = mconcat [ "kind" .= String "MsgInit" @@ -1252,7 +1252,7 @@ instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where mconcat [ "peer" .= toObject verb peerid ] <> toObject verb a -instance ToObject (AnyMessageAndAgency ps) +instance ToObject (AnyMessage ps) => ToObject (TraceSendRecv ps) where toObject verb (TraceSendMsg m) = mconcat [ "kind" .= String "Send" , "msg" .= toObject verb m ] From a78adf006f802ed33bdfa37376f17a61d9b78875 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 15:25:18 -0700 Subject: [PATCH 19/79] ouroboros-network upgrade: adjust to namespace changes --- .../src/Cardano/Node/Tracing/Consistency.hs | 23 +- .../src/Cardano/Node/Tracing/Documentation.hs | 147 +++++----- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 270 +++++++++--------- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 30 +- .../Tracing/OrphanInstances/Network.hs | 177 ++++++------ cardano-node/src/Cardano/Tracing/Tracers.hs | 22 +- 6 files changed, 332 insertions(+), 337 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index a2e4aa6bb35..2ff5e336903 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -53,11 +53,10 @@ import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId) -import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..)) +import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager import qualified Ouroboros.Network.Diffusion as Diffusion import Ouroboros.Network.Driver.Simple (TraceSendRecv) -import Ouroboros.Network.InboundGovernor (InboundGovernorTrace) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import qualified Ouroboros.Network.NodeToClient as NtC @@ -79,7 +78,7 @@ 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 Ouroboros.Network.Server2 (ServerTrace (..)) +import qualified Ouroboros.Network.Server2 as Server (Trace (..)) import Ouroboros.Network.Snocket (LocalAddress (..)) import Ouroboros.Network.Subscription.Dns (DnsTrace (..), WithDomainName (..)) import Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..)) @@ -88,7 +87,7 @@ import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbo import Control.Exception (SomeException) import qualified Data.Text as T -import Network.Mux (MuxTrace (..), WithMuxBearer (..)) +import qualified Network.Mux as Mux import qualified Network.Socket as Socket @@ -244,10 +243,10 @@ getAllNamespaces = dtMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote"]) (allNamespaces :: [Namespace - (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)]) + (Mux.WithBearer (ConnectionId RemoteAddress) Mux.Trace)]) dtLocalMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Local"]) (allNamespaces :: [Namespace - (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)]) + (Mux.WithBearer (ConnectionId LocalAddress) Mux.Trace)]) dtHandshakeNS = map (nsGetTuple . nsReplacePrefix ["Net", "Handshake", "Remote"]) (allNamespaces :: [Namespace @@ -301,7 +300,7 @@ getAllNamespaces = connectionManagerNS = map (nsGetTuple . nsReplacePrefix ["Net", "ConnectionManager", "Remote"]) (allNamespaces :: [Namespace - (ConnectionManagerTrace + (ConnectionManager.Trace Socket.SockAddr (ConnectionHandlerTrace UnversionedProtocol @@ -313,11 +312,11 @@ getAllNamespaces = Socket.SockAddr)]) serverNS = map (nsGetTuple . nsReplacePrefix ["Net", "Server", "Remote"]) - (allNamespaces :: [Namespace (ServerTrace Socket.SockAddr)]) + (allNamespaces :: [Namespace (Server.Trace Socket.SockAddr)]) inboundGovernorNS = map (nsGetTuple . nsReplacePrefix ["Net", "InboundGovernor", "Remote"]) (allNamespaces :: [Namespace - (InboundGovernorTrace Socket.SockAddr)]) + (InboundGovernor.Trace Socket.SockAddr)]) inboundGovernorTransitionsNS = map (nsGetTuple . nsReplacePrefix ["Net", "InboundGovernor", "Transition"]) (allNamespaces :: [Namespace @@ -325,7 +324,7 @@ getAllNamespaces = localConnectionManagerNS = map (nsGetTuple . nsReplacePrefix ["Net", "ConnectionManager", "Local"]) (allNamespaces :: [Namespace - (ConnectionManagerTrace + (ConnectionManager.Trace Socket.SockAddr (ConnectionHandlerTrace UnversionedProtocol @@ -333,11 +332,11 @@ getAllNamespaces = localServerNS = map (nsGetTuple . nsReplacePrefix ["Net", "Server", "Local"]) (allNamespaces :: [Namespace - (ServerTrace LocalAddress)]) + (Server.Trace LocalAddress)]) localInboundGovernorNS = map (nsGetTuple . nsReplacePrefix ["Net", "InboundGovernor", "Local"]) (allNamespaces :: [Namespace - (InboundGovernorTrace LocalAddress)]) + (InboundGovernor.Trace LocalAddress)]) -- -- DiffusionTracersExtra nonP2P diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index e217afba03d..7d207e35d9b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -18,7 +18,7 @@ module Cardano.Node.Tracing.Documentation , docTracersFirstPhase ) where -import Cardano.Logging +import Cardano.Logging as Logging import Cardano.Logging.Resources import Cardano.Logging.Resources.Types () import Cardano.Node.Handlers.Shutdown (ShutdownTrace) @@ -61,11 +61,10 @@ import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId) -import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..)) +import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager import qualified Ouroboros.Network.Diffusion as Diffusion import Ouroboros.Network.Driver.Simple (TraceSendRecv) -import Ouroboros.Network.InboundGovernor (InboundGovernorTrace) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import qualified Ouroboros.Network.NodeToClient as NtC @@ -87,7 +86,7 @@ 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 Ouroboros.Network.Server2 (ServerTrace (..)) +import qualified Ouroboros.Network.Server2 as Server (Trace (..)) import Ouroboros.Network.Snocket (LocalAddress (..)) import Ouroboros.Network.Subscription.Dns (DnsTrace (..), WithDomainName (..)) import Ouroboros.Network.Subscription.Ip (WithIPList (..)) @@ -101,7 +100,7 @@ import Data.Aeson.Types (ToJSON) import Data.Proxy (Proxy (..)) import qualified Data.Text.IO as T import GHC.Generics (Generic) -import Network.Mux (MuxTrace (..), WithMuxBearer (..)) +import qualified Network.Mux as Mux import qualified Network.Socket as Socket import qualified Options.Applicative as Opt import System.IO @@ -185,10 +184,10 @@ docTracersFirstPhase condConfigFileName = do trConfig <- case condConfigFileName of Just fn -> readConfigurationWithDefault fn defaultCardanoConfig Nothing -> pure defaultCardanoConfig - let trBase :: Trace IO FormattedMessage = docTracer (Stdout MachineFormat) - trForward :: Trace IO FormattedMessage = docTracer Forwarder + let trBase :: Logging.Trace IO FormattedMessage = docTracer (Stdout MachineFormat) + trForward :: Logging.Trace IO FormattedMessage = docTracer Forwarder trDataPoint = docTracerDatapoint DatapointBackend - mbTrEKG :: Maybe (Trace IO FormattedMessage) = Just (docTracer EKGBackend) + mbTrEKG :: Maybe (Logging.Trace IO FormattedMessage) = Just (docTracer EKGBackend) configReflection <- emptyConfigReflection @@ -196,53 +195,53 @@ docTracersFirstPhase condConfigFileName = do nodeInfoDp <- mkDataPointTracer trDataPoint configureTracers configReflection trConfig [nodeInfoDp] - nodeInfoDpDoc <- documentTracer (nodeInfoDp :: Trace IO NodeInfo) + nodeInfoDpDoc <- documentTracer (nodeInfoDp :: Logging.Trace IO NodeInfo) nodeStartupInfoDp <- mkDataPointTracer trDataPoint configureTracers configReflection trConfig [nodeStartupInfoDp] nodeStartupInfoDpDoc <- documentTracer - (nodeStartupInfoDp :: Trace IO NodeStartupInfo) + (nodeStartupInfoDp :: Logging.Trace IO NodeStartupInfo) nodeVersionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Version"] configureTracers configReflection trConfig [nodeVersionTr] - nodeVersionDoc <- documentTracer (nodeVersionTr :: Trace IO NodeVersionTrace) + nodeVersionDoc <- documentTracer (nodeVersionTr :: Logging.Trace IO NodeVersionTrace) -- State tracer stateTr <- mkCardanoTracer trBase trForward mbTrEKG ["NodeState"] configureTracers configReflection trConfig [stateTr] - stateTrDoc <- documentTracer (stateTr :: Trace IO SR.NodeState) + stateTrDoc <- documentTracer (stateTr :: Logging.Trace IO SR.NodeState) -- Peers tracer peersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "List"] configureTracers configReflection trConfig [peersTr] - peersTrDoc <- documentTracer (peersTr :: Trace IO [PeerT blk]) + peersTrDoc <- documentTracer (peersTr :: Logging.Trace IO [PeerT blk]) -- Resource tracer resourcesTr <- mkCardanoTracer trBase trForward mbTrEKG [] configureTracers configReflection trConfig [resourcesTr] - resourcesTrDoc <- documentTracer (resourcesTr :: Trace IO ResourceStats) + resourcesTrDoc <- documentTracer (resourcesTr :: Logging.Trace IO ResourceStats) -- Startup tracer startupTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup"] configureTracers configReflection trConfig [startupTr] - startupTrDoc <- documentTracer (startupTr :: Trace IO (StartupTrace blk)) + startupTrDoc <- documentTracer (startupTr :: Logging.Trace IO (StartupTrace blk)) shutdownTr <- mkCardanoTracer trBase trForward mbTrEKG ["Shutdown"] configureTracers configReflection trConfig [shutdownTr] - shutdownTrDoc <- documentTracer (shutdownTr :: Trace IO ShutdownTrace) + shutdownTrDoc <- documentTracer (shutdownTr :: Logging.Trace IO ShutdownTrace) chainDBTr <- mkCardanoTracer' trBase trForward mbTrEKG @@ -250,13 +249,13 @@ docTracersFirstPhase condConfigFileName = do withAddedToCurrentChainEmptyLimited configureTracers configReflection trConfig [chainDBTr] chainDBTrDoc <- documentTracer (chainDBTr :: - Trace IO (ChainDB.TraceEvent blk)) + Logging.Trace IO (ChainDB.TraceEvent blk)) replayBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainDB", "ReplayBlock"] configureTracers configReflection trConfig [replayBlockTr] - replayBlockTrDoc <- documentTracer (replayBlockTr :: Trace IO ReplayBlockStats) + replayBlockTrDoc <- documentTracer (replayBlockTr :: Logging.Trace IO ReplayBlockStats) -- Consensus tracers @@ -265,7 +264,7 @@ docTracersFirstPhase condConfigFileName = do ["ChainSync", "Client"] configureTracers configReflection trConfig [chainSyncClientTr] chainSyncClientTrDoc <- documentTracer (chainSyncClientTr :: - (Trace IO (BlockFetch.TraceLabelPeer + (Logging.Trace IO (BlockFetch.TraceLabelPeer (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk)))) @@ -274,21 +273,21 @@ docTracersFirstPhase condConfigFileName = do ["ChainSync", "ServerHeader"] configureTracers configReflection trConfig [chainSyncServerHeaderTr] chainSyncServerHeaderTrDoc <- documentTracer (chainSyncServerHeaderTr :: - (Trace IO (TraceChainSyncServerEvent blk))) + (Logging.Trace IO (TraceChainSyncServerEvent blk))) chainSyncServerBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "ServerBlock"] configureTracers configReflection trConfig [chainSyncServerBlockTr] chainSyncServerBlockTrDoc <- documentTracer (chainSyncServerBlockTr :: - (Trace IO (TraceChainSyncServerEvent blk))) + (Logging.Trace IO (TraceChainSyncServerEvent blk))) blockFetchDecisionTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Decision"] configureTracers configReflection trConfig [blockFetchDecisionTr] blockFetchDecisionTrDoc <- documentTracer (blockFetchDecisionTr :: - Trace IO [BlockFetch.TraceLabelPeer + Logging.Trace IO [BlockFetch.TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]) @@ -297,7 +296,7 @@ docTracersFirstPhase condConfigFileName = do ["BlockFetch", "Client"] configureTracers configReflection trConfig [blockFetchClientTr] blockFetchClientTrDoc <- documentTracer (blockFetchClientTr :: - Trace IO (BlockFetch.TraceLabelPeer + Logging.Trace IO (BlockFetch.TraceLabelPeer remotePeer (BlockFetch.TraceFetchClientState (Header blk)))) @@ -307,28 +306,28 @@ docTracersFirstPhase condConfigFileName = do configureTracers configReflection trConfig [blockFetchClientMetricsTr] blockFetchClientMetricsDoc <- documentTracer (blockFetchClientMetricsTr :: - Trace IO ClientMetrics) + Logging.Trace IO ClientMetrics) blockFetchServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Server"] configureTracers configReflection trConfig [blockFetchServerTr] blockFetchServerTrDoc <- documentTracer (blockFetchServerTr :: - Trace IO (TraceBlockFetchServerEvent blk)) + Logging.Trace IO (TraceBlockFetchServerEvent blk)) forgeKESInfoTr <- mkCardanoTracer trBase trForward mbTrEKG ["Forge"] configureTracers configReflection trConfig [forgeKESInfoTr] forgeKESInfoTrDoc <- documentTracer (forgeKESInfoTr :: - Trace IO (Consensus.TraceLabelCreds HotKey.KESInfo)) + Logging.Trace IO (Consensus.TraceLabelCreds HotKey.KESInfo)) txInboundTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "TxInbound"] configureTracers configReflection trConfig [txInboundTr] txInboundTrDoc <- documentTracer (txInboundTr :: - Trace IO (BlockFetch.TraceLabelPeer + Logging.Trace IO (BlockFetch.TraceLabelPeer remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))) @@ -337,7 +336,7 @@ docTracersFirstPhase condConfigFileName = do ["TxSubmission", "TxOutbound"] configureTracers configReflection trConfig [txOutboundTr] txOutboundTrDoc <- documentTracer (txOutboundTr :: - Trace IO (BlockFetch.TraceLabelPeer + Logging.Trace IO (BlockFetch.TraceLabelPeer remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))) @@ -346,21 +345,21 @@ docTracersFirstPhase condConfigFileName = do ["TxSubmission", "LocalServer"] configureTracers configReflection trConfig [localTxSubmissionServerTr] localTxSubmissionServerTrDoc <- documentTracer (localTxSubmissionServerTr :: - Trace IO (TraceLocalTxSubmissionServerEvent blk)) + Logging.Trace IO (TraceLocalTxSubmissionServerEvent blk)) mempoolTr <- mkCardanoTracer trBase trForward mbTrEKG ["Mempool"] configureTracers configReflection trConfig [mempoolTr] mempoolTrDoc <- documentTracer (mempoolTr :: - Trace IO (TraceEventMempool blk)) + Logging.Trace IO (TraceEventMempool blk)) forgeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Forge", "Loop"] configureTracers configReflection trConfig [forgeTr] forgeTrDoc <- documentTracer (forgeTr :: - Trace IO (ForgeTracerType blk)) + Logging.Trace IO (ForgeTracerType blk)) forgeTr' <- mkCardanoTracer @@ -368,14 +367,14 @@ docTracersFirstPhase condConfigFileName = do ["Forge", "ThreadStats"] configureTracers configReflection trConfig [forgeTr'] forgeThreadStatsTrDoc <- documentTracer (forgeTr' :: - Trace IO ForgeThreadStats) + Logging.Trace IO ForgeThreadStats) blockchainTimeTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockchainTime"] configureTracers configReflection trConfig [blockchainTimeTr] blockchainTimeTrDoc <- documentTracer (blockchainTimeTr :: - Trace IO (TraceBlockchainTimeEvent RelativeTime)) + Logging.Trace IO (TraceBlockchainTimeEvent RelativeTime)) -- Node to client @@ -384,14 +383,14 @@ docTracersFirstPhase condConfigFileName = do ["Net"] configureTracers configReflection trConfig [keepAliveClientTr] keepAliveClientTrDoc <- documentTracer (keepAliveClientTr :: - Trace IO (TraceKeepAliveClient peer)) + Logging.Trace IO (TraceKeepAliveClient peer)) chainSyncTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Local"] configureTracers configReflection trConfig [chainSyncTr] chainSyncTrDoc <- documentTracer (chainSyncTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))) @@ -401,7 +400,7 @@ docTracersFirstPhase condConfigFileName = do ["TxSubmission", "MonitorClient"] configureTracers configReflection trConfig [txMonitorTr] txMonitorTrDoc <- documentTracer (txMonitorTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv @@ -413,7 +412,7 @@ docTracersFirstPhase condConfigFileName = do ["TxSubmission", "Local"] configureTracers configReflection trConfig [txSubmissionTr] txSubmissionTrDoc <- documentTracer (txSubmissionTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv @@ -425,7 +424,7 @@ docTracersFirstPhase condConfigFileName = do ["StateQueryServer"] configureTracers configReflection trConfig [stateQueryTr] stateQueryTrDoc <- documentTracer (stateQueryTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))) @@ -437,7 +436,7 @@ docTracersFirstPhase condConfigFileName = do ["ChainSync", "Remote"] configureTracers configReflection trConfig [chainSyncNodeTr] chainSyncNodeTrDoc <- documentTracer (chainSyncNodeTr :: - Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))) chainSyncSerialisedTr <- mkCardanoTracer @@ -445,7 +444,7 @@ docTracersFirstPhase condConfigFileName = do ["ChainSync", "Remote", "Serialised"] configureTracers configReflection trConfig [chainSyncSerialisedTr] chainSyncSerialisedTrDoc <- documentTracer (chainSyncSerialisedTr :: - Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))) blockFetchTr <- mkCardanoTracer @@ -453,7 +452,7 @@ docTracersFirstPhase condConfigFileName = do ["BlockFetch", "Remote"] configureTracers configReflection trConfig [blockFetchTr] blockFetchTrDoc <- documentTracer (blockFetchTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))) @@ -463,7 +462,7 @@ docTracersFirstPhase condConfigFileName = do ["BlockFetch", "Remote", "Serialised"] configureTracers configReflection trConfig [blockFetchSerialisedTr] blockFetchSerialisedTrDoc <- documentTracer (blockFetchSerialisedTr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))) @@ -473,7 +472,7 @@ docTracersFirstPhase condConfigFileName = do ["TxSubmission", "Remote"] configureTracers configReflection trConfig [txSubmission2Tr] txSubmission2TrDoc <- documentTracer (txSubmission2Tr :: - Trace IO + Logging.Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))) @@ -484,28 +483,28 @@ docTracersFirstPhase condConfigFileName = do ["Net", "Mux", "Remote"] configureTracers configReflection trConfig [dtMuxTr] dtMuxTrDoc <- documentTracer (dtMuxTr :: - Trace IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)) + Logging.Trace IO (Mux.WithBearer (ConnectionId RemoteAddress) Mux.Trace)) dtLocalMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Local"] configureTracers configReflection trConfig [dtLocalMuxTr] dtLocalMuxTrDoc <- documentTracer (dtLocalMuxTr :: - Trace IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)) + Logging.Trace IO (Mux.WithBearer (ConnectionId LocalAddress) Mux.Trace)) dtHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Remote"] configureTracers configReflection trConfig [dtHandshakeTr] dtHandshakeTrDoc <- documentTracer (dtHandshakeTr :: - Trace IO (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion)) + Logging.Trace IO (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion)) dtLocalHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Local"] configureTracers configReflection trConfig [dtLocalHandshakeTr] dtLocalHandshakeTrDoc <- documentTracer (dtLocalHandshakeTr :: - Trace IO + Logging.Trace IO (NtC.HandshakeTr LocalAddress NtC.NodeToClientVersion)) dtDiffusionInitializationTr <- mkCardanoTracer @@ -513,14 +512,14 @@ docTracersFirstPhase condConfigFileName = do ["Startup", "DiffusionInit"] configureTracers configReflection trConfig [dtDiffusionInitializationTr] dtDiffusionInitializationTrDoc <- documentTracer (dtDiffusionInitializationTr :: - Trace IO (Diffusion.DiffusionTracer Socket.SockAddr LocalAddress)) + Logging.Trace IO (Diffusion.DiffusionTracer Socket.SockAddr LocalAddress)) dtLedgerPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "Ledger"] configureTracers configReflection trConfig [dtLedgerPeersTr] dtLedgerPeersTrDoc <- documentTracer (dtLedgerPeersTr :: - Trace IO TraceLedgerPeers) + Logging.Trace IO TraceLedgerPeers) -- DiffusionTracersExtra P2P localRootPeersTr <- mkCardanoTracer @@ -528,63 +527,63 @@ docTracersFirstPhase condConfigFileName = do ["Net", "Peers", "LocalRoot"] configureTracers configReflection trConfig [localRootPeersTr] localRootPeersTrDoc <- documentTracer (localRootPeersTr :: - Trace IO (TraceLocalRootPeers RemoteAddress SomeException)) + Logging.Trace IO (TraceLocalRootPeers RemoteAddress SomeException)) publicRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "PublicRoot"] configureTracers configReflection trConfig [publicRootPeersTr] publicRootPeersTrDoc <- documentTracer (publicRootPeersTr :: - Trace IO TracePublicRootPeers) + Logging.Trace IO TracePublicRootPeers) peerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Selection"] configureTracers configReflection trConfig [peerSelectionTr] peerSelectionTrDoc <- documentTracer (peerSelectionTr :: - Trace IO (TracePeerSelection Socket.SockAddr)) + Logging.Trace IO (TracePeerSelection Socket.SockAddr)) debugPeerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Initiator"] configureTracers configReflection trConfig [debugPeerSelectionTr] debugPeerSelectionTrDoc <- documentTracer (debugPeerSelectionTr :: - Trace IO (DebugPeerSelection Socket.SockAddr)) + Logging.Trace IO (DebugPeerSelection Socket.SockAddr)) debugPeerSelectionResponderTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Responder"] configureTracers configReflection trConfig [debugPeerSelectionResponderTr] debugPeerSelectionResponderTrDoc <- documentTracer (debugPeerSelectionResponderTr :: - Trace IO (DebugPeerSelection Socket.SockAddr)) + Logging.Trace IO (DebugPeerSelection Socket.SockAddr)) peerSelectionCountersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Counters"] configureTracers configReflection trConfig [peerSelectionCountersTr] peerSelectionCountersTrDoc <- documentTracer (peerSelectionCountersTr :: - Trace IO PeerSelectionCounters) + Logging.Trace IO PeerSelectionCounters) churnCountersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Churn"] configureTracers configReflection trConfig [churnCountersTr] - churnCountersTrDoc <- documentTracer (churnCountersTr :: Trace IO ChurnCounters) + churnCountersTrDoc <- documentTracer (churnCountersTr :: Logging.Trace IO ChurnCounters) peerSelectionActionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Actions"] configureTracers configReflection trConfig [peerSelectionActionsTr] peerSelectionActionsTrDoc <- documentTracer (peerSelectionActionsTr :: - Trace IO (PeerSelectionActionsTrace Socket.SockAddr LocalAddress)) + Logging.Trace IO (PeerSelectionActionsTrace Socket.SockAddr LocalAddress)) connectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Remote"] configureTracers configReflection trConfig [connectionManagerTr] connectionManagerTrDoc <- documentTracer (connectionManagerTr :: - Trace IO - (ConnectionManagerTrace + Logging.Trace IO + (ConnectionManager.Trace Socket.SockAddr (ConnectionHandlerTrace UnversionedProtocol UnversionedProtocolData))) @@ -593,36 +592,36 @@ docTracersFirstPhase condConfigFileName = do ["Net", "ConnectionManager", "Transition"] configureTracers configReflection trConfig [connectionManagerTransitionsTr] connectionManagerTransitionsTrDoc <- documentTracer (connectionManagerTransitionsTr :: - Trace IO (ConnectionManager.AbstractTransitionTrace Socket.SockAddr)) + Logging.Trace IO (ConnectionManager.AbstractTransitionTrace Socket.SockAddr)) serverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Server", "Remote"] configureTracers configReflection trConfig [serverTr] serverTrDoc <- documentTracer (serverTr :: - Trace IO (ServerTrace Socket.SockAddr)) + Logging.Trace IO (Server.Trace Socket.SockAddr)) inboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Remote"] configureTracers configReflection trConfig [inboundGovernorTr] inboundGovernorTrDoc <- documentTracer (inboundGovernorTr :: - Trace IO (InboundGovernorTrace Socket.SockAddr)) + Logging.Trace IO (InboundGovernor.Trace Socket.SockAddr)) inboundGovernorTransitionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Transition"] configureTracers configReflection trConfig [inboundGovernorTransitionsTr] inboundGovernorTransitionsTrDoc <- documentTracer (inboundGovernorTransitionsTr :: - Trace IO (InboundGovernor.RemoteTransitionTrace Socket.SockAddr)) + Logging.Trace IO (InboundGovernor.RemoteTransitionTrace Socket.SockAddr)) localConnectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Local"] configureTracers configReflection trConfig [localConnectionManagerTr] localConnectionManagerTrDoc <- documentTracer (localConnectionManagerTr :: - Trace IO - (ConnectionManagerTrace + Logging.Trace IO + (ConnectionManager.Trace Socket.SockAddr (ConnectionHandlerTrace UnversionedProtocol @@ -633,14 +632,14 @@ docTracersFirstPhase condConfigFileName = do ["Net", "Server", "Local"] configureTracers configReflection trConfig [localServerTr] localServerTrDoc <- documentTracer (localServerTr :: - Trace IO (ServerTrace LocalAddress)) + Logging.Trace IO (Server.Trace LocalAddress)) localInboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Local"] configureTracers configReflection trConfig [localInboundGovernorTr] localInboundGovernorTrDoc <- documentTracer (localInboundGovernorTr :: - Trace IO (InboundGovernorTrace LocalAddress)) + Logging.Trace IO (InboundGovernor.Trace LocalAddress)) -- -- DiffusionTracersExtra nonP2P @@ -650,49 +649,49 @@ docTracersFirstPhase condConfigFileName = do ["Net", "Subscription", "IP"] configureTracers configReflection trConfig [dtIpSubscriptionTr] dtIpSubscriptionTrDoc <- documentTracer (dtIpSubscriptionTr :: - Trace IO (WithIPList (SubscriptionTrace Socket.SockAddr))) + Logging.Trace IO (WithIPList (SubscriptionTrace Socket.SockAddr))) dtDnsSubscriptionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Subscription", "DNS"] configureTracers configReflection trConfig [dtDnsSubscriptionTr] dtDnsSubscriptionTrDoc <- documentTracer (dtDnsSubscriptionTr :: - Trace IO (WithDomainName (SubscriptionTrace Socket.SockAddr))) + Logging.Trace IO (WithDomainName (SubscriptionTrace Socket.SockAddr))) dtDnsResolverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "DNSResolver"] configureTracers configReflection trConfig [dtDnsResolverTr] dtDnsResolverTrDoc <- documentTracer (dtDnsResolverTr :: - Trace IO (WithDomainName DnsTrace)) + Logging.Trace IO (WithDomainName DnsTrace)) dtErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Remote"] configureTracers configReflection trConfig [dtErrorPolicyTr] dtErrorPolicyTrDoc <- documentTracer (dtErrorPolicyTr :: - Trace IO (WithAddr Socket.SockAddr ErrorPolicyTrace)) + Logging.Trace IO (WithAddr Socket.SockAddr ErrorPolicyTrace)) dtLocalErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Local"] configureTracers configReflection trConfig [dtLocalErrorPolicyTr] dtLocalErrorPolicyTrDoc <- documentTracer (dtLocalErrorPolicyTr :: - Trace IO (WithAddr LocalAddress ErrorPolicyTrace)) + Logging.Trace IO (WithAddr LocalAddress ErrorPolicyTrace)) dtAcceptPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "AcceptPolicy"] configureTracers configReflection trConfig [dtAcceptPolicyTr] dtAcceptPolicyTrDoc <- documentTracer (dtAcceptPolicyTr :: - Trace IO NtN.AcceptConnectionsPolicyTrace) + Logging.Trace IO NtN.AcceptConnectionsPolicyTrace) internalTr <- mkCardanoTracer trBase trForward mbTrEKG ["Reflection"] configureTracers configReflection trConfig [internalTr] internalTrDoc <- documentTracer (internalTr :: - Trace IO TraceDispatcherMessage) + Logging.Trace IO TraceDispatcherMessage) let bl = nodeInfoDpDoc diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 72b957128ee..71dd4031d6e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -19,8 +19,8 @@ import Cardano.Logging import Data.Aeson (Value (String), (.=)) import Data.Text (pack) import Formatting -import Network.Mux (MuxTrace (..), WithMuxBearer (..)) -import Network.Mux.Types +import qualified Network.Mux as Mux +import Network.Mux.Types (SDUHeader (..), unRemoteClockModel) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) import qualified Data.List as List @@ -36,52 +36,52 @@ import Cardano.Node.Configuration.TopologyP2P () -- Mux Tracer -------------------------------------------------------------------------------- -instance (LogFormatting peer, LogFormatting MuxTrace) => - LogFormatting (WithMuxBearer peer MuxTrace) where - forMachine dtal (WithMuxBearer b ev) = - mconcat [ "kind" .= String "MuxTrace" +instance (LogFormatting peer, LogFormatting Mux.Trace) => + LogFormatting (Mux.WithBearer peer Mux.Trace) where + forMachine dtal (Mux.WithBearer b ev) = + mconcat [ "kind" .= String "Mux.Trace" , "bearer" .= forMachine dtal b , "event" .= forMachine dtal ev ] - forHuman (WithMuxBearer b ev) = "With mux bearer " <> forHumanOrMachine b + forHuman (Mux.WithBearer b ev) = "With mux bearer " <> forHumanOrMachine b <> ". " <> forHumanOrMachine ev -instance MetaTrace tr => MetaTrace (WithMuxBearer peer tr) where - namespaceFor (WithMuxBearer _peer obj) = (nsCast . namespaceFor) obj +instance MetaTrace tr => MetaTrace (Mux.WithBearer peer tr) where + namespaceFor (Mux.WithBearer _peer obj) = (nsCast . namespaceFor) obj severityFor ns Nothing = severityFor (nsCast ns :: Namespace tr) Nothing - severityFor ns (Just (WithMuxBearer _peer obj)) = + severityFor ns (Just (Mux.WithBearer _peer obj)) = severityFor (nsCast ns) (Just obj) privacyFor ns Nothing = privacyFor (nsCast ns :: Namespace tr) Nothing - privacyFor ns (Just (WithMuxBearer _peer obj)) = + privacyFor ns (Just (Mux.WithBearer _peer obj)) = privacyFor (nsCast ns) (Just obj) detailsFor ns Nothing = detailsFor (nsCast ns :: Namespace tr) Nothing - detailsFor ns (Just (WithMuxBearer _peer obj)) = + detailsFor ns (Just (Mux.WithBearer _peer obj)) = detailsFor (nsCast ns) (Just obj) documentFor ns = documentFor (nsCast ns :: Namespace tr) metricsDocFor ns = metricsDocFor (nsCast ns :: Namespace tr) allNamespaces = map nsCast (allNamespaces :: [Namespace tr]) -instance LogFormatting MuxTrace where - forMachine _dtal MuxTraceRecvHeaderStart = mconcat - [ "kind" .= String "MuxTraceRecvHeaderStart" +instance LogFormatting Mux.Trace where + forMachine _dtal Mux.TraceRecvHeaderStart = mconcat + [ "kind" .= String "Mux.TraceRecvHeaderStart" , "msg" .= String "Bearer Receive Header Start" ] - forMachine _dtal (MuxTraceRecvHeaderEnd MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat - [ "kind" .= String "MuxTraceRecvHeaderStart" + forMachine _dtal (Mux.TraceRecvHeaderEnd SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat + [ "kind" .= String "Mux.TraceRecvHeaderStart" , "msg" .= String "Bearer Receive Header End" , "timestamp" .= String (showTHex (unRemoteClockModel mhTimestamp)) , "miniProtocolNum" .= String (showT mhNum) , "miniProtocolDir" .= String (showT mhDir) , "length" .= String (showT mhLength) ] - forMachine _dtal (MuxTraceRecvDeltaQObservation MuxSDUHeader { mhTimestamp, mhLength } ts) = mconcat - [ "kind" .= String "MuxTraceRecvDeltaQObservation" + forMachine _dtal (Mux.TraceRecvDeltaQObservation SDUHeader { mhTimestamp, mhLength } ts) = mconcat + [ "kind" .= String "Mux.TraceRecvDeltaQObservation" , "msg" .= String "Bearer DeltaQ observation" , "timeRemote" .= String (showT ts) , "timeLocal" .= String (showTHex (unRemoteClockModel mhTimestamp)) , "length" .= String (showT mhLength) ] - forMachine _dtal (MuxTraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = mconcat - [ "kind" .= String "MuxTraceRecvDeltaQSample" + forMachine _dtal (Mux.TraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = mconcat + [ "kind" .= String "Mux.TraceRecvDeltaQSample" , "msg" .= String "Bearer DeltaQ Sample" , "duration" .= String (showT d) , "packets" .= String (showT sp) @@ -92,83 +92,83 @@ instance LogFormatting MuxTrace where , "DeltaQ_estR" .= String (showT estR) , "sizeDist" .= String (showT sdud) ] - forMachine _dtal (MuxTraceRecvStart len) = mconcat - [ "kind" .= String "MuxTraceRecvStart" + forMachine _dtal (Mux.TraceRecvStart len) = mconcat + [ "kind" .= String "Mux.TraceRecvStart" , "msg" .= String "Bearer Receive Start" , "length" .= String (showT len) ] - forMachine _dtal (MuxTraceRecvEnd len) = mconcat - [ "kind" .= String "MuxTraceRecvEnd" + forMachine _dtal (Mux.TraceRecvEnd len) = mconcat + [ "kind" .= String "Mux.TraceRecvEnd" , "msg" .= String "Bearer Receive End" , "length" .= String (showT len) ] - forMachine _dtal (MuxTraceSendStart MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat - [ "kind" .= String "MuxTraceSendStart" + forMachine _dtal (Mux.TraceSendStart SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = mconcat + [ "kind" .= String "Mux.TraceSendStart" , "msg" .= String "Bearer Send Start" , "timestamp" .= String (showTHex (unRemoteClockModel mhTimestamp)) , "miniProtocolNum" .= String (showT mhNum) , "miniProtocolDir" .= String (showT mhDir) , "length" .= String (showT mhLength) ] - forMachine _dtal MuxTraceSendEnd = mconcat - [ "kind" .= String "MuxTraceSendEnd" + forMachine _dtal Mux.TraceSendEnd = mconcat + [ "kind" .= String "Mux.TraceSendEnd" , "msg" .= String "Bearer Send End" ] - forMachine _dtal (MuxTraceState new) = mconcat - [ "kind" .= String "MuxTraceState" + forMachine _dtal (Mux.TraceState new) = mconcat + [ "kind" .= String "Mux.TraceState" , "msg" .= String "MuxState" , "state" .= String (showT new) ] - forMachine _dtal (MuxTraceCleanExit mid dir) = mconcat - [ "kind" .= String "MuxTraceCleanExit" + 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 (MuxTraceExceptionExit mid dir exc) = mconcat - [ "kind" .= String "MuxTraceExceptionExit" + 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 (MuxTraceChannelRecvStart mid) = mconcat - [ "kind" .= String "MuxTraceChannelRecvStart" + forMachine _dtal (Mux.TraceChannelRecvStart mid) = mconcat + [ "kind" .= String "Mux.TraceChannelRecvStart" , "msg" .= String "Channel Receive Start" , "miniProtocolNum" .= String (showT mid) ] - forMachine _dtal (MuxTraceChannelRecvEnd mid len) = mconcat - [ "kind" .= String "MuxTraceChannelRecvEnd" + 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 (MuxTraceChannelSendStart mid len) = mconcat - [ "kind" .= String "MuxTraceChannelSendStart" + 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 (MuxTraceChannelSendEnd mid) = mconcat - [ "kind" .= String "MuxTraceChannelSendEnd" + forMachine _dtal (Mux.TraceChannelSendEnd mid) = mconcat + [ "kind" .= String "Mux.TraceChannelSendEnd" , "msg" .= String "Channel Send End" , "miniProtocolNum" .= String (showT mid) ] - forMachine _dtal MuxTraceHandshakeStart = mconcat - [ "kind" .= String "MuxTraceHandshakeStart" + forMachine _dtal Mux.TraceHandshakeStart = mconcat + [ "kind" .= String "Mux.TraceHandshakeStart" , "msg" .= String "Handshake start" ] - forMachine _dtal (MuxTraceHandshakeClientEnd duration) = mconcat - [ "kind" .= String "MuxTraceHandshakeClientEnd" + forMachine _dtal (Mux.TraceHandshakeClientEnd duration) = mconcat + [ "kind" .= String "Mux.TraceHandshakeClientEnd" , "msg" .= String "Handshake Client end" , "duration" .= String (showT duration) ] - forMachine _dtal MuxTraceHandshakeServerEnd = mconcat - [ "kind" .= String "MuxTraceHandshakeServerEnd" + forMachine _dtal Mux.TraceHandshakeServerEnd = mconcat + [ "kind" .= String "Mux.TraceHandshakeServerEnd" , "msg" .= String "Handshake Server end" ] - forMachine dtal (MuxTraceHandshakeClientError e duration) = mconcat - [ "kind" .= String "MuxTraceHandshakeClientError" + 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. @@ -176,59 +176,59 @@ instance LogFormatting MuxTrace where then show e else take 256 $ show e ] - forMachine dtal (MuxTraceHandshakeServerError e) = mconcat - [ "kind" .= String "MuxTraceHandshakeServerError" + 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 MuxTraceSDUReadTimeoutException = mconcat - [ "kind" .= String "MuxTraceSDUReadTimeoutException" + forMachine _dtal Mux.TraceSDUReadTimeoutException = mconcat + [ "kind" .= String "Mux.TraceSDUReadTimeoutException" , "msg" .= String "Timed out reading SDU" ] - forMachine _dtal MuxTraceSDUWriteTimeoutException = mconcat - [ "kind" .= String "MuxTraceSDUWriteTimeoutException" + forMachine _dtal Mux.TraceSDUWriteTimeoutException = mconcat + [ "kind" .= String "Mux.TraceSDUWriteTimeoutException" , "msg" .= String "Timed out writing SDU" ] - forMachine _dtal (MuxTraceStartEagerly mid dir) = mconcat - [ "kind" .= String "MuxTraceStartEagerly" + 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 (MuxTraceStartOnDemand mid dir) = mconcat - [ "kind" .= String "MuxTraceStartOnDemand" + 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 (MuxTraceStartedOnDemand mid dir) = mconcat - [ "kind" .= String "MuxTraceStartedOnDemand" + 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 (MuxTraceTerminating mid dir) = mconcat - [ "kind" .= String "MuxTraceTerminating" + forMachine _dtal (Mux.TraceTerminating mid dir) = mconcat + [ "kind" .= String "Mux.TraceTerminating" , "msg" .= String "Terminating" , "miniProtocolNum" .= String (showT mid) , "miniProtocolDir" .= String (showT dir) ] - forMachine _dtal MuxTraceStopping = mconcat - [ "kind" .= String "MuxTraceStopping" + forMachine _dtal Mux.TraceStopping = mconcat + [ "kind" .= String "Mux.TraceStopping" , "msg" .= String "Mux stopping" ] - forMachine _dtal MuxTraceStopped = mconcat - [ "kind" .= String "MuxTraceStopped" + forMachine _dtal Mux.TraceStopped = mconcat + [ "kind" .= String "Mux.TraceStopped" , "msg" .= String "Mux stoppped" ] #ifdef os_HOST_linux - forMachine _dtal (MuxTraceTCPInfo StructTCPInfo + forMachine _dtal (Mux.TraceTCPInfo StructTCPInfo { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans , tcpi_rtt, tcpi_rttvar, tcpi_snd_cwnd } len) = - [ "kind" .= String "MuxTraceTCPInfo" + [ "kind" .= String "Mux.TraceTCPInfo" , "msg" .= String "TCPInfo" , "rtt" .= String (show (fromIntegral tcpi_rtt :: Word)) , "rttvar" .= String (show (fromIntegral tcpi_rttvar :: Word)) @@ -240,79 +240,79 @@ instance LogFormatting MuxTrace where , "length" .= String (showT len) ] #else - forMachine _dtal (MuxTraceTCPInfo _ len) = mconcat - [ "kind" .= String "MuxTraceTCPInfo" + forMachine _dtal (Mux.TraceTCPInfo _ len) = mconcat + [ "kind" .= String "Mux.TraceTCPInfo" , "msg" .= String "TCPInfo" , "len" .= String (showT len) ] #endif - forHuman MuxTraceRecvHeaderStart = + forHuman Mux.TraceRecvHeaderStart = "Bearer Receive Header Start" - forHuman (MuxTraceRecvHeaderEnd MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = + forHuman (Mux.TraceRecvHeaderEnd SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = sformat ("Bearer Receive Header End: ts:" % prefixHex % "(" % shown % ") " % shown % " len " % int) (unRemoteClockModel mhTimestamp) mhNum mhDir mhLength - forHuman (MuxTraceRecvDeltaQObservation MuxSDUHeader { mhTimestamp, mhLength } ts) = + forHuman (Mux.TraceRecvDeltaQObservation SDUHeader { mhTimestamp, mhLength } ts) = sformat ("Bearer DeltaQ observation: remote ts" % int % " local ts " % shown % " length " % int) (unRemoteClockModel mhTimestamp) ts mhLength - forHuman (MuxTraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = + forHuman (Mux.TraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = sformat ("Bearer DeltaQ Sample: duration " % fixed 3 % " packets " % int % " sumBytes " % int % " DeltaQ_S " % fixed 3 % " DeltaQ_VMean " % fixed 3 % "DeltaQ_VVar " % fixed 3 % " DeltaQ_estR " % fixed 3 % " sizeDist " % string) d sp so dqs dqvm dqvs estR sdud - forHuman (MuxTraceRecvStart len) = + forHuman (Mux.TraceRecvStart len) = sformat ("Bearer Receive Start: length " % int) len - forHuman (MuxTraceRecvEnd len) = + forHuman (Mux.TraceRecvEnd len) = sformat ("Bearer Receive End: length " % int) len - forHuman (MuxTraceSendStart MuxSDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = + forHuman (Mux.TraceSendStart SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = sformat ("Bearer Send Start: ts: " % prefixHex % " (" % shown % ") " % shown % " length " % int) (unRemoteClockModel mhTimestamp) mhNum mhDir mhLength - forHuman MuxTraceSendEnd = + forHuman Mux.TraceSendEnd = "Bearer Send End" - forHuman (MuxTraceState new) = + forHuman (Mux.TraceState new) = sformat ("State: " % shown) new - forHuman (MuxTraceCleanExit mid dir) = + forHuman (Mux.TraceCleanExit mid dir) = sformat ("Miniprotocol (" % shown % ") " % shown % " terminated cleanly") mid dir - forHuman (MuxTraceExceptionExit mid dir e) = + forHuman (Mux.TraceExceptionExit mid dir e) = sformat ("Miniprotocol (" % shown % ") " % shown % " terminated with exception " % shown) mid dir e - forHuman (MuxTraceChannelRecvStart mid) = + forHuman (Mux.TraceChannelRecvStart mid) = sformat ("Channel Receive Start on " % shown) mid - forHuman (MuxTraceChannelRecvEnd mid len) = + forHuman (Mux.TraceChannelRecvEnd mid len) = sformat ("Channel Receive End on (" % shown % ") " % int) mid len - forHuman (MuxTraceChannelSendStart mid len) = + forHuman (Mux.TraceChannelSendStart mid len) = sformat ("Channel Send Start on (" % shown % ") " % int) mid len - forHuman (MuxTraceChannelSendEnd mid) = + forHuman (Mux.TraceChannelSendEnd mid) = sformat ("Channel Send End on " % shown) mid - forHuman MuxTraceHandshakeStart = + forHuman Mux.TraceHandshakeStart = "Handshake start" - forHuman (MuxTraceHandshakeClientEnd duration) = + forHuman (Mux.TraceHandshakeClientEnd duration) = sformat ("Handshake Client end, duration " % shown) duration - forHuman MuxTraceHandshakeServerEnd = + forHuman Mux.TraceHandshakeServerEnd = "Handshake Server end" - forHuman (MuxTraceHandshakeClientError e duration) = + 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 (MuxTraceHandshakeServerError e) = + forHuman (Mux.TraceHandshakeServerError e) = sformat ("Handshake Server Error " % shown) e - forHuman MuxTraceSDUReadTimeoutException = + forHuman Mux.TraceSDUReadTimeoutException = "Timed out reading SDU" - forHuman MuxTraceSDUWriteTimeoutException = + forHuman Mux.TraceSDUWriteTimeoutException = "Timed out writing SDU" - forHuman (MuxTraceStartEagerly mid dir) = + forHuman (Mux.TraceStartEagerly mid dir) = sformat ("Eagerly started (" % shown % ") in " % shown) mid dir - forHuman (MuxTraceStartOnDemand mid dir) = + forHuman (Mux.TraceStartOnDemand mid dir) = sformat ("Preparing to start (" % shown % ") in " % shown) mid dir - forHuman (MuxTraceStartedOnDemand mid dir) = + forHuman (Mux.TraceStartedOnDemand mid dir) = sformat ("Started on demand (" % shown % ") in " % shown) mid dir - forHuman (MuxTraceTerminating mid dir) = + forHuman (Mux.TraceTerminating mid dir) = sformat ("Terminating (" % shown % ") in " % shown) mid dir - forHuman MuxTraceStopping = "Mux stopping" - forHuman MuxTraceStopped = "Mux stoppped" + forHuman Mux.TraceStopping = "Mux stopping" + forHuman Mux.TraceStopped = "Mux stoppped" #ifdef os_HOST_linux - forHuman (MuxTraceTCPInfo StructTCPInfo + forHuman (Mux.TraceTCPInfo StructTCPInfo { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans , tcpi_rtt, tcpi_rttvar, tcpi_snd_cwnd } len) = @@ -325,67 +325,67 @@ instance LogFormatting MuxTrace where (fromIntegral tcpi_retrans :: Word) len #else - forHuman (MuxTraceTCPInfo _ len) = sformat ("TCPInfo len " % int) len + forHuman (Mux.TraceTCPInfo _ len) = sformat ("TCPInfo len " % int) len #endif -instance MetaTrace MuxTrace where - namespaceFor MuxTraceRecvHeaderStart {} = +instance MetaTrace Mux.Trace where + namespaceFor Mux.TraceRecvHeaderStart {} = Namespace [] ["RecvHeaderStart"] - namespaceFor MuxTraceRecvHeaderEnd {} = + namespaceFor Mux.TraceRecvHeaderEnd {} = Namespace [] ["RecvHeaderEnd"] - namespaceFor MuxTraceRecvStart {} = + namespaceFor Mux.TraceRecvStart {} = Namespace [] ["RecvStart"] - namespaceFor MuxTraceRecvEnd {} = + namespaceFor Mux.TraceRecvEnd {} = Namespace [] ["RecvEnd"] - namespaceFor MuxTraceSendStart {} = + namespaceFor Mux.TraceSendStart {} = Namespace [] ["SendStart"] - namespaceFor MuxTraceSendEnd = + namespaceFor Mux.TraceSendEnd = Namespace [] ["SendEnd"] - namespaceFor MuxTraceState {} = + namespaceFor Mux.TraceState {} = Namespace [] ["State"] - namespaceFor MuxTraceCleanExit {} = + namespaceFor Mux.TraceCleanExit {} = Namespace [] ["CleanExit"] - namespaceFor MuxTraceExceptionExit {} = + namespaceFor Mux.TraceExceptionExit {} = Namespace [] ["ExceptionExit"] - namespaceFor MuxTraceChannelRecvStart {} = + namespaceFor Mux.TraceChannelRecvStart {} = Namespace [] ["ChannelRecvStart"] - namespaceFor MuxTraceChannelRecvEnd {} = + namespaceFor Mux.TraceChannelRecvEnd {} = Namespace [] ["ChannelRecvEnd"] - namespaceFor MuxTraceChannelSendStart {} = + namespaceFor Mux.TraceChannelSendStart {} = Namespace [] ["ChannelSendStart"] - namespaceFor MuxTraceChannelSendEnd {} = + namespaceFor Mux.TraceChannelSendEnd {} = Namespace [] ["ChannelSendEnd"] - namespaceFor MuxTraceHandshakeStart = + namespaceFor Mux.TraceHandshakeStart = Namespace [] ["HandshakeStart"] - namespaceFor MuxTraceHandshakeClientEnd {} = + namespaceFor Mux.TraceHandshakeClientEnd {} = Namespace [] ["HandshakeClientEnd"] - namespaceFor MuxTraceHandshakeServerEnd = + namespaceFor Mux.TraceHandshakeServerEnd = Namespace [] ["HandshakeServerEnd"] - namespaceFor MuxTraceHandshakeClientError {} = + namespaceFor Mux.TraceHandshakeClientError {} = Namespace [] ["HandshakeClientError"] - namespaceFor MuxTraceHandshakeServerError {} = + namespaceFor Mux.TraceHandshakeServerError {} = Namespace [] ["HandshakeServerError"] - namespaceFor MuxTraceRecvDeltaQObservation {} = + namespaceFor Mux.TraceRecvDeltaQObservation {} = Namespace [] ["RecvDeltaQObservation"] - namespaceFor MuxTraceRecvDeltaQSample {} = + namespaceFor Mux.TraceRecvDeltaQSample {} = Namespace [] ["RecvDeltaQSample"] - namespaceFor MuxTraceSDUReadTimeoutException = + namespaceFor Mux.TraceSDUReadTimeoutException = Namespace [] ["SDUReadTimeoutException"] - namespaceFor MuxTraceSDUWriteTimeoutException = + namespaceFor Mux.TraceSDUWriteTimeoutException = Namespace [] ["SDUWriteTimeoutException"] - namespaceFor MuxTraceStartEagerly {} = + namespaceFor Mux.TraceStartEagerly {} = Namespace [] ["StartEagerly"] - namespaceFor MuxTraceStartOnDemand {} = + namespaceFor Mux.TraceStartOnDemand {} = Namespace [] ["StartOnDemand"] - namespaceFor MuxTraceStartedOnDemand {} = + namespaceFor Mux.TraceStartedOnDemand {} = Namespace [] ["StartedOnDemand"] - namespaceFor MuxTraceTerminating {} = + namespaceFor Mux.TraceTerminating {} = Namespace [] ["Terminating"] - namespaceFor MuxTraceStopping = + namespaceFor Mux.TraceStopping = Namespace [] ["Stopping"] - namespaceFor MuxTraceStopped = + namespaceFor Mux.TraceStopped = Namespace [] ["Stopped"] - namespaceFor MuxTraceTCPInfo {} = + namespaceFor Mux.TraceTCPInfo {} = Namespace [] ["TCPInfo"] severityFor (Namespace _ ["RecvHeaderStart"]) _ = Just Debug @@ -520,11 +520,11 @@ instance MetaTrace MuxTrace where -------------------------------------------------------------------------------- instance (Show adr, Show ver) => LogFormatting (NtN.HandshakeTr adr ver) where - forMachine _dtal (WithMuxBearer b ev) = + forMachine _dtal (Mux.WithBearer b ev) = mconcat [ "kind" .= String "HandshakeTrace" , "bearer" .= show b , "event" .= show ev ] - forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b + forHuman (Mux.WithBearer b ev) = "With mux bearer " <> showT b <> ". " <> showT ev instance MetaTrace (AnyMessage (HS.Handshake nt term)) where diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index aa36f94107f..eed42f692ae 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -26,12 +26,12 @@ import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) -import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..), - ConnectionManagerTrace (..)) +import Ouroboros.Network.ConnectionManager.Core as ConnectionManager (Trace (..)) +import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager -import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..)) +import Ouroboros.Network.InboundGovernor as InboundGovernor (Trace (..)) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor -import Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..)) +import Ouroboros.Network.InboundGovernor.State as InboundGovernor (Counters (..)) import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.Governor (ChurnCounters (..), DebugPeerSelection (..), DebugPeerSelectionState (..), PeerSelectionCounters, @@ -47,7 +47,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 (ServerTrace (..)) +import Ouroboros.Network.Server2 as Server import Ouroboros.Network.Snocket (LocalAddress (..)) import Data.Aeson (Object, ToJSON, ToJSONKey, Value (..), object, toJSON, toJSONList, @@ -1174,7 +1174,7 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) - => LogFormatting (ConnectionManagerTrace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where + => LogFormatting (ConnectionManager.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where forMachine dtal (TrIncludeConnection prov peerAddr) = mconcat $ reverse [ "kind" .= String "IncludeConnection" @@ -1356,7 +1356,7 @@ instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) , "command" .= show cerr ] -instance MetaTrace (ConnectionManagerTrace addr +instance MetaTrace (ConnectionManager.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where namespaceFor TrIncludeConnection {} = Namespace [] ["IncludeConnection"] namespaceFor TrUnregisterConnection {} = Namespace [] ["UnregisterConnection"] @@ -1501,7 +1501,7 @@ instance MetaTrace (ConnectionManager.AbstractTransitionTrace peerAddr) where -------------------------------------------------------------------------------- instance (Show addr, LogFormatting addr, ToJSON addr) - => LogFormatting (ServerTrace addr) where + => LogFormatting (Server.Trace addr) where forMachine dtal (TrAcceptConnection peerAddr) = mconcat [ "kind" .= String "AcceptConnection" , "address" .= forMachine dtal peerAddr @@ -1527,7 +1527,7 @@ instance (Show addr, LogFormatting addr, ToJSON addr) ] forHuman = pack . show -instance MetaTrace (ServerTrace addr) where +instance MetaTrace (Server.Trace addr) where namespaceFor TrAcceptConnection {} = Namespace [] ["AcceptConnection"] namespaceFor TrAcceptError {} = Namespace [] ["AcceptError"] namespaceFor TrAcceptPolicyTrace {} = Namespace [] ["AcceptPolicy"] @@ -1564,10 +1564,10 @@ instance MetaTrace (ServerTrace addr) where -- InboundGovernor Tracer -------------------------------------------------------------------------------- -instance LogFormatting (InboundGovernorTrace SockAddr) where +instance LogFormatting (InboundGovernor.Trace SockAddr) where forMachine = forMachineGov forHuman = pack . show - asMetrics (TrInboundGovernorCounters InboundGovernorCounters {..}) = + asMetrics (TrInboundGovernorCounters InboundGovernor.Counters {..}) = [ IntM "inboundGovernor.idle" (fromIntegral idlePeersRemote) @@ -1583,10 +1583,10 @@ instance LogFormatting (InboundGovernorTrace SockAddr) where ] asMetrics _ = [] -instance LogFormatting (InboundGovernorTrace LocalAddress) where +instance LogFormatting (InboundGovernor.Trace LocalAddress) where forMachine = forMachineGov forHuman = pack . show - asMetrics (TrInboundGovernorCounters InboundGovernorCounters {..}) = + asMetrics (TrInboundGovernorCounters InboundGovernor.Counters {..}) = [ IntM "localInboundGovernor.idle" (fromIntegral idlePeersRemote) @@ -1603,7 +1603,7 @@ instance LogFormatting (InboundGovernorTrace LocalAddress) where asMetrics _ = [] -forMachineGov :: (ToJSON adr, Show adr) => DetailLevel -> InboundGovernorTrace adr -> Object +forMachineGov :: (ToJSON adr, Show adr) => DetailLevel -> InboundGovernor.Trace adr -> Object forMachineGov _dtal (TrNewConnection p connId) = mconcat [ "kind" .= String "NewConnection" , "provenance" .= show p @@ -1697,7 +1697,7 @@ forMachineGov _dtal (InboundGovernor.TrInactive fresh) = , "fresh" .= toJSON fresh ] -instance MetaTrace (InboundGovernorTrace addr) where +instance MetaTrace (InboundGovernor.Trace addr) where namespaceFor TrNewConnection {} = Namespace [] ["NewConnection"] namespaceFor TrResponderRestarted {} = Namespace [] ["ResponderRestarted"] namespaceFor TrResponderStartFailure {} = Namespace [] ["ResponderStartFailure"] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index d4870456ab8..b4388ddd3ed 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -41,17 +41,17 @@ import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) +import Ouroboros.Network.ConnectionManager.Core as ConnMgr (Trace (..)) import Ouroboros.Network.ConnectionManager.Types (AbstractState (..), - ConnectionManagerCounters (..), ConnectionManagerTrace (..), + ConnectionManagerCounters (..), OperationResult (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnMgr import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import qualified Ouroboros.Network.Diffusion as ND import Ouroboros.Network.Driver.Limits (ProtocolLimitFailure (..)) import Ouroboros.Network.ExitPolicy (RepromoteDelay (..)) -import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..), RemoteSt (..)) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor -import Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..)) +import qualified Ouroboros.Network.InboundGovernor.State as InboundGovernor import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.NodeToClient (NodeToClientVersion (..), @@ -96,8 +96,7 @@ import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount PeerSharingResult (..)) import Ouroboros.Network.Protocol.TxSubmission2.Type as TxSubmission2 import Ouroboros.Network.RethrowPolicy (ErrorCommand (..)) -import Ouroboros.Network.Server2 (ServerTrace (..)) -import qualified Ouroboros.Network.Server2 as Server +import Ouroboros.Network.Server2 as Server import Ouroboros.Network.Snocket (LocalAddress (..)) import Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..), SubscriberError (..), SubscriptionTrace (..), WithDomainName (..), @@ -122,10 +121,10 @@ 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 (..), MuxTrace (..), WithMuxBearer (..)) +import Network.Mux (MiniProtocolNum (..)) +import qualified Network.Mux as Mux import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) -import Network.TypedProtocol.Core (PeerHasAgency (..)) {- HLINT ignore "Use record patterns" -} @@ -369,38 +368,38 @@ instance ToObject (Identity (SubscriptionTrace LocalAddress)) where ] -instance HasPrivacyAnnotation (WithMuxBearer peer MuxTrace) -instance HasSeverityAnnotation (WithMuxBearer peer MuxTrace) where - getSeverityAnnotation (WithMuxBearer _ ev) = case ev of - MuxTraceRecvHeaderStart -> Debug - MuxTraceRecvHeaderEnd {} -> Debug - MuxTraceRecvStart {} -> Debug - MuxTraceRecvEnd {} -> Debug - MuxTraceSendStart {} -> Debug - MuxTraceSendEnd -> Debug - MuxTraceState {} -> Info - MuxTraceCleanExit {} -> Notice - MuxTraceExceptionExit {} -> Notice - MuxTraceChannelRecvStart {} -> Debug - MuxTraceChannelRecvEnd {} -> Debug - MuxTraceChannelSendStart {} -> Debug - MuxTraceChannelSendEnd {} -> Debug - MuxTraceHandshakeStart -> Debug - MuxTraceHandshakeClientEnd {} -> Info - MuxTraceHandshakeServerEnd -> Debug - MuxTraceHandshakeClientError {} -> Error - MuxTraceHandshakeServerError {} -> Error - MuxTraceRecvDeltaQObservation {} -> Debug - MuxTraceRecvDeltaQSample {} -> Debug - MuxTraceSDUReadTimeoutException -> Notice - MuxTraceSDUWriteTimeoutException -> Notice - MuxTraceStartEagerly _ _ -> Info - MuxTraceStartOnDemand _ _ -> Info - MuxTraceStartedOnDemand _ _ -> Info - MuxTraceTerminating {} -> Debug - MuxTraceStopping -> Debug - MuxTraceStopped -> Debug - MuxTraceTCPInfo {} -> Debug +instance HasPrivacyAnnotation (Mux.WithBearer peer Mux.Trace) +instance HasSeverityAnnotation (Mux.WithBearer peer Mux.Trace) where + getSeverityAnnotation (Mux.WithBearer _ ev) = case ev of + Mux.TraceRecvHeaderStart -> Debug + Mux.TraceRecvHeaderEnd {} -> Debug + Mux.TraceRecvStart {} -> Debug + 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.TraceRecvDeltaQObservation {} -> Debug + Mux.TraceRecvDeltaQSample {} -> Debug + Mux.TraceSDUReadTimeoutException -> Notice + Mux.TraceSDUWriteTimeoutException -> Notice + Mux.TraceStartEagerly _ _ -> Info + Mux.TraceStartOnDemand _ _ -> Info + Mux.TraceStartedOnDemand _ _ -> Info + Mux.TraceTerminating {} -> Debug + Mux.TraceStopping -> Debug + Mux.TraceStopped -> Debug + Mux.TraceTCPInfo {} -> Debug instance HasPrivacyAnnotation (TraceLocalRootPeers RemoteAddress exception) instance HasSeverityAnnotation (TraceLocalRootPeers RemoteAddress exception) where @@ -501,8 +500,8 @@ instance HasPrivacyAnnotation PeerSelectionCounters instance HasSeverityAnnotation PeerSelectionCounters where getSeverityAnnotation _ = Info -instance HasPrivacyAnnotation (ConnectionManagerTrace addr connTrace) -instance HasSeverityAnnotation (ConnectionManagerTrace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where +instance HasPrivacyAnnotation (ConnMgr.Trace addr connTrace) +instance HasSeverityAnnotation (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where getSeverityAnnotation ev = case ev of TrIncludeConnection {} -> Debug @@ -539,8 +538,8 @@ instance HasPrivacyAnnotation (ConnMgr.AbstractTransitionTrace addr) instance HasSeverityAnnotation (ConnMgr.AbstractTransitionTrace addr) where getSeverityAnnotation _ = Debug -instance HasPrivacyAnnotation (ServerTrace addr) -instance HasSeverityAnnotation (ServerTrace addr) where +instance HasPrivacyAnnotation (Server.Trace addr) +instance HasSeverityAnnotation (Server.Trace addr) where getSeverityAnnotation ev = case ev of Server.TrAcceptConnection {} -> Debug @@ -550,8 +549,8 @@ instance HasSeverityAnnotation (ServerTrace addr) where Server.TrServerStopped {} -> Notice Server.TrServerError {} -> Critical -instance HasPrivacyAnnotation (InboundGovernorTrace addr) -instance HasSeverityAnnotation (InboundGovernorTrace addr) where +instance HasPrivacyAnnotation (InboundGovernor.Trace addr) +instance HasSeverityAnnotation (InboundGovernor.Trace addr) where getSeverityAnnotation ev = case ev of InboundGovernor.TrNewConnection {} -> Debug @@ -717,11 +716,11 @@ instance HasTextFormatter (WithIPList (SubscriptionTrace SockAddr)) where instance (Show peer, ToObject peer) - => Transformable Text IO (WithMuxBearer peer MuxTrace) where + => Transformable Text IO (Mux.WithBearer peer Mux.Trace) where trTransformer = trStructuredText instance (Show peer) - => HasTextFormatter (WithMuxBearer peer MuxTrace) where - formatText (WithMuxBearer peer ev) _o = + => HasTextFormatter (Mux.WithBearer peer Mux.Trace) where + formatText (Mux.WithBearer peer ev) _o = "Bearer on " <> pack (show peer) <> " event: " <> pack (show ev) @@ -761,12 +760,12 @@ instance HasTextFormatter PeerSelectionCounters where instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions ) - => Transformable Text IO (ConnectionManagerTrace + => Transformable Text IO (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where trTransformer = trStructuredText instance (Show addr, Show versionNumber, Show agreedOptions) - => HasTextFormatter (ConnectionManagerTrace + => HasTextFormatter (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where formatText a _ = pack (show a) @@ -779,17 +778,17 @@ instance Show addr formatText a _ = pack (show a) instance (Show addr, ToObject addr, ToJSON addr) - => Transformable Text IO (ServerTrace addr) where + => Transformable Text IO (Server.Trace addr) where trTransformer = trStructuredText instance Show addr - => HasTextFormatter (ServerTrace addr) where + => HasTextFormatter (Server.Trace addr) where formatText a _ = pack (show a) instance (ToJSON addr, Show addr) - => Transformable Text IO (InboundGovernorTrace addr) where + => Transformable Text IO (InboundGovernor.Trace addr) where trTransformer = trStructuredText instance Show addr - => HasTextFormatter (InboundGovernorTrace addr) where + => HasTextFormatter (InboundGovernor.Trace addr) where formatText a _ = pack (show a) instance (Show addr, ToJSON addr) @@ -1118,14 +1117,14 @@ instance (Show ntnAddr, Show ntcAddr) => ToObject (ND.DiffusionTracer ntnAddr nt ] instance ToObject (NtC.HandshakeTr LocalAddress NodeToClientVersion) where - toObject _verb (WithMuxBearer b ev) = + 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 (WithMuxBearer b ev) = + toObject _verb (Mux.WithBearer b ev) = mconcat [ "kind" .= String "HandshakeTrace" , "bearer" .= show b , "event" .= show ev ] @@ -1472,9 +1471,9 @@ instance ToObject (WithDomainName (SubscriptionTrace SockAddr)) where , "event" .= show ev ] -instance ToObject peer => ToObject (WithMuxBearer peer MuxTrace) where - toObject verb (WithMuxBearer b ev) = - mconcat [ "kind" .= String "MuxTrace" +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 ] @@ -2245,7 +2244,7 @@ instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) - => ToObject (ConnectionManagerTrace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where + => ToObject (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where toObject verb ev = case ev of TrIncludeConnection prov peerAddr -> @@ -2402,27 +2401,27 @@ instance (Show addr, ToObject addr, ToJSON addr) ] instance (Show addr, ToObject addr, ToJSON addr) - => ToObject (ServerTrace addr) where - toObject verb (TrAcceptConnection peerAddr) = + => ToObject (Server.Trace addr) where + toObject verb (Server.TrAcceptConnection peerAddr) = mconcat [ "kind" .= String "AcceptConnection" , "address" .= toObject verb peerAddr ] - toObject _verb (TrAcceptError exception) = + toObject _verb (Server.TrAcceptError exception) = mconcat [ "kind" .= String "AcceptErroor" , "reason" .= show exception ] - toObject verb (TrAcceptPolicyTrace policyTrace) = - mconcat [ "kind" .= String "AcceptPolicyTrace" + toObject verb (Server.TrAcceptPolicyTrace policyTrace) = + mconcat [ "kind" .= String "AcceptPolicyServer.Trace" , "policy" .= toObject verb policyTrace ] - toObject verb (TrServerStarted peerAddrs) = - mconcat [ "kind" .= String "AcceptPolicyTrace" + toObject verb (Server.TrServerStarted peerAddrs) = + mconcat [ "kind" .= String "AcceptPolicyServer.Trace" , "addresses" .= toJSON (toObject verb `map` peerAddrs) ] - toObject _verb TrServerStopped = + toObject _verb Server.TrServerStopped = mconcat [ "kind" .= String "ServerStopped" ] - toObject _verb (TrServerError exception) = + toObject _verb (Server.TrServerError exception) = mconcat [ "kind" .= String "ServerError" , "reason" .= show exception ] @@ -2485,79 +2484,79 @@ instance ToObject NtC.LocalConnectionId where , "remote" .= toObject verb r ] instance (ToJSON addr, Show addr) - => ToObject (InboundGovernorTrace addr) where - toObject _verb (TrNewConnection p connId) = + => ToObject (InboundGovernor.Trace addr) where + toObject _verb (InboundGovernor.TrNewConnection p connId) = mconcat [ "kind" .= String "NewConnection" , "provenance" .= show p , "connectionId" .= toJSON connId ] - toObject _verb (TrResponderRestarted connId m) = + toObject _verb (InboundGovernor.TrResponderRestarted connId m) = mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] - toObject _verb (TrResponderStartFailure connId m s) = + toObject _verb (InboundGovernor.TrResponderStartFailure connId m s) = mconcat [ "kind" .= String "ResponderStartFailure" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] - toObject _verb (TrResponderErrored connId m s) = + toObject _verb (InboundGovernor.TrResponderErrored connId m s) = mconcat [ "kind" .= String "ResponderErrored" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] - toObject _verb (TrResponderStarted connId m) = + toObject _verb (InboundGovernor.TrResponderStarted connId m) = mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] - toObject _verb (TrResponderTerminated connId m) = + toObject _verb (InboundGovernor.TrResponderTerminated connId m) = mconcat [ "kind" .= String "ResponderTerminated" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] - toObject _verb (TrPromotedToWarmRemote connId opRes) = + toObject _verb (InboundGovernor.TrPromotedToWarmRemote connId opRes) = mconcat [ "kind" .= String "PromotedToWarmRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] - toObject _verb (TrPromotedToHotRemote connId) = + toObject _verb (InboundGovernor.TrPromotedToHotRemote connId) = mconcat [ "kind" .= String "PromotedToHotRemote" , "connectionId" .= toJSON connId ] - toObject _verb (TrDemotedToColdRemote connId od) = + toObject _verb (InboundGovernor.TrDemotedToColdRemote connId od) = mconcat [ "kind" .= String "DemotedToColdRemote" , "connectionId" .= toJSON connId , "result" .= show od ] - toObject _verb (TrDemotedToWarmRemote connId) = + toObject _verb (InboundGovernor.TrDemotedToWarmRemote connId) = mconcat [ "kind" .= String "DemotedToWarmRemote" , "connectionId" .= toJSON connId ] - toObject _verb (TrWaitIdleRemote connId opRes) = + toObject _verb (InboundGovernor.TrWaitIdleRemote connId opRes) = mconcat [ "kind" .= String "WaitIdleRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] - toObject _verb (TrMuxCleanExit connId) = + toObject _verb (InboundGovernor.TrMuxCleanExit connId) = mconcat [ "kind" .= String "MuxCleanExit" , "connectionId" .= toJSON connId ] - toObject _verb (TrMuxErrored connId s) = + toObject _verb (InboundGovernor.TrMuxErrored connId s) = mconcat [ "kind" .= String "MuxErrored" , "connectionId" .= toJSON connId , "reason" .= show s ] - toObject _verb (TrInboundGovernorCounters counters) = + toObject _verb (InboundGovernor.TrInboundGovernorCounters counters) = mconcat [ "kind" .= String "InboundGovernorCounters" - , "idlePeers" .= idlePeersRemote counters - , "coldPeers" .= coldPeersRemote counters - , "warmPeers" .= warmPeersRemote counters - , "hotPeers" .= hotPeersRemote counters + , "idlePeers" .= InboundGovernor.idlePeersRemote counters + , "coldPeers" .= InboundGovernor.coldPeersRemote counters + , "warmPeers" .= InboundGovernor.warmPeersRemote counters + , "hotPeers" .= InboundGovernor.hotPeersRemote counters ] - toObject _verb (TrRemoteState st) = + toObject _verb (InboundGovernor.TrRemoteState st) = mconcat [ "kind" .= String "RemoteState" , "remoteSt" .= toJSON st ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 8f4636ac6e1..5047e4f5669 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -93,13 +93,13 @@ import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState TraceLabelPeer (..)) import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) import Ouroboros.Network.ConnectionId (ConnectionId) -import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..), - ConnectionManagerTrace (..)) +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.NonP2P as NonP2P import qualified Ouroboros.Network.Diffusion.P2P as P2P -import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..)) -import Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..)) +import qualified Ouroboros.Network.InboundGovernor as InboundGovernor +import Ouroboros.Network.InboundGovernor.State as InboundGovernor import Ouroboros.Network.NodeToClient (LocalAddress) import Ouroboros.Network.NodeToNode (RemoteAddress) import Ouroboros.Network.PeerSelection.Governor (ChurnCounters (..), @@ -245,12 +245,10 @@ instance ElidingTracer (WithSeverity (ChainDB.TraceEvent blk)) where doelide (WithSeverity _ (ChainDB.TraceGCEvent _)) = True doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreBlockOlderThanK _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreInvalidBlock _ _))) = False - doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.BlockInTheFuture _ _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.StoreButDontChange _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.TrySwitchToAFork _ _))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.SwitchedToAFork{}))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation (ChainDB.InvalidBlock _ _)))) = False - doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{}))) = False doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation _))) = True doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.AddedToCurrentChain events _ _ _))) = null events doelide (WithSeverity _ (ChainDB.TraceAddBlockEvent (ChainDB.PipeliningEvent{}))) = True @@ -1490,14 +1488,14 @@ teeTraceBlockFetchDecisionElide = elideToLogObject traceConnectionManagerTraceMetrics :: OnOff TraceConnectionManagerCounters -> Maybe EKGDirect - -> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace) + -> Tracer IO (ConnectionManager.Trace peerAddr handlerTrace) traceConnectionManagerTraceMetrics _ Nothing = nullTracer traceConnectionManagerTraceMetrics (OnOff False) _ = nullTracer traceConnectionManagerTraceMetrics (OnOff True) (Just ekgDirect) = cmtTracer where - cmtTracer :: Tracer IO (ConnectionManagerTrace peerAddr handlerTrace) + cmtTracer :: Tracer IO (ConnectionManager.Trace peerAddr handlerTrace) cmtTracer = Tracer $ \case - (TrConnectionManagerCounters + (ConnectionManager.TrConnectionManagerCounters (ConnectionManagerCounters prunableConns duplexConns @@ -1621,14 +1619,14 @@ traceInboundGovernorCountersMetrics :: forall addr. OnOff TraceInboundGovernorCounters -> Maybe EKGDirect - -> Tracer IO (InboundGovernorTrace addr) + -> Tracer IO (InboundGovernor.Trace addr) traceInboundGovernorCountersMetrics _ Nothing = nullTracer traceInboundGovernorCountersMetrics (OnOff False) _ = nullTracer traceInboundGovernorCountersMetrics (OnOff True) (Just ekgDirect) = ipgcTracer where - ipgcTracer :: Tracer IO (InboundGovernorTrace addr) + ipgcTracer :: Tracer IO (InboundGovernor.Trace addr) ipgcTracer = Tracer $ \case - (TrInboundGovernorCounters InboundGovernorCounters { + (InboundGovernor.TrInboundGovernorCounters InboundGovernor.Counters { idlePeersRemote, coldPeersRemote, warmPeersRemote, From c02edc5d82a172907db75ad8f6c8883ec2c2de24 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 15:26:21 -0700 Subject: [PATCH 20/79] ouroboros-network upgrade: accommodate new and changed constructors --- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 10 ++++++ .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 19 +++++++++-- .../Tracing/OrphanInstances/Network.hs | 34 ++++++++++--------- 3 files changed, 45 insertions(+), 18 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 71dd4031d6e..e7d8d94a088 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -851,6 +851,10 @@ instance LogFormatting TraceLedgerPeers where , "domainAccessPoint" .= show dap , "error" .= show reason ] + forMachine _dtal UsingBigLedgerPeerSnapshot = + mconcat + [ "kind" .= String "UsingBigLedgerPeerSnapshot" + ] instance MetaTrace TraceLedgerPeers where namespaceFor PickedLedgerPeer {} = @@ -885,6 +889,8 @@ instance MetaTrace TraceLedgerPeers where Namespace [] ["TraceLedgerPeersResult"] namespaceFor TraceLedgerPeersFailure {} = Namespace [] ["TraceLedgerPeersFailure"] + namespaceFor UsingBigLedgerPeerSnapshot {} = + Namespace [] ["UsingBigLedgerPeerSnapshot"] severityFor (Namespace _ ["PickedPeer"]) _ = Just Debug severityFor (Namespace _ ["PickedPeers"]) _ = Just Info @@ -900,6 +906,7 @@ instance MetaTrace TraceLedgerPeers where severityFor (Namespace _ ["TraceLedgerPeersDomains"]) _ = Just Debug severityFor (Namespace _ ["TraceLedgerPeersResult"]) _ = Just Debug severityFor (Namespace _ ["TraceLedgerPeersFailure"]) _ = Just Debug + severityFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) _ = Just Info severityFor _ _ = Nothing documentFor (Namespace _ ["PickedPeer"]) = Just @@ -928,6 +935,8 @@ instance MetaTrace TraceLedgerPeers where "" documentFor (Namespace _ ["TraceLedgerPeersFailure"]) = Just "" + documentFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) = Just + "" documentFor _ = Nothing allNamespaces = [ @@ -943,4 +952,5 @@ instance MetaTrace TraceLedgerPeers where , Namespace [] ["TraceLedgerPeersDomains"] , Namespace [] ["TraceLedgerPeersResult"] , Namespace [] ["TraceLedgerPeersFailure"] + , Namespace [] ["UsingBigLedgerPeerSnapshot"] ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index eed42f692ae..305d35e1c60 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -50,6 +50,7 @@ import Ouroboros.Network.RethrowPolicy (ErrorCommand (..)) import Ouroboros.Network.Server2 as Server import Ouroboros.Network.Snocket (LocalAddress (..)) +import Control.Exception (displayException) import Data.Aeson (Object, ToJSON, ToJSONKey, Value (..), object, toJSON, toJSONList, (.=)) import Data.Aeson.Types (listValue) @@ -515,6 +516,9 @@ instance LogFormatting (TracePeerSelection SockAddr) where forMachine _dtal TraceBootstrapPeersFlagChangedWhilstInSensitiveState = mconcat [ "kind" .= String "BootstrapPeersFlagChangedWhilstInSensitiveState" ] + forMachine _dtal (TraceVerifyPeerSnapshot result) = + mconcat [ "kind" .= String "VerifyPeerSnapshot" + , "result" .= toJSON result ] forMachine _dtal (TraceOutboundGovernorCriticalFailure err) = mconcat [ "kind" .= String "OutboundGovernorCriticalFailure" , "reason" .= show err @@ -668,6 +672,8 @@ instance MetaTrace (TracePeerSelection SockAddr) where Namespace [] ["OnlyBootstrapPeers"] namespaceFor TraceUseBootstrapPeersChanged {} = Namespace [] ["UseBootstrapPeersChanged"] + namespaceFor TraceVerifyPeerSnapshot {} = + Namespace [] ["VerifyPeerSnapshot"] namespaceFor TraceBootstrapPeersFlagChangedWhilstInSensitiveState = Namespace [] ["BootstrapPeersFlagChangedWhilstInSensitiveState"] namespaceFor TraceOutboundGovernorCriticalFailure {} = @@ -1137,6 +1143,10 @@ instance Show lAddr => LogFormatting (PeerSelectionActionsTrace SockAddr lAddr) , "connectionId" .= toJSON connId , "withProtocolTemp" .= show wf ] + forMachine _dtal (AcquireConnectionError exception) = + mconcat [ "kind" .= String "AcquireConnectionError" + , "error" .= displayException exception + ] forHuman = pack . show instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where @@ -1144,11 +1154,13 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where namespaceFor PeerStatusChangeFailure {} = Namespace [] ["StatusChangeFailure"] namespaceFor PeerMonitoringError {} = Namespace [] ["MonitoringError"] namespaceFor PeerMonitoringResult {} = Namespace [] ["MonitoringResult"] + namespaceFor AcquireConnectionError {} = Namespace [] ["ConnectionError"] 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 _ _ = Nothing documentFor (Namespace _ ["StatusChanged"]) = Just @@ -1159,6 +1171,8 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where "" documentFor (Namespace _ ["MonitoringResult"]) = Just "" + documentFor (Namespace _ ["ConnectionError"]) = Just + "" documentFor _ = Nothing allNamespaces = [ @@ -1166,6 +1180,7 @@ instance MetaTrace (PeerSelectionActionsTrace SockAddr lAddr) where , Namespace [] ["StatusChangeFailure"] , Namespace [] ["MonitoringError"] , Namespace [] ["MonitoringResult"] + , Namespace [] ["ConnectionError"] ] -------------------------------------------------------------------------------- @@ -1181,7 +1196,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] - forMachine dtal (TrUnregisterConnection prov peerAddr) = + forMachine dtal (TrReleaseConnection prov peerAddr) = mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= forMachine dtal peerAddr @@ -1359,7 +1374,7 @@ instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) instance MetaTrace (ConnectionManager.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where namespaceFor TrIncludeConnection {} = Namespace [] ["IncludeConnection"] - namespaceFor TrUnregisterConnection {} = Namespace [] ["UnregisterConnection"] + namespaceFor TrReleaseConnection {} = Namespace [] ["UnregisterConnection"] namespaceFor TrConnect {} = Namespace [] ["Connect"] namespaceFor TrConnectError {} = Namespace [] ["ConnectError"] namespaceFor TrTerminatingConnection {} = Namespace [] ["TerminatingConnection"] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index b4388ddd3ed..50c672e3621 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -242,6 +242,7 @@ instance HasSeverityAnnotation TraceLedgerPeers where TraceLedgerPeersDomains {} -> Debug TraceLedgerPeersResult {} -> Debug TraceLedgerPeersFailure {} -> Debug + UsingBigLedgerPeerSnapshot {} -> Info instance HasPrivacyAnnotation (WithAddr addr ErrorPolicyTrace) @@ -444,6 +445,7 @@ instance HasSeverityAnnotation (TracePeerSelection addr) where TraceGovernorWakeup {} -> Info TraceChurnWait {} -> Info TraceChurnMode {} -> Info + TraceVerifyPeerSnapshot {} -> Info TraceForgetBigLedgerPeers {} -> Info @@ -495,6 +497,7 @@ instance HasSeverityAnnotation (PeerSelectionActionsTrace SockAddr lAddr) where PeerStatusChangeFailure {} -> Error PeerMonitoringError {} -> Error PeerMonitoringResult {} -> Debug + AcquireConnectionError {} -> Error instance HasPrivacyAnnotation PeerSelectionCounters instance HasSeverityAnnotation PeerSelectionCounters where @@ -505,7 +508,7 @@ instance HasSeverityAnnotation (ConnMgr.Trace addr (ConnectionHandlerTrace versi getSeverityAnnotation ev = case ev of TrIncludeConnection {} -> Debug - TrUnregisterConnection {} -> Debug + TrReleaseConnection {} -> Debug TrConnect {} -> Debug TrConnectError {} -> Info TrTerminatingConnection {} -> Debug @@ -1439,7 +1442,10 @@ instance ToObject TraceLedgerPeers where , "domainAccessPoint" .= show dap , "error" .= show reason ] - + toObject _verb UsingBigLedgerPeerSnapshot = + mconcat + [ "kind" .= String "UsingBigLedgerPeerSnapshot" + ] instance Show addr => ToObject (WithAddr addr ErrorPolicyTrace) where @@ -1917,6 +1923,9 @@ instance ToObject (TracePeerSelection SockAddr) where toObject _verb TraceBootstrapPeersFlagChangedWhilstInSensitiveState = mconcat [ "kind" .= String "BootstrapPeersFlagChangedWhilstInSensitiveState" ] + toObject _verb (TraceVerifyPeerSnapshot result) = + mconcat [ "kind" .= String "VerifyPeerSnapshot" + , "result" .= toJSON result ] toObject _verb (TraceOutboundGovernorCriticalFailure err) = mconcat [ "kind" .= String "OutboundGovernorCriticalFailure" , "reason" .= show err @@ -2058,6 +2067,10 @@ instance Show lAddr => ToObject (PeerSelectionActionsTrace SockAddr lAddr) where , "connectionId" .= toJSON connId , "withProtocolTemp" .= show wf ] + toObject _verb (AcquireConnectionError exception) = + mconcat [ "kind" .= String "AcquireConnectionError" + , "error" .= displayException exception + ] instance ToObject PeerSelectionCounters where toObject _verb PeerSelectionCounters {..} = @@ -2103,25 +2116,14 @@ instance ToObject PeerSelectionCounters where , "activeBootstrapPeersDemotions" .= numberOfActiveBootstrapPeersDemotions ] -instance (Show (ClientHasAgency st), Show (ServerHasAgency st)) - => ToJSON (PeerHasAgency pr st) where - toJSON (ClientAgency cha) = - Aeson.object [ "kind" .= String "ClientAgency" - , "agency" .= show cha - ] - toJSON (ServerAgency sha) = - Aeson.object [ "kind" .= String "ServerAgency" - , "agency" .= show sha - ] - instance ToJSON ProtocolLimitFailure where toJSON (ExceededSizeLimit tok) = Aeson.object [ "kind" .= String "ProtocolLimitFailure" - , "agency" .= toJSON tok + , "agency" .= show tok ] toJSON (ExceededTimeLimit tok) = Aeson.object [ "kind" .= String "ProtocolLimitFailure" - , "agency" .= toJSON tok + , "agency" .= show tok ] instance Show vNumber => ToJSON (RefuseReason vNumber) where @@ -2253,7 +2255,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, , "remoteAddress" .= toObject verb peerAddr , "provenance" .= String (pack . show $ prov) ] - TrUnregisterConnection prov peerAddr -> + TrReleaseConnection prov peerAddr -> mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= toObject verb peerAddr From fea110753fd5b53a11c550a37cb78785972304d7 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 6 Dec 2024 16:37:58 -0700 Subject: [PATCH 21/79] ouroboros-network upgrade: instances for stateful protocol messages --- cardano-node/cardano-node.cabal | 1 + .../Node/Tracing/Tracers/NodeToClient.hs | 383 +++++++++++++----- 2 files changed, 283 insertions(+), 101 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 048a4a8cc0f..64f0c147a59 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -213,6 +213,7 @@ library , transformers , transformers-except , typed-protocols >= 0.3 + , typed-protocols-stateful >= 0.3 , yaml executable cardano-node diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs index 26c046689da..71f03104b4b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs @@ -12,7 +12,8 @@ module Cardano.Node.Tracing.Tracers.NodeToClient () where import Cardano.Logging import Ouroboros.Consensus.Ledger.Query (Query) -import Ouroboros.Network.Driver.Simple (TraceSendRecv (..)) +import qualified Ouroboros.Network.Driver.Simple as Simple +import qualified Ouroboros.Network.Driver.Stateful as Stateful import Ouroboros.Network.Protocol.ChainSync.Type as ChainSync import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM @@ -20,75 +21,141 @@ import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS import Data.Aeson (Value (String), (.=)) import Data.Text (Text, pack) -import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) +import qualified Network.TypedProtocol.Codec as Simple +import qualified Network.TypedProtocol.Stateful.Codec as Stateful {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-} +instance LogFormatting (Simple.AnyMessage ps) + => LogFormatting (Simple.TraceSendRecv ps) where + forMachine dtal (Simple.TraceSendMsg m) = mconcat + [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] + forMachine dtal (Simple.TraceRecvMsg m) = mconcat + [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ] + + forHuman (Simple.TraceSendMsg m) = "Send: " <> forHumanOrMachine m + forHuman (Simple.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m -instance LogFormatting (AnyMessage ps) - => LogFormatting (TraceSendRecv ps) where - forMachine dtal (TraceSendMsg m) = mconcat + asMetrics (Simple.TraceSendMsg m) = asMetrics m + asMetrics (Simple.TraceRecvMsg m) = asMetrics m + +instance LogFormatting (Stateful.AnyMessage ps f) + => LogFormatting (Stateful.TraceSendRecv ps f) where + forMachine dtal (Stateful.TraceSendMsg m) = mconcat [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] - forMachine dtal (TraceRecvMsg m) = mconcat + forMachine dtal (Stateful.TraceRecvMsg m) = mconcat [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ] - forHuman (TraceSendMsg m) = "Send: " <> forHumanOrMachine m - forHuman (TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m + forHuman (Stateful.TraceSendMsg m) = "Send: " <> forHumanOrMachine m + forHuman (Stateful.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m + + asMetrics (Stateful.TraceSendMsg m) = asMetrics m + asMetrics (Stateful.TraceRecvMsg m) = asMetrics m + +instance MetaTrace (Simple.AnyMessage ps) => + MetaTrace (Simple.TraceSendRecv ps) where + namespaceFor (Simple.TraceSendMsg msg) = + nsPrependInner "Send" (namespaceFor msg) + namespaceFor (Simple.TraceRecvMsg msg) = + nsPrependInner "Receive" (namespaceFor msg) + + severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + severityFor (Namespace out tl) (Just msg) + severityFor (Namespace out ("Send" : tl)) Nothing = + severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + severityFor (Namespace out tl) (Just msg) + severityFor (Namespace out ("Receive" : tl)) Nothing = + severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + severityFor _ _ = Nothing + + privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + privacyFor (Namespace out tl) (Just msg) + privacyFor (Namespace out ("Send" : tl)) Nothing = + privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + privacyFor (Namespace out tl) (Just msg) + privacyFor (Namespace out ("Receive" : tl)) Nothing = + privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + privacyFor _ _ = Nothing + + detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + detailsFor (Namespace out tl) (Just msg) + detailsFor (Namespace out ("Send" : tl)) Nothing = + detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + detailsFor (Namespace out tl) (Just msg) + detailsFor (Namespace out ("Receive" : tl)) Nothing = + detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing + detailsFor _ _ = Nothing + + metricsDocFor (Namespace out ("Send" : tl)) = + metricsDocFor (nsCast (Namespace out tl) :: Namespace (Simple.AnyMessage ps)) + metricsDocFor (Namespace out ("Receive" : tl)) = + metricsDocFor (nsCast (Namespace out tl) :: Namespace (Simple.AnyMessage ps)) + metricsDocFor _ = [] + + documentFor (Namespace out ("Send" : tl)) = + documentFor (nsCast (Namespace out tl) :: Namespace (Simple.AnyMessage ps)) + documentFor (Namespace out ("Receive" : tl)) = + documentFor (nsCast (Namespace out tl) :: Namespace (Simple.AnyMessage ps)) + documentFor _ = Nothing - asMetrics (TraceSendMsg m) = asMetrics m - asMetrics (TraceRecvMsg m) = asMetrics m + allNamespaces = + let cn = allNamespaces :: [Namespace (Simple.AnyMessage ps)] + in fmap (nsPrependInner "Send") cn ++ fmap (nsPrependInner "Receive") cn -instance MetaTrace (AnyMessage ps) => - MetaTrace (TraceSendRecv ps) where - namespaceFor (TraceSendMsg msg) = +instance MetaTrace (Stateful.AnyMessage ps f) => + MetaTrace (Stateful.TraceSendRecv ps f) where + namespaceFor (Stateful.TraceSendMsg msg) = nsPrependInner "Send" (namespaceFor msg) - namespaceFor (TraceRecvMsg msg) = + namespaceFor (Stateful.TraceRecvMsg msg) = nsPrependInner "Receive" (namespaceFor msg) - severityFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = + severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Send" : tl)) Nothing = - severityFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing - severityFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = + severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing + severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Receive" : tl)) Nothing = - severityFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing + severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing severityFor _ _ = Nothing - privacyFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = + privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Send" : tl)) Nothing = - privacyFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing - privacyFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = + privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing + privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Receive" : tl)) Nothing = - privacyFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing + privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing privacyFor _ _ = Nothing - detailsFor (Namespace out ("Send" : tl)) (Just (TraceSendMsg msg)) = + detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Send" : tl)) Nothing = - detailsFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing - detailsFor (Namespace out ("Receive" : tl)) (Just (TraceSendMsg msg)) = + detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing + detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Receive" : tl)) Nothing = - detailsFor (Namespace out tl :: Namespace (AnyMessage ps)) Nothing + detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing detailsFor _ _ = Nothing metricsDocFor (Namespace out ("Send" : tl)) = - metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) + metricsDocFor (nsCast (Namespace out tl) :: Namespace (Stateful.AnyMessage ps f)) metricsDocFor (Namespace out ("Receive" : tl)) = - metricsDocFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) + metricsDocFor (nsCast (Namespace out tl) :: Namespace (Stateful.AnyMessage ps f)) metricsDocFor _ = [] documentFor (Namespace out ("Send" : tl)) = - documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) + documentFor (nsCast (Namespace out tl) :: Namespace (Stateful.AnyMessage ps f)) documentFor (Namespace out ("Receive" : tl)) = - documentFor (nsCast (Namespace out tl) :: Namespace (AnyMessage ps)) + documentFor (nsCast (Namespace out tl) :: Namespace (Stateful.AnyMessage ps f)) documentFor _ = Nothing allNamespaces = - let cn = allNamespaces :: [Namespace (AnyMessage ps)] + let cn = allNamespaces :: [Namespace (Stateful.AnyMessage ps f)] in fmap (nsPrependInner "Send") cn ++ fmap (nsPrependInner "Receive") cn @@ -96,56 +163,56 @@ instance MetaTrace (AnyMessage ps) => -- -- TChainSync Tracer -- -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessage (ChainSync blk pt tip)) where - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = +instance LogFormatting (Simple.AnyMessage (ChainSync blk pt tip)) where + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = mconcat [ "kind" .= String "MsgRequestNext" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgAwaitReply{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgAwaitReply{}) = mconcat [ "kind" .= String "MsgAwaitReply" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRollForward{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgRollForward{}) = mconcat [ "kind" .= String "MsgRollForward" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRollBackward{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgRollBackward{}) = mconcat [ "kind" .= String "MsgRollBackward" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgFindIntersect{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgFindIntersect{}) = mconcat [ "kind" .= String "MsgFindIntersect" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgIntersectFound{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgIntersectFound{}) = mconcat [ "kind" .= String "MsgIntersectFound" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgIntersectNotFound{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgIntersectNotFound{}) = mconcat [ "kind" .= String "MsgIntersectNotFound" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgDone{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok ChainSync.MsgDone{}) = mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessage (ChainSync blk pt tip)) where - namespaceFor (AnyMessageAndAgency _agency (MsgRequestNext {})) = +instance MetaTrace (Simple.AnyMessage (ChainSync blk pt tip)) where + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgRequestNext {})) = Namespace [] ["RequestNext"] - namespaceFor (AnyMessageAndAgency _agency (MsgAwaitReply {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgAwaitReply {})) = Namespace [] ["AwaitReply"] - namespaceFor (AnyMessageAndAgency _agency (MsgRollForward {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgRollForward {})) = Namespace [] ["RollForward"] - namespaceFor (AnyMessageAndAgency _agency (MsgRollBackward {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgRollBackward {})) = Namespace [] ["RollBackward"] - namespaceFor (AnyMessageAndAgency _agency (MsgFindIntersect {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgFindIntersect {})) = Namespace [] ["FindIntersect"] - namespaceFor (AnyMessageAndAgency _agency (MsgIntersectFound {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgIntersectFound {})) = Namespace [] ["IntersectFound"] - namespaceFor (AnyMessageAndAgency _agency (MsgIntersectNotFound {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgIntersectNotFound {})) = Namespace [] ["IntersectNotFound"] - namespaceFor (AnyMessageAndAgency _agency (MsgDone {})) = + namespaceFor (Simple.AnyMessageAndAgency _agency (MsgDone {})) = Namespace [] ["Done"] severityFor (Namespace _ ["RequestNext"]) _ = Just Info @@ -220,74 +287,74 @@ instance MetaTrace (AnyMessage (ChainSync blk pt tip)) where -- LocalTxMonitor Tracer -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAcquire {}) = +instance LogFormatting (Simple.AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgAcquire {}) = mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAcquired {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgAcquired {}) = mconcat [ "kind" .= String "MsgAcquired" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAwaitAcquire {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgAwaitAcquire {}) = mconcat [ "kind" .= String "MsgAwaitAcquire" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgNextTx {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgNextTx {}) = mconcat [ "kind" .= String "MsgNextTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyNextTx {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgReplyNextTx {}) = mconcat [ "kind" .= String "MsgReplyNextTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgHasTx {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgHasTx {}) = mconcat [ "kind" .= String "MsgHasTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyHasTx {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgReplyHasTx {}) = mconcat [ "kind" .= String "MsgReplyHasTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgGetSizes {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgGetSizes {}) = mconcat [ "kind" .= String "MsgGetSizes" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyGetSizes {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgReplyGetSizes {}) = mconcat [ "kind" .= String "MsgReplyGetSizes" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgRelease {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgRelease {}) = mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTM.MsgDone {}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTM.MsgDone {}) = mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where - namespaceFor (AnyMessageAndAgency _agency LTM.MsgAcquire {}) = +instance MetaTrace (Simple.AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgAcquire {}) = Namespace [] ["Acquire"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgAcquired {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgAcquired {}) = Namespace [] ["Acquired"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgAwaitAcquire {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgAwaitAcquire {}) = Namespace [] ["AwaitAcquire"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgNextTx {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgNextTx {}) = Namespace [] ["NextTx"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgReplyNextTx {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgReplyNextTx {}) = Namespace [] ["ReplyNextTx"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgHasTx {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgHasTx {}) = Namespace [] ["HasTx"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgReplyHasTx {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgReplyHasTx {}) = Namespace [] ["ReplyHasTx"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgGetSizes {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgGetSizes {}) = Namespace [] ["GetSizes"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgReplyGetSizes {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgReplyGetSizes {}) = Namespace [] ["ReplyGetSizes"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgRelease {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgRelease {}) = Namespace [] ["Release"] - namespaceFor (AnyMessageAndAgency _agency LTM.MsgDone {}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTM.MsgDone {}) = Namespace [] ["Done"] severityFor (Namespace _ ["Acquire"]) _ = Just Info @@ -344,32 +411,32 @@ instance MetaTrace (AnyMessage (LTM.LocalTxMonitor txid tx slotNo)) where -- LocalTxSubmission Tracer -------------------------------------------------------------------------------- -instance LogFormatting (AnyMessage (LTS.LocalTxSubmission tx err)) where - forMachine _dtal (AnyMessageAndAgency stok LTS.MsgSubmitTx{}) = +instance LogFormatting (Simple.AnyMessage (LTS.LocalTxSubmission tx err)) where + forMachine _dtal (Simple.AnyMessageAndAgency stok LTS.MsgSubmitTx{}) = mconcat [ "kind" .= String "MsgSubmitTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTS.MsgAcceptTx{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTS.MsgAcceptTx{}) = mconcat [ "kind" .= String "MsgAcceptTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTS.MsgRejectTx{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTS.MsgRejectTx{}) = mconcat [ "kind" .= String "MsgRejectTx" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LTS.MsgDone{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LTS.MsgDone{}) = mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessage (LTS.LocalTxSubmission tx err)) where - namespaceFor (AnyMessageAndAgency _agency LTS.MsgSubmitTx{}) = +instance MetaTrace (Simple.AnyMessage (LTS.LocalTxSubmission tx err)) where + namespaceFor (Simple.AnyMessageAndAgency _agency LTS.MsgSubmitTx{}) = Namespace [] ["SubmitTx"] - namespaceFor (AnyMessageAndAgency _agency LTS.MsgAcceptTx{}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTS.MsgAcceptTx{}) = Namespace [] ["AcceptTx"] - namespaceFor (AnyMessageAndAgency _agency LTS.MsgRejectTx{}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTS.MsgRejectTx{}) = Namespace [] ["RejectTx"] - namespaceFor (AnyMessageAndAgency _agency LTS.MsgDone{}) = + namespaceFor (Simple.AnyMessageAndAgency _agency LTS.MsgDone{}) = Namespace [] ["Done"] severityFor (Namespace _ ["SubmitTx"]) _ = Just Info @@ -401,56 +468,170 @@ instance MetaTrace (AnyMessage (LTS.LocalTxSubmission tx err)) where -------------------------------------------------------------------------------- instance (forall result. Show (Query blk result)) - => LogFormatting (AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgAcquire{}) = + => LogFormatting (Simple.AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgAcquire{}) = mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgAcquired{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgAcquired{}) = mconcat [ "kind" .= String "MsgAcquired" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgFailure{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgFailure{}) = mconcat [ "kind" .= String "MsgFailure" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgQuery{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgQuery{}) = mconcat [ "kind" .= String "MsgQuery" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgResult{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgResult{}) = mconcat [ "kind" .= String "MsgResult" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgRelease{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgRelease{}) = mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgReAcquire{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgReAcquire{}) = mconcat [ "kind" .= String "MsgReAcquire" , "agency" .= String (pack $ show stok) ] - forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgDone{}) = + forMachine _dtal (Simple.AnyMessageAndAgency stok LSQ.MsgDone{}) = mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] -instance MetaTrace (AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgAcquire{}) = +instance (forall result. Show (Query blk result)) + => LogFormatting (Stateful.AnyMessage (LSQ.LocalStateQuery blk pt (Query blk)) f) where + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgAcquire{}) = + mconcat [ "kind" .= String "MsgAcquire" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgAcquired{}) = + mconcat [ "kind" .= String "MsgAcquired" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgFailure{}) = + mconcat [ "kind" .= String "MsgFailure" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgQuery{}) = + mconcat [ "kind" .= String "MsgQuery" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgResult{}) = + mconcat [ "kind" .= String "MsgResult" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgRelease{}) = + mconcat [ "kind" .= String "MsgRelease" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgReAcquire{}) = + mconcat [ "kind" .= String "MsgReAcquire" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (Stateful.AnyMessageAndAgency stok _ LSQ.MsgDone{}) = + mconcat [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] + +instance MetaTrace (Simple.AnyMessage (LSQ.LocalStateQuery blk pt (Query blk))) where + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgAcquire{}) = + Namespace [] ["Acquire"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgAcquired{}) = + Namespace [] ["Acquired"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgFailure{}) = + Namespace [] ["Failure"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgQuery{}) = + Namespace [] ["Query"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgResult{}) = + Namespace [] ["Result"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgRelease{}) = + Namespace [] ["Release"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgReAcquire{}) = + Namespace [] ["ReAcquire"] + namespaceFor (Simple.AnyMessageAndAgency _agency LSQ.MsgDone{}) = + Namespace [] ["Done"] + + severityFor (Namespace _ ["Acquire"]) _ = Just Info + severityFor (Namespace _ ["Acquired"]) _ = Just Info + severityFor (Namespace _ ["Failure"]) _ = Just Warning + severityFor (Namespace _ ["Query"]) _ = Just Info + severityFor (Namespace _ ["Result"]) _ = Just Info + severityFor (Namespace _ ["Release"]) _ = Just Info + severityFor (Namespace _ ["ReAcquire"]) _ = Just Info + severityFor (Namespace _ ["Done"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace _ ["Acquire"]) = Just $ mconcat + [ "The client requests that the state as of a particular recent point on " + , "the server's chain (within K of the tip) be made available to query, " + , "and waits for confirmation or failure. " + , "\n " + , "From 'NodeToClient_V8' onwards if the point is not specified, current tip " + , "will be acquired. For previous versions of the protocol 'point' must be " + , "given." + ] + documentFor (Namespace _ ["Acquired"]) = Just + "The server can confirm that it has the state at the requested point." + documentFor (Namespace _ ["Failure"]) = Just $ mconcat + [ "The server can report that it cannot obtain the state for the " + , "requested point." + ] + documentFor (Namespace _ ["Query"]) = Just + "The client can perform queries on the current acquired state." + documentFor (Namespace _ ["Result"]) = Just + "The server must reply with the queries." + documentFor (Namespace _ ["Release"]) = Just $ mconcat + [ "The client can instruct the server to release the state. This lets " + , "the server free resources." + ] + documentFor (Namespace _ ["ReAcquire"]) = Just $ mconcat + [ "This is like 'MsgAcquire' but for when the client already has a " + , "state. By moving to another state directly without a 'MsgRelease' it " + , "enables optimisations on the server side (e.g. moving to the state for " + , "the immediate next block). " + , "\n " + , "Note that failure to re-acquire is equivalent to 'MsgRelease', " + , "rather than keeping the exiting acquired state. " + , "\n " + , "From 'NodeToClient_V8' onwards if the point is not specified, current tip " + , "will be acquired. For previous versions of the protocol 'point' must be " + , "given." + ] + documentFor (Namespace _ ["Done"]) = Just + "The client can terminate the protocol." + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["Acquire"] + , Namespace [] ["Acquired"] + , Namespace [] ["Failure"] + , Namespace [] ["Query"] + , Namespace [] ["Result"] + , Namespace [] ["Release"] + , Namespace [] ["ReAcquire"] + , Namespace [] ["Done"] + ] + +instance MetaTrace (Stateful.AnyMessage (LSQ.LocalStateQuery blk pt (Query blk)) f) where + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgAcquire{}) = Namespace [] ["Acquire"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgAcquired{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgAcquired{}) = Namespace [] ["Acquired"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgFailure{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgFailure{}) = Namespace [] ["Failure"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgQuery{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgQuery{}) = Namespace [] ["Query"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgResult{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgResult{}) = Namespace [] ["Result"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgRelease{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgRelease{}) = Namespace [] ["Release"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgReAcquire{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgReAcquire{}) = Namespace [] ["ReAcquire"] - namespaceFor (AnyMessageAndAgency _agency LSQ.MsgDone{}) = + namespaceFor (Stateful.AnyMessageAndAgency _agency _ LSQ.MsgDone{}) = Namespace [] ["Done"] severityFor (Namespace _ ["Acquire"]) _ = Just Info From 04f620ea610069006f6620b9ad1927edaea25732 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 6 Dec 2024 16:38:43 -0700 Subject: [PATCH 22/79] ouroboros-network upgrade: support the KeepAlive message type --- .../src/Cardano/Node/Tracing/Tracers.hs | 7 ++ .../Node/Tracing/Tracers/NodeToNode.hs | 51 ++++++++++++ cardano-node/src/Cardano/Tracing/Config.hs | 10 +++ .../Tracing/OrphanInstances/Network.hs | 79 +++++++++++++++++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 16 +++- 5 files changed, 160 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 4fab3056553..50d2f7b824f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -461,6 +461,11 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon ["TxSubmission", "Remote"] configureTracers configReflection trConfig [txSubmission2Tracer] + !keepAliveTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["KeepAlive", "Remote"] + configureTracers configReflection trConfig [keepAliveTracer] + pure $ NtN.Tracers { NtN.tChainSyncTracer = Tracer $ traceWith chainSyncTracer @@ -472,6 +477,8 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon traceWith blockFetchSerialisedTr , NtN.tTxSubmission2Tracer = Tracer $ traceWith txSubmission2Tracer + , NtN.tKeepAliveTracer = Tracer $ + traceWith keepAliveTracer } mkDiffusionTracers diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index f646eee74c8..4388b1d64b3 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -22,6 +22,7 @@ import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, e import Ouroboros.Network.Block (Point, Serialised (..), blockHash) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..), Message (..)) import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as STX +import qualified Ouroboros.Network.Protocol.KeepAlive.Type as KA import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Data.Aeson (ToJSON (..), Value (String), (.=)) @@ -328,3 +329,53 @@ instance MetaTrace (AnyMessage (STX.TxSubmission2 txid tx)) where , Namespace [] ["ReplyTxs"] , Namespace [] ["Done"] ] + +-------------------------------------------------------------------------------- +-- KeepAlive Tracer +-------------------------------------------------------------------------------- + +instance LogFormatting (AnyMessage KA.KeepAlive) where + forMachine _dtal (AnyMessageAndAgency stok KA.MsgKeepAlive {}) = + mconcat + [ "kind" .= String "KeepAlive" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (AnyMessageAndAgency stok KA.MsgKeepAliveResponse {}) = + mconcat + [ "kind" .= String "KeepAliveResponse" + , "agency" .= String (pack $ show stok) + ] + forMachine _dtal (AnyMessageAndAgency stok KA.MsgDone) = + mconcat + [ "kind" .= String "Done" + , "agency" .= String (pack $ show stok) + ] + +instance MetaTrace (AnyMessage KA.KeepAlive) where + namespaceFor (AnyMessageAndAgency _stok KA.MsgKeepAlive {}) = + Namespace [] ["KeepAlive"] + namespaceFor (AnyMessageAndAgency _stok KA.MsgKeepAliveResponse {}) = + Namespace [] ["KeepAliveResponse"] + namespaceFor (AnyMessageAndAgency _stok KA.MsgDone) = + Namespace [] ["Done"] + + severityFor (Namespace _ ["KeepAlive"]) _ = Just Info + severityFor (Namespace _ ["KeepAliveResponse"]) _ = Just Info + severityFor (Namespace _ ["Done"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace _ ["KeepAlive"]) = Just + "Client side message to keep the connection alive." + documentFor (Namespace _ ["KeepAliveResponse"]) = Just $ mconcat + [ "Server side response to a previous client KeepAlive message." + ] + documentFor (Namespace _ ["Done"]) = Just $ mconcat + [ "Termination message, initiated by the client." + ] + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["KeepAlive"] + , Namespace [] ["KeepAliveResponse"] + , Namespace [] ["Done"] + ] diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 2dd739efd0e..e871960c4b0 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -70,6 +70,7 @@ module Cardano.Tracing.Config , TraceTxOutbound , TraceTxSubmissionProtocol , TraceTxSubmission2Protocol + , TraceKeepAliveProtocol , proxyName ) where @@ -175,6 +176,7 @@ type TraceTxInbound = ("TraceTxInbound" :: Symbol) type TraceTxOutbound = ("TraceTxOutbound" :: Symbol) type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) +type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -246,6 +248,7 @@ data TraceSelection , traceTxOutbound :: OnOff TraceTxOutbound , traceTxSubmissionProtocol :: OnOff TraceTxSubmissionProtocol , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol + , traceKeepAliveProtocol :: OnOff TraceKeepAliveProtocol , traceGsm :: OnOff TraceGsm } deriving (Eq, Show) @@ -311,6 +314,7 @@ data PartialTraceSelection , pTraceTxOutbound :: Last (OnOff TraceTxOutbound) , pTraceTxSubmissionProtocol :: Last (OnOff TraceTxSubmissionProtocol) , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) + , pTraceKeepAliveProtocol :: Last (OnOff TraceKeepAliveProtocol) , pTraceGsm :: Last (OnOff TraceGsm) } deriving (Eq, Generic, Show) @@ -377,6 +381,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxOutbound) v <*> parseTracer (Proxy @TraceTxSubmissionProtocol) v <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v + <*> parseTracer (Proxy @TraceKeepAliveProtocol) v <*> parseTracer (Proxy @TraceGsm) v @@ -440,6 +445,7 @@ defaultPartialTraceConfiguration = , pTraceTxOutbound = pure $ OnOff False , pTraceTxSubmissionProtocol = pure $ OnOff False , pTraceTxSubmission2Protocol = pure $ OnOff False + , pTraceKeepAliveProtocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True } @@ -505,6 +511,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxOutbound <- proxyLastToEither (Proxy @TraceTxOutbound) pTraceTxOutbound traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol + traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity @@ -563,6 +570,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxOutbound = traceTxOutbound , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol + , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm } @@ -625,6 +633,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxOutbound <- proxyLastToEither (Proxy @TraceTxOutbound) pTraceTxOutbound traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol + traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity @@ -683,6 +692,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxOutbound = traceTxOutbound , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol + , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm } diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 50c672e3621..4febc84f091 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -49,6 +49,7 @@ import qualified Ouroboros.Network.ConnectionManager.Types as ConnMgr import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import qualified Ouroboros.Network.Diffusion as ND 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 @@ -86,6 +87,7 @@ 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 import Ouroboros.Network.Protocol.LocalTxMonitor.Type (LocalTxMonitor) @@ -125,6 +127,7 @@ import Network.Mux (MiniProtocolNum (..)) import qualified Network.Mux as Mux import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) +import qualified Network.TypedProtocol.Stateful.Codec as Stateful {- HLINT ignore "Use record patterns" -} @@ -174,6 +177,11 @@ instance HasSeverityAnnotation (TraceSendRecv a) where getSeverityAnnotation _ = Debug +instance HasPrivacyAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) f) +instance HasSeverityAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) f) where + getSeverityAnnotation _ = Debug + + instance HasPrivacyAnnotation a => HasPrivacyAnnotation (TraceLabelPeer peer a) instance HasSeverityAnnotation a => HasSeverityAnnotation (TraceLabelPeer peer a) where getSeverityAnnotation (TraceLabelPeer _p a) = getSeverityAnnotation a @@ -658,6 +666,17 @@ instance (LocalStateQuery.ShowQuery (BlockQuery blk), ToObject localPeer) => Transformable Text IO (TraceLabelPeer localPeer (NtN.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))) where trTransformer = trStructured +instance (ToObject localPeer) + => Transformable Text IO (TraceLabelPeer localPeer (NtN.TraceSendRecv KA.KeepAlive)) where + trTransformer = trStructured + +instance + ( HasPrivacyAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) f) + , HasSeverityAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) f) + , LocalStateQuery.ShowQuery (BlockQuery blk), ToObject localPeer) + => Transformable Text IO (TraceLabelPeer localPeer (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) f)) where + trTransformer = trStructured + instance (ToObject peer, Show (TxId (GenTx blk)), Show (GenTx blk)) => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))) where trTransformer = trStructured @@ -885,6 +904,41 @@ instance (forall result. Show (query result)) , "agency" .= String (pack $ show stok) ] +instance (forall result. Show (query result)) + => ToObject (Stateful.AnyMessage (LocalStateQuery blk pt query) f) where + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgAcquire{}) = + mconcat [ "kind" .= String "MsgAcquire" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgAcquired{}) = + mconcat [ "kind" .= String "MsgAcquired" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgFailure{}) = + mconcat [ "kind" .= String "MsgFailure" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgQuery{}) = + mconcat [ "kind" .= String "MsgQuery" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgResult{}) = + mconcat [ "kind" .= String "MsgResult" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgRelease{}) = + mconcat [ "kind" .= String "MsgRelease" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgReAcquire{}) = + mconcat [ "kind" .= String "MsgReAcquire" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (Stateful.AnyMessageAndAgency stok _ LocalStateQuery.MsgDone{}) = + mconcat [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] + instance ToObject (AnyMessage (LocalTxMonitor txid tx slotno)) where toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgAcquire {}) = mconcat [ "kind" .= String "MsgAcuire" @@ -1018,6 +1072,23 @@ instance (Show txid, Show tx) , "agency" .= String (pack $ show stok) ] +instance ToObject (AnyMessage KA.KeepAlive) where + toObject _verb (AnyMessageAndAgency stok KA.MsgKeepAlive {}) = + mconcat + [ "kind" .= String "MsgKeepAlive" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok KA.MsgKeepAliveResponse {}) = + mconcat + [ "kind" .= String "MsgKeepAliveResponse" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok KA.MsgDone) = + mconcat + [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] + instance ToJSON peerAddr => ToJSON (ConnectionId peerAddr) where toJSON ConnectionId { localAddress, remoteAddress } = Aeson.object [ "localAddress" .= toJSON localAddress @@ -1262,6 +1333,14 @@ instance ToObject (AnyMessage ps) [ "kind" .= String "Recv" , "msg" .= toObject verb m ] +instance ToObject (Stateful.AnyMessage ps f) + => ToObject (Stateful.TraceSendRecv ps f) where + toObject verb (Stateful.TraceSendMsg m) = mconcat + [ "kind" .= String "Send" , "msg" .= toObject verb m ] + toObject verb (Stateful.TraceRecvMsg m) = mconcat + [ "kind" .= String "Recv" , "msg" .= toObject verb m ] + + instance ToObject (TraceTxSubmissionInbound txid tx) where toObject _verb (TraceTxSubmissionCollected count) = mconcat diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5047e4f5669..e253b1b40de 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -69,7 +69,7 @@ import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError) import Ouroboros.Consensus.Ledger.Abstract (LedgerErr, LedgerState) import Ouroboros.Consensus.Ledger.Extended (ledgerState) import Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent) -import Ouroboros.Consensus.Ledger.Query (BlockQuery) +import Ouroboros.Consensus.Ledger.Query (BlockQuery, Query) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs, LedgerSupportsMempool, ByteSize32 (..)) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) @@ -98,6 +98,7 @@ import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCou import qualified Ouroboros.Network.Diffusion 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 import Ouroboros.Network.NodeToClient (LocalAddress) @@ -106,7 +107,8 @@ import Ouroboros.Network.PeerSelection.Governor (ChurnCounters (..), PeerSelectionCounters, PeerSelectionView (..)) import qualified Ouroboros.Network.PeerSelection.Governor as Governor import Ouroboros.Network.Point (fromWithOrigin) -import Ouroboros.Network.Protocol.LocalStateQuery.Type (ShowQuery) +import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery, ShowQuery) +import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery import Ouroboros.Network.TxSubmission.Inbound import Codec.CBOR.Read (DeserialiseFailure) @@ -522,6 +524,7 @@ mkTracers _ _ _ _ _ enableP2P = , NodeToNode.tBlockFetchTracer = nullTracer , NodeToNode.tBlockFetchSerialisedTracer = nullTracer , NodeToNode.tTxSubmission2Tracer = nullTracer + , NodeToNode.tKeepAliveTracer = nullTracer } , diffusionTracers = Diffusion.nullTracers , diffusionTracersExtra = @@ -1385,8 +1388,12 @@ forgeStateInfoTracer p _ts tracer = Tracer $ \ev -> do -------------------------------------------------------------------------------- nodeToClientTracers' - :: ( ToObject localPeer + :: forall blk localPeer. + ( HasPrivacyAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) LocalStateQuery.State) + , HasSeverityAnnotation (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) LocalStateQuery.State) + , ToObject (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) LocalStateQuery.State) , ShowQuery (BlockQuery blk) + , ToObject localPeer ) => TraceSelection -> TracingVerbosity @@ -1440,6 +1447,9 @@ nodeToNodeTracers' trSel verb tr = , NodeToNode.tTxSubmission2Tracer = tracerOnOff (traceTxSubmissionProtocol trSel) verb "TxSubmissionProtocol" tr + , NodeToNode.tKeepAliveTracer = + tracerOnOff (traceKeepAliveProtocol trSel) + verb "KeepAliveProtocol" tr } teeTraceBlockFetchDecision From 4e2c2806d3414ce05cbcd81759b20815c7f58e28 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 08:13:49 -0700 Subject: [PATCH 23/79] ouroboros-network upgrade: add new information to configuration * ConsensusMode * MinBigLedgerPeersForTrustedState --- .../src/Cardano/Node/Configuration/POM.hs | 19 +++++++++++++ cardano-node/src/Cardano/Node/Parsers.hs | 2 ++ cardano-node/src/Cardano/Node/Run.hs | 28 ++++++++++++------- cardano-node/src/Cardano/Node/Types.hs | 18 ++++++++++++ cardano-node/test/Test/Cardano/Node/POM.hs | 7 +++++ 5 files changed, 64 insertions(+), 10 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 3ce3341e431..70ecc7e46c5 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -37,6 +37,8 @@ import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..)) +import Ouroboros.Network.Diffusion.Configuration (ConsensusMode, + MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode (..)) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) @@ -103,6 +105,7 @@ data NodeConfiguration , ncProtocolConfig :: !NodeProtocolConfiguration -- Node parameters, not protocol-specific: + , ncConsensusMode :: !ConsensusMode , ncDiffusionMode :: !DiffusionMode , ncNumOfDiskSnapshots :: !NumOfDiskSnapshots , ncSnapshotInterval :: !SnapshotInterval @@ -157,6 +160,7 @@ data NodeConfiguration , ncTargetNumberOfKnownBigLedgerPeers :: Int , ncTargetNumberOfEstablishedBigLedgerPeers :: Int , ncTargetNumberOfActiveBigLedgerPeers :: Int + , ncMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState -- Enable experimental P2P mode , ncEnableP2P :: SomeNetworkP2PMode @@ -185,6 +189,7 @@ data PartialNodeConfiguration , pncProtocolConfig :: !(Last NodeProtocolConfiguration) -- Node parameters, not protocol-specific: + , pncConsensusMode :: !(Last ConsensusMode) , pncDiffusionMode :: !(Last DiffusionMode ) , pncNumOfDiskSnapshots :: !(Last NumOfDiskSnapshots) , pncSnapshotInterval :: !(Last SnapshotInterval) @@ -220,6 +225,7 @@ data PartialNodeConfiguration , pncTargetNumberOfKnownBigLedgerPeers :: !(Last Int) , pncTargetNumberOfEstablishedBigLedgerPeers :: !(Last Int) , pncTargetNumberOfActiveBigLedgerPeers :: !(Last Int) + , pncMinBigLedgerPeersForTrustedState :: !(Last MinBigLedgerPeersForTrustedState) -- Enable experimental P2P mode , pncEnableP2P :: !(Last NetworkP2PMode) @@ -244,6 +250,8 @@ instance FromJSON PartialNodeConfiguration where -- Node parameters, not protocol-specific pncSocketPath <- Last <$> v .:? "SocketPath" pncDatabaseFile <- Last <$> v .:? "DatabasePath" + pncConsensusMode + <- Last . fmap getConsensusMode <$> v .:? "ConsensusMode" pncDiffusionMode <- Last . fmap getDiffusionMode <$> v .:? "DiffusionMode" pncNumOfDiskSnapshots @@ -308,6 +316,7 @@ instance FromJSON PartialNodeConfiguration where pncTargetNumberOfKnownBigLedgerPeers <- Last <$> v .:? "TargetNumberOfKnownBigLedgerPeers" pncTargetNumberOfEstablishedBigLedgerPeers <- Last <$> v .:? "TargetNumberOfEstablishedBigLedgerPeers" pncTargetNumberOfActiveBigLedgerPeers <- Last <$> v .:? "TargetNumberOfActiveBigLedgerPeers" + pncMinBigLedgerPeersForTrustedState <- Last <$> v .:? "MinBigLedgerPeersForTrustedState" pncChainSyncIdleTimeout <- Last <$> v .:? "ChainSyncIdleTimeout" @@ -326,6 +335,7 @@ instance FromJSON PartialNodeConfiguration where pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath + , pncConsensusMode , pncDiffusionMode , pncNumOfDiskSnapshots , pncSnapshotInterval @@ -355,6 +365,7 @@ instance FromJSON PartialNodeConfiguration where , pncTargetNumberOfKnownBigLedgerPeers , pncTargetNumberOfEstablishedBigLedgerPeers , pncTargetNumberOfActiveBigLedgerPeers + , pncMinBigLedgerPeersForTrustedState , pncEnableP2P , pncPeerSharing } @@ -497,6 +508,7 @@ defaultPartialNodeConfiguration = , pncDatabaseFile = Last . Just $ OnePathForAllDbs "mainnet/db/" , pncLoggingSwitch = Last $ Just True , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty mempty + , pncConsensusMode = Last $ Just defaultConsensusMode , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode , pncNumOfDiskSnapshots = Last $ Just DefaultNumOfDiskSnapshots , pncSnapshotInterval = Last $ Just DefaultSnapshotInterval @@ -531,6 +543,7 @@ defaultPartialNodeConfiguration = , pncTargetNumberOfKnownBigLedgerPeers = Last (Just 15) , pncTargetNumberOfEstablishedBigLedgerPeers = Last (Just 10) , pncTargetNumberOfActiveBigLedgerPeers = Last (Just 5) + , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) } @@ -549,6 +562,7 @@ makeNodeConfiguration pnc = do loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc traceConfig <- first Text.unpack $ partialTraceSelectionToEither $ pncTraceConfig pnc + consensusMode <- lastToEither "Missing ConsensusMode" $ pncConsensusMode pnc diffusionMode <- lastToEither "Missing DiffusionMode" $ pncDiffusionMode pnc numOfDiskSnapshots <- lastToEither "Missing NumOfDiskSnapshots" $ pncNumOfDiskSnapshots pnc snapshotInterval <- lastToEither "Missing SnapshotInterval" $ pncSnapshotInterval pnc @@ -576,6 +590,9 @@ makeNodeConfiguration pnc = do ncTargetNumberOfActiveBigLedgerPeers <- lastToEither "Missing TargetNumberOfActiveBigLedgerPeers" $ pncTargetNumberOfActiveBigLedgerPeers pnc + ncMinBigLedgerPeersForTrustedState <- + lastToEither "Missing MinBigLedgerPeersForTrustedState" + $ pncMinBigLedgerPeersForTrustedState pnc ncProtocolIdleTimeout <- lastToEither "Missing ProtocolIdleTimeout" $ pncProtocolIdleTimeout pnc @@ -618,6 +635,7 @@ makeNodeConfiguration pnc = do , ncStartAsNonProducingNode = startAsNonProducingNode , ncProtocolConfig = protocolConfig , ncSocketConfig = socketConfig + , ncConsensusMode = consensusMode , ncDiffusionMode = diffusionMode , ncNumOfDiskSnapshots = numOfDiskSnapshots , ncSnapshotInterval = snapshotInterval @@ -641,6 +659,7 @@ makeNodeConfiguration pnc = do , ncTargetNumberOfKnownBigLedgerPeers , ncTargetNumberOfEstablishedBigLedgerPeers , ncTargetNumberOfActiveBigLedgerPeers + , ncMinBigLedgerPeersForTrustedState , ncEnableP2P = case enableP2P of EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index d77bb991e28..ef49725ed06 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -89,6 +89,7 @@ nodeRunParser = do , pncConfigFile = ConfigYamlFilePath <$> nodeConfigFp , pncTopologyFile = TopologyFile <$> topFp , pncDatabaseFile = dbFp + , pncConsensusMode = mempty , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = numOfDiskSnapshots , pncSnapshotInterval = snapshotInterval @@ -124,6 +125,7 @@ nodeRunParser = do , pncTargetNumberOfKnownBigLedgerPeers = mempty , pncTargetNumberOfEstablishedBigLedgerPeers = mempty , pncTargetNumberOfActiveBigLedgerPeers = mempty + , pncMinBigLedgerPeersForTrustedState = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty } diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index c383befb163..17d6665567a 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -78,7 +78,7 @@ import Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), ConnectionId, PeerSelectionTargets (..), RemoteAddress) import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers, LedgerPeerSnapshot) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) @@ -858,6 +858,8 @@ mkP2PArguments NodeConfiguration { ncTargetNumberOfKnownBigLedgerPeers, ncTargetNumberOfEstablishedBigLedgerPeers, ncTargetNumberOfActiveBigLedgerPeers, + ncMinBigLedgerPeersForTrustedState, + ncConsensusMode, ncProtocolIdleTimeout, ncTimeWaitTimeout, ncPeerSharing @@ -867,11 +869,13 @@ mkP2PArguments NodeConfiguration { daReadUseLedgerPeers daReadUseBootstrapPeers = Diffusion.P2PArguments P2P.ArgumentsExtra - { P2P.daPeerSelectionTargets + { P2P.daPeerTargets , P2P.daReadLocalRootPeers , P2P.daReadPublicRootPeers , P2P.daReadUseLedgerPeers , P2P.daReadUseBootstrapPeers + , P2P.daConsensusMode = ncConsensusMode + , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout , P2P.daTimeWaitTimeout = ncTimeWaitTimeout , P2P.daDeadlineChurnInterval = 3300 @@ -879,14 +883,18 @@ mkP2PArguments NodeConfiguration { , P2P.daOwnPeerSharing = ncPeerSharing } where - daPeerSelectionTargets = PeerSelectionTargets { - targetNumberOfRootPeers = ncTargetNumberOfRootPeers, - targetNumberOfKnownPeers = ncTargetNumberOfKnownPeers, - targetNumberOfEstablishedPeers = ncTargetNumberOfEstablishedPeers, - targetNumberOfActivePeers = ncTargetNumberOfActivePeers, - targetNumberOfKnownBigLedgerPeers = ncTargetNumberOfKnownBigLedgerPeers, - targetNumberOfEstablishedBigLedgerPeers = ncTargetNumberOfEstablishedBigLedgerPeers, - targetNumberOfActiveBigLedgerPeers = ncTargetNumberOfActiveBigLedgerPeers + daPeerTargets = Configuration.ConsensusModePeerTargets { + Configuration.deadlineTargets = peerSelectionTargets, + Configuration.syncTargets = peerSelectionTargets + } + peerSelectionTargets = PeerSelectionTargets { + targetNumberOfRootPeers = ncTargetNumberOfRootPeers, + targetNumberOfKnownPeers = ncTargetNumberOfKnownPeers, + targetNumberOfEstablishedPeers = ncTargetNumberOfEstablishedPeers, + targetNumberOfActivePeers = ncTargetNumberOfActivePeers, + targetNumberOfKnownBigLedgerPeers = ncTargetNumberOfKnownBigLedgerPeers, + targetNumberOfEstablishedBigLedgerPeers = ncTargetNumberOfEstablishedBigLedgerPeers, + targetNumberOfActiveBigLedgerPeers = ncTargetNumberOfActiveBigLedgerPeers } mkNonP2PArguments diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index 87cc9c72685..b16ca45e4aa 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -20,6 +20,7 @@ module Cardano.Node.Types , MaxConcurrencyDeadline(..) -- * Networking , TopologyFile(..) + , NodeConsensusMode (..) , NodeDiffusionMode (..) -- * Consensus protocol configuration , NodeByronProtocolConfiguration(..) @@ -38,6 +39,7 @@ import Cardano.Api import Cardano.Crypto (RequiresNetworkMagic (..)) import qualified Cardano.Crypto.Hash as Crypto import Cardano.Node.Configuration.Socket (SocketConfig (..)) +import Ouroboros.Network.ConsensusMode (ConsensusMode (..)) import Ouroboros.Network.NodeToNode (DiffusionMode (..)) import Control.Exception @@ -96,6 +98,22 @@ newtype MaxConcurrencyDeadline = MaxConcurrencyDeadline deriving newtype (FromJSON, Show) +-- | Newtype wrapper which provides 'FromJSON' instance for 'ConsensusMode'. +-- +newtype NodeConsensusMode + = NodeConsensusMode { getConsensusMode :: ConsensusMode } + deriving newtype Show + +instance FromJSON NodeConsensusMode where + parseJSON (String str) = + case str of + "Genesis" + -> pure $ NodeConsensusMode GenesisMode + "Praos" + -> pure $ NodeConsensusMode PraosMode + _ -> fail "Parsing NodeConsensusMode failed: can be either 'Genesis' or 'Praos'" + parseJSON _ = fail "Parsing NodeConsensusMode failed" + -- | Newtype wrapper which provides 'FromJSON' instance for 'DiffusionMode'. -- newtype NodeDiffusionMode diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 2b2c416d704..81a9d890dfb 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -17,6 +17,7 @@ import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..)) import Ouroboros.Network.Block (SlotNo (..)) +import Ouroboros.Network.Diffusion.Configuration (MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode (InitiatorAndResponderDiffusionMode)) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) @@ -116,6 +117,7 @@ testPartialYamlConfig = , pncSocketConfig = Last . Just $ SocketConfig (Last Nothing) mempty mempty mempty , pncShutdownConfig = Last Nothing , pncStartAsNonProducingNode = Last $ Just False + , pncConsensusMode = mempty , pncDiffusionMode = Last Nothing , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = mempty @@ -143,6 +145,7 @@ testPartialYamlConfig = , pncTargetNumberOfKnownBigLedgerPeers = mempty , pncTargetNumberOfEstablishedBigLedgerPeers = mempty , pncTargetNumberOfActiveBigLedgerPeers = mempty + , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) } @@ -158,6 +161,7 @@ testPartialCliConfig = , pncConfigFile = mempty , pncTopologyFile = mempty , pncDatabaseFile = mempty + , pncConsensusMode = mempty , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = Last . Just . RequestedSnapshotInterval $ secondsToDiffTime 100 @@ -183,6 +187,7 @@ testPartialCliConfig = , pncTargetNumberOfKnownBigLedgerPeers = mempty , pncTargetNumberOfEstablishedBigLedgerPeers = mempty , pncTargetNumberOfActiveBigLedgerPeers = mempty + , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) } @@ -202,6 +207,7 @@ eExpectedConfig = do , ncProtocolFiles = ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing , ncValidateDB = True , ncProtocolConfig = testNodeProtocolConfiguration + , ncConsensusMode = defaultConsensusMode , ncDiffusionMode = InitiatorAndResponderDiffusionMode , ncNumOfDiskSnapshots = DefaultNumOfDiskSnapshots , ncSnapshotInterval = RequestedSnapshotInterval $ secondsToDiffTime 100 @@ -229,6 +235,7 @@ eExpectedConfig = do , ncTargetNumberOfKnownBigLedgerPeers = 15 , ncTargetNumberOfEstablishedBigLedgerPeers = 10 , ncTargetNumberOfActiveBigLedgerPeers = 5 + , ncMinBigLedgerPeersForTrustedState = MinBigLedgerPeersForTrustedState 3 -- TODO: Review , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled } From 32e28e2f398c990d3fcf435ec55a2e0b38c9164b Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 08:19:19 -0700 Subject: [PATCH 24/79] ouroboros-network upgrade: add LedgerPeerSnapshot reader to config --- cardano-node/src/Cardano/Node/Run.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 17d6665567a..d5b3d4e0f4a 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -489,6 +489,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do (readTVar publicRootsVar) (readTVar useLedgerVar) (readTVar useBootstrapVar) + (pure Nothing) -- FIXME: implement a reader in Node.run nodeArgs { @@ -849,8 +850,10 @@ mkP2PArguments -> STM IO (Map RelayAccessPoint PeerAdvertise) -> STM IO UseLedgerPeers -> STM IO UseBootstrapPeers + -> STM IO (Maybe LedgerPeerSnapshot) -> Diffusion.ExtraArguments 'Diffusion.P2P IO mkP2PArguments NodeConfiguration { + ncConsensusMode, ncTargetNumberOfRootPeers, ncTargetNumberOfKnownPeers, ncTargetNumberOfEstablishedPeers, @@ -859,7 +862,6 @@ mkP2PArguments NodeConfiguration { ncTargetNumberOfEstablishedBigLedgerPeers, ncTargetNumberOfActiveBigLedgerPeers, ncMinBigLedgerPeersForTrustedState, - ncConsensusMode, ncProtocolIdleTimeout, ncTimeWaitTimeout, ncPeerSharing @@ -867,13 +869,15 @@ mkP2PArguments NodeConfiguration { daReadLocalRootPeers daReadPublicRootPeers daReadUseLedgerPeers - daReadUseBootstrapPeers = + daReadUseBootstrapPeers + daReadLedgerPeerSnapshot = Diffusion.P2PArguments P2P.ArgumentsExtra { P2P.daPeerTargets , P2P.daReadLocalRootPeers , P2P.daReadPublicRootPeers , P2P.daReadUseLedgerPeers , P2P.daReadUseBootstrapPeers + , P2P.daReadLedgerPeerSnapshot , P2P.daConsensusMode = ncConsensusMode , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout From 0dc979f08d4c9aa1fb496d3d4f66467ee7bcb178 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 10:23:17 -0700 Subject: [PATCH 25/79] ouroboros-network upgrade: blocking style changes --- .../Benchmarking/GeneratorTx/Submission.hs | 8 ++--- .../GeneratorTx/SubmissionClient.hs | 36 +++++++++---------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index e2d98eddf78..af229b362f0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -45,7 +45,7 @@ import Cardano.Tracing.OrphanInstances.Consensus () import Cardano.Tracing.OrphanInstances.Network () import Cardano.Tracing.OrphanInstances.Shelley () -import Ouroboros.Network.Protocol.TxSubmission2.Type (TokBlockingStyle (..)) +import Ouroboros.Network.Protocol.TxSubmission2.Type (SingBlockingStyle (..)) import Cardano.Api hiding (Active) import Cardano.TxGenerator.Types (TPSRate, TxGenError) @@ -124,11 +124,11 @@ mkSubmissionSummary startTime reportsRefs txStreamSource :: forall era. MVar (StreamState (TxStream IO era)) -> TpsThrottle -> TxSource era txStreamSource streamRef tpsThrottle = Active worker where - worker :: forall m blocking . MonadIO m => TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]) + worker :: forall m blocking . MonadIO m => SingBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]) worker blocking req = do (done, txCount) <- case blocking of - TokBlocking -> liftIO $ consumeTxsBlocking tpsThrottle req - TokNonBlocking -> liftIO $ consumeTxsNonBlocking tpsThrottle req + SingBlocking -> liftIO $ consumeTxsBlocking tpsThrottle req + SingNonBlocking -> liftIO $ consumeTxsNonBlocking tpsThrottle req txList <- liftIO $ unFold txCount case done of Stop -> return (Exhausted, txList) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 577c47df682..ef33626b5a0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -46,7 +46,7 @@ import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId (Sh import Ouroboros.Network.Protocol.TxSubmission2.Client (ClientStIdle (..), ClientStTxIds (..), ClientStTxs (..), TxSubmissionClient (..)) import Ouroboros.Network.Protocol.TxSubmission2.Type (BlockingReplyList (..), - NumTxIdsToAck (..), NumTxIdsToReq (..), TokBlockingStyle (..)) + NumTxIdsToAck (..), NumTxIdsToReq (..), SingBlockingStyle (..)) import Ouroboros.Network.SizeInBytes import Prelude (error, fail) @@ -71,14 +71,14 @@ data TxSource era = Exhausted | Active (ProduceNextTxs era) -type ProduceNextTxs era = (forall m blocking . MonadIO m => TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era])) +type ProduceNextTxs era = (forall m blocking . MonadIO m => SingBlockingStyle blocking -> Req -> m (TxSource era, [Tx era])) -produceNextTxs :: forall m blocking era . MonadIO m => TokBlockingStyle blocking -> Req -> LocalState era -> m (LocalState era, [Tx era]) +produceNextTxs :: forall m blocking era . MonadIO m => SingBlockingStyle blocking -> Req -> LocalState era -> m (LocalState era, [Tx era]) produceNextTxs blocking req (txProducer, unack, stats) = do (newTxProducer, txList) <- produceNextTxs' blocking req txProducer return ((newTxProducer, unack, stats), txList) -produceNextTxs' :: forall m blocking era . MonadIO m => TokBlockingStyle blocking -> Req -> TxSource era -> m (TxSource era, [Tx era]) +produceNextTxs' :: forall m blocking era . MonadIO m => SingBlockingStyle blocking -> Req -> TxSource era -> m (TxSource era, [Tx era]) produceNextTxs' _ _ Exhausted = return (Exhausted, []) produceNextTxs' blocking req (Active callback) = callback blocking req @@ -99,10 +99,10 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = TxSubmissionClient $ pure $ client (initialTxSource, UnAcked [], SubmissionThreadStats 0 0 0) where - discardAcknowledged :: TokBlockingStyle a -> Ack -> LocalState era -> m (LocalState era) + discardAcknowledged :: SingBlockingStyle a -> Ack -> LocalState era -> m (LocalState era) discardAcknowledged blocking (Ack ack) (txSource, UnAcked unAcked, stats) = do when (tokIsBlocking blocking && ack /= length unAcked) $ do - let err = "decideAnnouncement: TokBlocking, but length unAcked != ack" + let err = "decideAnnouncement: SingBlocking, but length unAcked != ack" traceWith bmtr (TraceBenchTxSubError err) fail (T.unpack err) let (stillUnacked, acked) = L.splitAtEnd ack unAcked @@ -123,7 +123,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = requestTxIds :: forall blocking. LocalState era - -> TokBlockingStyle blocking + -> SingBlockingStyle blocking -> NumTxIdsToAck -> NumTxIdsToReq -> m (ClientStTxIds blocking (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()) @@ -140,7 +140,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> outs) case blocking of - TokBlocking -> case NE.nonEmpty newTxs of + SingBlocking -> case NE.nonEmpty newTxs of Nothing -> do traceWith tr EndOfProtocol endOfProtocolCallback stats @@ -148,7 +148,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = (Just txs) -> pure $ SendMsgReplyTxIds (BlockingReply $ txToIdSize <$> txs) (client stateC) - TokNonBlocking -> pure $ SendMsgReplyTxIds + SingNonBlocking -> pure $ SendMsgReplyTxIds (NonBlockingReply $ txToIdSize <$> newTxs) (client stateC) @@ -196,17 +196,17 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = fromGenTxId (Block.GenTxIdConway (Mempool.ShelleyTxId i)) = fromShelleyTxId i fromGenTxId _ = error "TODO: fix incomplete match" - tokIsBlocking :: TokBlockingStyle a -> Bool + tokIsBlocking :: SingBlockingStyle a -> Bool tokIsBlocking = \case - TokBlocking -> True - TokNonBlocking -> False + SingBlocking -> True + SingNonBlocking -> False - reqIdsTrace :: Ack -> Req -> TokBlockingStyle a -> NodeToNodeSubmissionTrace + reqIdsTrace :: Ack -> Req -> SingBlockingStyle a -> NodeToNodeSubmissionTrace reqIdsTrace ack req = \case - TokBlocking -> ReqIdsBlocking ack req - TokNonBlocking -> ReqIdsNonBlocking ack req + SingBlocking -> ReqIdsBlocking ack req + SingNonBlocking -> ReqIdsNonBlocking ack req - idListTrace :: ToAnnce tx -> TokBlockingStyle a -> NodeToNodeSubmissionTrace + idListTrace :: ToAnnce tx -> SingBlockingStyle a -> NodeToNodeSubmissionTrace idListTrace (ToAnnce toAnn) = \case - TokBlocking -> IdsListBlocking $ length toAnn - TokNonBlocking -> IdsListNonBlocking $ length toAnn + SingBlocking -> IdsListBlocking $ length toAnn + SingNonBlocking -> IdsListNonBlocking $ length toAnn From 4bb6293ad5d17f6737c1b83e6472ed9ea9c79518 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 10:08:00 -0700 Subject: [PATCH 26/79] ouroboros-consensus upgrade: adjust to ResourceRegistry being spun off --- cardano-node/cardano-node.cabal | 1 + cardano-node/src/Cardano/Node/Handlers/Shutdown.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 64f0c147a59..090aa91121c 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -197,6 +197,7 @@ library , prettyprinter , prettyprinter-ansi-terminal , psqueues + , resource-registry , safe-exceptions , scientific , si-timers diff --git a/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs b/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs index ada94ad7427..11c8ad9f845 100644 --- a/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs +++ b/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs @@ -31,7 +31,6 @@ where import Cardano.Slotting.Slot (WithOrigin (..)) import Ouroboros.Consensus.Block (Header) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) import Ouroboros.Consensus.Util.STM (Watcher (..), forkLinkedWatcher) import Ouroboros.Network.Block (BlockNo (..), HasHeader, SlotNo (..), pointSlot) @@ -40,6 +39,7 @@ import Control.DeepSeq (NFData) import Control.Exception (try) import Control.Exception.Base (throwIO) import Control.Monad (void, when) +import Control.ResourceRegistry (ResourceRegistry) import "contra-tracer" Control.Tracer import Data.Aeson (FromJSON, ToJSON) import Data.Foldable (asum) From ed60092643a6fbfd63555b4fa3a725cf94f4da41 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 10:48:15 -0700 Subject: [PATCH 27/79] ouroboros-consensus upgrade: adjust to changed constructors and types --- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 3 +- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 82 ------------------- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 5 +- .../Tracing/OrphanInstances/Consensus.hs | 64 +-------------- .../Tracing/OrphanInstances/Shelley.hs | 3 +- 5 files changed, 9 insertions(+), 148 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 1dd16d81ad0..0fc00842fcd 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -1268,11 +1268,12 @@ instance , "opCertStartingKesPeriod" .= oCertStartKesPeriod , "error" .= err ] - Praos.InvalidKesSignatureOCERT currentKesPeriod opCertStartKesPeriod expectedKesEvos err -> + Praos.InvalidKesSignatureOCERT currentKesPeriod opCertStartKesPeriod expectedKesEvos maxKesEvos err -> mconcat [ "kind" .= String "InvalidKesSignatureOCERT" , "currentKesPeriod" .= currentKesPeriod , "opCertStartingKesPeriod" .= opCertStartKesPeriod , "expectedKesEvolutions" .= expectedKesEvos + , "maximumKesEvos" .= maxKesEvos , "error" .= err ] Praos.NoCounterForKeyHashOCERT stakePoolKeyHash-> diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 696c710fdcc..295673186ff 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -417,8 +417,6 @@ instance ( LogFormatting (Header blk) "Popping block from queue" FallingEdgeWith pt -> "Popped block from queue: " <> renderRealPointAsPhrase pt - forHuman (ChainDB.BlockInTheFuture pt slot) = - "Ignoring block from future: " <> renderRealPointAsPhrase pt <> ", slot " <> condenseT slot forHuman (ChainDB.StoreButDontChange pt) = "Ignoring block: " <> renderRealPointAsPhrase pt forHuman (ChainDB.TryAddToCurrentChain pt) = @@ -438,8 +436,6 @@ instance ( LogFormatting (Header blk) case enclosing of RisingEdge -> "Chain about to add block " <> renderRealPointAsPhrase pt FallingEdge -> "Chain added block " <> renderRealPointAsPhrase pt - forHuman (ChainDB.ChainSelectionForFutureBlock pt) = - "Chain selection run for block previously from future: " <> renderRealPointAsPhrase pt forHuman (ChainDB.PipeliningEvent ev') = forHumanOrMachine ev' forHuman ChainDB.AddedReprocessLoEBlocksToQueue = "Added request to queue to reprocess blocks postponed by LoE." @@ -468,10 +464,6 @@ instance ( LogFormatting (Header blk) , case edgePt of RisingEdge -> "risingEdge" .= True FallingEdgeWith pt -> "block" .= forMachine dtal pt ] - forMachine dtal (ChainDB.BlockInTheFuture pt slot) = - mconcat [ "kind" .= String "BlockInTheFuture" - , "block" .= forMachine dtal pt - , "slot" .= forMachine dtal slot ] forMachine dtal (ChainDB.StoreButDontChange pt) = mconcat [ "kind" .= String "StoreButDontChange" , "block" .= forMachine dtal pt ] @@ -562,9 +554,6 @@ instance ( LogFormatting (Header blk) , "block" .= forMachine dtal pt , "blockNo" .= showT bn ] <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ] - forMachine dtal (ChainDB.ChainSelectionForFutureBlock pt) = - mconcat [ "kind" .= String "TChainSelectionForFutureBlock" - , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.PipeliningEvent ev') = forMachine dtal ev' forMachine _dtal ChainDB.AddedReprocessLoEBlocksToQueue = @@ -640,8 +629,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where Namespace [] ["AddedBlockToQueue"] namespaceFor ChainDB.PoppedBlockFromQueue {} = Namespace [] ["PoppedBlockFromQueue"] - namespaceFor ChainDB.BlockInTheFuture {} = - Namespace [] ["BlockInTheFuture"] namespaceFor ChainDB.AddedBlockToVolatileDB {} = Namespace [] ["AddedBlockToVolatileDB"] namespaceFor ChainDB.TryAddToCurrentChain {} = @@ -658,8 +645,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where Namespace [] ["ChangingSelection"] namespaceFor (ChainDB.AddBlockValidation ev') = nsPrependInner "AddBlockValidation" (namespaceFor ev') - namespaceFor ChainDB.ChainSelectionForFutureBlock {} = - Namespace [] ["ChainSelectionForFutureBlock"] namespaceFor (ChainDB.PipeliningEvent ev') = nsPrependInner "PipeliningEvent" (namespaceFor ev') namespaceFor ChainDB.AddedReprocessLoEBlocksToQueue = @@ -673,7 +658,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where severityFor (Namespace _ ["IgnoreBlockAlreadyInVolatileDB"]) _ = Just Info severityFor (Namespace _ ["IgnoreInvalidBlock"]) _ = Just Info severityFor (Namespace _ ["AddedBlockToQueue"]) _ = Just Debug - severityFor (Namespace _ ["BlockInTheFuture"]) _ = Just Info severityFor (Namespace _ ["AddedBlockToVolatileDB"]) _ = Just Debug severityFor (Namespace _ ["PoppedBlockFromQueue"]) _ = Just Debug severityFor (Namespace _ ["TryAddToCurrentChain"]) _ = Just Debug @@ -693,7 +677,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where (Just (ChainDB.AddBlockValidation ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace _ ("AddBlockValidation" : _tl)) Nothing = Just Notice - severityFor (Namespace _ ["ChainSelectionForFutureBlock"]) _ = Just Debug severityFor (Namespace out ("PipeliningEvent" : tl)) (Just (ChainDB.PipeliningEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("PipeliningEvent" : tl)) Nothing = @@ -793,10 +776,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where [ "The block was added to the queue and will be added to the ChainDB by" , " the background thread. The size of the queue is included.." ] - documentFor (Namespace _ ["BlockInTheFuture"]) = Just $ mconcat - [ "The block is from the future, i.e., its slot number is greater than" - , " the current slot (the second argument)." - ] documentFor (Namespace _ ["AddedBlockToVolatileDB"]) = Just "A block was added to the Volatile DB" documentFor (Namespace _ ["PoppedBlockFromQueue"]) = Just "" @@ -829,11 +808,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where ] documentFor (Namespace out ("AddBlockValidation" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) - documentFor (Namespace _ ["ChainSelectionForFutureBlock"]) = Just $ mconcat - [ "Run chain selection for a block that was previously from the future." - , " This is done for all blocks from the future each time a new block is" - , " added." - ] documentFor (Namespace out ("PipeliningEvent" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TracePipeliningEvent blk)) documentFor _ = Nothing @@ -844,7 +818,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where , Namespace [] ["IgnoreBlockAlreadyInVolatileDB"] , Namespace [] ["IgnoreInvalidBlock"] , Namespace [] ["AddedBlockToQueue"] - , Namespace [] ["BlockInTheFuture"] , Namespace [] ["AddedBlockToVolatileDB"] , Namespace [] ["PoppedBlockFromQueue"] , Namespace [] ["TryAddToCurrentChain"] @@ -853,7 +826,6 @@ instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where , Namespace [] ["ChangingSelection"] , Namespace [] ["AddedToCurrentChain"] , Namespace [] ["SwitchedToAFork"] - , Namespace [] ["ChainSelectionForFutureBlock"] , Namespace [] ["AddedReprocessLoEBlocksToQueue"] , Namespace [] ["PoppedReprocessLoEBlocksFromQueue"] , Namespace [] ["ChainSelectionLoEDebug"] @@ -1171,14 +1143,6 @@ instance ( LedgerSupportsProtocol blk "Invalid block " <> renderRealPointAsPhrase pt <> ": " <> showT err forHuman (ChainDB.ValidCandidate c) = "Valid candidate " <> renderPointAsPhrase (AF.headPoint c) - forHuman (ChainDB.CandidateContainsFutureBlocks c hdrs) = - "Candidate contains blocks from near future: " <> - renderPointAsPhrase (AF.headPoint c) <> ", slots " <> - Text.intercalate ", " (map (renderPoint . headerPoint) hdrs) - forHuman (ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs) = - "Candidate contains blocks from future exceeding clock skew limit: " <> - renderPointAsPhrase (AF.headPoint c) <> ", slots " <> - Text.intercalate ", " (map (renderPoint . headerPoint) hdrs) forHuman (ChainDB.UpdateLedgerDbTraceEvent (StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) @@ -1200,14 +1164,6 @@ instance ( LedgerSupportsProtocol blk forMachine dtal (ChainDB.ValidCandidate c) = mconcat [ "kind" .= String "ValidCandidate" , "block" .= renderPointForDetails dtal (AF.headPoint c) ] - forMachine dtal (ChainDB.CandidateContainsFutureBlocks c hdrs) = - mconcat [ "kind" .= String "CandidateContainsFutureBlocks" - , "block" .= renderPointForDetails dtal (AF.headPoint c) - , "headers" .= map (renderPointForDetails dtal . headerPoint) hdrs ] - forMachine dtal (ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs) = - mconcat [ "kind" .= String "CandidateContainsFutureBlocksExceedingClockSkew" - , "block" .= renderPointForDetails dtal (AF.headPoint c) - , "headers" .= map (renderPointForDetails dtal . headerPoint) hdrs ] forMachine _dtal (ChainDB.UpdateLedgerDbTraceEvent (StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) @@ -1222,18 +1178,12 @@ instance ( LedgerSupportsProtocol blk instance MetaTrace (ChainDB.TraceValidationEvent blk) where namespaceFor ChainDB.ValidCandidate {} = Namespace [] ["ValidCandidate"] - namespaceFor ChainDB.CandidateContainsFutureBlocks {} = - Namespace [] ["CandidateContainsFutureBlocks"] - namespaceFor ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} = - Namespace [] ["CandidateContainsFutureBlocksExceedingClockSkew"] namespaceFor ChainDB.InvalidBlock {} = Namespace [] ["InvalidBlock"] namespaceFor ChainDB.UpdateLedgerDbTraceEvent {} = Namespace [] ["UpdateLedgerDb"] severityFor (Namespace _ ["ValidCandidate"]) _ = Just Info - severityFor (Namespace _ ["CandidateContainsFutureBlocks"]) _ = Just Debug - severityFor (Namespace _ ["CandidateContainsFutureBlocksExceedingClockSkew"]) _ = Just Error severityFor (Namespace _ ["InvalidBlock"]) _ = Just Error severityFor (Namespace _ ["UpdateLedgerDb"]) _ = Just Debug severityFor _ _ = Nothing @@ -1242,16 +1192,6 @@ instance MetaTrace (ChainDB.TraceValidationEvent blk) where [ "An event traced during validating performed while adding a block." , " A candidate chain was valid." ] - documentFor (Namespace _ ["CandidateContainsFutureBlocks"]) = Just $ mconcat - [ "An event traced during validating performed while adding a block." - , " Candidate contains headers from the future which do no exceed the" - , " clock skew." - ] - documentFor (Namespace _ ["CandidateContainsFutureBlocksExceedingClockSkew"]) = Just $ mconcat - [ "An event traced during validating performed while adding a block." - , " Candidate contains headers from the future which exceed the" - , " clock skew." - ] documentFor (Namespace _ ["InvalidBlock"]) = Just $ mconcat [ "An event traced during validating performed while adding a block." , " A point was found to be invalid." @@ -1261,8 +1201,6 @@ instance MetaTrace (ChainDB.TraceValidationEvent blk) where allNamespaces = [ Namespace [] ["ValidCandidate"] - , Namespace [] ["CandidateContainsFutureBlocks"] - , Namespace [] ["CandidateContainsFutureBlocksExceedingClockSkew"] , Namespace [] ["InvalidBlock"] , Namespace [] ["UpdateLedgerDb"] ] @@ -2338,23 +2276,3 @@ instance (Show (PBFT.PBftVerKeyHash c)) [ "kind" .= String "PBftCannotForgeThresholdExceeded" , "numForged" .= numForged ] - -instance ( ConvertRawHash blk - , StandardHash blk - , LogFormatting (LedgerError blk) - , LogFormatting (RealPoint blk) - , LogFormatting (OtherHeaderEnvelopeError blk) - , LogFormatting (ExtValidationError blk) - , LogFormatting (ValidationErr (BlockProtocol blk)) - ) - => LogFormatting (ChainDB.InvalidBlockReason blk) where - forMachine dtal (ChainDB.ValidationError extvalerr) = - mconcat - [ "kind" .= String "ValidationError" - , "error" .= forMachine dtal extvalerr - ] - forMachine dtal (ChainDB.InFutureExceedsClockSkew point) = - mconcat - [ "kind" .= String "InFutureExceedsClockSkew" - , "point" .= forMachine dtal point - ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 38d8b141c6d..e364c402130 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -40,6 +40,7 @@ import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockch import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), TraceGDDEvent (..)) +import Ouroboros.Consensus.Ledger.Extended (ExtValidationError) import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpdate, LedgerWarning) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, ByteSize32 (..), GenTxId, HasTxId, LedgerSupportsMempool, txForgetValidated, txId) @@ -1374,8 +1375,8 @@ instance ( tx ~ GenTx blk , HasTxId (GenTx blk) , Show (ForgeStateUpdateError blk) , Show (CannotForge blk) - , LogFormatting (InvalidBlockReason blk) , LogFormatting (CannotForge blk) + , LogFormatting (ExtValidationError blk) , LogFormatting (ForgeStateUpdateError blk)) => LogFormatting (ForgeTracerType blk) where forMachine dtal (Left i) = forMachine dtal i @@ -1471,8 +1472,8 @@ instance ( tx ~ GenTx blk , Show (ForgeStateUpdateError blk) , Show (CannotForge blk) , Show (TxId (GenTx blk)) - , LogFormatting (InvalidBlockReason blk) , LogFormatting (CannotForge blk) + , LogFormatting (ExtValidationError blk) , LogFormatting (ForgeStateUpdateError blk)) => LogFormatting (TraceForgeEvent blk) where forMachine _dtal (TraceStartLeadershipCheck slotNo) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index c685dc7b9b1..e69ee350fb2 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -26,12 +26,12 @@ import Cardano.Slotting.Slot (fromWithOrigin) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Network () import Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderHeaderHash, - renderHeaderHashForVerbosity, renderPoint, renderPointAsPhrase, + renderHeaderHashForVerbosity, renderPointAsPhrase, renderPointForVerbosity, renderRealPoint, renderRealPointAsPhrase, renderTipBlockNo, renderTipHash, renderWithOrigin) import Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge, ConvertRawHash (..), ForgeStateUpdateError, GenesisWindow (..), GetHeader (..), - Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, headerPoint, + Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, pointHash, realPointHash, realPointSlot, withOriginToMaybe) import Ouroboros.Consensus.Block.SupportsSanityCheck import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), @@ -145,7 +145,6 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where ChainDB.IgnoreInvalidBlock {} -> Info ChainDB.AddedBlockToQueue {} -> Debug ChainDB.PoppedBlockFromQueue {} -> Debug - ChainDB.BlockInTheFuture {} -> Info ChainDB.AddedBlockToVolatileDB {} -> Debug ChainDB.TryAddToCurrentChain {} -> Debug ChainDB.TrySwitchToAFork {} -> Info @@ -158,10 +157,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where ChainDB.AddBlockValidation ev' -> case ev' of ChainDB.InvalidBlock {} -> Error ChainDB.ValidCandidate {} -> Info - ChainDB.CandidateContainsFutureBlocks{} -> Debug - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{} -> Error ChainDB.UpdateLedgerDbTraceEvent {} -> Debug - ChainDB.ChainSelectionForFutureBlock{} -> Debug ChainDB.PipeliningEvent {} -> Debug ChainDB.AddedReprocessLoEBlocksToQueue -> Debug ChainDB.PoppedReprocessLoEBlocksFromQueue -> Debug @@ -208,8 +204,6 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where ChainDB.InitChainSelValidation ev' -> case ev' of ChainDB.InvalidBlock{} -> Debug ChainDB.ValidCandidate {} -> Info - ChainDB.CandidateContainsFutureBlocks {} -> Debug - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> Debug ChainDB.UpdateLedgerDbTraceEvent {} -> Info getSeverityAnnotation (ChainDB.TraceIteratorEvent ev) = case ev of @@ -538,8 +532,6 @@ instance ( ConvertRawHash blk "Popping block from queue" FallingEdgeWith pt -> "Popped block from queue: " <> renderRealPointAsPhrase pt - ChainDB.BlockInTheFuture pt slot -> - "Ignoring block from future: " <> renderRealPointAsPhrase pt <> ", slot " <> condenseT slot ChainDB.StoreButDontChange pt -> "Ignoring block: " <> renderRealPointAsPhrase pt ChainDB.TryAddToCurrentChain pt -> @@ -559,14 +551,6 @@ instance ( ConvertRawHash blk "Invalid block " <> renderRealPointAsPhrase pt <> ": " <> showT err ChainDB.ValidCandidate c -> "Valid candidate " <> renderPointAsPhrase (AF.headPoint c) - ChainDB.CandidateContainsFutureBlocks c hdrs -> - "Candidate contains blocks from near future: " <> - renderPointAsPhrase (AF.headPoint c) <> ", slots " <> - Text.intercalate ", " (map (renderPoint . headerPoint) hdrs) - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs -> - "Candidate contains blocks from future exceeding clock skew limit: " <> - renderPointAsPhrase (AF.headPoint c) <> ", slots " <> - Text.intercalate ", " (map (renderPoint . headerPoint) hdrs) ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> let fromSlot = unSlotNo $ realPointSlot start atSlot = unSlotNo $ realPointSlot curr @@ -579,8 +563,6 @@ instance ( ConvertRawHash blk ChainDB.AddedBlockToVolatileDB pt _ _ enclosing -> case enclosing of RisingEdge -> "Chain about to add block " <> renderRealPointAsPhrase pt FallingEdge -> "Chain added block " <> renderRealPointAsPhrase pt - ChainDB.ChainSelectionForFutureBlock pt -> - "Chain selection run for block previously from future: " <> renderRealPointAsPhrase pt ChainDB.PipeliningEvent ev' -> case ev' of ChainDB.SetTentativeHeader hdr enclosing -> case enclosing of RisingEdge -> "About to set tentative header to " <> renderPointAsPhrase (blockPoint hdr) @@ -665,8 +647,6 @@ instance ( ConvertRawHash blk ChainDB.InitChainSelValidation e -> case e of ChainDB.InvalidBlock _err _pt -> "Invalid block found during Initial chain selection, truncating the candidate and retrying to select a best candidate." ChainDB.ValidCandidate af -> "Valid candidate at tip " <> renderPointAsPhrase (AF.lastPoint af) - ChainDB.CandidateContainsFutureBlocks {} -> "Found a candidate containing future blocks during Initial chain selection, truncating the candidate and retrying to select a best candidate." - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> "Found a candidate containing future blocks exceeding clock skew during Initial chain selection, truncating the candidate and retrying to select a best candidate." ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> let fromSlot = unSlotNo $ realPointSlot start atSlot = unSlotNo $ realPointSlot curr @@ -850,23 +830,6 @@ instance ( StandardHash blk ] -instance ( ConvertRawHash blk - , StandardHash blk - , ToObject (LedgerError blk) - , ToObject (OtherHeaderEnvelopeError blk) - , ToObject (ValidationErr (BlockProtocol blk))) - => ToObject (ChainDB.InvalidBlockReason blk) where - toObject verb (ChainDB.ValidationError extvalerr) = - mconcat - [ "kind" .= String "ValidationError" - , "error" .= toObject verb extvalerr - ] - toObject verb (ChainDB.InFutureExceedsClockSkew point) = - mconcat - [ "kind" .= String "InFutureExceedsClockSkew" - , "point" .= toObject verb point - ] - instance (Show (PBFT.PBftVerKeyHash c)) => ToObject (PBFT.PBftValidationErr c) where toObject _verb (PBFT.PBftInvalidSignature text) = @@ -950,10 +913,6 @@ instance ( ConvertRawHash blk , case edgePt of RisingEdge -> "risingEdge" .= True FallingEdgeWith pt -> "block" .= toObject verb pt ] - ChainDB.BlockInTheFuture pt slot -> - mconcat [ "kind" .= String "TraceAddBlockEvent.BlockInTheFuture" - , "block" .= toObject verb pt - , "slot" .= toObject verb slot ] ChainDB.StoreButDontChange pt -> mconcat [ "kind" .= String "TraceAddBlockEvent.StoreButDontChange" , "block" .= toObject verb pt ] @@ -1004,14 +963,6 @@ instance ( ConvertRawHash blk ChainDB.ValidCandidate c -> mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.ValidCandidate" , "block" .= renderPointForVerbosity verb (AF.headPoint c) ] - ChainDB.CandidateContainsFutureBlocks c hdrs -> - mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocks" - , "block" .= renderPointForVerbosity verb (AF.headPoint c) - , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs -> - mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew" - , "block" .= renderPointForVerbosity verb (AF.headPoint c) - , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDb" , "startingBlock" .= renderRealPoint start @@ -1023,9 +974,6 @@ instance ( ConvertRawHash blk , "block" .= toObject verb pt , "blockNo" .= show bn ] <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ] - ChainDB.ChainSelectionForFutureBlock pt -> - mconcat [ "kind" .= String "TraceAddBlockEvent.ChainSelectionForFutureBlock" - , "block" .= toObject verb pt ] ChainDB.PipeliningEvent ev' -> case ev' of ChainDB.SetTentativeHeader hdr enclosing -> mconcat $ [ "kind" .= String "TraceAddBlockEvent.PipeliningEvent.SetTentativeHeader" @@ -1169,14 +1117,6 @@ instance ( ConvertRawHash blk ChainDB.ValidCandidate c -> mconcat [ "kind" .= String "TraceInitChainSelEvent.ValidCandidate" , "block" .= renderPointForVerbosity verb (AF.headPoint c) ] - ChainDB.CandidateContainsFutureBlocks c hdrs -> - mconcat [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocks" - , "block" .= renderPointForVerbosity verb (AF.headPoint c) - , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] - ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs -> - mconcat [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocksExceedingClockSkew" - , "block" .= renderPointForVerbosity verb (AF.headPoint c) - , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr) ) -> mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index a1349d310db..7bba56ed962 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -1289,11 +1289,12 @@ instance Core.Crypto crypto => ToObject (Praos.PraosValidationErr crypto) where , "opCertStartingKesPeriod" .= oCertStartKesPeriod , "error" .= err ] - Praos.InvalidKesSignatureOCERT currentKesPeriod opCertStartKesPeriod expectedKesEvos err -> + Praos.InvalidKesSignatureOCERT currentKesPeriod opCertStartKesPeriod expectedKesEvos maxKesEvos err -> mconcat [ "kind" .= String "InvalidKesSignatureOCERT" , "currentKesPeriod" .= currentKesPeriod , "opCertStartingKesPeriod" .= opCertStartKesPeriod , "expectedKesEvolutions" .= expectedKesEvos + , "maximumKesEvolutions" .= maxKesEvos , "error" .= err ] Praos.NoCounterForKeyHashOCERT stakePoolKeyHash-> From 34aac38c7a308ad59c9f0ba6bb8fe64894ab6d88 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 5 Dec 2024 18:09:53 -0700 Subject: [PATCH 28/79] ouroboros-consensus upgrade: TriggerHardFork changes --- .../src/Cardano/Node/Protocol/Cardano.hs | 57 ++++++++----------- 1 file changed, 25 insertions(+), 32 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 84f312ea522..0fe737d4315 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -29,9 +29,9 @@ import Cardano.Node.Protocol.Types import Cardano.Node.Types import Cardano.Tracing.OrphanInstances.Byron () import Cardano.Tracing.OrphanInstances.Shelley () +import Data.Function ((&)) import Ouroboros.Consensus.Cardano import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus import Ouroboros.Consensus.Cardano.Condense () import qualified Ouroboros.Consensus.Cardano.Node as Consensus import Ouroboros.Consensus.Config (emptyCheckpointsMap) @@ -91,17 +91,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { -- not-yet-ready eras in released node versions without mainnet nodes -- prematurely advertising that they could hard fork into the new era. npcTestShelleyHardForkAtEpoch, - npcTestShelleyHardForkAtVersion, npcTestAllegraHardForkAtEpoch, - npcTestAllegraHardForkAtVersion, npcTestMaryHardForkAtEpoch, - npcTestMaryHardForkAtVersion, npcTestAlonzoHardForkAtEpoch, - npcTestAlonzoHardForkAtVersion, npcTestBabbageHardForkAtEpoch, - npcTestBabbageHardForkAtVersion, - npcTestConwayHardForkAtEpoch, - npcTestConwayHardForkAtVersion + npcTestConwayHardForkAtEpoch } files = do byronGenesis <- @@ -182,7 +176,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Consensus.CardanoHardForkTriggers' { triggerHardForkShelley = -- What will trigger the Byron -> Shelley hard fork? - case npcTestShelleyHardForkAtEpoch of + npcTestShelleyHardForkAtEpoch & maybe -- This specifies the major protocol version number update that will -- trigger us moving to the Shelley protocol. @@ -202,37 +196,36 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { -- But we also provide an override to allow for simpler test setups -- such as triggering at the 0 -> 1 transition . -- - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 2 fromIntegral npcTestShelleyHardForkAtVersion) + Consensus.CardanoTriggerHardForkAtDefaultVersion -- Alternatively, for testing we can transition at a specific epoch. -- - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + Consensus.CardanoTriggerHardForkAtEpoch , triggerHardForkAllegra = - case npcTestAllegraHardForkAtEpoch of - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 3 fromIntegral npcTestAllegraHardForkAtVersion) - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + npcTestAllegraHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch , triggerHardForkMary = - case npcTestMaryHardForkAtEpoch of - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 4 fromIntegral npcTestMaryHardForkAtVersion) - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + npcTestMaryHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch , triggerHardForkAlonzo = - case npcTestAlonzoHardForkAtEpoch of - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 5 fromIntegral npcTestAlonzoHardForkAtVersion) - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + npcTestAlonzoHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch , triggerHardForkBabbage = - case npcTestBabbageHardForkAtEpoch of - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 7 fromIntegral npcTestBabbageHardForkAtVersion) - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + npcTestBabbageHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch , triggerHardForkConway = - case npcTestConwayHardForkAtEpoch of - Nothing -> Consensus.TriggerHardForkAtVersion - (maybe 9 fromIntegral npcTestConwayHardForkAtVersion) - Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + npcTestConwayHardForkAtEpoch & + maybe + Consensus.CardanoTriggerHardForkAtDefaultVersion + Consensus.CardanoTriggerHardForkAtEpoch } -- TODO: once https://github.com/IntersectMBO/cardano-node/issues/5730 is implemented 'emptyCheckpointsMap' needs to be replaced with the checkpoints map read from a configuration file. , Consensus.cardanoCheckpoints = emptyCheckpointsMap From b9df8f369c1e826acc62939021f629c7bb6db59e Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Wed, 4 Dec 2024 11:10:20 +0100 Subject: [PATCH 29/79] ouroboros-consensus upgrade: integrate ledger snapshot checksum - Categorise `LedgerDB.SnapshotMissingChecksum` trace as `Warning` - Expose snapshot checksum switch in config file --- .../src/Cardano/Node/Configuration/POM.hs | 22 ++++++++---- cardano-node/src/Cardano/Node/Orphans.hs | 10 ++++-- cardano-node/src/Cardano/Node/Parsers.hs | 1 + cardano-node/src/Cardano/Node/Run.hs | 4 ++- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 35 +++++++++++++++---- .../Tracing/OrphanInstances/Consensus.hs | 7 ++++ cardano-node/test/Test/Cardano/Node/POM.hs | 6 +++- 7 files changed, 69 insertions(+), 16 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 70ecc7e46c5..8a907384bf3 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -35,8 +37,8 @@ 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.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), - SnapshotInterval (..)) +import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag (..), + NumOfDiskSnapshots (..), SnapshotInterval (..), pattern DoDiskSnapshotChecksum) import Ouroboros.Network.Diffusion.Configuration (ConsensusMode, MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode (..)) @@ -105,10 +107,11 @@ data NodeConfiguration , ncProtocolConfig :: !NodeProtocolConfiguration -- Node parameters, not protocol-specific: - , ncConsensusMode :: !ConsensusMode - , ncDiffusionMode :: !DiffusionMode - , ncNumOfDiskSnapshots :: !NumOfDiskSnapshots - , ncSnapshotInterval :: !SnapshotInterval + , ncConsensusMode :: !ConsensusMode + , ncDiffusionMode :: !DiffusionMode + , ncNumOfDiskSnapshots :: !NumOfDiskSnapshots + , ncSnapshotInterval :: !SnapshotInterval + , ncDoDiskSnapshotChecksum :: !(Flag "DoDiskSnapshotChecksum") -- | During the development and integration of new network protocols -- (node-to-node and node-to-client) we wish to be able to test them @@ -193,6 +196,7 @@ data PartialNodeConfiguration , pncDiffusionMode :: !(Last DiffusionMode ) , pncNumOfDiskSnapshots :: !(Last NumOfDiskSnapshots) , pncSnapshotInterval :: !(Last SnapshotInterval) + , pncDoDiskSnapshotChecksum :: !(Last (Flag "DoDiskSnapshotChecksum")) , pncExperimentalProtocolsEnabled :: !(Last Bool) -- BlockFetch configuration @@ -258,6 +262,8 @@ instance FromJSON PartialNodeConfiguration where <- Last . fmap RequestedNumOfDiskSnapshots <$> v .:? "NumOfDiskSnapshots" pncSnapshotInterval <- Last . fmap RequestedSnapshotInterval <$> v .:? "SnapshotInterval" + pncDoDiskSnapshotChecksum + <- Last <$> v .:? "DoDiskSnapshotChecksum" pncExperimentalProtocolsEnabled <- fmap Last $ do mValue <- v .:? "ExperimentalProtocolsEnabled" @@ -339,6 +345,7 @@ instance FromJSON PartialNodeConfiguration where , pncDiffusionMode , pncNumOfDiskSnapshots , pncSnapshotInterval + , pncDoDiskSnapshotChecksum , pncExperimentalProtocolsEnabled , pncMaxConcurrencyBulkSync , pncMaxConcurrencyDeadline @@ -512,6 +519,7 @@ defaultPartialNodeConfiguration = , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode , pncNumOfDiskSnapshots = Last $ Just DefaultNumOfDiskSnapshots , pncSnapshotInterval = Last $ Just DefaultSnapshotInterval + , pncDoDiskSnapshotChecksum = Last $ Just DoDiskSnapshotChecksum , pncExperimentalProtocolsEnabled = Last $ Just False , pncTopologyFile = Last . Just $ TopologyFile "configuration/cardano/mainnet-topology.json" , pncProtocolFiles = mempty @@ -566,6 +574,7 @@ makeNodeConfiguration pnc = do diffusionMode <- lastToEither "Missing DiffusionMode" $ pncDiffusionMode pnc numOfDiskSnapshots <- lastToEither "Missing NumOfDiskSnapshots" $ pncNumOfDiskSnapshots pnc snapshotInterval <- lastToEither "Missing SnapshotInterval" $ pncSnapshotInterval pnc + doDiskSnapshotChecksum <- lastToEither "Missing DoDiskSnapshotChecksum" $ pncDoDiskSnapshotChecksum pnc shutdownConfig <- lastToEither "Missing ShutdownConfig" $ pncShutdownConfig pnc socketConfig <- lastToEither "Missing SocketConfig" $ pncSocketConfig pnc @@ -639,6 +648,7 @@ makeNodeConfiguration pnc = do , ncDiffusionMode = diffusionMode , ncNumOfDiskSnapshots = numOfDiskSnapshots , ncSnapshotInterval = snapshotInterval + , ncDoDiskSnapshotChecksum = doDiskSnapshotChecksum , ncExperimentalProtocolsEnabled = experimentalProtocols , ncMaxConcurrencyBulkSync = getLast $ pncMaxConcurrencyBulkSync pnc , ncMaxConcurrencyDeadline = getLast $ pncMaxConcurrencyDeadline pnc diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index b0246e0f6e7..eefa6e7b84b 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-} @@ -8,6 +10,7 @@ module Cardano.Node.Orphans () where import Cardano.Api () +import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag(..)) import Ouroboros.Consensus.Node import qualified Data.Text as Text import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..)) @@ -46,11 +49,14 @@ instance FromJSON AcceptedConnectionsLimit where <*> v .: "delay" instance FromJSON NodeDatabasePaths where - parseJSON o@(Object{})= - withObject "NodeDatabasePaths" + parseJSON o@(Object{})= + withObject "NodeDatabasePaths" (\v -> MultipleDbPaths <$> v .: "ImmutableDbPath" <*> v .: "VolatileDbPath" ) o parseJSON (String s) = return . OnePathForAllDbs $ Text.unpack s parseJSON _ = fail "NodeDatabasePaths must be an object or a string" + +deriving newtype instance FromJSON (Flag symbol) +deriving newtype instance ToJSON (Flag symbol) diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index ef49725ed06..08ab701d89b 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -93,6 +93,7 @@ nodeRunParser = do , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = numOfDiskSnapshots , pncSnapshotInterval = snapshotInterval + , pncDoDiskSnapshotChecksum = mempty , pncExperimentalProtocolsEnabled = mempty , pncProtocolFiles = Last $ Just ProtocolFilepaths { byronCertFile diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index d5b3d4e0f4a..ffda9eda087 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} @@ -63,7 +64,7 @@ import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..)) import Cardano.Tracing.Tracers import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) -import Ouroboros.Consensus.Node (DiskPolicyArgs (..), NetworkP2PMode (..), +import Ouroboros.Consensus.Node (DiskPolicyArgs (..), pattern DoDiskSnapshotChecksum, pattern NoDoDiskSnapshotChecksum, NetworkP2PMode (..), NodeDatabasePaths (..), RunNodeArgs (..), StdRunNodeArgs (..)) import qualified Ouroboros.Consensus.Node as Node (NodeDatabasePaths (..), getChainDB, run) import Ouroboros.Consensus.Node.Genesis @@ -651,6 +652,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do DiskPolicyArgs (ncSnapshotInterval nc) (ncNumOfDiskSnapshots nc) + (ncDoDiskSnapshotChecksum nc) -------------------------------------------------------------------------------- -- SIGHUP Handlers diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 295673186ff..00fa50d6960 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -1522,21 +1522,35 @@ instance ( StandardHash blk , ConvertRawHash blk) => LogFormatting (LedgerDB.TraceSnapshotEvent blk) where forHuman (LedgerDB.TookSnapshot snap pt RisingEdge) = - "Taking ledger snapshot " <> showT snap <> - " at " <> renderRealPointAsPhrase pt + Text.unwords [ "Taking ledger snapshot" + , showT snap + , "at" + , renderRealPointAsPhrase pt + ] forHuman (LedgerDB.TookSnapshot snap pt (FallingEdgeWith t)) = - "Took ledger snapshot " <> showT snap <> - " at " <> renderRealPointAsPhrase pt <> ", duration: " <> showT t + Text.unwords [ "Took ledger snapshot" + , showT snap + , "at" + , renderRealPointAsPhrase pt + , ", duration:" + , showT t + ] forHuman (LedgerDB.DeletedSnapshot snap) = - "Deleted old snapshot " <> showT snap + Text.unwords ["Deleted old snapshot", showT snap] forHuman (LedgerDB.InvalidSnapshot snap failure) = - "Invalid snapshot " <> showT snap <> showT failure <> context + Text.unwords [ "Invalid snapshot" + , showT snap + , showT failure + , context + ] where context = case failure of LedgerDB.InitFailureRead{} -> " This is most likely an expected change in the serialization format," <> " which currently requires a chain replay" _ -> "" + forHuman (LedgerDB.SnapshotMissingChecksum snap) = + "Checksum file is missing for snapshot " <> showT snap forMachine dtals (LedgerDB.TookSnapshot snap pt enclosedTiming) = mconcat [ "kind" .= String "TookSnapshot" @@ -1550,15 +1564,21 @@ instance ( StandardHash blk mconcat [ "kind" .= String "InvalidSnapshot" , "snapshot" .= forMachine dtals snap , "failure" .= show failure ] + forMachine dtals (LedgerDB.SnapshotMissingChecksum snap) = + mconcat [ "kind" .= String "SnapshotMissingChecksum" + , "snapshot" .= forMachine dtals snap + ] instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where namespaceFor LedgerDB.TookSnapshot {} = Namespace [] ["TookSnapshot"] namespaceFor LedgerDB.DeletedSnapshot {} = Namespace [] ["DeletedSnapshot"] namespaceFor LedgerDB.InvalidSnapshot {} = Namespace [] ["InvalidSnapshot"] + namespaceFor LedgerDB.SnapshotMissingChecksum {} = Namespace [] ["SnapshotMissingChecksum"] severityFor (Namespace _ ["TookSnapshot"]) _ = Just Info severityFor (Namespace _ ["DeletedSnapshot"]) _ = Just Debug severityFor (Namespace _ ["InvalidSnapshot"]) _ = Just Error + severityFor (Namespace _ ["SnapshotMissingChecksum"]) _ = Just Warning severityFor _ _ = Nothing documentFor (Namespace _ ["TookSnapshot"]) = Just $ mconcat @@ -1570,12 +1590,15 @@ instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where "A snapshot was deleted from the disk." documentFor (Namespace _ ["InvalidSnapshot"]) = Just "An on disk snapshot was invalid. Unless it was suffixed, it will be deleted" + documentFor (Namespace _ ["SnapshotMissingChecksum"]) = Just + "Checksum file was missing for snapshot." documentFor _ = Nothing allNamespaces = [ Namespace [] ["TookSnapshot"] , Namespace [] ["DeletedSnapshot"] , Namespace [] ["InvalidSnapshot"] + , Namespace [] ["SnapshotMissingChecksum"] ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index e69ee350fb2..e42672f330d 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -173,6 +173,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where LedgerDB.TookSnapshot {} -> Info LedgerDB.DeletedSnapshot {} -> Debug LedgerDB.InvalidSnapshot {} -> Error + LedgerDB.SnapshotMissingChecksum {} -> Warning getSeverityAnnotation (ChainDB.TraceCopyToImmutableDBEvent ev) = case ev of ChainDB.CopiedBlockToImmutableDB {} -> Debug @@ -599,6 +600,8 @@ instance ( ConvertRawHash blk " This is most likely an expected change in the serialization format," <> " which currently requires a chain replay" _ -> "" + LedgerDB.SnapshotMissingChecksum snap -> + "Checksum file is missing for snapshot " <> showT snap LedgerDB.TookSnapshot snap pt RisingEdge -> "Taking ledger snapshot " <> showT snap <> @@ -1051,6 +1054,10 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TraceSnapshotEvent.InvalidSnapshot" , "snapshot" .= toObject verb snap , "failure" .= show failure ] + LedgerDB.SnapshotMissingChecksum snap -> + mconcat [ "kind" .= String "TraceSnapshotEvent.SnapshotMissingChecksum" + , "snapshot" .= toObject verb snap + ] toObject verb (ChainDB.TraceCopyToImmutableDBEvent ev) = case ev of ChainDB.CopiedBlockToImmutableDB pt -> diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 81a9d890dfb..882c5cede40 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} module Test.Cardano.Node.POM @@ -15,7 +16,7 @@ import Cardano.Tracing.Config (PartialTraceOptions (..), defaultPartia import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), - SnapshotInterval (..)) + SnapshotInterval (..), pattern DoDiskSnapshotChecksum) import Ouroboros.Network.Block (SlotNo (..)) import Ouroboros.Network.Diffusion.Configuration (MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), @@ -121,6 +122,7 @@ testPartialYamlConfig = , pncDiffusionMode = Last Nothing , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = mempty + , pncDoDiskSnapshotChecksum = Last . Just $ DoDiskSnapshotChecksum , pncExperimentalProtocolsEnabled = Last Nothing , pncMaxConcurrencyBulkSync = Last Nothing , pncMaxConcurrencyDeadline = Last Nothing @@ -165,6 +167,7 @@ testPartialCliConfig = , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = Last . Just . RequestedSnapshotInterval $ secondsToDiffTime 100 + , pncDoDiskSnapshotChecksum = Last . Just $ DoDiskSnapshotChecksum , pncExperimentalProtocolsEnabled = Last $ Just True , pncProtocolFiles = Last . Just $ ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing , pncValidateDB = Last $ Just True @@ -211,6 +214,7 @@ eExpectedConfig = do , ncDiffusionMode = InitiatorAndResponderDiffusionMode , ncNumOfDiskSnapshots = DefaultNumOfDiskSnapshots , ncSnapshotInterval = RequestedSnapshotInterval $ secondsToDiffTime 100 + , ncDoDiskSnapshotChecksum = DoDiskSnapshotChecksum , ncExperimentalProtocolsEnabled = True , ncMaxConcurrencyBulkSync = Nothing , ncMaxConcurrencyDeadline = Nothing From 738e5ad322d32ada9c1c7c77ae762d5eeab8638d Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 4 Dec 2024 16:10:49 -0700 Subject: [PATCH 30/79] cardano-api upgrade: increase version to 10.6 --- bench/plutus-scripts-bench/plutus-scripts-bench.cabal | 2 +- bench/tx-generator/tx-generator.cabal | 2 +- cardano-node/cardano-node.cabal | 2 +- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index ad0fa7a099f..4c6dc8ed805 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -82,7 +82,7 @@ library -- IOG dependencies -------------------------- build-depends: - , cardano-api ^>=10.1 + , cardano-api ^>=10.6 , plutus-ledger-api ^>=1.37 , plutus-tx ^>=1.37 , plutus-tx-plugin ^>=1.37 diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index b8275a8da51..e8e9a59dacd 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -106,7 +106,7 @@ library , attoparsec-aeson , base16-bytestring , bytestring - , cardano-api ^>= 10.1 + , cardano-api ^>= 10.6 , cardano-binary , cardano-cli ^>= 10.1 , cardano-crypto-class diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 090aa91121c..4ff933b5300 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -145,7 +145,7 @@ library , async , base16-bytestring , bytestring - , cardano-api ^>= 10.1 + , cardano-api ^>= 10.6 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>=0.2.2 diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 17b3dc2e75d..4e5f55e7cd4 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -39,7 +39,7 @@ library , aeson , async , bytestring - , cardano-api ^>= 10.1 + , cardano-api ^>= 10.6 , cardano-binary , cardano-cli ^>= 10.1 , cardano-crypto-class ^>= 2.1.2 diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 19b3df840fb..1005ac04414 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -35,7 +35,7 @@ library , aeson-pretty , ansi-terminal , bytestring - , cardano-api ^>= 10.1 + , cardano-api ^>= 10.6 , cardano-cli ^>= 10.1 , cardano-crypto-class , cardano-crypto-wrapper From 70f58c125be37921fe50717d425e8a717a0ea78f Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 10 Dec 2024 08:53:00 -0700 Subject: [PATCH 31/79] cardano-api upgrade: use convert instead of deprecated conwayEraOnwardsToShelleyBasedEra --- cardano-testnet/src/Testnet/Components/Query.hs | 2 +- cardano-testnet/src/Testnet/Process/Cli/DRep.hs | 4 ++-- .../Cardano/Testnet/Test/Cli/Conway/Plutus.hs | 2 +- .../Cardano/Testnet/Test/Cli/KesPeriodInfo.hs | 2 +- .../Cardano/Testnet/Test/Cli/LeadershipSchedule.hs | 2 +- .../Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs | 2 +- .../Cardano/Testnet/Test/Gov/CommitteeAddNew.hs | 2 +- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 4 ++-- .../Cardano/Testnet/Test/Gov/DRepDeposit.hs | 2 +- .../Cardano/Testnet/Test/Gov/GovActionTimeout.hs | 2 +- .../Cardano/Testnet/Test/Gov/InfoAction.hs | 2 +- .../Cardano/Testnet/Test/Gov/NoConfidence.hs | 2 +- .../Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs | 4 ++-- .../Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs | 6 +++--- .../Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs | 2 +- .../Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs | 2 +- .../Cardano/Testnet/Test/Gov/TreasuryDonation.hs | 2 +- .../Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs | 2 +- 18 files changed, 23 insertions(+), 23 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 4977c04d37f..2697b150a81 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -465,7 +465,7 @@ getGovState -> m (L.ConwayGovState (ShelleyLedgerEra era)) -- ^ The governance state getGovState epochStateView ceo = withFrozenCallStack $ do AnyNewEpochState sbe' newEpochState <- getEpochState epochStateView - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo Refl <- H.leftFail $ assertErasEqual sbe sbe' pure $ conwayEraOnwardsConstraints ceo $ newEpochState ^. L.newEpochStateGovStateL diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index 23ae6e90f98..cf3a1ba7c31 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -227,7 +227,7 @@ registerDRep -- as returned by 'cardanoTestnetDefault'. -> m (KeyPair PaymentKey) registerDRep execConfig epochStateView ceo work prefix wallet = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era @@ -354,7 +354,7 @@ makeActivityChangeProposal makeActivityChangeProposal execConfig epochStateView ceo work prevGovActionInfo drepActivity stakeKeyPair wallet timeout = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era KeyPair{verificationKey=File stakeVkeyFp} = stakeKeyPair diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 1ebede4c87d..b29a33deb71 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -55,7 +55,7 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa let tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe anyEra = AnyCardanoEra era options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs index dc70f16dd98..53f7b8c5345 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs @@ -62,7 +62,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe eraString = eraToString sbe cTestnetOptions = def { cardanoNodeEra = asbe } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs index 40373ff4910..c2960c48519 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs @@ -62,7 +62,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe cTestnetOptions = def { cardanoNodeEra = asbe 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 53b36186c7a..a27e01a1f89 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 @@ -49,7 +49,7 @@ hprop_tx_register_deregister_stake_address = integrationWorkspace "register-dere work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo eraName = eraToString sbe fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } shelleyOptions = def { genesisEpochLength = 200 } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 997ab0753d8..0ef209cce41 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -74,7 +74,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co nDrepVotes = length drepVotes nSpos = fromIntegral $ cardanoNumPools fastTestnetOptions ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era eraName = eraToString era diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index 87a3cb874ce..20eb2b5c9a5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -60,7 +60,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = 1 @@ -219,7 +219,7 @@ activityChangeProposalTest -> m (String, Word16) -- ^ The transaction id and the index of the governance action. activityChangeProposalTest execConfig epochStateView ceo work prefix stakeKeys wallet votes change minWait mExpected maxWait = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo mPreviousProposalInfo <- getLastPParamUpdateActionId execConfig 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 1d5fcca563c..77342d63ca4 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 @@ -42,7 +42,7 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era fastTestnetOptions = def diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs index 6916c5c3fcd..6107805897a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs @@ -51,7 +51,7 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te -- Create default testnet let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo eraName = eraToString sbe asbe = AnyShelleyBasedEra sbe fastTestnetOptions = def { cardanoNodeEra = asbe } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index ea8744af10b..9c60c7707ae 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -58,7 +58,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe eraName = eraToString sbe fastTestnetOptions = def { cardanoNodeEra = asbe } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 0912f85c1e9..c7c7623adb8 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -64,7 +64,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe era = toCardanoEra sbe cEra = AnyCardanoEra era diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs index 5218ba340c5..a86c447b519 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs @@ -58,7 +58,7 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs -- Create default testnet let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe eraName = eraToString sbe fastTestnetOptions = def { cardanoNodeEra = asbe } @@ -163,7 +163,7 @@ failToVoteChangeProposalWithSPOs ceo execConfig epochStateView work prefix governanceActionTxId governanceActionIndex votes wallet = withFrozenCallStack $ do baseDir <- H.createDirectoryIfMissing $ work prefix - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 6b504e94aec..7869ffaba93 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -74,7 +74,7 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = 3 @@ -186,7 +186,7 @@ desiredPoolNumberProposalTest -> m (String, Word16) desiredPoolNumberProposalTest execConfig epochStateView ceo work prefix wallet previousProposalInfo votes change minWait mExpected maxWait = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo baseDir <- H.createDirectoryIfMissing $ work prefix @@ -229,7 +229,7 @@ makeDesiredPoolNumberChangeProposal makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix prevGovActionInfo desiredPoolNumber wallet = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo + let sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index b9b9eed06a2..de60bc4d1cd 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -70,7 +70,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new annotateShow numVotes let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era eraName = eraToString sbe diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs index 9ff14059756..06793e3a943 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs @@ -52,7 +52,7 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe cEra = AnyCardanoEra era fastTestnetOptions = def diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs index 16fbd89a13f..a0cf0a25442 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -45,7 +45,7 @@ hprop_ledger_events_treasury_donation = integrationRetryWorkspace 2 "treasury-do let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } shelleyOptions = def { genesisEpochLength = 100 } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index 0b663315af4..6415f302200 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -58,7 +58,7 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo era = toCardanoEra sbe eraName = eraToString era From 1391457d0122b84c42c777a7b0a06a5341bd5a7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 17 Apr 2024 22:02:27 +0200 Subject: [PATCH 32/79] Support for big ledger peer snapshot This change introduces support for big ledger peers in the node. A new optional entry in network topology JSON parser is added that is intended to point to a path containing a serialized snapshot of big ledger peers taken from some slot a priori. When present, this file is decoded at node startup, or when a SIGHUP is triggered, and made available to the diffusion layer via reading from a TVar. --- cardano-node/ChangeLog.md | 5 ++ .../Cardano/Node/Configuration/TopologyP2P.hs | 38 ++++++++++-- cardano-node/src/Cardano/Node/Run.hs | 58 +++++++++++++++---- cardano-node/src/Cardano/Node/Startup.hs | 4 ++ .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 7 ++- .../Cardano/Node/Tracing/Tracers/Startup.hs | 21 ++++++- cardano-node/src/Cardano/Node/Types.hs | 9 +++ .../Tracing/OrphanInstances/Network.hs | 2 +- cardano-node/test/Test/Cardano/Node/Gen.hs | 9 +++ 9 files changed, 131 insertions(+), 22 deletions(-) diff --git a/cardano-node/ChangeLog.md b/cardano-node/ChangeLog.md index 7e3aff8ac10..76e7cfd2474 100644 --- a/cardano-node/ChangeLog.md +++ b/cardano-node/ChangeLog.md @@ -9,6 +9,11 @@ - `--mempool-capacity-override` and `--no-mempool-capacity-override` can be set in the configuration file via the key `MempoolCapacityBytesOverride`. - `--snapshot-interval` can be set in the configuration file via the key `SnapshotInterval`. - `--num-of-disk-snapshots` can be set in the configuration file via the key `NumOfDiskSnapshots`. +- Ledger peer snapshot path entry added to topology JSON parser, + which a new decoder function `readPeerSnapshotFile` processes + at startup and SIGHUP. Data is available to the diffusion layer + via TVar. + - Use metric names of old-tracing in new-tracing as well, and fix some metrics in new tracing. diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs index dfad181fa7f..fa6948e4716 100644 --- a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs +++ b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs @@ -17,6 +17,7 @@ module Cardano.Node.Configuration.TopologyP2P , PeerAdvertise(..) , nodeAddressToSockAddr , readTopologyFile + , readPeerSnapshotFile , readTopologyFileOrError , rootConfigToRelayAccessPoint ) @@ -25,11 +26,15 @@ where import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Configuration.Topology (TopologyError (..)) +import Cardano.Node.Startup (StartupTrace (..)) import Cardano.Node.Types +import Cardano.Logging (traceWith) import Cardano.Tracing.OrphanInstances.Network () +import Ouroboros.Network.ConsensusMode import Ouroboros.Network.NodeToNode (PeerAdvertise (..)) import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..)) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..), + UseLedgerPeers (..)) import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..), @@ -39,6 +44,7 @@ import Control.Applicative (Alternative (..)) import Control.Exception (IOException) import qualified Control.Exception as Exception import Control.Exception.Base (Exception (..)) +import Control.Monad.Trans.Except.Extra import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -171,6 +177,7 @@ data NetworkTopology = RealNodeTopology { ntLocalRootPeersGroups :: !LocalRootPe , ntPublicRootPeers :: ![PublicRootPeers] , ntUseLedgerPeers :: !UseLedgerPeers , ntUseBootstrapPeers :: !UseBootstrapPeers + , ntPeerSnapshotPath :: !(Maybe PeerSnapshotFile) } deriving (Eq, Show) @@ -179,7 +186,8 @@ instance FromJSON NetworkTopology where RealNodeTopology <$> (o .: "localRoots" ) <*> (o .: "publicRoots" ) <*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers ) - <*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers) + <*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers ) + <*> (o .:? "peerSnapshotFile") instance ToJSON NetworkTopology where toJSON top = @@ -188,10 +196,12 @@ instance ToJSON NetworkTopology where , ntPublicRootPeers , ntUseLedgerPeers , ntUseBootstrapPeers + , ntPeerSnapshotPath } -> object [ "localRoots" .= ntLocalRootPeersGroups , "publicRoots" .= ntPublicRootPeers , "useLedgerAfterSlot" .= ntUseLedgerPeers , "bootstrapPeers" .= ntUseBootstrapPeers + , "peerSnapshotFile" .= ntPeerSnapshotPath ] -- | Read the `NetworkTopology` configuration from the specified file. @@ -207,8 +217,15 @@ readTopologyFile nc = do return $ case eitherDecode bs' of Left err -> Left (handlerJSON err) Right t - | isValidTrustedPeerConfiguration t -> Right t - | otherwise -> Left handlerBootstrap + | isValidTrustedPeerConfiguration t -> + if isGenesisCompatible (ncConsensusMode nc) (ntUseBootstrapPeers t) + then return (Right t) + else do + traceWith (ncTraceConfig nc) $ + NetworkConfigUpdateError genesisIncompatible + return . Right $ t { ntUseBootstrapPeers = DontUseBootstrapPeers } + | otherwise -> + Left handlerBootstrap where handler :: IOException -> Text handler e = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: " @@ -223,6 +240,9 @@ readTopologyFile nc = do , "configuration flag. " , Text.pack err ] + genesisIncompatible + = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: " + <> "Bootstrap peers are not used in Genesis consensus mode." handlerBootstrap :: Text handlerBootstrap = mconcat [ "You seem to have not configured any trustable peers. " @@ -230,6 +250,8 @@ readTopologyFile nc = do , "in bootstrap mode. Make sure you provide at least one bootstrap peer " , "source. " ] + isGenesisCompatible GenesisMode (UseBootstrapPeers{}) = False + isGenesisCompatible _ _ = True readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology readTopologyFileOrError nc = @@ -238,6 +260,12 @@ readTopologyFileOrError nc = <> Text.unpack err) pure +readPeerSnapshotFile :: PeerSnapshotFile -> IO LedgerPeerSnapshot +readPeerSnapshotFile (PeerSnapshotFile psf) = either error pure =<< runExceptT + (handleLeftT (left . ("Cardano.Node.Configuration.TopologyP2P.readPeerSnapshotFile: " <>)) $ do + bs <- BS.readFile psf `catchIOExceptT` displayException + hoistEither (eitherDecode . LBS.fromStrict $ bs)) + -- -- Checking for chance of progress in bootstrap phase -- @@ -245,7 +273,7 @@ readTopologyFileOrError nc = -- | This function returns false if non-trustable peers are configured -- isValidTrustedPeerConfiguration :: NetworkTopology -> Bool -isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp) = +isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp _) = case ubp of DontUseBootstrapPeers -> True UseBootstrapPeers [] -> anyTrustable diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index ffda9eda087..fb3a06bf0c2 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -79,7 +79,7 @@ import Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), ConnectionId, PeerSelectionTargets (..), RemoteAddress) import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers, LedgerPeerSnapshot) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot(..), UseLedgerPeers) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) @@ -92,7 +92,7 @@ import Control.Concurrent (killThread, mkWeakThreadId, myThreadId) import Control.Concurrent.Class.MonadSTM.Strict import Control.Exception (try) import qualified Control.Exception as Exception -import Control.Monad (forM_, unless, void, when) +import Control.Monad (forM, forM_, unless, void, when) import Control.Monad.Class.MonadThrow (MonadThrow (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT, runExceptT) @@ -436,16 +436,24 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do nt@TopologyP2P.RealNodeTopology { ntUseLedgerPeers , ntUseBootstrapPeers + , ntPeerSnapshotPath } <- TopologyP2P.readTopologyFileOrError nc let (localRoots, publicRoots) = producerAddresses nt traceWith (startupTracer tracers) $ NetworkConfig localRoots publicRoots ntUseLedgerPeers - localRootsVar <- newTVarIO localRoots - publicRootsVar <- newTVarIO publicRoots - useLedgerVar <- newTVarIO ntUseLedgerPeers + ntPeerSnapshotPath + localRootsVar <- newTVarIO localRoots + publicRootsVar <- newTVarIO publicRoots + useLedgerVar <- newTVarIO ntUseLedgerPeers useBootstrapVar <- newTVarIO ntUseBootstrapPeers + ledgerPeerSnapshotPathVar <- newTVarIO ntPeerSnapshotPath + ledgerPeerSnapshotVar <- newTVarIO =<< updateLedgerPeerSnapshot + (startupTracer tracers) + (readTVar ledgerPeerSnapshotPathVar) + (const . pure $ ()) + let nodeArgs = RunNodeArgs { rnGenesisConfig = disableGenesisConfig , rnTraceConsensus = consensusTracers tracers @@ -479,6 +487,11 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do updateTopologyConfiguration (startupTracer tracers) nc localRootsVar publicRootsVar useLedgerVar useBootstrapVar + ledgerPeerSnapshotPathVar + void $ updateLedgerPeerSnapshot + (startupTracer tracers) + (readTVar ledgerPeerSnapshotPathVar) + (writeTVar ledgerPeerSnapshotVar) traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective) ) Nothing @@ -490,7 +503,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do (readTVar publicRootsVar) (readTVar useLedgerVar) (readTVar useBootstrapVar) - (pure Nothing) -- FIXME: implement a reader + (readTVar ledgerPeerSnapshotVar) in Node.run nodeArgs { @@ -498,6 +511,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do -- reinstall `SIGHUP` handler installP2PSigHUPHandler (startupTracer tracers) blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapVar + ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar rnNodeKernelHook nodeArgs registry nodeKernel } StdRunNodeArgs @@ -668,17 +682,24 @@ installP2PSigHUPHandler :: Tracer IO (StartupTrace blk) -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) -> StrictTVar IO UseLedgerPeers -> StrictTVar IO UseBootstrapPeers + -> StrictTVar IO (Maybe PeerSnapshotFile) + -> StrictTVar IO (Maybe LedgerPeerSnapshot) -> IO () #ifndef UNIX -installP2PSigHUPHandler _ _ _ _ _ _ _ _ = return () +installP2PSigHUPHandler _ _ _ _ _ _ _ _ _ _ = return () #else installP2PSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar - useBootstrapPeersVar = + useBootstrapPeersVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar = void $ Signals.installHandler Signals.sigHUP (Signals.Catch $ do updateBlockForging startupTracer blockType nodeKernel nc - updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar + updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar + useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar + void $ updateLedgerPeerSnapshot + startupTracer + (readTVar ledgerPeerSnapshotPathVar) + (writeTVar ledgerPeerSnapshotVar) ) Nothing #endif @@ -763,9 +784,10 @@ updateTopologyConfiguration :: Tracer IO (StartupTrace blk) -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) -> StrictTVar IO UseLedgerPeers -> StrictTVar IO UseBootstrapPeers + -> StrictTVar IO (Maybe PeerSnapshotFile) -> IO () updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar - useBootsrapPeersVar = do + useBootsrapPeersVar ledgerPeerSnapshotPathVar = do traceWith startupTracer NetworkConfigUpdate result <- try $ readTopologyFileOrError nc case result of @@ -775,17 +797,31 @@ updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLed $ pack "Error reading topology configuration file:" <> err Right nt@RealNodeTopology { ntUseLedgerPeers , ntUseBootstrapPeers + , ntPeerSnapshotPath } -> do let (localRoots, publicRoots) = producerAddresses nt traceWith startupTracer - $ NetworkConfig localRoots publicRoots ntUseLedgerPeers + $ NetworkConfig localRoots publicRoots ntUseLedgerPeers ntPeerSnapshotPath atomically $ do writeTVar localRootsVar localRoots writeTVar publicRootsVar publicRoots writeTVar useLedgerVar ntUseLedgerPeers writeTVar useBootsrapPeersVar ntUseBootstrapPeers + writeTVar ledgerPeerSnapshotPathVar ntPeerSnapshotPath #endif +updateLedgerPeerSnapshot :: Tracer IO (StartupTrace blk) + -> STM IO (Maybe PeerSnapshotFile) + -> (Maybe LedgerPeerSnapshot -> STM IO ()) + -> IO (Maybe LedgerPeerSnapshot) +updateLedgerPeerSnapshot startupTracer readLedgerPeerPath writeVar = do + mPeerSnapshotFile <- atomically readLedgerPeerPath + mLedgerPeerSnapshot <- forM mPeerSnapshotFile $ \f -> do + lps@(LedgerPeerSnapshot (wOrigin, _)) <- readPeerSnapshotFile f + lps <$ traceWith startupTracer (LedgerPeerSnapshotLoaded wOrigin) + atomically . writeVar $ mLedgerPeerSnapshot + pure mLedgerPeerSnapshot + -------------------------------------------------------------------------------- -- Helper functions -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 9f75890bafc..d2f2e30c09a 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -19,6 +19,8 @@ import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProto import Cardano.Node.Configuration.Socket import Cardano.Node.Protocol (ProtocolInstantiationError) import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) +import Cardano.Node.Types (PeerSnapshotFile) +import Cardano.Slotting.Slot (SlotNo, WithOrigin) import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Cardano.CanHardFork (shelleyLedgerConfig) @@ -109,6 +111,7 @@ data StartupTrace blk = | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] (Map RelayAccessPoint PeerAdvertise) UseLedgerPeers + (Maybe PeerSnapshotFile) -- | Warn when 'DisabledP2P' is set. | NonP2PWarning @@ -127,6 +130,7 @@ data StartupTrace blk = | BIShelley BasicInfoShelleyBased | BIByron BasicInfoByron | BINetwork BasicInfoNetwork + | LedgerPeerSnapshotLoaded (WithOrigin SlotNo) data EnabledBlockForging = EnabledBlockForging | DisabledBlockForging diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index e7d8d94a088..5c95b2c8a01 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -906,7 +906,7 @@ instance MetaTrace TraceLedgerPeers where severityFor (Namespace _ ["TraceLedgerPeersDomains"]) _ = Just Debug severityFor (Namespace _ ["TraceLedgerPeersResult"]) _ = Just Debug severityFor (Namespace _ ["TraceLedgerPeersFailure"]) _ = Just Debug - severityFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) _ = Just Info + severityFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) _ = Just Debug severityFor _ _ = Nothing documentFor (Namespace _ ["PickedPeer"]) = Just @@ -935,8 +935,9 @@ instance MetaTrace TraceLedgerPeers where "" documentFor (Namespace _ ["TraceLedgerPeersFailure"]) = Just "" - documentFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) = Just - "" + documentFor (Namespace _ ["UsingBigLedgerPeerSnapshot"]) = Just $ mconcat + [ "Trace for when a request for big ledger peers is fulfilled from the snapshot file" + , " defined in the topology configuration file."] documentFor _ = Nothing allNamespaces = [ diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index dddbe63f8d0..7ef202a6b3c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -26,6 +26,7 @@ import Cardano.Node.Configuration.POM (NodeConfiguration, ncProtocol) import Cardano.Node.Configuration.Socket import Cardano.Node.Protocol (SomeConsensusProtocol (..)) import Cardano.Node.Startup +import Cardano.Node.Types (PeerSnapshotFile (..)) import Cardano.Slotting.Slot (EpochSize (..)) import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT import Ouroboros.Consensus.Byron.Ledger.Conversions (fromByronEpochSlots, @@ -215,17 +216,24 @@ instance ( Show (BlockNodeToNodeVersion blk) forMachine _dtal NetworkConfigUpdate = mconcat [ "kind" .= String "NetworkConfigUpdate" , "message" .= String "network configuration update" ] + forMachine _dtal (LedgerPeerSnapshotLoaded wOrigin) = + mconcat [ "kind" .= String "LedgerPeerSnapshotLoaded" + , "message" .= String (showT wOrigin)] forMachine _dtal NetworkConfigUpdateUnsupported = mconcat [ "kind" .= String "NetworkConfigUpdate" , "message" .= String "network topology reconfiguration is not supported in non-p2p mode" ] forMachine _dtal (NetworkConfigUpdateError err) = mconcat [ "kind" .= String "NetworkConfigUpdateError" , "error" .= String err ] - forMachine _dtal (NetworkConfig localRoots publicRoots useLedgerPeers) = + forMachine _dtal (NetworkConfig localRoots publicRoots useLedgerPeers peerSnapshotFileMaybe) = mconcat [ "kind" .= String "NetworkConfig" , "localRoots" .= toJSON localRoots , "publicRoots" .= toJSON publicRoots , "useLedgerAfter" .= useLedgerPeers + , "peerSnapshotFile" .= + case peerSnapshotFileMaybe of + Nothing -> Null + Just (PeerSnapshotFile path) -> String (pack path) ] forMachine _dtal NonP2PWarning = mconcat [ "kind" .= String "NonP2PWarning" @@ -305,6 +313,8 @@ instance MetaTrace (StartupTrace blk) where Namespace [] ["BlockForgingBlockTypeMismatch"] namespaceFor NetworkConfigUpdate {} = Namespace [] ["NetworkConfigUpdate"] + namespaceFor LedgerPeerSnapshotLoaded {} = + Namespace [] ["LedgerPeerSnapshotLoaded"] namespaceFor NetworkConfigUpdateUnsupported {} = Namespace [] ["NetworkConfigUpdateUnsupported"] namespaceFor NetworkConfigUpdateError {} = @@ -506,7 +516,7 @@ ppStartupInfoTrace NetworkConfigUpdate = "Performing topology configuration upda ppStartupInfoTrace NetworkConfigUpdateUnsupported = "Network topology reconfiguration is not supported in non-p2p mode" ppStartupInfoTrace (NetworkConfigUpdateError err) = err -ppStartupInfoTrace (NetworkConfig localRoots publicRoots useLedgerPeers) = +ppStartupInfoTrace (NetworkConfig localRoots publicRoots useLedgerPeers peerSnapshotFile) = pack $ intercalate "\n" [ "\nLocal Root Groups:" @@ -522,8 +532,15 @@ ppStartupInfoTrace (NetworkConfig localRoots publicRoots useLedgerPeers) = ++ show (unSlotNo slotNo) UseLedgerPeers Always -> "Use ledger peers in any slot." + , case peerSnapshotFile of + Nothing -> "Topology configuration does not specify ledger peer snapshot file" + Just p -> "Topology configuration specifies ledger peer snapshot file: " + <> show (unPeerSnapshotFile p) ] +ppStartupInfoTrace (LedgerPeerSnapshotLoaded wOrigin) = + "Topology: Peer snapshot containing ledger peers " <> showT wOrigin <> " loaded." + ppStartupInfoTrace NonP2PWarning = nonP2PWarningMessage ppStartupInfoTrace (WarningDevelopmentNodeToNodeVersions ntnVersions) = diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index b16ca45e4aa..7932bf89e82 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -14,6 +14,7 @@ module Cardano.Node.Types , ConfigYamlFilePath(..) , DbFile(..) , GenesisFile(..) + , PeerSnapshotFile (..) , ProtocolFilepaths (..) , GenesisHash(..) , MaxConcurrencyBulkSync(..) @@ -82,6 +83,14 @@ newtype GenesisFile = GenesisFile deriving stock (Eq, Ord) deriving newtype (IsString, Show) +-- | Path containing a serialized ledger peer snapshot +-- for use by diffusion layer to facilitate bootstrapping +-- a node in Genesis consensus mode +-- +newtype PeerSnapshotFile = PeerSnapshotFile { unPeerSnapshotFile :: FilePath } + deriving stock (Eq, Show) + deriving newtype (FromJSON, ToJSON) + instance FromJSON GenesisFile where parseJSON (String genFp) = pure . GenesisFile $ Text.unpack genFp parseJSON invalid = fail $ "Parsing of GenesisFile failed due to type mismatch. " diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 4febc84f091..568e52f15bd 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -250,7 +250,7 @@ instance HasSeverityAnnotation TraceLedgerPeers where TraceLedgerPeersDomains {} -> Debug TraceLedgerPeersResult {} -> Debug TraceLedgerPeersFailure {} -> Debug - UsingBigLedgerPeerSnapshot {} -> Info + UsingBigLedgerPeerSnapshot {} -> Debug instance HasPrivacyAnnotation (WithAddr addr ErrorPolicyTrace) diff --git a/cardano-node/test/Test/Cardano/Node/Gen.hs b/cardano-node/test/Test/Cardano/Node/Gen.hs index f7851a7aca0..44546e5c73e 100644 --- a/cardano-node/test/Test/Cardano/Node/Gen.hs +++ b/cardano-node/test/Test/Cardano/Node/Gen.hs @@ -25,6 +25,7 @@ import Cardano.Node.Configuration.NodeAddress (NodeAddress' (..), Node import Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroup (..), LocalRootPeersGroups (..), NetworkTopology (..), NodeSetup (..), PeerAdvertise (..), PublicRootPeers (..), RootConfig (..)) +import Cardano.Node.Types import Cardano.Slotting.Slot (SlotNo (..)) import Ouroboros.Network.PeerSelection.Bootstrap import Ouroboros.Network.PeerSelection.LedgerPeers.Type (AfterSlot (..), @@ -55,6 +56,7 @@ genNetworkTopology = <*> Gen.list (Range.linear 0 10) genPublicRootPeers <*> genUseLedgerPeers <*> genUseBootstrapPeers + <*> genPeerSnapshotPath ] -- | Generate valid encodings of p2p topology files @@ -205,5 +207,12 @@ genUseBootstrapPeers = do domains <- Gen.list (Range.linear 0 6) genRelayAddress Gen.element [ DontUseBootstrapPeers , UseBootstrapPeers domains ] +genPeerSnapshotPath :: Gen (Maybe PeerSnapshotFile) +genPeerSnapshotPath = + Gen.element + [ Nothing + , Just . PeerSnapshotFile $ "dummy" + ] + genPeerTrustable :: Gen PeerTrustable genPeerTrustable = Gen.element [ IsNotTrustable, IsTrustable ] From 398ee91481bf749471117a6d9f4770a0dcf6ff7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 5 Jun 2024 22:16:57 +0200 Subject: [PATCH 33/79] Added trace tags used in validation of big ledger peer snapshot --- cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs | 9 +++++++++ .../src/Cardano/Tracing/OrphanInstances/Network.hs | 6 ++++++ 2 files changed, 15 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 305d35e1c60..b3a78cc2f6b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -558,6 +558,9 @@ instance LogFormatting (TracePeerSelection SockAddr) where , "upstreamyness" .= dpssUpstreamyness ds , "fetchynessBlocks" .= dpssFetchynessBlocks ds ] + forMachine _dtal (TraceVerifyPeerSnapshot result) = + mconcat [ "kind" .= String "VerifyPeerSnapshot" + , "result" .= result] forHuman = pack . show @@ -684,6 +687,8 @@ instance MetaTrace (TracePeerSelection SockAddr) where Namespace [] ["ChurnTimeout"] namespaceFor TraceDebugState {} = Namespace [] ["DebugState"] + namespaceFor TraceVerifyPeerSnapshot {} = + Namespace [] ["VerifyPeerSnapshot"] severityFor (Namespace [] ["LocalRootPeersChanged"]) _ = Just Notice severityFor (Namespace [] ["TargetsChanged"]) _ = Just Notice @@ -719,6 +724,7 @@ instance MetaTrace (TracePeerSelection SockAddr) where severityFor (Namespace [] ["ChurnAction"]) _ = Just Info severityFor (Namespace [] ["ChurnTimeout"]) _ = Just Notice severityFor (Namespace [] ["DebugState"]) _ = Just Info + severityFor (Namespace [] ["VerifyPeerSnapshot"]) _ = Just Error severityFor _ _ = Nothing documentFor (Namespace [] ["LocalRootPeersChanged"]) = Just "" @@ -777,6 +783,8 @@ instance MetaTrace (TracePeerSelection SockAddr) where "Outbound Governor was killed unexpectedly" documentFor (Namespace [] ["DebugState"]) = Just "peer selection internal state" + documentFor (Namespace [] ["VerifyPeerSnapshot"]) = Just + "Big ledger peer snapshot file failed integrity check against the ledger" documentFor _ = Nothing metricsDocFor (Namespace [] ["ChurnAction"]) = @@ -822,6 +830,7 @@ instance MetaTrace (TracePeerSelection SockAddr) where , Namespace [] ["PickInboundPeers"] , Namespace [] ["OutboundGovernorCriticalFailure"] , Namespace [] ["DebugState"] + , Namespace [] ["VerifyPeerSnapshot"] ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 568e52f15bd..68895328bb5 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -493,6 +493,9 @@ instance HasSeverityAnnotation (TracePeerSelection addr) where TraceDebugState {} -> Info + TraceVerifyPeerSnapshot True -> Info + TraceVerifyPeerSnapshot False -> Error + instance HasPrivacyAnnotation (DebugPeerSelection addr) instance HasSeverityAnnotation (DebugPeerSelection addr) where getSeverityAnnotation _ = Debug @@ -2046,6 +2049,9 @@ instance ToObject (TracePeerSelection SockAddr) where , "ledgerStateJudgement" .= dpssLedgerStateJudgement ds , "associationMode" .= dpssAssociationMode ds ] + toObject _verb (TraceVerifyPeerSnapshot result) = + mconcat [ "kind" .= String "VerifyPeerSnapshot" + , "result" .= result ] -- Connection manager abstract state. For explanation of each state see -- From 380dfd913c72e21d8c7111da8e04c1293fea07bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Tue, 4 Jun 2024 15:05:26 +0200 Subject: [PATCH 34/79] Added ConsensusMode option and Genesis targets for diffusion governors. The ConsensusMode configuration option determines whether support for Genesis syncing is enabled. If this flag is GenesisMode, alternate targets for active peers (non- big ledger) and all big ledger targets is used by the peer selection and churn governors in the diffusion layer. These targets are in effect when ledger state is deemed `TooOld` by consensus layer. The large active big ledger peer targets crucially depend on chain skipping to maintain performance requirements. Otherwise, in PraosMode, the legacy algorithm with a single set of targets is employed. --- .../src/Cardano/Node/Configuration/POM.hs | 222 +++++++++++------- cardano-node/src/Cardano/Node/Parsers.hs | 22 +- cardano-node/src/Cardano/Node/Run.hs | 59 +++-- cardano-node/test/Test/Cardano/Node/POM.hs | 28 ++- configuration/cardano/mainnet-config.json | 1 + configuration/cardano/mainnet-config.yaml | 3 +- configuration/cardano/shelley_qa-config.json | 1 + 7 files changed, 206 insertions(+), 130 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 8a907384bf3..637d1c1644b 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -35,14 +35,12 @@ import Cardano.Tracing.Config import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..)) -import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) +import Ouroboros.Consensus.Node (NodeDatabasePaths (..), + pattern DoDiskSnapshotChecksum) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) -import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag (..), - NumOfDiskSnapshots (..), SnapshotInterval (..), pattern DoDiskSnapshotChecksum) -import Ouroboros.Network.Diffusion.Configuration (ConsensusMode, - MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) -import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode (..)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) +import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag, + NumOfDiskSnapshots (..), SnapshotInterval (..)) +import Ouroboros.Network.Diffusion.Configuration as Configuration import Control.Monad (when) import Data.Aeson @@ -107,7 +105,6 @@ data NodeConfiguration , ncProtocolConfig :: !NodeProtocolConfiguration -- Node parameters, not protocol-specific: - , ncConsensusMode :: !ConsensusMode , ncDiffusionMode :: !DiffusionMode , ncNumOfDiskSnapshots :: !NumOfDiskSnapshots , ncSnapshotInterval :: !SnapshotInterval @@ -156,14 +153,21 @@ data NodeConfiguration , ncAcceptedConnectionsLimit :: !AcceptedConnectionsLimit -- P2P governor targets - , ncTargetNumberOfRootPeers :: Int - , ncTargetNumberOfKnownPeers :: Int - , ncTargetNumberOfEstablishedPeers :: Int - , ncTargetNumberOfActivePeers :: Int - , ncTargetNumberOfKnownBigLedgerPeers :: Int - , ncTargetNumberOfEstablishedBigLedgerPeers :: Int - , ncTargetNumberOfActiveBigLedgerPeers :: Int - , ncMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState + , ncDeadlineTargetOfRootPeers :: !Int + , ncDeadlineTargetOfKnownPeers :: !Int + , ncDeadlineTargetOfEstablishedPeers :: !Int + , ncDeadlineTargetOfActivePeers :: !Int + , ncDeadlineTargetOfKnownBigLedgerPeers :: !Int + , ncDeadlineTargetOfEstablishedBigLedgerPeers :: !Int + , ncDeadlineTargetOfActiveBigLedgerPeers :: !Int + , ncSyncTargetOfActivePeers :: !Int + , ncSyncTargetOfKnownBigLedgerPeers :: !Int + , ncSyncTargetOfEstablishedBigLedgerPeers :: !Int + , ncSyncTargetOfActiveBigLedgerPeers :: !Int + + -- Used to determine which set of peer targets to use + -- by the diffusion layer when syncing + , ncConsensusMode :: !ConsensusMode -- Enable experimental P2P mode , ncEnableP2P :: SomeNetworkP2PMode @@ -192,8 +196,7 @@ data PartialNodeConfiguration , pncProtocolConfig :: !(Last NodeProtocolConfiguration) -- Node parameters, not protocol-specific: - , pncConsensusMode :: !(Last ConsensusMode) - , pncDiffusionMode :: !(Last DiffusionMode ) + , pncDiffusionMode :: !(Last DiffusionMode) , pncNumOfDiskSnapshots :: !(Last NumOfDiskSnapshots) , pncSnapshotInterval :: !(Last SnapshotInterval) , pncDoDiskSnapshotChecksum :: !(Last (Flag "DoDiskSnapshotChecksum")) @@ -222,14 +225,21 @@ data PartialNodeConfiguration , pncAcceptedConnectionsLimit :: !(Last AcceptedConnectionsLimit) -- P2P governor targets - , pncTargetNumberOfRootPeers :: !(Last Int) - , pncTargetNumberOfKnownPeers :: !(Last Int) - , pncTargetNumberOfEstablishedPeers :: !(Last Int) - , pncTargetNumberOfActivePeers :: !(Last Int) - , pncTargetNumberOfKnownBigLedgerPeers :: !(Last Int) - , pncTargetNumberOfEstablishedBigLedgerPeers :: !(Last Int) - , pncTargetNumberOfActiveBigLedgerPeers :: !(Last Int) - , pncMinBigLedgerPeersForTrustedState :: !(Last MinBigLedgerPeersForTrustedState) + , pncDeadlineTargetOfRootPeers :: !(Last Int) + , pncDeadlineTargetOfKnownPeers :: !(Last Int) + , pncDeadlineTargetOfEstablishedPeers :: !(Last Int) + , pncDeadlineTargetOfActivePeers :: !(Last Int) + , pncDeadlineTargetOfKnownBigLedgerPeers :: !(Last Int) + , pncDeadlineTargetOfEstablishedBigLedgerPeers :: !(Last Int) + , pncDeadlineTargetOfActiveBigLedgerPeers :: !(Last Int) + , pncSyncTargetOfActivePeers :: !(Last Int) + , pncSyncTargetOfKnownBigLedgerPeers :: !(Last Int) + , pncSyncTargetOfEstablishedBigLedgerPeers :: !(Last Int) + , pncSyncTargetOfActiveBigLedgerPeers :: !(Last Int) + , pncSyncMinTrusted :: !(Last MinBigLedgerPeersForTrustedState) + + -- Consensus mode for diffusion layer + , pncConsensusMode :: !(Last ConsensusMode) -- Enable experimental P2P mode , pncEnableP2P :: !(Last NetworkP2PMode) @@ -254,8 +264,6 @@ instance FromJSON PartialNodeConfiguration where -- Node parameters, not protocol-specific pncSocketPath <- Last <$> v .:? "SocketPath" pncDatabaseFile <- Last <$> v .:? "DatabasePath" - pncConsensusMode - <- Last . fmap getConsensusMode <$> v .:? "ConsensusMode" pncDiffusionMode <- Last . fmap getDiffusionMode <$> v .:? "DiffusionMode" pncNumOfDiskSnapshots @@ -315,14 +323,20 @@ instance FromJSON PartialNodeConfiguration where <- Last <$> v .:? "AcceptedConnectionsLimit" -- P2P Governor parameters, with conservative defaults. - pncTargetNumberOfRootPeers <- Last <$> v .:? "TargetNumberOfRootPeers" - pncTargetNumberOfKnownPeers <- Last <$> v .:? "TargetNumberOfKnownPeers" - pncTargetNumberOfEstablishedPeers <- Last <$> v .:? "TargetNumberOfEstablishedPeers" - pncTargetNumberOfActivePeers <- Last <$> v .:? "TargetNumberOfActivePeers" - pncTargetNumberOfKnownBigLedgerPeers <- Last <$> v .:? "TargetNumberOfKnownBigLedgerPeers" - pncTargetNumberOfEstablishedBigLedgerPeers <- Last <$> v .:? "TargetNumberOfEstablishedBigLedgerPeers" - pncTargetNumberOfActiveBigLedgerPeers <- Last <$> v .:? "TargetNumberOfActiveBigLedgerPeers" - pncMinBigLedgerPeersForTrustedState <- Last <$> v .:? "MinBigLedgerPeersForTrustedState" + pncDeadlineTargetOfRootPeers <- Last <$> v .:? "TargetNumberOfRootPeers" + pncDeadlineTargetOfKnownPeers <- Last <$> v .:? "TargetNumberOfKnownPeers" + pncDeadlineTargetOfEstablishedPeers <- Last <$> v .:? "TargetNumberOfEstablishedPeers" + pncDeadlineTargetOfActivePeers <- Last <$> v .:? "TargetNumberOfActivePeers" + pncDeadlineTargetOfKnownBigLedgerPeers <- Last <$> v .:? "TargetNumberOfKnownBigLedgerPeers" + pncDeadlineTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "TargetNumberOfEstablishedBigLedgerPeers" + pncDeadlineTargetOfActiveBigLedgerPeers <- Last <$> v .:? "TargetNumberOfActiveBigLedgerPeers" + pncSyncTargetOfActivePeers <- Last <$> v .:? "SyncTargetNumberOfActivePeers" + pncSyncTargetOfKnownBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfKnownBigLedgerPeers" + pncSyncTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfEstablishedBigLedgerPeers" + pncSyncTargetOfActiveBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfActiveBigLedgerPeers" + pncSyncMinTrusted <- Last <$> v .:? "SyncMinNumberOfBigLedgerPeersForTrustedState" + + pncConsensusMode <- Last <$> v .:? "ConsensusMode" pncChainSyncIdleTimeout <- Last <$> v .:? "ChainSyncIdleTimeout" @@ -336,12 +350,11 @@ instance FromJSON PartialNodeConfiguration where -- Peer Sharing -- DISABLED BY DEFAULT - pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just PeerSharingDisabled + pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just Configuration.PeerSharingDisabled pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath - , pncConsensusMode , pncDiffusionMode , pncNumOfDiskSnapshots , pncSnapshotInterval @@ -365,14 +378,19 @@ instance FromJSON PartialNodeConfiguration where , pncTimeWaitTimeout , pncChainSyncIdleTimeout , pncAcceptedConnectionsLimit - , pncTargetNumberOfRootPeers - , pncTargetNumberOfKnownPeers - , pncTargetNumberOfEstablishedPeers - , pncTargetNumberOfActivePeers - , pncTargetNumberOfKnownBigLedgerPeers - , pncTargetNumberOfEstablishedBigLedgerPeers - , pncTargetNumberOfActiveBigLedgerPeers - , pncMinBigLedgerPeersForTrustedState + , pncDeadlineTargetOfRootPeers + , pncDeadlineTargetOfKnownPeers + , pncDeadlineTargetOfEstablishedPeers + , pncDeadlineTargetOfActivePeers + , pncDeadlineTargetOfKnownBigLedgerPeers + , pncDeadlineTargetOfEstablishedBigLedgerPeers + , pncDeadlineTargetOfActiveBigLedgerPeers + , pncSyncTargetOfActivePeers + , pncSyncTargetOfKnownBigLedgerPeers + , pncSyncTargetOfEstablishedBigLedgerPeers + , pncSyncTargetOfActiveBigLedgerPeers + , pncSyncMinTrusted + , pncConsensusMode , pncEnableP2P , pncPeerSharing } @@ -515,7 +533,6 @@ defaultPartialNodeConfiguration = , pncDatabaseFile = Last . Just $ OnePathForAllDbs "mainnet/db/" , pncLoggingSwitch = Last $ Just True , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty mempty - , pncConsensusMode = Last $ Just defaultConsensusMode , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode , pncNumOfDiskSnapshots = Last $ Just DefaultNumOfDiskSnapshots , pncSnapshotInterval = Last $ Just DefaultSnapshotInterval @@ -543,18 +560,37 @@ defaultPartialNodeConfiguration = , acceptedConnectionsSoftLimit = 384 , acceptedConnectionsDelay = 5 } - , pncTargetNumberOfRootPeers = Last (Just 85) - , pncTargetNumberOfKnownPeers = Last (Just 85) - , pncTargetNumberOfEstablishedPeers = Last (Just 40) - , pncTargetNumberOfActivePeers = Last (Just 15) + , pncDeadlineTargetOfRootPeers = Last (Just deadlineRoots) + , pncDeadlineTargetOfKnownPeers = Last (Just deadlineKnown) + , pncDeadlineTargetOfEstablishedPeers = Last (Just deadlineEstablished) + , pncDeadlineTargetOfActivePeers = Last (Just deadlineActive) , pncChainSyncIdleTimeout = mempty - , pncTargetNumberOfKnownBigLedgerPeers = Last (Just 15) - , pncTargetNumberOfEstablishedBigLedgerPeers = Last (Just 10) - , pncTargetNumberOfActiveBigLedgerPeers = Last (Just 5) - , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review - , pncEnableP2P = Last (Just EnabledP2PMode) - , pncPeerSharing = Last (Just PeerSharingDisabled) + , pncDeadlineTargetOfKnownBigLedgerPeers = Last (Just deadlineBigKnown) + , pncDeadlineTargetOfEstablishedBigLedgerPeers = Last (Just deadlineBigEst) + , pncDeadlineTargetOfActiveBigLedgerPeers = Last (Just deadlineBigAct) + , pncSyncTargetOfActivePeers = Last (Just syncActive) + , pncSyncTargetOfKnownBigLedgerPeers = Last (Just syncBigKnown) + , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just syncBigEst) + , pncSyncTargetOfActiveBigLedgerPeers = Last (Just syncBigAct) + , pncSyncMinTrusted = Last (Just defaultMinBigLedgerPeersForTrustedState) + , pncConsensusMode = mempty + , pncEnableP2P = Last (Just EnabledP2PMode) + , pncPeerSharing = Last (Just Configuration.PeerSharingDisabled) } + where + Configuration.PeerSelectionTargets { + targetNumberOfRootPeers = deadlineRoots, + targetNumberOfKnownPeers = deadlineKnown, + targetNumberOfEstablishedPeers = deadlineEstablished, + targetNumberOfActivePeers = deadlineActive, + targetNumberOfKnownBigLedgerPeers = deadlineBigKnown, + targetNumberOfEstablishedBigLedgerPeers = deadlineBigEst, + targetNumberOfActiveBigLedgerPeers = deadlineBigAct } = defaultDeadlineTargets + Configuration.PeerSelectionTargets { + targetNumberOfActivePeers = syncActive, + targetNumberOfKnownBigLedgerPeers = syncBigKnown, + targetNumberOfEstablishedBigLedgerPeers = syncBigEst, + targetNumberOfActiveBigLedgerPeers = syncBigAct } = defaultSyncTargets lastOption :: Parser a -> Parser (Last a) lastOption = fmap Last . optional @@ -570,7 +606,6 @@ makeNodeConfiguration pnc = do loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc traceConfig <- first Text.unpack $ partialTraceSelectionToEither $ pncTraceConfig pnc - consensusMode <- lastToEither "Missing ConsensusMode" $ pncConsensusMode pnc diffusionMode <- lastToEither "Missing DiffusionMode" $ pncDiffusionMode pnc numOfDiskSnapshots <- lastToEither "Missing NumOfDiskSnapshots" $ pncNumOfDiskSnapshots pnc snapshotInterval <- lastToEither "Missing SnapshotInterval" $ pncSnapshotInterval pnc @@ -578,30 +613,45 @@ makeNodeConfiguration pnc = do shutdownConfig <- lastToEither "Missing ShutdownConfig" $ pncShutdownConfig pnc socketConfig <- lastToEither "Missing SocketConfig" $ pncSocketConfig pnc - ncTargetNumberOfRootPeers <- + ncDeadlineTargetOfRootPeers <- lastToEither "Missing TargetNumberOfRootPeers" - $ pncTargetNumberOfRootPeers pnc - ncTargetNumberOfKnownPeers <- + $ pncDeadlineTargetOfRootPeers pnc + ncDeadlineTargetOfKnownPeers <- lastToEither "Missing TargetNumberOfKnownPeers" - $ pncTargetNumberOfKnownPeers pnc - ncTargetNumberOfEstablishedPeers <- + $ pncDeadlineTargetOfKnownPeers pnc + ncDeadlineTargetOfEstablishedPeers <- lastToEither "Missing TargetNumberOfEstablishedPeers" - $ pncTargetNumberOfEstablishedPeers pnc - ncTargetNumberOfActivePeers <- + $ pncDeadlineTargetOfEstablishedPeers pnc + ncDeadlineTargetOfActivePeers <- lastToEither "Missing TargetNumberOfActivePeers" - $ pncTargetNumberOfActivePeers pnc - ncTargetNumberOfKnownBigLedgerPeers <- + $ pncDeadlineTargetOfActivePeers pnc + ncDeadlineTargetOfKnownBigLedgerPeers <- lastToEither "Missing TargetNumberOfKnownBigLedgerPeers" - $ pncTargetNumberOfKnownBigLedgerPeers pnc - ncTargetNumberOfEstablishedBigLedgerPeers <- + $ pncDeadlineTargetOfKnownBigLedgerPeers pnc + ncDeadlineTargetOfEstablishedBigLedgerPeers <- lastToEither "Missing TargetNumberOfEstablishedBigLedgerPeers" - $ pncTargetNumberOfEstablishedBigLedgerPeers pnc - ncTargetNumberOfActiveBigLedgerPeers <- + $ pncDeadlineTargetOfEstablishedBigLedgerPeers pnc + ncDeadlineTargetOfActiveBigLedgerPeers <- lastToEither "Missing TargetNumberOfActiveBigLedgerPeers" - $ pncTargetNumberOfActiveBigLedgerPeers pnc - ncMinBigLedgerPeersForTrustedState <- - lastToEither "Missing MinBigLedgerPeersForTrustedState" - $ pncMinBigLedgerPeersForTrustedState pnc + $ pncDeadlineTargetOfActiveBigLedgerPeers pnc + ncSyncTargetOfActivePeers <- + lastToEither "Missing SyncTargetNumberOfActivePeers" + $ pncSyncTargetOfActivePeers pnc + ncSyncTargetOfKnownBigLedgerPeers <- + lastToEither "Missing SyncTargetNumberOfKnownBigLedgerPeers" + $ pncSyncTargetOfKnownBigLedgerPeers pnc + ncSyncTargetOfEstablishedBigLedgerPeers <- + lastToEither "Missing SyncTargetNumberOfEstablishedBigLedgerPeers" + $ pncSyncTargetOfEstablishedBigLedgerPeers pnc + ncSyncTargetOfActiveBigLedgerPeers <- + lastToEither "Missing SyncTargetNumberOfActiveBigLedgerPeers" + $ pncSyncTargetOfActiveBigLedgerPeers pnc + ncSyncMinTrusted <- + lastToEither "Missing SyncMinNumberOfBigLedgerPeersForTrustedState" + $ pncSyncMinTrusted pnc + ncConsensusMode <- + lastToEither "Missing ConsensusMode" + $ pncConsensusMode pnc ncProtocolIdleTimeout <- lastToEither "Missing ProtocolIdleTimeout" $ pncProtocolIdleTimeout pnc @@ -644,7 +694,6 @@ makeNodeConfiguration pnc = do , ncStartAsNonProducingNode = startAsNonProducingNode , ncProtocolConfig = protocolConfig , ncSocketConfig = socketConfig - , ncConsensusMode = consensusMode , ncDiffusionMode = diffusionMode , ncNumOfDiskSnapshots = numOfDiskSnapshots , ncSnapshotInterval = snapshotInterval @@ -662,18 +711,23 @@ makeNodeConfiguration pnc = do , ncTimeWaitTimeout , ncChainSyncIdleTimeout , ncAcceptedConnectionsLimit - , ncTargetNumberOfRootPeers - , ncTargetNumberOfKnownPeers - , ncTargetNumberOfEstablishedPeers - , ncTargetNumberOfActivePeers - , ncTargetNumberOfKnownBigLedgerPeers - , ncTargetNumberOfEstablishedBigLedgerPeers - , ncTargetNumberOfActiveBigLedgerPeers - , ncMinBigLedgerPeersForTrustedState + , ncDeadlineTargetOfRootPeers + , ncDeadlineTargetOfKnownPeers + , ncDeadlineTargetOfEstablishedPeers + , ncDeadlineTargetOfActivePeers + , ncDeadlineTargetOfKnownBigLedgerPeers + , ncDeadlineTargetOfEstablishedBigLedgerPeers + , ncDeadlineTargetOfActiveBigLedgerPeers + , ncSyncTargetOfActivePeers + , ncSyncTargetOfKnownBigLedgerPeers + , ncSyncTargetOfEstablishedBigLedgerPeers + , ncSyncTargetOfActiveBigLedgerPeers + , ncSyncMinTrusted , ncEnableP2P = case enableP2P of EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing + , ncConsensusMode } ncProtocol :: NodeConfiguration -> Protocol diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 08ab701d89b..36f836c4bda 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -89,7 +89,6 @@ nodeRunParser = do , pncConfigFile = ConfigYamlFilePath <$> nodeConfigFp , pncTopologyFile = TopologyFile <$> topFp , pncDatabaseFile = dbFp - , pncConsensusMode = mempty , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = numOfDiskSnapshots , pncSnapshotInterval = snapshotInterval @@ -119,14 +118,19 @@ nodeRunParser = do , pncTimeWaitTimeout = mempty , pncChainSyncIdleTimeout = mempty , pncAcceptedConnectionsLimit = mempty - , pncTargetNumberOfRootPeers = mempty - , pncTargetNumberOfKnownPeers = mempty - , pncTargetNumberOfEstablishedPeers = mempty - , pncTargetNumberOfActivePeers = mempty - , pncTargetNumberOfKnownBigLedgerPeers = mempty - , pncTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncTargetNumberOfActiveBigLedgerPeers = mempty - , pncMinBigLedgerPeersForTrustedState = mempty + , pncDeadlineTargetOfRootPeers = mempty + , pncDeadlineTargetOfKnownPeers = mempty + , pncDeadlineTargetOfEstablishedPeers = mempty + , pncDeadlineTargetOfActivePeers = mempty + , pncDeadlineTargetOfKnownBigLedgerPeers = mempty + , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty + , pncDeadlineTargetOfActiveBigLedgerPeers = mempty + , pncSyncTargetOfActivePeers = mempty + , pncSyncTargetOfKnownBigLedgerPeers = mempty + , pncSyncTargetOfEstablishedBigLedgerPeers = mempty + , pncSyncTargetOfActiveBigLedgerPeers = mempty + , pncSyncMinTrusted = mempty + , pncConsensusMode = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty } diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index fb3a06bf0c2..2d3204c021c 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -891,18 +891,22 @@ mkP2PArguments -> STM IO (Maybe LedgerPeerSnapshot) -> Diffusion.ExtraArguments 'Diffusion.P2P IO mkP2PArguments NodeConfiguration { - ncConsensusMode, - ncTargetNumberOfRootPeers, - ncTargetNumberOfKnownPeers, - ncTargetNumberOfEstablishedPeers, - ncTargetNumberOfActivePeers, - ncTargetNumberOfKnownBigLedgerPeers, - ncTargetNumberOfEstablishedBigLedgerPeers, - ncTargetNumberOfActiveBigLedgerPeers, - ncMinBigLedgerPeersForTrustedState, + ncDeadlineTargetOfRootPeers, + ncDeadlineTargetOfKnownPeers, + ncDeadlineTargetOfEstablishedPeers, + ncDeadlineTargetOfActivePeers, + ncDeadlineTargetOfKnownBigLedgerPeers, + ncDeadlineTargetOfEstablishedBigLedgerPeers, + ncDeadlineTargetOfActiveBigLedgerPeers, + ncSyncTargetOfActivePeers, + ncSyncTargetOfKnownBigLedgerPeers, + ncSyncTargetOfEstablishedBigLedgerPeers, + ncSyncTargetOfActiveBigLedgerPeers, + ncSyncMinTrusted, ncProtocolIdleTimeout, ncTimeWaitTimeout, - ncPeerSharing + ncPeerSharing, + ncConsensusMode } daReadLocalRootPeers daReadPublicRootPeers @@ -910,7 +914,9 @@ mkP2PArguments NodeConfiguration { daReadUseBootstrapPeers daReadLedgerPeerSnapshot = Diffusion.P2PArguments P2P.ArgumentsExtra - { P2P.daPeerTargets + { P2P.daPeerTargets = Configuration.ConsensusModePeerTargets { + Configuration.deadlineTargets, + Configuration.syncTargets } , P2P.daReadLocalRootPeers , P2P.daReadPublicRootPeers , P2P.daReadUseLedgerPeers @@ -920,24 +926,27 @@ mkP2PArguments NodeConfiguration { , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout , P2P.daTimeWaitTimeout = ncTimeWaitTimeout - , P2P.daDeadlineChurnInterval = 3300 - , P2P.daBulkChurnInterval = 900 + , P2P.daDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval + , P2P.daBulkChurnInterval = Configuration.defaultBulkChurnInterval , P2P.daOwnPeerSharing = ncPeerSharing + , P2P.daConsensusMode = ncConsensusMode + , P2P.daMinBigLedgerPeersForTrustedState = ncSyncMinTrusted } where - daPeerTargets = Configuration.ConsensusModePeerTargets { - Configuration.deadlineTargets = peerSelectionTargets, - Configuration.syncTargets = peerSelectionTargets - } - peerSelectionTargets = PeerSelectionTargets { - targetNumberOfRootPeers = ncTargetNumberOfRootPeers, - targetNumberOfKnownPeers = ncTargetNumberOfKnownPeers, - targetNumberOfEstablishedPeers = ncTargetNumberOfEstablishedPeers, - targetNumberOfActivePeers = ncTargetNumberOfActivePeers, - targetNumberOfKnownBigLedgerPeers = ncTargetNumberOfKnownBigLedgerPeers, - targetNumberOfEstablishedBigLedgerPeers = ncTargetNumberOfEstablishedBigLedgerPeers, - targetNumberOfActiveBigLedgerPeers = ncTargetNumberOfActiveBigLedgerPeers + deadlineTargets = Configuration.defaultDeadlineTargets { + targetNumberOfRootPeers = ncDeadlineTargetOfRootPeers, + targetNumberOfKnownPeers = ncDeadlineTargetOfKnownPeers, + targetNumberOfEstablishedPeers = ncDeadlineTargetOfEstablishedPeers, + targetNumberOfActivePeers = ncDeadlineTargetOfActivePeers, + targetNumberOfKnownBigLedgerPeers = ncDeadlineTargetOfKnownBigLedgerPeers, + targetNumberOfEstablishedBigLedgerPeers = ncDeadlineTargetOfEstablishedBigLedgerPeers, + targetNumberOfActiveBigLedgerPeers = ncDeadlineTargetOfActiveBigLedgerPeers } + syncTargets = Configuration.defaultSyncTargets { + targetNumberOfActivePeers = ncSyncTargetOfActivePeers, + targetNumberOfKnownBigLedgerPeers = ncSyncTargetOfKnownBigLedgerPeers, + targetNumberOfEstablishedBigLedgerPeers = ncSyncTargetOfEstablishedBigLedgerPeers, + targetNumberOfActiveBigLedgerPeers = ncSyncTargetOfActiveBigLedgerPeers } mkNonP2PArguments :: IPSubscriptionTarget diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 882c5cede40..b6b59c403d9 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -18,10 +18,7 @@ import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..), pattern DoDiskSnapshotChecksum) import Ouroboros.Network.Block (SlotNo (..)) -import Ouroboros.Network.Diffusion.Configuration (MinBigLedgerPeersForTrustedState (..), defaultConsensusMode) -import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), - DiffusionMode (InitiatorAndResponderDiffusionMode)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) +import Ouroboros.Network.Diffusion.Configuration import Data.Monoid (Last (..)) import Data.Text (Text) @@ -118,7 +115,6 @@ testPartialYamlConfig = , pncSocketConfig = Last . Just $ SocketConfig (Last Nothing) mempty mempty mempty , pncShutdownConfig = Last Nothing , pncStartAsNonProducingNode = Last $ Just False - , pncConsensusMode = mempty , pncDiffusionMode = Last Nothing , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = mempty @@ -147,9 +143,13 @@ testPartialYamlConfig = , pncTargetNumberOfKnownBigLedgerPeers = mempty , pncTargetNumberOfEstablishedBigLedgerPeers = mempty , pncTargetNumberOfActiveBigLedgerPeers = mempty - , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review + , pncGenesisTargetNumberOfActivePeers = mempty + , pncGenesisTargetNumberOfKnownBigLedgerPeers = mempty + , pncGenesisTargetNumberOfEstablishedBigLedgerPeers = mempty + , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) + , pncConsensusMode = Last (Just PraosMode) } -- | Example partial configuration theoretically created @@ -163,7 +163,6 @@ testPartialCliConfig = , pncConfigFile = mempty , pncTopologyFile = mempty , pncDatabaseFile = mempty - , pncConsensusMode = mempty , pncDiffusionMode = mempty , pncNumOfDiskSnapshots = Last Nothing , pncSnapshotInterval = Last . Just . RequestedSnapshotInterval $ secondsToDiffTime 100 @@ -190,9 +189,13 @@ testPartialCliConfig = , pncTargetNumberOfKnownBigLedgerPeers = mempty , pncTargetNumberOfEstablishedBigLedgerPeers = mempty , pncTargetNumberOfActiveBigLedgerPeers = mempty - , pncMinBigLedgerPeersForTrustedState = pure (MinBigLedgerPeersForTrustedState 3) -- TODO: Review + , pncGenesisTargetNumberOfActivePeers = mempty + , pncGenesisTargetNumberOfKnownBigLedgerPeers = mempty + , pncGenesisTargetNumberOfEstablishedBigLedgerPeers = mempty + , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) + , pncConsensusMode = Last (Just GenesisMode) } -- | Expected final NodeConfiguration @@ -210,7 +213,6 @@ eExpectedConfig = do , ncProtocolFiles = ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing , ncValidateDB = True , ncProtocolConfig = testNodeProtocolConfiguration - , ncConsensusMode = defaultConsensusMode , ncDiffusionMode = InitiatorAndResponderDiffusionMode , ncNumOfDiskSnapshots = DefaultNumOfDiskSnapshots , ncSnapshotInterval = RequestedSnapshotInterval $ secondsToDiffTime 100 @@ -232,16 +234,20 @@ eExpectedConfig = do , acceptedConnectionsSoftLimit = 384 , acceptedConnectionsDelay = 5 } - , ncTargetNumberOfRootPeers = 85 + , ncTargetNumberOfRootPeers = 60 , ncTargetNumberOfKnownPeers = 85 , ncTargetNumberOfEstablishedPeers = 40 , ncTargetNumberOfActivePeers = 15 , ncTargetNumberOfKnownBigLedgerPeers = 15 , ncTargetNumberOfEstablishedBigLedgerPeers = 10 , ncTargetNumberOfActiveBigLedgerPeers = 5 - , ncMinBigLedgerPeersForTrustedState = MinBigLedgerPeersForTrustedState 3 -- TODO: Review + , ncGenesisTargetNumberOfActivePeers = 0 + , ncGenesisTargetNumberOfKnownBigLedgerPeers = 100 + , ncGenesisTargetNumberOfEstablishedBigLedgerPeers = 50 + , ncGenesisTargetNumberOfActiveBigLedgerPeers = 30 , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled + , ncConsensusMode = GenesisMode } -- ----------------------------------------------------------------------------- diff --git a/configuration/cardano/mainnet-config.json b/configuration/cardano/mainnet-config.json index 53e8e03d7b6..3900717bafb 100644 --- a/configuration/cardano/mainnet-config.json +++ b/configuration/cardano/mainnet-config.json @@ -16,6 +16,7 @@ "RequiresNetworkMagic": "RequiresNoMagic", "ShelleyGenesisFile": "mainnet-shelley-genesis.json", "ShelleyGenesisHash": "1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81", + "ConsensusMode": "PraosMode", "TargetNumberOfActivePeers": 20, "TargetNumberOfEstablishedPeers": 40, "TargetNumberOfKnownPeers": 150, diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index a0f289896b6..c169516f7a5 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -12,7 +12,7 @@ ConwayGenesisHash: 15a199f895e461ec0ffc6dd4e4028af28a492ab4e806d39cb674c88f7643e ShelleyGenesisFile: mainnet-shelley-genesis.json ShelleyGenesisHash: 1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81 -EnableP2P: true +EnableP2P: True ##### Core protocol parameters ##### @@ -34,6 +34,7 @@ MaxKnownMajorProtocolVersion: 2 ##### Network Configuration ##### +ConsensusMode: PraosMode PeerSharing: True TargetNumberOfActivePeers: 20 TargetNumberOfEstablishedPeers: 40 diff --git a/configuration/cardano/shelley_qa-config.json b/configuration/cardano/shelley_qa-config.json index 853c6a48dc3..5f9db54810b 100644 --- a/configuration/cardano/shelley_qa-config.json +++ b/configuration/cardano/shelley_qa-config.json @@ -17,6 +17,7 @@ "RequiresNetworkMagic": "RequiresMagic", "ShelleyGenesisFile": "shelley_qa-shelley-genesis.json", "ShelleyGenesisHash": "73a9f6bdb0aa97f5e63190a6f14a702bd64a21f2bec831cbfc28f6037128b952", + "ConsensusMode": "PraosMode" "TargetNumberOfActivePeers": 20, "TargetNumberOfEstablishedPeers": 40, "TargetNumberOfKnownPeers": 150, From 67edb97169d9e1241a2dd61dc9add35ac494fb4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 13 Nov 2024 13:41:26 +0100 Subject: [PATCH 35/79] Integrate o-network and o-consensus Missing updating Node Configuration parser to read genesis targets and ledger snapshot. --- bench/tx-generator/tx-generator.cabal | 1 + .../src/Cardano/Node/Configuration/POM.hs | 30 +++++--- cardano-node/src/Cardano/Node/Parsers.hs | 2 +- cardano-node/src/Cardano/Node/Run.hs | 4 +- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 2 +- cardano-node/test/Test/Cardano/Node/POM.hs | 75 ++++++++++--------- 6 files changed, 63 insertions(+), 51 deletions(-) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index e8e9a59dacd..009457d76f5 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -158,6 +158,7 @@ library , transformers-except , unordered-containers , yaml + , microlens default-language: Haskell2010 default-extensions: OverloadedStrings diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 637d1c1644b..be72eda35c1 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -169,6 +169,10 @@ data NodeConfiguration -- by the diffusion layer when syncing , ncConsensusMode :: !ConsensusMode + -- Minimum number of active big ledger peers we must be connected to + -- in Genesis mode + , ncMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState + -- Enable experimental P2P mode , ncEnableP2P :: SomeNetworkP2PMode @@ -236,7 +240,9 @@ data PartialNodeConfiguration , pncSyncTargetOfKnownBigLedgerPeers :: !(Last Int) , pncSyncTargetOfEstablishedBigLedgerPeers :: !(Last Int) , pncSyncTargetOfActiveBigLedgerPeers :: !(Last Int) - , pncSyncMinTrusted :: !(Last MinBigLedgerPeersForTrustedState) + -- Minimum number of active big ledger peers we must be connected to + -- in Genesis mode + , pncMinBigLedgerPeersForTrustedState :: !(Last MinBigLedgerPeersForTrustedState) -- Consensus mode for diffusion layer , pncConsensusMode :: !(Last ConsensusMode) @@ -334,7 +340,9 @@ instance FromJSON PartialNodeConfiguration where pncSyncTargetOfKnownBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfKnownBigLedgerPeers" pncSyncTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfEstablishedBigLedgerPeers" pncSyncTargetOfActiveBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfActiveBigLedgerPeers" - pncSyncMinTrusted <- Last <$> v .:? "SyncMinNumberOfBigLedgerPeersForTrustedState" + -- Minimum number of active big ledger peers we must be connected to + -- in Genesis mode + pncMinBigLedgerPeersForTrustedState <- Last <$> v .:? "MinBigLedgerPeersForTrustedState" pncConsensusMode <- Last <$> v .:? "ConsensusMode" @@ -350,7 +358,7 @@ instance FromJSON PartialNodeConfiguration where -- Peer Sharing -- DISABLED BY DEFAULT - pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just Configuration.PeerSharingDisabled + pncPeerSharing <- Last <$> v .:? "PeerSharing" pure PartialNodeConfiguration { pncProtocolConfig @@ -389,7 +397,7 @@ instance FromJSON PartialNodeConfiguration where , pncSyncTargetOfKnownBigLedgerPeers , pncSyncTargetOfEstablishedBigLedgerPeers , pncSyncTargetOfActiveBigLedgerPeers - , pncSyncMinTrusted + , pncMinBigLedgerPeersForTrustedState , pncConsensusMode , pncEnableP2P , pncPeerSharing @@ -572,10 +580,10 @@ defaultPartialNodeConfiguration = , pncSyncTargetOfKnownBigLedgerPeers = Last (Just syncBigKnown) , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just syncBigEst) , pncSyncTargetOfActiveBigLedgerPeers = Last (Just syncBigAct) - , pncSyncMinTrusted = Last (Just defaultMinBigLedgerPeersForTrustedState) - , pncConsensusMode = mempty + , pncMinBigLedgerPeersForTrustedState = Last (Just defaultMinBigLedgerPeersForTrustedState) + , pncConsensusMode = Last (Just defaultConsensusMode) , pncEnableP2P = Last (Just EnabledP2PMode) - , pncPeerSharing = Last (Just Configuration.PeerSharingDisabled) + , pncPeerSharing = Last (Just defaultPeerSharing) } where Configuration.PeerSelectionTargets { @@ -646,9 +654,9 @@ makeNodeConfiguration pnc = do ncSyncTargetOfActiveBigLedgerPeers <- lastToEither "Missing SyncTargetNumberOfActiveBigLedgerPeers" $ pncSyncTargetOfActiveBigLedgerPeers pnc - ncSyncMinTrusted <- - lastToEither "Missing SyncMinNumberOfBigLedgerPeersForTrustedState" - $ pncSyncMinTrusted pnc + ncMinBigLedgerPeersForTrustedState <- + lastToEither "Missing MinBigLedgerPeersForTrustedState" + $ pncMinBigLedgerPeersForTrustedState pnc ncConsensusMode <- lastToEither "Missing ConsensusMode" $ pncConsensusMode pnc @@ -722,7 +730,7 @@ makeNodeConfiguration pnc = do , ncSyncTargetOfKnownBigLedgerPeers , ncSyncTargetOfEstablishedBigLedgerPeers , ncSyncTargetOfActiveBigLedgerPeers - , ncSyncMinTrusted + , ncMinBigLedgerPeersForTrustedState , ncEnableP2P = case enableP2P of EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 36f836c4bda..8011e0e14c9 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -129,7 +129,7 @@ nodeRunParser = do , pncSyncTargetOfKnownBigLedgerPeers = mempty , pncSyncTargetOfEstablishedBigLedgerPeers = mempty , pncSyncTargetOfActiveBigLedgerPeers = mempty - , pncSyncMinTrusted = mempty + , pncMinBigLedgerPeersForTrustedState = mempty , pncConsensusMode = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 2d3204c021c..09fcc680f3a 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -902,7 +902,7 @@ mkP2PArguments NodeConfiguration { ncSyncTargetOfKnownBigLedgerPeers, ncSyncTargetOfEstablishedBigLedgerPeers, ncSyncTargetOfActiveBigLedgerPeers, - ncSyncMinTrusted, + ncMinBigLedgerPeersForTrustedState, ncProtocolIdleTimeout, ncTimeWaitTimeout, ncPeerSharing, @@ -930,7 +930,7 @@ mkP2PArguments NodeConfiguration { , P2P.daBulkChurnInterval = Configuration.defaultBulkChurnInterval , P2P.daOwnPeerSharing = ncPeerSharing , P2P.daConsensusMode = ncConsensusMode - , P2P.daMinBigLedgerPeersForTrustedState = ncSyncMinTrusted + , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState } where deadlineTargets = Configuration.defaultDeadlineTargets { diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index b3a78cc2f6b..5444f1a209d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -784,7 +784,7 @@ instance MetaTrace (TracePeerSelection SockAddr) where documentFor (Namespace [] ["DebugState"]) = Just "peer selection internal state" documentFor (Namespace [] ["VerifyPeerSnapshot"]) = Just - "Big ledger peer snapshot file failed integrity check against the ledger" + "Verification outcome of big ledger peer snapshot" documentFor _ = Nothing metricsDocFor (Namespace [] ["ChurnAction"]) = diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index b6b59c403d9..f79b664c4d1 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -136,20 +136,21 @@ testPartialYamlConfig = , pncTimeWaitTimeout = mempty , pncChainSyncIdleTimeout = mempty , pncAcceptedConnectionsLimit = mempty - , pncTargetNumberOfRootPeers = mempty - , pncTargetNumberOfKnownPeers = mempty - , pncTargetNumberOfEstablishedPeers = mempty - , pncTargetNumberOfActivePeers = mempty - , pncTargetNumberOfKnownBigLedgerPeers = mempty - , pncTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncTargetNumberOfActiveBigLedgerPeers = mempty - , pncGenesisTargetNumberOfActivePeers = mempty - , pncGenesisTargetNumberOfKnownBigLedgerPeers = mempty - , pncGenesisTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty + , pncDeadlineTargetOfRootPeers = mempty + , pncDeadlineTargetOfKnownPeers = mempty + , pncDeadlineTargetOfEstablishedPeers = mempty + , pncDeadlineTargetOfActivePeers = mempty + , pncDeadlineTargetOfKnownBigLedgerPeers = mempty + , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty + , pncDeadlineTargetOfActiveBigLedgerPeers = mempty + , pncSyncTargetNumberOfActivePeers = mempty + , pncSyncTargetNumberOfKnownBigLedgerPeers = mempty + , pncSyncTargetNumberOfEstablishedBigLedgerPeers = mempty + , pncSyncTargetNumberOfActiveBigLedgerPeers = mempty + , pncMinBigLedgerPeersForTrustedState = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) - , pncConsensusMode = Last (Just PraosMode) + , pncConsensusMode = mempty } -- | Example partial configuration theoretically created @@ -182,20 +183,21 @@ testPartialCliConfig = , pncTimeWaitTimeout = mempty , pncChainSyncIdleTimeout = mempty , pncAcceptedConnectionsLimit = mempty - , pncTargetNumberOfRootPeers = mempty - , pncTargetNumberOfKnownPeers = mempty - , pncTargetNumberOfEstablishedPeers = mempty - , pncTargetNumberOfActivePeers = mempty - , pncTargetNumberOfKnownBigLedgerPeers = mempty - , pncTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncTargetNumberOfActiveBigLedgerPeers = mempty - , pncGenesisTargetNumberOfActivePeers = mempty - , pncGenesisTargetNumberOfKnownBigLedgerPeers = mempty - , pncGenesisTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty + , pncDeadlineTargetNumberOfRootPeers = mempty + , pncDeadlineTargetNumberOfKnownPeers = mempty + , pncDeadlineTargetNumberOfEstablishedPeers = mempty + , pncDeadlineTargetNumberOfActivePeers = mempty + , pncDeadlineTargetNumberOfKnownBigLedgerPeers = mempty + , pncDeadlineTargetNumberOfEstablishedBigLedgerPeers = mempty + , pncDeadlineTargetNumberOfActiveBigLedgerPeers = mempty + , pncSyncTargetNumberOfActivePeers = mempty + , pncSyncTargetNumberOfKnownBigLedgerPeers = mempty + , pncSyncTargetNumberOfEstablishedBigLedgerPeers = mempty + , pncSyncTargetNumberOfActiveBigLedgerPeers = mempty + , pncMinBigLedgerPeersForTrustedState = Last (Just defaultMinBigLedgerPeersForTrustedState) , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) - , pncConsensusMode = Last (Just GenesisMode) + , pncConsensusMode = Last (Just PraosMode) } -- | Expected final NodeConfiguration @@ -234,20 +236,21 @@ eExpectedConfig = do , acceptedConnectionsSoftLimit = 384 , acceptedConnectionsDelay = 5 } - , ncTargetNumberOfRootPeers = 60 - , ncTargetNumberOfKnownPeers = 85 - , ncTargetNumberOfEstablishedPeers = 40 - , ncTargetNumberOfActivePeers = 15 - , ncTargetNumberOfKnownBigLedgerPeers = 15 - , ncTargetNumberOfEstablishedBigLedgerPeers = 10 - , ncTargetNumberOfActiveBigLedgerPeers = 5 - , ncGenesisTargetNumberOfActivePeers = 0 - , ncGenesisTargetNumberOfKnownBigLedgerPeers = 100 - , ncGenesisTargetNumberOfEstablishedBigLedgerPeers = 50 - , ncGenesisTargetNumberOfActiveBigLedgerPeers = 30 + , ncDeadlineTargetNumberOfRootPeers = 60 + , ncDeadlineTargetNumberOfKnownPeers = 85 + , ncDeadlineTargetNumberOfEstablishedPeers = 40 + , ncDeadlineTargetNumberOfActivePeers = 15 + , ncDeadlineTargetNumberOfKnownBigLedgerPeers = 15 + , ncDeadlineTargetNumberOfEstablishedBigLedgerPeers = 10 + , ncDeadlineTargetNumberOfActiveBigLedgerPeers = 5 + , ncSyncTargetNumberOfActivePeers = 0 + , ncSyncTargetNumberOfKnownBigLedgerPeers = 100 + , ncSyncTargetNumberOfEstablishedBigLedgerPeers = 50 + , ncSyncTargetNumberOfActiveBigLedgerPeers = 30 + , ncMinBigLedgerPeersForTrustedState = defaultMinBigLedgerPeersForTrustedState , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled - , ncConsensusMode = GenesisMode + , ncConsensusMode = PraosMode } -- ----------------------------------------------------------------------------- From 511aa4fff6b7dda85607608e3fd857efec207765 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 3 Dec 2024 22:08:50 +0100 Subject: [PATCH 36/79] Updated with connection manager changes --- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 31 ++++++++++------- .../Tracing/OrphanInstances/Network.hs | 33 +++++++++++++------ 2 files changed, 43 insertions(+), 21 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 5444f1a209d..4c445161a20 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -28,6 +28,7 @@ import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (.. import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.ConnectionManager.Core as ConnectionManager (Trace (..)) import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..)) +import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnectionManager import Ouroboros.Network.InboundGovernor as InboundGovernor (Trace (..)) import qualified Ouroboros.Network.InboundGovernor as InboundGovernor @@ -1205,10 +1206,10 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] - forMachine dtal (TrReleaseConnection prov peerAddr) = + forMachine dtal (TrReleaseConnection prov connId) = mconcat $ reverse [ "kind" .= String "UnregisterConnection" - , "remoteAddress" .= forMachine dtal peerAddr + , "remoteAddress" .= toJSON connId , "provenance" .= String (pack . show $ prov) ] forMachine _dtal (TrConnect (Just localAddress) remoteAddress) = @@ -1284,12 +1285,12 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= forMachine dtal remoteAddress , "connectionState" .= toJSON connState ] - forMachine dtal (TrPruneConnections pruningSet numberPruned chosenPeers) = + forMachine _dtal (TrPruneConnections pruningSet numberPruned chosenPeers) = mconcat [ "kind" .= String "PruneConnections" , "prunedPeers" .= toJSON pruningSet , "numberPrunedPeers" .= toJSON numberPruned - , "choiceSet" .= toJSON (forMachine dtal `Set.map` chosenPeers) + , "choiceSet" .= toJSON (toJSON `Set.map` chosenPeers) ] forMachine _dtal (TrConnectionCleanup connId) = mconcat @@ -1314,12 +1315,20 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, forMachine _dtal (TrState cmState) = mconcat [ "kind" .= String "ConnectionManagerState" - , "state" .= listValue (\(addr, connState) -> + , "state" .= listValue (\(remoteAddr, inner) -> object - [ "remoteAddress" .= toJSON addr - , "connectionState" .= toJSON connState - ]) - (Map.toList cmState) + [ "connections" .= + listValue (\(localAddr, connState) -> + object + [ "localAddress" .= localAddr + , "state" .= toJSON connState + ] + ) + (Map.toList inner) + , "remoteAddress" .= toJSON remoteAddr + ] + ) + (Map.toList (getConnMap cmState)) ] forMachine _dtal (ConnectionManager.TrUnexpectedlyFalseAssertion info) = mconcat @@ -1526,9 +1535,9 @@ instance MetaTrace (ConnectionManager.AbstractTransitionTrace peerAddr) where instance (Show addr, LogFormatting addr, ToJSON addr) => LogFormatting (Server.Trace addr) where - forMachine dtal (TrAcceptConnection peerAddr) = + forMachine dtal (TrAcceptConnection connId) = mconcat [ "kind" .= String "AcceptConnection" - , "address" .= forMachine dtal peerAddr + , "address" .= toJSON connId ] forMachine _dtal (TrAcceptError exception) = mconcat [ "kind" .= String "AcceptErroor" diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 68895328bb5..48431c98ee0 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -42,6 +42,7 @@ import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecl 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.Types (AbstractState (..), ConnectionManagerCounters (..), OperationResult (..)) @@ -2329,6 +2330,10 @@ 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 (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) => ToObject (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where @@ -2340,10 +2345,10 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, , "remoteAddress" .= toObject verb peerAddr , "provenance" .= String (pack . show $ prov) ] - TrReleaseConnection prov peerAddr -> + TrReleaseConnection prov connId -> mconcat $ reverse [ "kind" .= String "UnregisterConnection" - , "remoteAddress" .= toObject verb peerAddr + , "remoteAddress" .= toJSON connId , "provenance" .= String (pack . show $ prov) ] TrConnect (Just localAddress) remoteAddress -> @@ -2424,7 +2429,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, [ "kind" .= String "PruneConnections" , "prunedPeers" .= toJSON pruningSet , "numberPrunedPeers" .= toJSON numberPruned - , "choiceSet" .= toJSON (toObject verb `Set.map` chosenPeers) + , "choiceSet" .= toJSON (toJSON `Set.map` chosenPeers) ] TrConnectionCleanup connId -> mconcat @@ -2449,12 +2454,20 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, TrState cmState -> mconcat [ "kind" .= String "ConnectionManagerState" - , "state" .= listValue (\(addr, connState) -> + , "state" .= listValue (\(remoteAddr, inner) -> Aeson.object - [ "remoteAddress" .= toJSON addr - , "connectionState" .= toJSON connState - ]) - (Map.toList cmState) + [ "connections" .= + listValue (\(localAddr, connState) -> + Aeson.object + [ "localAddress" .= localAddr + , "state" .= toJSON connState + ] + ) + (Map.toList inner) + , "remoteAddress" .= toJSON remoteAddr + ] + ) + (Map.toList (getConnMap cmState)) ] ConnMgr.TrUnexpectedlyFalseAssertion info -> mconcat @@ -2489,9 +2502,9 @@ instance (Show addr, ToObject addr, ToJSON addr) instance (Show addr, ToObject addr, ToJSON addr) => ToObject (Server.Trace addr) where - toObject verb (Server.TrAcceptConnection peerAddr) = + toObject verb (Server.TrAcceptConnection connId) = mconcat [ "kind" .= String "AcceptConnection" - , "address" .= toObject verb peerAddr + , "connectionId" .= toJSON connId ] toObject _verb (Server.TrAcceptError exception) = mconcat [ "kind" .= String "AcceptErroor" From e74730e10ba76fbbcb0a9cd2ce1f7588784384bf Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 6 Dec 2024 06:48:26 +0100 Subject: [PATCH 37/79] Add diffusionMode to local root peers group configuration "diffusionMode" can be either `"InitiatorOnly"` or `"InitiatorAndResponder"`. If not given, the latter is the default - for backward compatibility. When "InitiatorOnly" is used, the connections to these local roots will only negotiate `InitiatorOnly` mode (it won't be possible to be reused by the other side) and will not bind to the server address, e.g. it will be made from an ephemeral port. See https://github.com/IntersectMBO/ouroboros-network/issues/5020 why this feature was requested by some SPOs. An example configuration: ```json { "localRoots": [ { "accessPoints": [ { "address": "10.0.0.1" , "port": 3001 } ] , "advertise": false , "diffusionMode": "InitiatorOnly" , "warmValency": 1 , "hotValency": 1 } , { "accessPoints": [ { "address": "10.0.0.2" , "port": 3001 } ] , "advertise": true , "diffusionMode": "InititiatorAndResponder" , "warmValency": 1 , "hotValency": 1 } ] , "publicRoots": [] , "useLedgerAfterSlot": -1 } ``` --- .../Cardano/Node/Configuration/TopologyP2P.hs | 16 ++++++--- cardano-node/src/Cardano/Node/Run.hs | 35 +++++++++++++------ cardano-node/src/Cardano/Node/Startup.hs | 5 ++- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 6 ++-- cardano-node/src/Cardano/Node/Types.hs | 11 ++++-- .../Tracing/OrphanInstances/Network.hs | 28 +++++++++++++-- cardano-node/src/Cardano/Tracing/Tracers.hs | 1 + .../src/Testnet/Components/Configuration.hs | 2 ++ 8 files changed, 79 insertions(+), 25 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs index fa6948e4716..7bdfa720d0e 100644 --- a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs +++ b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs @@ -31,7 +31,7 @@ import Cardano.Node.Types import Cardano.Logging (traceWith) import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Network.ConsensusMode -import Ouroboros.Network.NodeToNode (PeerAdvertise (..)) +import Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..)) import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..), UseLedgerPeers (..)) @@ -111,7 +111,7 @@ instance ToJSON RootConfig where rootConfigToRelayAccessPoint :: RootConfig -> [(RelayAccessPoint, PeerAdvertise)] -rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise } = +rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise } = [ (ap, rootAdvertise) | ap <- rootAccessPoints ] @@ -128,6 +128,8 @@ data LocalRootPeersGroup = LocalRootPeersGroup , trustable :: PeerTrustable -- ^ 'trustable' configures whether the root should be trusted in fallback -- state. + , rootDiffusionMode :: DiffusionMode + -- ^ diffusion mode; used for local root peers. } deriving (Eq, Show) -- | Does not use the 'FromJSON' instance of 'RootConfig', so that @@ -142,6 +144,9 @@ instance FromJSON LocalRootPeersGroup where <*> pure hv <*> o .:? "warmValency" .!= WarmValency v <*> o .:? "trustable" .!= IsNotTrustable + -- deserialise via NodeDiffusionMode + <*> (maybe InitiatorAndResponderDiffusionMode getDiffusionMode + <$> o .:? "diffusionMode") instance ToJSON LocalRootPeersGroup where toJSON lrpg = @@ -151,6 +156,8 @@ instance ToJSON LocalRootPeersGroup where , "hotValency" .= hotValency lrpg , "warmValency" .= warmValency lrpg , "trustable" .= trustable lrpg + -- serialise via NodeDiffusionMode + , "diffusionMode" .= NodeDiffusionMode (rootDiffusionMode lrpg) ] newtype LocalRootPeersGroups = LocalRootPeersGroups @@ -280,10 +287,11 @@ isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ UseBootstrapPeers (_:_) -> True where anyTrustable = - any (\(LocalRootPeersGroup lr _ _ pt) -> case pt of + any (\LocalRootPeersGroup {localRoots, trustable} -> + case trustable of IsNotTrustable -> False IsTrustable -> not . null . rootAccessPoints - $ lr + $ localRoots ) lprgs diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 09fcc680f3a..1d05392fe0e 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -9,7 +9,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -83,7 +82,7 @@ import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSna import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) -import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) +import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, LocalRootConfig (..), WarmValency) import Ouroboros.Network.Protocol.ChainSync.Codec import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..), IPSubscriptionTarget (..)) @@ -678,7 +677,7 @@ installP2PSigHUPHandler :: Tracer IO (StartupTrace blk) -> Api.BlockType blk -> NodeConfiguration -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk - -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] + -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)] -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) -> StrictTVar IO UseLedgerPeers -> StrictTVar IO UseBootstrapPeers @@ -780,7 +779,7 @@ updateBlockForging startupTracer blockType nodeKernel nc = do updateTopologyConfiguration :: Tracer IO (StartupTrace blk) -> NodeConfiguration - -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] + -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)] -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise) -> StrictTVar IO UseLedgerPeers -> StrictTVar IO UseBootstrapPeers @@ -882,7 +881,7 @@ checkVRFFilePermissions (File vrfPrivKey) = do mkP2PArguments :: NodeConfiguration - -> STM IO [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] + -> STM IO [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)] -- ^ non-overlapping local root peers groups; the 'Int' denotes the -- valency of its group. -> STM IO (Map RelayAccessPoint PeerAdvertise) @@ -980,18 +979,32 @@ producerAddressesNonP2P nt = producerAddresses :: NetworkTopology - -> ( [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] - , Map RelayAccessPoint PeerAdvertise) + -> ( [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)] + , Map RelayAccessPoint PeerAdvertise + ) + -- ^ local roots & public roots producerAddresses RealNodeTopology { ntLocalRootPeersGroups , ntPublicRootPeers } = ( map (\lrp -> ( hotValency lrp , warmValency lrp - , Map.fromList $ map (fmap (, trustable lrp)) - $ rootConfigToRelayAccessPoint - $ localRoots lrp + , Map.fromList + . map (\(addr, peerAdvertise) -> + ( addr + , LocalRootConfig { + diffusionMode = rootDiffusionMode lrp, + peerAdvertise, + peerTrustable = trustable lrp + } + ) + ) + . rootConfigToRelayAccessPoint + $ localRoots lrp ) ) (groups ntLocalRootPeersGroups) - , foldMap (Map.fromList . rootConfigToRelayAccessPoint . publicRoots) ntPublicRootPeers + , foldMap ( Map.fromList + . rootConfigToRelayAccessPoint + . publicRoots + ) ntPublicRootPeers ) diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index d2f2e30c09a..420ff47d5ac 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -36,9 +36,8 @@ import Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket, NodeToClientVersion) import Ouroboros.Network.NodeToNode (DiffusionMode (..), NodeToNodeVersion, PeerAdvertise) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers) -import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint) -import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) +import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, LocalRootConfig, WarmValency) import Ouroboros.Network.Subscription.Dns (DnsSubscriptionTarget (..)) import Ouroboros.Network.Subscription.Ip (IPSubscriptionTarget (..)) @@ -108,7 +107,7 @@ data StartupTrace blk = -- | Log peer-to-peer network configuration, either on startup or when its -- updated. -- - | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))] + | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)] (Map RelayAccessPoint PeerAdvertise) UseLedgerPeers (Maybe PeerSnapshotFile) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 4c445161a20..9009960674a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -1212,15 +1212,17 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= toJSON connId , "provenance" .= String (pack . show $ prov) ] - forMachine _dtal (TrConnect (Just localAddress) remoteAddress) = + forMachine _dtal (TrConnect (Just localAddress) remoteAddress diffusionMode) = mconcat [ "kind" .= String "ConnectTo" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } + , "diffusionMode" .= toJSON diffusionMode ] - forMachine dtal (TrConnect Nothing remoteAddress) = + forMachine dtal (TrConnect Nothing remoteAddress diffusionMode) = mconcat [ "kind" .= String "ConnectTo" , "remoteAddress" .= forMachine dtal remoteAddress + , "diffusionMode" .= toJSON diffusionMode ] forMachine _dtal (TrConnectError (Just localAddress) remoteAddress err) = mconcat diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index 7932bf89e82..174d6d2f0db 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -123,11 +123,18 @@ instance FromJSON NodeConsensusMode where _ -> fail "Parsing NodeConsensusMode failed: can be either 'Genesis' or 'Praos'" parseJSON _ = fail "Parsing NodeConsensusMode failed" --- | Newtype wrapper which provides 'FromJSON' instance for 'DiffusionMode'. +-- | Newtype wrapper which provides 'ToJSON' and 'FromJSON' instances for +-- 'DiffusionMode'. -- newtype NodeDiffusionMode = NodeDiffusionMode { getDiffusionMode :: DiffusionMode } - deriving newtype Show + deriving newtype (Eq, Show) + +instance ToJSON NodeDiffusionMode where + toJSON (NodeDiffusionMode InitiatorOnlyDiffusionMode) + = String "InitiatorOnly" + toJSON (NodeDiffusionMode InitiatorAndResponderDiffusionMode) + = String "InitiatorAndResponder" instance FromJSON NodeDiffusionMode where parseJSON (String str) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 48431c98ee0..0d266c12557 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -43,6 +43,7 @@ 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.State (ConnStateId (..)) import Ouroboros.Network.ConnectionManager.Types (AbstractState (..), ConnectionManagerCounters (..), OperationResult (..)) @@ -80,7 +81,7 @@ import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers 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 (..)) + 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 (..)) @@ -1579,6 +1580,16 @@ instance FromJSON HotValency where instance FromJSON WarmValency where parseJSON v = WarmValency <$> parseJSON v +instance ToJSON LocalRootConfig where + toJSON LocalRootConfig { peerAdvertise, + peerTrustable, + diffusionMode } = + Aeson.object + [ "peerAdvertise" .= peerAdvertise + , "peerTrustable" .= peerTrustable + , "diffusionMode" .= show diffusionMode + ] + instance Show exception => ToObject (TraceLocalRootPeers RemoteAddress exception) where toObject _verb (TraceLocalRootDomains groups) = mconcat [ "kind" .= String "LocalRootDomains" @@ -2334,6 +2345,15 @@ 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 ] + instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) => ToObject (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where @@ -2351,15 +2371,17 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, , "remoteAddress" .= toJSON connId , "provenance" .= String (pack . show $ prov) ] - TrConnect (Just localAddress) remoteAddress -> + TrConnect (Just localAddress) remoteAddress diffusionMode -> mconcat [ "kind" .= String "ConnectTo" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } + , "diffusionMode" .= toJSON diffusionMode ] - TrConnect Nothing remoteAddress -> + TrConnect Nothing remoteAddress diffusionMode -> mconcat [ "kind" .= String "ConnectTo" , "remoteAddress" .= toObject verb remoteAddress + , "diffusionMode" .= toJSON diffusionMode ] TrConnectError (Just localAddress) remoteAddress err -> mconcat diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index e253b1b40de..5a39cb11dea 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -57,6 +57,7 @@ import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (. import Cardano.Tracing.Config import Cardano.Tracing.HasIssuer (BlockIssuerVerificationKeyHash (..), HasIssuer (..)) import Cardano.Tracing.Metrics +import Cardano.Tracing.OrphanInstances.Network () import Cardano.Tracing.Render (renderChainHash, renderHeaderHash) import Cardano.Tracing.Shutdown () import Cardano.Tracing.Startup () diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 86b80aed801..ddbf7fc741f 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -27,6 +27,7 @@ import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import Cardano.Ledger.Conway.Genesis (ConwayGenesis) import qualified Cardano.Node.Configuration.Topology as NonP2P import qualified Cardano.Node.Configuration.TopologyP2P as P2P +import Ouroboros.Network.NodeToNode (DiffusionMode (..)) import Ouroboros.Network.PeerSelection.Bootstrap import Ouroboros.Network.PeerSelection.LedgerPeers import Ouroboros.Network.PeerSelection.PeerTrustable @@ -225,6 +226,7 @@ mkTopologyConfig numNodes allPorts port True = A.encodePretty topologyP2P (HotValency (numNodes - 1)) (WarmValency (numNodes - 1)) IsNotTrustable + InitiatorAndResponderDiffusionMode ] topologyP2P :: P2P.NetworkTopology From ed0c5684b6716da42b1e50229d9cc9c1b09fd375 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 11 Dec 2024 15:48:00 +0100 Subject: [PATCH 38/79] Renamed connection-manager trace --- cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs | 4 ++-- cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 9009960674a..1a13f2659d1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -1214,13 +1214,13 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, ] forMachine _dtal (TrConnect (Just localAddress) remoteAddress diffusionMode) = mconcat - [ "kind" .= String "ConnectTo" + [ "kind" .= String "Connect" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } , "diffusionMode" .= toJSON diffusionMode ] forMachine dtal (TrConnect Nothing remoteAddress diffusionMode) = mconcat - [ "kind" .= String "ConnectTo" + [ "kind" .= String "Connect" , "remoteAddress" .= forMachine dtal remoteAddress , "diffusionMode" .= toJSON diffusionMode ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 0d266c12557..0e70a416f8c 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -2373,13 +2373,13 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, ] TrConnect (Just localAddress) remoteAddress diffusionMode -> mconcat - [ "kind" .= String "ConnectTo" + [ "kind" .= String "Connect" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } , "diffusionMode" .= toJSON diffusionMode ] TrConnect Nothing remoteAddress diffusionMode -> mconcat - [ "kind" .= String "ConnectTo" + [ "kind" .= String "Connect" , "remoteAddress" .= toObject verb remoteAddress , "diffusionMode" .= toJSON diffusionMode ] From 3088c875c5ea7cdf53a7eae6423fbc68b27fe426 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 19 Dec 2024 09:31:16 +0100 Subject: [PATCH 39/79] Add BlockFetch tracing instances --- .../Tracing/OrphanInstances/Network.hs | 28 +++++++++++++++---- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 0e70a416f8c..41985b2afc3 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -39,6 +39,7 @@ import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) +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 (..)) @@ -213,6 +214,12 @@ instance HasSeverityAnnotation [TraceLabelPeer peer (FetchDecision [Point header Right _ -> Info +instance HasPrivacyAnnotation (BlockFetch.TraceDecisionEvent peer header) +instance HasSeverityAnnotation (BlockFetch.TraceDecisionEvent peer header) where + getSeverityAnnotation (BlockFetch.PeersFetch xs) = getSeverityAnnotation xs + getSeverityAnnotation BlockFetch.PeerStarvedUs {} = Info + + instance HasPrivacyAnnotation (TraceTxSubmissionInbound txid tx) instance HasSeverityAnnotation (TraceTxSubmissionInbound txid tx) where getSeverityAnnotation TraceTxSubmissionCollected {} = Debug @@ -455,7 +462,7 @@ instance HasSeverityAnnotation (TracePeerSelection addr) where TraceGovernorWakeup {} -> Info TraceChurnWait {} -> Info TraceChurnMode {} -> Info - TraceVerifyPeerSnapshot {} -> Info + -- TraceVerifyPeerSnapshot {} -> Info TraceForgetBigLedgerPeers {} -> Info @@ -636,6 +643,13 @@ instance (Show header, StandardHash header, Show peer) => HasTextFormatter (TraceLabelPeer peer (TraceFetchClientState header)) where formatText a _ = pack (show a) +instance (StandardHash header, Show peer, ToObject peer) + => Transformable Text IO (BlockFetch.TraceDecisionEvent peer header) where + trTransformer = trStructuredText +instance (StandardHash header, Show peer) + => HasTextFormatter (BlockFetch.TraceDecisionEvent peer header) where + formatText a _ = pack (show a) + instance ToObject peer => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))) where trTransformer = trStructured @@ -1329,6 +1343,13 @@ instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where toObject verb (TraceLabelPeer peerid a) = mconcat [ "peer" .= toObject verb peerid ] <> toObject verb a +instance ToObject peer + => ToObject (BlockFetch.TraceDecisionEvent peer header) where + toObject verb (BlockFetch.PeersFetch as) = toObject verb as + toObject verb (BlockFetch.PeerStarvedUs peer) = mconcat + [ "kind" .= String "PeersStarvedUs" + , "peer" .= toObject verb peer + ] instance ToObject (AnyMessage ps) => ToObject (TraceSendRecv ps) where @@ -2061,9 +2082,6 @@ instance ToObject (TracePeerSelection SockAddr) where , "ledgerStateJudgement" .= dpssLedgerStateJudgement ds , "associationMode" .= dpssAssociationMode ds ] - toObject _verb (TraceVerifyPeerSnapshot result) = - mconcat [ "kind" .= String "VerifyPeerSnapshot" - , "result" .= result ] -- Connection manager abstract state. For explanation of each state see -- @@ -2524,7 +2542,7 @@ instance (Show addr, ToObject addr, ToJSON addr) instance (Show addr, ToObject addr, ToJSON addr) => ToObject (Server.Trace addr) where - toObject verb (Server.TrAcceptConnection connId) = + toObject _verb (Server.TrAcceptConnection connId) = mconcat [ "kind" .= String "AcceptConnection" , "connectionId" .= toJSON connId ] From 690a8e20a7caa34fc8d353896c8a1fadc70823ba Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 19 Dec 2024 16:23:11 -0700 Subject: [PATCH 40/79] ouroboros-consensus upgrade: ChainSync changes Authored by: Javier Sagredo --- cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs | 7 +++---- cardano-node/src/Cardano/Tracing/Peer.hs | 7 +++---- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index 0175ead4890..0c7964cc834 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -15,8 +15,7 @@ import Cardano.Node.Orphans () import Cardano.Node.Queries import Ouroboros.Consensus.Block (Header) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (ChainSyncClientHandle, - csCandidate, viewChainSyncState) -import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar) + csCandidate, cschcMap, viewChainSyncState, ) import Ouroboros.Consensus.Util.Orphans () import qualified Ouroboros.Network.AnchoredFragment as Net import Ouroboros.Network.Block (unSlotNo) @@ -104,7 +103,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: StrictTVar IO (Map peer (ChainSyncClientHandle IO blk)) + :: STM.STM IO (Map peer (ChainSyncClientHandle IO blk)) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) getCandidates handle = viewChainSyncState handle csCandidate @@ -116,7 +115,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd . Net.readFetchClientsStateVars . getFetchClientRegistry $ kernel ) - candidates <- STM.atomically . getCandidates . getChainSyncHandles $ kernel + candidates <- STM.atomically . getCandidates . cschcMap . getChainSyncHandles $ kernel let peers = flip Map.mapMaybeWithKey candidates $ \cid af -> maybe Nothing diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index 6366a0d8be7..d7caff501b0 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -18,8 +18,7 @@ import Cardano.Node.Orphans () import Cardano.Node.Queries import Ouroboros.Consensus.Block (Header) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (ChainSyncClientHandle, - csCandidate, viewChainSyncState) -import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar) + csCandidate, cschcMap, viewChainSyncState) import Ouroboros.Consensus.Util.Orphans () import qualified Ouroboros.Network.AnchoredFragment as Net import Ouroboros.Network.Block (unSlotNo) @@ -97,7 +96,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: StrictTVar IO (Map peer (ChainSyncClientHandle IO blk)) + :: STM.STM IO (Map peer (ChainSyncClientHandle IO blk)) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) getCandidates handle = viewChainSyncState handle csCandidate @@ -109,7 +108,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd . Net.readFetchClientsStateVars . getFetchClientRegistry $ kernel ) - candidates <- STM.atomically . getCandidates . getChainSyncHandles $ kernel + candidates <- STM.atomically . getCandidates . cschcMap . getChainSyncHandles $ kernel let peers = flip Map.mapMaybeWithKey candidates $ \cid af -> maybe Nothing From a1752a502953009122063f67c14d814fbd8c372e Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 19 Dec 2024 22:23:55 -0700 Subject: [PATCH 41/79] Add support for ChainDB.TraceChainSelStarvationEvent --- cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs | 6 ++++++ .../src/Cardano/Tracing/OrphanInstances/Consensus.hs | 7 ++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 00fa50d6960..f0609b58301 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -96,6 +96,7 @@ instance ( LogFormatting (Header blk) forHuman (ChainDB.TraceLedgerReplayEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceImmutableDBEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceVolatileDBEvent v) = forHumanOrMachine v + forHuman (ChainDB.TraceChainSelStarvationEvent v)= forHumanOrMachine v forMachine _ ChainDB.TraceLastShutdownUnclean = mconcat [ "kind" .= String "LastShutdownUnclean" ] @@ -121,6 +122,8 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceVolatileDBEvent v) = forMachine details v + forMachine details (ChainDB.TraceChainSelStarvationEvent v) = + forMachine details v asMetrics ChainDB.TraceLastShutdownUnclean = [] asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v @@ -134,6 +137,7 @@ instance ( LogFormatting (Header blk) asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceChainSelStarvationEvent v)= asMetrics v instance MetaTrace (ChainDB.TraceEvent blk) where @@ -161,6 +165,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "ImmDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceVolatileDBEvent ev) = nsPrependInner "VolatileDbEvent" (namespaceFor ev) + namespaceFor (ChainDB.TraceChainSelStarvationEvent ev) = + nsPrependInner "ChainSelStarvationEvent" (namespaceFor ev) severityFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Info severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index e42672f330d..2f378cbde24 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -237,6 +237,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where VolDb.InvalidFileNames{} -> Warning VolDb.DBClosed{} -> Info getSeverityAnnotation ChainDB.TraceLastShutdownUnclean = Warning + getSeverityAnnotation (ChainDB.TraceChainSelStarvationEvent _) = Warning -- TODO: review instance HasSeverityAnnotation (LedgerEvent blk) where getSeverityAnnotation (LedgerUpdate _) = Notice @@ -749,6 +750,7 @@ instance ( ConvertRawHash blk VolDb.Truncate e pth offs -> "Truncating the file at " <> showT pth <> " at offset " <> showT offs <> ": " <> showT e VolDb.InvalidFileNames fs -> "Invalid Volatile DB files: " <> showT fs VolDb.DBClosed -> "Closed Volatile DB." + ChainDB.TraceChainSelStarvationEvent _ -> "ChainSelStarvationEvent" -- TODO: review where showProgressT :: Int -> Int -> Text showProgressT chunkNo outOf = pack (showFFloat (Just 2) (100 * fromIntegral chunkNo / fromIntegral outOf :: Float) mempty) @@ -1012,7 +1014,6 @@ instance ( ConvertRawHash blk [ "anchor" .= renderPointForVerbosity verb (AF.anchorPoint frag) , "head" .= renderPointForVerbosity verb (AF.headPoint frag) ] - where addedHdrsNewChain :: AF.AnchoredFragment (Header blk) @@ -1239,6 +1240,10 @@ instance ( ConvertRawHash blk , "files" .= String (Text.pack . show $ map show fsPaths) ] VolDb.DBClosed -> mconcat [ "kind" .= String "TraceVolatileDbEvent.DBClosed"] + toObject _verb (ChainDB.TraceChainSelStarvationEvent _) = + mconcat [ "kind" .= String "ChainSelStarvationEvent" + -- TODO: add fields + ] instance ConvertRawHash blk => ToObject (ImmDB.TraceChunkValidation blk ChunkNo) where toObject verb ev = case ev of From 19fe118e15c0108eefa3783b430392122ca2876d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 26 Dec 2024 17:21:01 +0100 Subject: [PATCH 42/79] Fix BlockFetch + CSJ tracing instances --- .../src/Cardano/Node/Tracing/Tracers.hs | 7 +++ .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 53 ++++++++++++------- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 42 ++++++++++++++- cardano-node/src/Cardano/Tracing/Config.hs | 9 ++++ .../Tracing/OrphanInstances/Consensus.hs | 38 ++++++++++--- cardano-node/src/Cardano/Tracing/Tracers.hs | 2 + 6 files changed, 124 insertions(+), 27 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 50d2f7b824f..171b7daaf3c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -335,6 +335,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "GSM"] configureTracers configReflection trConfig [consensusGsmTr] + !consensusCsjTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "CSJ"] + configureTracers configReflection trConfig [consensusCsjTr] + pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ traceWith chainSyncClientTr @@ -377,6 +382,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr + , Consensus.csjTracer = Tracer $ + traceWith consensusCsjTr } mkNodeToClientTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index f0609b58301..fe32e91f5a3 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -96,10 +96,20 @@ instance ( LogFormatting (Header blk) forHuman (ChainDB.TraceLedgerReplayEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceImmutableDBEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceVolatileDBEvent v) = forHumanOrMachine v - forHuman (ChainDB.TraceChainSelStarvationEvent v)= forHumanOrMachine v + forHuman (ChainDB.TraceChainSelStarvationEvent ev) = case ev of + ChainDB.ChainSelStarvation RisingEdge -> + "Chain Selection was starved." + ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> + "Chain Selection was unstarved by " <> renderRealPoint pt forMachine _ ChainDB.TraceLastShutdownUnclean = mconcat [ "kind" .= String "LastShutdownUnclean" ] + forMachine dtal (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation edge)) = + mconcat [ "kind" .= String "ChainSelStarvation" + , case edge of + RisingEdge -> "risingEdge" .= True + FallingEdgeWith pt -> "fallingEdge" .= forMachine dtal pt + ] forMachine details (ChainDB.TraceAddBlockEvent v) = forMachine details v forMachine details (ChainDB.TraceFollowerEvent v) = @@ -122,27 +132,27 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceVolatileDBEvent v) = forMachine details v - forMachine details (ChainDB.TraceChainSelStarvationEvent v) = - forMachine details v - asMetrics ChainDB.TraceLastShutdownUnclean = [] - asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v - asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v - asMetrics (ChainDB.TraceCopyToImmutableDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceGCEvent v) = asMetrics v - asMetrics (ChainDB.TraceInitChainSelEvent v) = asMetrics v - asMetrics (ChainDB.TraceOpenEvent v) = asMetrics v - asMetrics (ChainDB.TraceIteratorEvent v) = asMetrics v - asMetrics (ChainDB.TraceSnapshotEvent v) = asMetrics v - asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v - asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceChainSelStarvationEvent v)= asMetrics v + asMetrics ChainDB.TraceLastShutdownUnclean = [] + asMetrics (ChainDB.TraceChainSelStarvationEvent _) = [] + asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v + asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v + asMetrics (ChainDB.TraceCopyToImmutableDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceGCEvent v) = asMetrics v + asMetrics (ChainDB.TraceInitChainSelEvent v) = asMetrics v + asMetrics (ChainDB.TraceOpenEvent v) = asMetrics v + asMetrics (ChainDB.TraceIteratorEvent v) = asMetrics v + asMetrics (ChainDB.TraceSnapshotEvent v) = asMetrics v + asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v + asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v instance MetaTrace (ChainDB.TraceEvent blk) where namespaceFor ChainDB.TraceLastShutdownUnclean = Namespace [] ["LastShutdownUnclean"] + namespaceFor ChainDB.TraceChainSelStarvationEvent{} = + Namespace [] ["ChainSelStarvationEvent"] namespaceFor (ChainDB.TraceAddBlockEvent ev) = nsPrependInner "AddBlockEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceFollowerEvent ev) = @@ -165,10 +175,9 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "ImmDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceVolatileDBEvent ev) = nsPrependInner "VolatileDbEvent" (namespaceFor ev) - namespaceFor (ChainDB.TraceChainSelStarvationEvent ev) = - nsPrependInner "ChainSelStarvationEvent" (namespaceFor ev) severityFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Info + severityFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Debug severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -216,6 +225,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where severityFor _ns _ = Nothing privacyFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Public + privacyFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Public privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -263,6 +273,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where privacyFor _ _ = Nothing detailsFor (Namespace _ ["LastShutdownUnclean"]) _ = Just DNormal + detailsFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just DNormal detailsFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -338,6 +349,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where , " state. Therefore, revalidating all the immutable chunks is necessary to" , " ensure the correctness of the chain." ] + documentFor (Namespace _ ["ChainSelStarvationEvent"]) = Just $ mconcat + [ "ChainSel is waiting for a next block to process, but there is no block in the queue." + , " Despite the name, it is a pretty normal (and frequent) event." + ] documentFor (Namespace out ("AddBlockEvent" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) documentFor (Namespace out ("FollowerEvent" : tl)) = @@ -364,7 +379,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where allNamespaces = Namespace [] ["LastShutdownUnclean"] - + : Namespace [] ["ChainSelStarvationEvent"] : (map (nsPrependInner "AddBlockEvent") (allNamespaces :: [Namespace (ChainDB.TraceAddBlockEvent blk)]) ++ map (nsPrependInner "FollowerEvent") diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index e364c402130..69be0437edb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -49,8 +49,7 @@ import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempoo import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client -import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping (Instruction (..), - JumpInstruction (..), JumpResult (..)) +import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Jumping import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (JumpInfo (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Server import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server @@ -72,6 +71,7 @@ import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import Network.TypedProtocol.Core import Control.Monad (guard) import Control.Monad.Class.MonadTime.SI (Time (..)) @@ -231,6 +231,8 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) [ "ChainSync Jumping -- the client is asked to jump to " , showT (jumpInstructionToPoint instruction) ] + TraceDrainingThePipe n -> + "ChainSync client is draining the pipe. Pipelined messages expected: " <> showT (natToInt n) where jumpInstructionToPoint = AF.headPoint . jTheirFragment . \case JumpTo ji -> ji @@ -304,6 +306,11 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) [ "kind" .= String "TraceJumpingInstructionIs" , "instr" .= instructionToObject instruction ] + TraceDrainingThePipe n -> + mconcat + [ "kind" .= String "TraceDrainingThePipe" + , "n" .= natToInt n + ] where instructionToObject :: Instruction blk -> Aeson.Object instructionToObject = \case @@ -327,6 +334,30 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) jumpInfoToPoint = AF.headPoint . jTheirFragment +-- TODO @tweag-genesis +instance MetaTrace (Jumping.TraceEvent addr) where + namespaceFor RotatedDynamo{} = Namespace [] ["RotatedDynamo"] + + severityFor (Namespace [] ["RotatedDynamo"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace [] ["RotatedDynamo"]) = + Just "The dynamo rotated" + documentFor _ = Nothing + + allNamespaces = + [ Namespace [] ["RotatedDynamo"] ] + +instance Show addr => LogFormatting (Jumping.TraceEvent addr) where + forHuman (RotatedDynamo fromPeer toPeer) = + "Rotated the dynamo from " <> showT fromPeer <> " to " <> showT toPeer + forMachine _dtal (RotatedDynamo fromPeer toPeer) = + mconcat + [ "kind" .= String "RotatedDynamo" + , "from" .= showT fromPeer + , "to" .= showT toPeer + ] + tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object tipToObject = \case TipGenesis -> mconcat @@ -368,6 +399,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Namespace [] ["JumpingWaitingForNextInstruction"] TraceJumpingInstructionIs _ -> Namespace [] ["JumpingInstructionIs"] + TraceDrainingThePipe _ -> + Namespace [] ["DrainingThePipe"] severityFor ns _ = case ns of @@ -397,6 +430,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Just Debug Namespace _ ["JumpingInstructionIs"] -> Just Debug + Namespace _ ["DrainingThePipe"] -> + Just Debug _ -> Nothing @@ -434,6 +469,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Just "The client is waiting for the next instruction" Namespace _ ["JumpingInstructionIs"] -> Just "The client got its next instruction" + Namespace _ ["DrainingThePipe"] -> + Just "The client is draining the pipe of messages" _ -> Nothing @@ -451,6 +488,7 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where , Namespace [] ["JumpResult"] , Namespace [] ["JumpingWaitingForNextInstruction"] , Namespace [] ["JumpingInstructionIs"] + , Namespace [] ["DrainingThePipe"] ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index e871960c4b0..b50a3543416 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -178,6 +178,7 @@ type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) +type TraceCsj = ("TraceCsj" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -250,6 +251,7 @@ data TraceSelection , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol , traceKeepAliveProtocol :: OnOff TraceKeepAliveProtocol , traceGsm :: OnOff TraceGsm + , traceCsj :: OnOff TraceCsj } deriving (Eq, Show) @@ -316,6 +318,7 @@ data PartialTraceSelection , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) , pTraceKeepAliveProtocol :: Last (OnOff TraceKeepAliveProtocol) , pTraceGsm :: Last (OnOff TraceGsm) + , pTraceCsj :: Last (OnOff TraceCsj) } deriving (Eq, Generic, Show) @@ -383,6 +386,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v <*> parseTracer (Proxy @TraceKeepAliveProtocol) v <*> parseTracer (Proxy @TraceGsm) v + <*> parseTracer (Proxy @TraceCsj) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -447,6 +451,7 @@ defaultPartialTraceConfiguration = , pTraceTxSubmission2Protocol = pure $ OnOff False , pTraceKeepAliveProtocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True + , pTraceCsj = pure $ OnOff True } @@ -513,6 +518,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -572,6 +578,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm + , traceCsj = traceCsj } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -635,6 +642,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -694,6 +702,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm + , traceCsj = traceCsj } 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 2f378cbde24..781a7da684f 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -79,6 +79,7 @@ import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) +import Network.TypedProtocol.Core import Control.Monad (guard) import Data.Aeson (Value (..)) @@ -237,7 +238,8 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where VolDb.InvalidFileNames{} -> Warning VolDb.DBClosed{} -> Info getSeverityAnnotation ChainDB.TraceLastShutdownUnclean = Warning - getSeverityAnnotation (ChainDB.TraceChainSelStarvationEvent _) = Warning -- TODO: review + + getSeverityAnnotation ChainDB.TraceChainSelStarvationEvent{} = Debug instance HasSeverityAnnotation (LedgerEvent blk) where getSeverityAnnotation (LedgerUpdate _) = Notice @@ -269,6 +271,7 @@ instance HasSeverityAnnotation (TraceChainSyncClientEvent blk) where getSeverityAnnotation (TraceJumpResult _) = Debug getSeverityAnnotation TraceJumpingWaitingForNextInstruction = Debug getSeverityAnnotation (TraceJumpingInstructionIs _) = Debug + getSeverityAnnotation (TraceDrainingThePipe _) = Debug instance HasPrivacyAnnotation (TraceChainSyncServerEvent blk) @@ -750,7 +753,9 @@ instance ( ConvertRawHash blk VolDb.Truncate e pth offs -> "Truncating the file at " <> showT pth <> " at offset " <> showT offs <> ": " <> showT e VolDb.InvalidFileNames fs -> "Invalid Volatile DB files: " <> showT fs VolDb.DBClosed -> "Closed Volatile DB." - ChainDB.TraceChainSelStarvationEvent _ -> "ChainSelStarvationEvent" -- TODO: review + ChainDB.TraceChainSelStarvationEvent ev -> case ev of + ChainDB.ChainSelStarvation RisingEdge -> "Chain Selection was starved." + ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> "Chain Selection was unstarved by " <> renderRealPoint pt where showProgressT :: Int -> Int -> Text showProgressT chunkNo outOf = pack (showFFloat (Just 2) (100 * fromIntegral chunkNo / fromIntegral outOf :: Float) mempty) @@ -1240,10 +1245,12 @@ instance ( ConvertRawHash blk , "files" .= String (Text.pack . show $ map show fsPaths) ] VolDb.DBClosed -> mconcat [ "kind" .= String "TraceVolatileDbEvent.DBClosed"] - toObject _verb (ChainDB.TraceChainSelStarvationEvent _) = - mconcat [ "kind" .= String "ChainSelStarvationEvent" - -- TODO: add fields - ] + toObject verb (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation edge)) = + mconcat [ "kind" .= String "ChainDB.ChainSelStarvation" + , case edge of + RisingEdge -> "risingEdge" .= True + FallingEdgeWith pt -> "fallingEdge" .= toObject verb pt + ] instance ConvertRawHash blk => ToObject (ImmDB.TraceChunkValidation blk ChunkNo) where toObject verb ev = case ev of @@ -1375,6 +1382,10 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) mconcat [ "kind" .= String "ChainSyncClientEvent.TraceJumpingInstructionIs" , "instr" .= toObject verb instr ] + TraceDrainingThePipe n -> + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceDrainingThePipe" + , "n" .= natToInt n + ] instance ( LedgerSupportsProtocol blk, ConvertRawHash blk @@ -1409,6 +1420,21 @@ instance ( LedgerSupportsProtocol blk, , "ourFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jOurFragment info)) , "theirFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jTheirFragment info)) ] +-- TODO @tweag-genesis +instance HasPrivacyAnnotation (ChainSync.Client.TraceEvent peer) where +instance HasSeverityAnnotation (ChainSync.Client.TraceEvent peer) where + getSeverityAnnotation _ = Info +instance Show peer => Transformable Text IO (ChainSync.Client.TraceEvent peer) where + trTransformer = trStructured + +instance Show peer => ToObject (ChainSync.Client.TraceEvent peer) where + toObject _verb (ChainSync.Client.RotatedDynamo fromPeer toPeer) = + mconcat + [ "kind" .= String "RotatedDynamo" + , "from" .= showT fromPeer + , "to" .= showT toPeer + ] + instance ConvertRawHash blk => ToObject (TraceChainSyncServerEvent blk) where toObject verb ev = case ev of diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5a39cb11dea..cb223c32450 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -512,6 +512,7 @@ mkTracers _ _ _ _ _ enableP2P = , Consensus.blockchainTimeTracer = nullTracer , Consensus.consensusErrorTracer = nullTracer , Consensus.gsmTracer = nullTracer + , Consensus.csjTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -813,6 +814,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.consensusErrorTracer = Tracer $ \err -> traceWith (toLogObject tr) (ConsensusStartupException err) , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr + , Consensus.csjTracer = tracerOnOff (traceCsj trSel) verb "CSJ" tr } where mkForgeTracers :: IO ForgeTracers From 64d5306fe0582e312818c46a2ca948b370241806 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 26 Dec 2024 17:25:54 +0100 Subject: [PATCH 43/79] Dummy implementation for network tracers --- .../Cardano/Node/Configuration/TopologyP2P.hs | 21 +++++++------ cardano-node/src/Cardano/Node/Run.hs | 4 +-- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 31 +++++++++++++++++++ .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 11 ++----- cardano-node/src/Cardano/Tracing/Tracers.hs | 13 +++++--- 5 files changed, 55 insertions(+), 25 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs index 7bdfa720d0e..2e7517bf31e 100644 --- a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs +++ b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} @@ -28,7 +29,6 @@ import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Configuration.Topology (TopologyError (..)) import Cardano.Node.Startup (StartupTrace (..)) import Cardano.Node.Types -import Cardano.Logging (traceWith) import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Network.ConsensusMode import Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..)) @@ -45,6 +45,7 @@ import Control.Exception (IOException) import qualified Control.Exception as Exception import Control.Exception.Base (Exception (..)) import Control.Monad.Trans.Except.Extra +import qualified "contra-tracer" Control.Tracer as CT import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -213,26 +214,26 @@ instance ToJSON NetworkTopology where -- | Read the `NetworkTopology` configuration from the specified file. -- -readTopologyFile :: NodeConfiguration -> IO (Either Text NetworkTopology) -readTopologyFile nc = do +readTopologyFile :: NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text NetworkTopology) +readTopologyFile nc tr = do eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc) case eBs of Left e -> return . Left $ handler e Right bs -> let bs' = LBS.fromStrict bs in - return $ case eitherDecode bs' of - Left err -> Left (handlerJSON err) + case eitherDecode bs' of + Left err -> return $ Left (handlerJSON err) Right t | isValidTrustedPeerConfiguration t -> if isGenesisCompatible (ncConsensusMode nc) (ntUseBootstrapPeers t) then return (Right t) else do - traceWith (ncTraceConfig nc) $ + CT.traceWith tr $ NetworkConfigUpdateError genesisIncompatible return . Right $ t { ntUseBootstrapPeers = DontUseBootstrapPeers } | otherwise -> - Left handlerBootstrap + pure $ Left handlerBootstrap where handler :: IOException -> Text handler e = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: " @@ -260,9 +261,9 @@ readTopologyFile nc = do isGenesisCompatible GenesisMode (UseBootstrapPeers{}) = False isGenesisCompatible _ _ = True -readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology -readTopologyFileOrError nc = - readTopologyFile nc +readTopologyFileOrError :: NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO NetworkTopology +readTopologyFileOrError nc tr = + readTopologyFile nc tr >>= either (\err -> error $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: " <> Text.unpack err) pure diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 1d05392fe0e..ba82f3bd98c 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -436,7 +436,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do { ntUseLedgerPeers , ntUseBootstrapPeers , ntPeerSnapshotPath - } <- TopologyP2P.readTopologyFileOrError nc + } <- TopologyP2P.readTopologyFileOrError nc (startupTracer tracers) let (localRoots, publicRoots) = producerAddresses nt traceWith (startupTracer tracers) $ NetworkConfig localRoots @@ -921,8 +921,6 @@ mkP2PArguments NodeConfiguration { , P2P.daReadUseLedgerPeers , P2P.daReadUseBootstrapPeers , P2P.daReadLedgerPeerSnapshot - , P2P.daConsensusMode = ncConsensusMode - , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState , P2P.daProtocolIdleTimeout = ncProtocolIdleTimeout , P2P.daTimeWaitTimeout = ncTimeWaitTimeout , P2P.daDeadlineChurnInterval = Configuration.defaultDeadlineChurnInterval diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 69be0437edb..408270ab20a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -65,6 +65,7 @@ import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision +import Ouroboros.Network.BlockFetch.Decision.Trace import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) @@ -698,6 +699,36 @@ calculateBlockFetchClientMetrics cm _lc _ = pure cm -- BlockFetchDecision Tracer -------------------------------------------------------------------------------- +-- TODO @ouroboros-network +instance MetaTrace (TraceDecisionEvent peer (Header blk)) where + namespaceFor PeersFetch{} = Namespace [] ["PeersFetch"] + namespaceFor PeerStarvedUs{} = Namespace [] ["PeerStarvedUs"] + + severityFor (Namespace _ ["PeersFetch"]) _ = Just Debug + severityFor (Namespace _ ["PeerStarvedUs"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace [] ["PeersFetch"]) = + Just "TODO: @ouroboros-network" + documentFor (Namespace [] ["PeerStarvedUs"]) = + Just "TODO: @ouroboros-network" + documentFor _ = Nothing + + allNamespaces = + [ Namespace [] ["PeersFetch"], Namespace [] ["PeerStarvedUs"] ] + +-- TODO @ouroboros-network +instance LogFormatting (TraceDecisionEvent peer (Header blk)) where + forHuman (PeersFetch _traces) = + "TODO: @ouroboros-network" + forHuman (PeerStarvedUs _traces) = + "TODO: @ouroboros-network" + + forMachine _dtal (PeersFetch _traces) = + mconcat [ "kind" .= String "TODO: @ouroboros-network" ] + forMachine _dtal (PeerStarvedUs _traces) = + mconcat [ "kind" .= String "TODO: @ouroboros-network" ] + instance (LogFormatting peer, Show peer) => LogFormatting [TraceLabelPeer peer (FetchDecision [Point header])] where forMachine DMinimal _ = mempty diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 1a13f2659d1..7a548bbb2f4 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -559,9 +559,6 @@ instance LogFormatting (TracePeerSelection SockAddr) where , "upstreamyness" .= dpssUpstreamyness ds , "fetchynessBlocks" .= dpssFetchynessBlocks ds ] - forMachine _dtal (TraceVerifyPeerSnapshot result) = - mconcat [ "kind" .= String "VerifyPeerSnapshot" - , "result" .= result] forHuman = pack . show @@ -688,8 +685,6 @@ instance MetaTrace (TracePeerSelection SockAddr) where Namespace [] ["ChurnTimeout"] namespaceFor TraceDebugState {} = Namespace [] ["DebugState"] - namespaceFor TraceVerifyPeerSnapshot {} = - Namespace [] ["VerifyPeerSnapshot"] severityFor (Namespace [] ["LocalRootPeersChanged"]) _ = Just Notice severityFor (Namespace [] ["TargetsChanged"]) _ = Just Notice @@ -1206,7 +1201,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] - forMachine dtal (TrReleaseConnection prov connId) = + forMachine _dtal (TrReleaseConnection prov connId) = mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= toJSON connId @@ -1323,7 +1318,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, listValue (\(localAddr, connState) -> object [ "localAddress" .= localAddr - , "state" .= toJSON connState + , "state" .= toJSON connState ] ) (Map.toList inner) @@ -1537,7 +1532,7 @@ instance MetaTrace (ConnectionManager.AbstractTransitionTrace peerAddr) where instance (Show addr, LogFormatting addr, ToJSON addr) => LogFormatting (Server.Trace addr) where - forMachine dtal (TrAcceptConnection connId) = + forMachine _dtal (TrAcceptConnection connId) = mconcat [ "kind" .= String "AcceptConnection" , "address" .= toJSON connId ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index cb223c32450..2ac74d7fb2a 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -93,6 +93,7 @@ import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), HasHea import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..), TraceLabelPeer (..)) import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) +import Ouroboros.Network.BlockFetch.Decision.Trace import Ouroboros.Network.ConnectionId (ConnectionId) import qualified Ouroboros.Network.ConnectionManager.Core as ConnectionManager import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..)) @@ -1455,6 +1456,7 @@ nodeToNodeTracers' trSel verb tr = verb "KeepAliveProtocol" tr } +-- TODO @ouroboros-network teeTraceBlockFetchDecision :: ( Eq peer , HasHeader blk @@ -1464,11 +1466,14 @@ teeTraceBlockFetchDecision => TracingVerbosity -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) -> Trace IO Text - -> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]) + -> Tracer IO (WithSeverity (TraceDecisionEvent peer (Header blk))) teeTraceBlockFetchDecision verb eliding tr = - Tracer $ \ev -> do - traceWith (teeTraceBlockFetchDecision' meTr) ev - traceWith (teeTraceBlockFetchDecisionElide verb eliding bfdTr) ev + Tracer $ \(WithSeverity s ev) -> case ev of + PeerStarvedUs {} -> do + traceWith (toLogObject' verb meTr) ev + PeersFetch ev' -> do + traceWith (teeTraceBlockFetchDecision' meTr) (WithSeverity s ev') + traceWith (teeTraceBlockFetchDecisionElide verb eliding bfdTr) (WithSeverity s ev') where meTr = appendName "metrics" tr bfdTr = appendName "BlockFetchDecision" tr From 42360ad9d719c708fdb6a139fce62f6925b7b191 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 26 Dec 2024 17:27:40 +0100 Subject: [PATCH 44/79] Fix tests related to ouroboros-network --- cardano-node/src/Cardano/Node/Run.hs | 2 +- cardano-node/test/Test/Cardano/Node/Gen.hs | 5 +- cardano-node/test/Test/Cardano/Node/POM.hs | 52 +++++++++---------- .../src/Testnet/Components/Configuration.hs | 1 + 4 files changed, 31 insertions(+), 29 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index ba82f3bd98c..7a5d2ee3d17 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -788,7 +788,7 @@ updateTopologyConfiguration :: Tracer IO (StartupTrace blk) updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar useBootsrapPeersVar ledgerPeerSnapshotPathVar = do traceWith startupTracer NetworkConfigUpdate - result <- try $ readTopologyFileOrError nc + result <- try $ readTopologyFileOrError nc startupTracer case result of Left (FatalError err) -> traceWith startupTracer diff --git a/cardano-node/test/Test/Cardano/Node/Gen.hs b/cardano-node/test/Test/Cardano/Node/Gen.hs index 44546e5c73e..b2d6048403d 100644 --- a/cardano-node/test/Test/Cardano/Node/Gen.hs +++ b/cardano-node/test/Test/Cardano/Node/Gen.hs @@ -27,6 +27,7 @@ import Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroup (.. PeerAdvertise (..), PublicRootPeers (..), RootConfig (..)) import Cardano.Node.Types import Cardano.Slotting.Slot (SlotNo (..)) +import Ouroboros.Network.NodeToNode.Version import Ouroboros.Network.PeerSelection.Bootstrap import Ouroboros.Network.PeerSelection.LedgerPeers.Type (AfterSlot (..), UseLedgerPeers (..)) @@ -182,7 +183,7 @@ genLocalRootPeersGroup = do ra <- genRootConfig hval <- Gen.int (Range.linear 0 (length (rootAccessPoints ra))) wval <- WarmValency <$> Gen.int (Range.linear 0 hval) - LocalRootPeersGroup ra (HotValency hval) wval <$> genPeerTrustable + LocalRootPeersGroup ra (HotValency hval) wval <$> genPeerTrustable <*> pure InitiatorAndResponderDiffusionMode genLocalRootPeersGroups :: Gen LocalRootPeersGroups genLocalRootPeersGroups = @@ -212,7 +213,7 @@ genPeerSnapshotPath = Gen.element [ Nothing , Just . PeerSnapshotFile $ "dummy" - ] + ] genPeerTrustable :: Gen PeerTrustable genPeerTrustable = Gen.element [ IsNotTrustable, IsTrustable ] diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index f79b664c4d1..9e7a7f84bc0 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -143,10 +143,10 @@ testPartialYamlConfig = , pncDeadlineTargetOfKnownBigLedgerPeers = mempty , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty , pncDeadlineTargetOfActiveBigLedgerPeers = mempty - , pncSyncTargetNumberOfActivePeers = mempty - , pncSyncTargetNumberOfKnownBigLedgerPeers = mempty - , pncSyncTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncSyncTargetNumberOfActiveBigLedgerPeers = mempty + , pncSyncTargetOfActivePeers = mempty + , pncSyncTargetOfKnownBigLedgerPeers = mempty + , pncSyncTargetOfEstablishedBigLedgerPeers = mempty + , pncSyncTargetOfActiveBigLedgerPeers = mempty , pncMinBigLedgerPeersForTrustedState = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) @@ -183,17 +183,17 @@ testPartialCliConfig = , pncTimeWaitTimeout = mempty , pncChainSyncIdleTimeout = mempty , pncAcceptedConnectionsLimit = mempty - , pncDeadlineTargetNumberOfRootPeers = mempty - , pncDeadlineTargetNumberOfKnownPeers = mempty - , pncDeadlineTargetNumberOfEstablishedPeers = mempty - , pncDeadlineTargetNumberOfActivePeers = mempty - , pncDeadlineTargetNumberOfKnownBigLedgerPeers = mempty - , pncDeadlineTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncDeadlineTargetNumberOfActiveBigLedgerPeers = mempty - , pncSyncTargetNumberOfActivePeers = mempty - , pncSyncTargetNumberOfKnownBigLedgerPeers = mempty - , pncSyncTargetNumberOfEstablishedBigLedgerPeers = mempty - , pncSyncTargetNumberOfActiveBigLedgerPeers = mempty + , pncDeadlineTargetOfRootPeers = mempty + , pncDeadlineTargetOfKnownPeers = mempty + , pncDeadlineTargetOfEstablishedPeers = mempty + , pncDeadlineTargetOfActivePeers = mempty + , pncDeadlineTargetOfKnownBigLedgerPeers = mempty + , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty + , pncDeadlineTargetOfActiveBigLedgerPeers = mempty + , pncSyncTargetOfActivePeers = mempty + , pncSyncTargetOfKnownBigLedgerPeers = mempty + , pncSyncTargetOfEstablishedBigLedgerPeers = mempty + , pncSyncTargetOfActiveBigLedgerPeers = mempty , pncMinBigLedgerPeersForTrustedState = Last (Just defaultMinBigLedgerPeersForTrustedState) , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) @@ -236,17 +236,17 @@ eExpectedConfig = do , acceptedConnectionsSoftLimit = 384 , acceptedConnectionsDelay = 5 } - , ncDeadlineTargetNumberOfRootPeers = 60 - , ncDeadlineTargetNumberOfKnownPeers = 85 - , ncDeadlineTargetNumberOfEstablishedPeers = 40 - , ncDeadlineTargetNumberOfActivePeers = 15 - , ncDeadlineTargetNumberOfKnownBigLedgerPeers = 15 - , ncDeadlineTargetNumberOfEstablishedBigLedgerPeers = 10 - , ncDeadlineTargetNumberOfActiveBigLedgerPeers = 5 - , ncSyncTargetNumberOfActivePeers = 0 - , ncSyncTargetNumberOfKnownBigLedgerPeers = 100 - , ncSyncTargetNumberOfEstablishedBigLedgerPeers = 50 - , ncSyncTargetNumberOfActiveBigLedgerPeers = 30 + , ncDeadlineTargetOfRootPeers = 60 + , ncDeadlineTargetOfKnownPeers = 85 + , ncDeadlineTargetOfEstablishedPeers = 40 + , ncDeadlineTargetOfActivePeers = 15 + , ncDeadlineTargetOfKnownBigLedgerPeers = 15 + , ncDeadlineTargetOfEstablishedBigLedgerPeers = 10 + , ncDeadlineTargetOfActiveBigLedgerPeers = 5 + , ncSyncTargetOfActivePeers = 0 + , ncSyncTargetOfKnownBigLedgerPeers = 100 + , ncSyncTargetOfEstablishedBigLedgerPeers = 50 + , ncSyncTargetOfActiveBigLedgerPeers = 30 , ncMinBigLedgerPeersForTrustedState = defaultMinBigLedgerPeersForTrustedState , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index ddbf7fc741f..2e5686d0f1a 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -236,3 +236,4 @@ mkTopologyConfig numNodes allPorts port True = A.encodePretty topologyP2P [] DontUseLedgerPeers DontUseBootstrapPeers + Nothing From cd02098aed5e9bce9c3f115c0109e8fad3d1a813 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 26 Dec 2024 17:27:51 +0100 Subject: [PATCH 45/79] Fix tests related to cardano-cli --- .../cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs | 4 ++++ 1 file changed, 4 insertions(+) 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 f190ff36fb9..837ca75a4e3 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 @@ -439,6 +439,10 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- treasury H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury" ] + TestQueryProposalsCmd -> do + -- TODO @cardano-cli team + pure () + where -- | Wait for the part of the epoch when futurePParams are known waitForFuturePParamsToStabilise From 9354a62427b7528eb285d312dd4527d5c24ff64a Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Sat, 28 Dec 2024 11:22:42 +0100 Subject: [PATCH 46/79] Network tracing instances for fetch decisions * Provide instances for `FetchDecisionEvent` for new tracing system. * Provide `ToJSON` instances for `FetchDecision` (via `FetchDecisionToJSON` newtype wrapper), `TraceDecisionEvent`, `Point` which can be used by both new and old tracing system. * Provide `Verbose` newtype wrapper wich `ToJSON` instances provide more verbose output. --- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 33 +++--- .../Tracing/OrphanInstances/Network.hs | 108 +++++++++++++----- cardano-node/src/Cardano/Tracing/Tracers.hs | 13 ++- 3 files changed, 103 insertions(+), 51 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 408270ab20a..e40a453120b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -32,6 +32,7 @@ import Cardano.Node.Tracing.Formatting () import Cardano.Node.Tracing.Render import Cardano.Node.Tracing.Tracers.ConsensusStartupException () import Cardano.Node.Tracing.Tracers.StartLeadershipCheck +import Cardano.Tracing.OrphanInstances.Network (Verbose (..)) import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) import Cardano.Slotting.Slot (WithOrigin (..)) import Ouroboros.Consensus.Block @@ -65,7 +66,7 @@ import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision -import Ouroboros.Network.BlockFetch.Decision.Trace +import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) @@ -699,7 +700,6 @@ calculateBlockFetchClientMetrics cm _lc _ = pure cm -- BlockFetchDecision Tracer -------------------------------------------------------------------------------- --- TODO @ouroboros-network instance MetaTrace (TraceDecisionEvent peer (Header blk)) where namespaceFor PeersFetch{} = Namespace [] ["PeersFetch"] namespaceFor PeerStarvedUs{} = Namespace [] ["PeerStarvedUs"] @@ -709,25 +709,28 @@ instance MetaTrace (TraceDecisionEvent peer (Header blk)) where severityFor _ _ = Nothing documentFor (Namespace [] ["PeersFetch"]) = - Just "TODO: @ouroboros-network" + Just "list of block-fetch decisions" documentFor (Namespace [] ["PeerStarvedUs"]) = - Just "TODO: @ouroboros-network" + Just "current peer starved us, the node will switch to a different peer" documentFor _ = Nothing allNamespaces = [ Namespace [] ["PeersFetch"], Namespace [] ["PeerStarvedUs"] ] --- TODO @ouroboros-network -instance LogFormatting (TraceDecisionEvent peer (Header blk)) where - forHuman (PeersFetch _traces) = - "TODO: @ouroboros-network" - forHuman (PeerStarvedUs _traces) = - "TODO: @ouroboros-network" - - forMachine _dtal (PeersFetch _traces) = - mconcat [ "kind" .= String "TODO: @ouroboros-network" ] - forMachine _dtal (PeerStarvedUs _traces) = - mconcat [ "kind" .= String "TODO: @ouroboros-network" ] +instance (Show peer, ToJSON peer, ConvertRawHash (Header blk), HasHeader blk) + => LogFormatting (TraceDecisionEvent peer (Header blk)) where + forHuman = Text.pack . show + + forMachine dtal (PeersFetch xs) = + mconcat [ "kind" .= String "PeerFetch" + , "decisions" .= if dtal >= DMaximum + then toJSON (Verbose <$> xs) + else toJSON xs + ] + forMachine _dtal (PeerStarvedUs peer) = + mconcat [ "kind" .= String "PeerStarvedUs" + , "peer" .= toJSON peer + ] instance (LogFormatting peer, Show peer) => LogFormatting [TraceLabelPeer peer (FetchDecision [Point header])] where diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 41985b2afc3..c36aa985814 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -22,7 +22,10 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} #endif -module Cardano.Tracing.OrphanInstances.Network () where +module Cardano.Tracing.OrphanInstances.Network + ( Verbose (..) + , FetchDecisionToJSON (..) + ) where import Cardano.Node.Queries (ConvertTxId) import Cardano.Tracing.OrphanInstances.Common @@ -629,7 +632,7 @@ instance HasTextFormatter NtN.AcceptConnectionsPolicyTrace where formatText a _ = pack (show a) -instance (StandardHash header, Show peer, ToObject peer) +instance (StandardHash header, Show peer, ToJSON peer, ConvertRawHash header) => Transformable Text IO [TraceLabelPeer peer (FetchDecision [Point header])] where trTransformer = trStructuredText instance (StandardHash header, Show peer) @@ -643,7 +646,7 @@ instance (Show header, StandardHash header, Show peer) => HasTextFormatter (TraceLabelPeer peer (TraceFetchClientState header)) where formatText a _ = pack (show a) -instance (StandardHash header, Show peer, ToObject peer) +instance (StandardHash header, Show peer, ToJSON peer, ConvertRawHash header) => Transformable Text IO (BlockFetch.TraceDecisionEvent peer header) where trTransformer = trStructuredText instance (StandardHash header, Show peer) @@ -1128,16 +1131,6 @@ instance Aeson.ToJSON ConnectionManagerCounters where , "outbound" .= outboundConns ] -instance ToObject (FetchDecision [Point header]) where - toObject _verb (Left decline) = - mconcat [ "kind" .= String "FetchDecision declined" - , "declined" .= String (pack (show decline)) - ] - toObject _verb (Right results) = - mconcat [ "kind" .= String "FetchDecision results" - , "length" .= String (pack $ show $ length results) - ] - -- TODO: use 'ToJSON' constraints instance (Show ntnAddr, Show ntcAddr) => ToObject (ND.DiffusionTracer ntnAddr ntcAddr) where toObject _verb (ND.RunServer sockAddr) = mconcat @@ -1243,17 +1236,45 @@ instance ToObject NtN.AcceptConnectionsPolicyTrace where ] +instance ConvertRawHash header + => ToJSON (Point header) where + toJSON GenesisPoint = String "GenesisPoint" + toJSON (BlockPoint (SlotNo slotNo) hash) = + -- it is unlikely that there will be two short hashes in the same slot + String $ renderHeaderHashForVerbosity + (Proxy @header) + MinimalVerbosity + hash + <> "@" + <> pack (show slotNo) + + +newtype Verbose a = Verbose a + +instance ConvertRawHash header + => ToJSON (Verbose (Point header)) where + toJSON (Verbose GenesisPoint) = String "GenesisPoint" + toJSON (Verbose (BlockPoint (SlotNo slotNo) hash)) = + -- it is unlikely that there will be two short hashes in the same slot + String $ renderHeaderHashForVerbosity + (Proxy @header) + MaximalVerbosity + hash + <> "@" + <> pack (show slotNo) + + instance ConvertRawHash blk => ToObject (Point blk) where toObject _verb GenesisPoint = - mconcat - [ "kind" .= String "GenesisPoint" ] - toObject verb (BlockPoint slot h) = - mconcat - [ "kind" .= String "BlockPoint" - , "slot" .= toJSON (unSlotNo slot) - , "headerHash" .= renderHeaderHashForVerbosity (Proxy @blk) verb h - ] + mconcat [ "point" .= String "GenesisPoint" ] + toObject verb point@BlockPoint{} = + mconcat [ "point" .= + case verb of + MaximalVerbosity + -> toJSON (Verbose point) + _ -> toJSON point + ] instance ToObject SlotNo where @@ -1329,26 +1350,51 @@ instance (HasHeader header, ConvertRawHash header) , "outstanding" .= outstanding ] - -instance (ToObject peer) +instance (ToJSON peer, ConvertRawHash header) => ToObject [TraceLabelPeer peer (FetchDecision [Point header])] where toObject MinimalVerbosity _ = mempty toObject _ [] = mempty toObject _ xs = mconcat - [ "kind" .= String "PeersFetch" - , "peers" .= toJSON - (foldl' (\acc x -> toObject MaximalVerbosity x : acc) [] xs) ] + [ "kind" .= String "FetchDecisions" + , "decisions" .= toJSON xs + ] instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where toObject verb (TraceLabelPeer peerid a) = mconcat [ "peer" .= toObject verb peerid ] <> toObject verb a -instance ToObject peer +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)) = + Aeson.object + [ "peer" .= toJSON peer + , "decision" .= toJSON (FetchDecisionToJSON $ map Verbose <$> decision) + ] + +newtype FetchDecisionToJSON point = + FetchDecisionToJSON (FetchDecision [point]) + +instance ToJSON point + => ToJSON (FetchDecisionToJSON point) where + toJSON (FetchDecisionToJSON (Left decline)) = + Aeson.object [ "declined" .= String (pack . show $ decline) ] + toJSON (FetchDecisionToJSON (Right points)) = + toJSON points + +instance (ToJSON peer, ConvertRawHash header) => ToObject (BlockFetch.TraceDecisionEvent peer header) where - toObject verb (BlockFetch.PeersFetch as) = toObject verb as - toObject verb (BlockFetch.PeerStarvedUs peer) = mconcat - [ "kind" .= String "PeersStarvedUs" - , "peer" .= toObject verb peer + toObject verb (BlockFetch.PeersFetch as) = toObject verb as + toObject _verb (BlockFetch.PeerStarvedUs peer) = mconcat + [ "kind" .= String "PeerStarvedUs" + , "peer" .= toJSON peer ] instance ToObject (AnyMessage ps) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 2ac74d7fb2a..edcdfab451c 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -725,6 +725,8 @@ mkConsensusTracers :: forall blk peer localPeer. ( Show peer , Eq peer + , ToObject peer + , ToJSON peer , LedgerQueries blk , ToJSON (GenTxId blk) , ToObject (ApplyTxErr blk) @@ -734,7 +736,6 @@ mkConsensusTracers , ToObject (OtherHeaderEnvelopeError blk) , ToObject (ValidationErr (BlockProtocol blk)) , ToObject (ForgeStateUpdateError blk) - , ToObject peer , Consensus.RunNode blk , HasKESMetricsData blk , HasKESInfo blk @@ -1459,9 +1460,10 @@ nodeToNodeTracers' trSel verb tr = -- TODO @ouroboros-network teeTraceBlockFetchDecision :: ( Eq peer - , HasHeader blk , Show peer - , ToObject peer + , ToJSON peer + , HasHeader blk + , ConvertRawHash blk ) => TracingVerbosity -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) @@ -1489,9 +1491,10 @@ teeTraceBlockFetchDecision' tr = teeTraceBlockFetchDecisionElide :: ( Eq peer - , HasHeader blk , Show peer - , ToObject peer + , ToJSON peer + , HasHeader blk + , ConvertRawHash blk ) => TracingVerbosity -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) From daf29588e65349818d68bd6b9da177e2a21edb71 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 27 Dec 2024 15:36:49 +0100 Subject: [PATCH 47/79] cardano-testnet | fix stake registration check failures and adapt to create-testnet-data changes --- .../src/Testnet/Components/Configuration.hs | 21 +- cardano-testnet/src/Testnet/Defaults.hs | 8 +- cardano-testnet/src/Testnet/Ping.hs | 7 +- cardano-testnet/src/Testnet/Runtime.hs | 16 +- cardano-testnet/src/Testnet/Start/Byron.hs | 33 - cardano-testnet/src/Testnet/Start/Cardano.hs | 28 +- .../Cardano/Testnet/Test/Cli/Query.hs | 2 +- .../Testnet/Test/Gov/CommitteeAddNew.hs | 3 + .../Testnet/Test/Gov/GovActionTimeout.hs | 3 + .../Cardano/Testnet/Test/Gov/InfoAction.hs | 3 + .../Testnet/Test/Gov/PParamChangeFailsSPO.hs | 2 + .../Cardano/Testnet/Test/Node/Shutdown.hs | 7 +- .../files/golden/queries/govStateOut.json | 2780 +++++++++-------- .../queries/protocolParametersFileOut.json | 492 +-- .../golden/queries/protocolParametersOut.txt | 492 +-- .../golden/tx.failed.response.json.golden | 2 +- 16 files changed, 2128 insertions(+), 1771 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 2e5686d0f1a..5cf18b357d2 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -73,7 +73,7 @@ createConfigJson :: () -> ShelleyBasedEra era -- ^ The era used for generating the hard fork configuration toggle -> m LBS.ByteString createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ do - byronGenesisHash <- getByronGenesisHash $ tempAbsPath "byron/genesis.json" + byronGenesisHash <- getByronGenesisHash $ tempAbsPath "byron-genesis.json" shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash" alonzoGenesisHash <- getHash AlonzoEra "AlonzoGenesisHash" conwayGenesisHash <- getHash ConwayEra "ConwayGenesisHash" @@ -126,7 +126,7 @@ createSPOGenesisAndFiles -> ConwayGenesis StandardCrypto -- ^ The conway genesis to use, for example 'Defaults.defaultConwayGenesis'. -> TmpAbsolutePath -> m FilePath -- ^ Shelley genesis directory -createSPOGenesisAndFiles nPoolNodes nDelReps maxSupply sbe shelleyGenesis +createSPOGenesisAndFiles nPoolNodes nDelReps maxSupply asbe@(AnyShelleyBasedEra sbe) shelleyGenesis alonzoGenesis conwayGenesis (TmpAbsolutePath tempAbsPath) = GHC.withFrozenCallStack $ do let inputGenesisShelleyFp = tempAbsPath genesisInputFilepath ShelleyEra inputGenesisAlonzoFp = tempAbsPath genesisInputFilepath AlonzoEra @@ -162,8 +162,10 @@ createSPOGenesisAndFiles nPoolNodes nDelReps maxSupply sbe shelleyGenesis H.note_ $ "Number of stake delegators: " <> show nPoolNodes H.note_ $ "Number of seeded UTxO keys: " <> show numSeededUTxOKeys - execCli_ - [ anyShelleyBasedEraToString sbe, "genesis", "create-testnet-data" + let eraString = anyShelleyBasedEraToString asbe + era = toCardanoEra sbe + execCli_ $ + [ eraString, "genesis", "create-testnet-data" , "--spec-shelley", inputGenesisShelleyFp , "--spec-alonzo", inputGenesisAlonzoFp , "--spec-conway", inputGenesisConwayFp @@ -171,23 +173,18 @@ createSPOGenesisAndFiles nPoolNodes nDelReps maxSupply sbe shelleyGenesis , "--pools", show nPoolNodes , "--total-supply", show maxSupply -- Half of this will be delegated, see https://github.com/IntersectMBO/cardano-cli/pull/874 , "--stake-delegators", show numStakeDelegators - , "--utxo-keys", show numSeededUTxOKeys - , "--drep-keys", show nDelReps - , "--start-time", DTC.formatIso8601 startTime + , "--utxo-keys", show numSeededUTxOKeys] + <> monoidForEraInEon @ConwayEraOnwards era (const ["--drep-keys", show nDelReps]) + <> [ "--start-time", DTC.formatIso8601 startTime , "--out-dir", tempAbsPath ] -- Remove the input files. We don't need them anymore, since create-testnet-data wrote new versions. forM_ [inputGenesisShelleyFp, inputGenesisAlonzoFp, inputGenesisConwayFp] (liftIO . System.removeFile) - -- Move all genesis related files - genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath "byron" - files <- H.listDirectory tempAbsPath forM_ files H.note - H.renameFile (tempAbsPath "byron-gen-command" "genesis.json") (genesisByronDir "genesis.json") - return genesisShelleyDir where genesisInputFilepath e = "genesis-input." <> anyEraToString (AnyCardanoEra e) <> ".json" diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index fc8beba1cfd..fdfb5c06fa4 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -290,7 +290,7 @@ defaultYamlConfig = , ("EnableLogging", Aeson.Bool True) -- Genesis filepaths - , ("ByronGenesisFile", "byron/genesis.json") + , ("ByronGenesisFile", genesisPath ByronEra) , ("ShelleyGenesisFile", genesisPath ShelleyEra) , ("AlonzoGenesisFile", genesisPath AlonzoEra) , ("ConwayGenesisFile", genesisPath ConwayEra) @@ -545,9 +545,9 @@ plutusV3Script :: Text plutusV3Script = "{ \"type\": \"PlutusScriptV3\", \"description\": \"\", \"cborHex\": \"46450101002499\" }" --- | Created via: cabal run plutus-scripts-bench -- print SupplementalDatum -o supplemental-datum.plutus -plutusV3SupplementalDatumScript :: Text -plutusV3SupplementalDatumScript = +-- | Created via: cabal run plutus-scripts-bench -- print SupplementalDatum -o supplemental-datum.plutus +plutusV3SupplementalDatumScript :: Text +plutusV3SupplementalDatumScript = "{ \"type\": \"PlutusScriptV3\", \"description\": \"\", \"cborHex\": \"590e72590e6f01000032323322332233223232323232323232323232323225335533535353232325335333573466e1d200000201301213232323232333222123330010040030023232325335333573466e1d200000201b01a1323232323232323232323232323232323333333333332333233233222222222222222212333333333333333300101101000f00e00d00c00b00a00900800700600500400300230013574202860026ae8404cc0948c8c8c94cd4ccd5cd19b87480000080c40c04cc8848cc00400c008c074d5d080098029aba135744002260589201035054310035573c0046aae74004dd5000998128009aba101123232325335333573466e1d200000203002f13232333322221233330010050040030023232325335333573466e1d2000002035034133221233001003002302e357420026605e4646464a66a666ae68cdc3a4000004072070264244600400660646ae8400454cd4ccd5cd19b87480080080e40e04c8ccc888488ccc00401401000cdd69aba1002375a6ae84004dd69aba1357440026ae880044c0d12401035054310035573c0046aae74004dd50009aba135744002260609201035054310035573c0046aae74004dd51aba1003300735742004646464a66a666ae68cdc3a400000406a068224440062a66a666ae68cdc3a400400406a068264244460020086eb8d5d08008a99a999ab9a3370e900200101a81a099091118010021aba1001130304901035054310035573c0046aae74004dd51aba10013302c75c6ae84d5d10009aba200135744002260569201035054310035573c0046aae74004dd50009bad3574201e60026ae84038c008c009d69981180a9aba100c33302702475a6ae8402cc8c8c94cd4ccd5cd19b87480000080b80b44cc8848cc00400c008c8c8c94cd4ccd5cd19b87480000080c40c04cc8848cc00400c008cc09dd69aba10013026357426ae880044c0b1241035054310035573c0046aae74004dd51aba10013232325335333573466e1d20000020310301332212330010030023302775a6ae84004c098d5d09aba20011302c491035054310035573c0046aae74004dd51aba13574400226052921035054310035573c0046aae74004dd51aba100a3302375c6ae84024ccc09c8c8c8c94cd4ccd5cd19b87480000080bc0b84c84888888c01401cdd71aba100115335333573466e1d200200202f02e13212222223002007301b357420022a66a666ae68cdc3a400800405e05c2642444444600600e60506ae8400454cd4ccd5cd19b87480180080bc0b84cc884888888cc01802001cdd69aba10013019357426ae8800454cd4ccd5cd19b87480200080bc0b84c84888888c00401cc068d5d08008a99a999ab9a3370e9005001017817099910911111198020040039bad3574200260306ae84d5d1000898152481035054310035573c0046aae74004dd500080f9aba10083300201f3574200e6eb8d5d080319981380b198138111191919299a999ab9a3370e9000001017817089110010a99a999ab9a3370e9001001017817089110008a99a999ab9a3370e900200101781708911001898152481035054310035573c0046aae74004dd50009aba1005330230143574200860026ae8400cc004d5d09aba2003302475a604aeb8d5d10009aba2001357440026ae88004d5d10009aba2001357440026ae88004d5d10009aba2001357440026ae88004d5d10009aba200113016491035054310035573c0046aae74004dd51aba10063574200a646464a66a666ae68cdc3a40000040360342642444444600a00e6eb8d5d08008a99a999ab9a3370e900100100d80d0999109111111980100400398039aba10013301500f357426ae8800454cd4ccd5cd19b874801000806c0684c84888888c00c01cc050d5d08008a99a999ab9a3370e900300100d80d099910911111198030040039bad35742002600a6ae84d5d10008a99a999ab9a3370e900400100d80d0990911111180080398031aba100115335333573466e1d200a00201b01a13322122222233004008007375a6ae84004c010d5d09aba2001130164901035054310035573c0046aae74004dd51aba13574400a4646464a66a666ae68cdc3a4000004036034264666444246660020080060046eb4d5d0801180a9aba10013232325335333573466e1d200000201f01e1323332221222222233300300a0090083301a017357420046ae84004cc069d71aba1357440026ae8800454cd4ccd5cd19b874800800807c0784cc8848888888cc01c024020cc064058d5d0800991919299a999ab9a3370e90000010110108999109198008018011bad357420026eb4d5d09aba20011301d491035054310035573c0046aae74004dd51aba1357440022a66a666ae68cdc3a400800403e03c266442444444466004012010666036030eb4d5d08009980cbae357426ae8800454cd4ccd5cd19b874801800807c0784c848888888c010020cc064058d5d08008a99a999ab9a3370e900400100f80f09919199991110911111119998008058050048041980d80c1aba10033301901a3574200466603a034eb4d5d08009a991919299a999ab9a3370e90000010120118998149bad357420026eb4d5d09aba20011301f4901035054310035573c0046aae74004dd51aba135744002446602a0040026ae88004d5d10008a99a999ab9a3370e900500100f80f0999109111111198028048041980c80b1aba10013232325335333573466e1d200000202202113301c75c6ae840044c075241035054310035573c0046aae74004dd51aba1357440022a66a666ae68cdc3a401800403e03c22444444400c26034921035054310035573c0046aae74004dd51aba1357440026ae880044c059241035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100d00c899910911111111111980280680618099aba10013301475a6ae84d5d10008a99a999ab9a3370e900100100d00c899910911111111111980100680618099aba10013301475a6ae84d5d10008a9919a999ab9a3370e900200180d80d0999109111111111119805006806180a1aba10023001357426ae8800854cd4ccd5cd19b874801800c06c0684c8ccc888488888888888ccc018038034030c054d5d080198011aba1001375a6ae84d5d10009aba200215335333573466e1d200800301b01a133221222222222223300700d00c3014357420046eb4d5d09aba200215335333573466e1d200a00301b01a132122222222222300100c3014357420042a66a666ae68cdc3a4018006036034266442444444444446600601a01860286ae84008dd69aba1357440042a66a666ae68cdc3a401c006036034266442444444444446601201a0186eb8d5d08011bae357426ae8800854cd4ccd5cd19b874804000c06c0684cc88488888888888cc020034030dd71aba1002375a6ae84d5d10010a99a999ab9a3370e900900180d80d0999109111111111119805806806180a1aba10023014357426ae8800854cd4ccd5cd19b874805000c06c0684c8488888888888c010030c050d5d08010980b2481035054310023232325335333573466e1d200000201e01d13212223003004375c6ae8400454c8cd4ccd5cd19b874800800c07c0784c84888c004010c004d5d08010a99a999ab9a3370e900200180f80f099910911198010028021bae3574200460026ae84d5d10010980d2481035054310023232325335333573466e1d200000202202113212223003004301b357420022a66a666ae68cdc3a4004004044042224440042a66a666ae68cdc3a4008004044042224440022603a921035054310035573c0046aae74004dd50009aab9e00235573a0026ea8004d55cf0011aab9d00137540024646464a66a666ae68cdc3a40000040320302642444600600860246ae8400454cd4ccd5cd19b87480080080640604c84888c008010c048d5d08008a99a999ab9a3370e900200100c80c099091118008021bae3574200226028921035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100c00b8999109198008018011bae357420026eb4d5d09aba200113013491035054310035573c0046aae74004dd50009aba20011300e491035054310035573c0046aae74004dd50009110019111111111111111180f0031080888078a4c26016921035054350030142225335333573466e1d20000010110101300c491035054330015335333573466e20005200001101013300333702900000119b81480000044c8cc8848cc00400c008cdc200180099b840020013300400200130132225335333573466e1d200000101000f10021330030013370c00400240024646464a66a666ae68cdc3a400000401e01c201c2a66a666ae68cdc3a400400401e01c201e260149201035054310035573c0046aae74004dd500091191919299a999ab9a3370e9000001007807089110010a99a999ab9a3370e90010010078070990911180180218029aba100115335333573466e1d200400200f00e112220011300a4901035054310035573c0046aae74004dd50009191919299a999ab9a3370e90000010068060999109198008018011bae357420026eb4d5d09aba200113008491035054310035573c0046aae74004dd5000919118011bac001300f2233335573e002401c466a01a60086ae84008c00cd5d10010041191919299a999ab9a3370e900000100580509909118010019bae357420022a66a666ae68cdc3a400400401601426424460020066eb8d5d0800898032481035054310035573c0046aae74004dd500091191919299a999ab9a3370e90010010058050a8070a99a999ab9a3370e90000010058050980798029aba1001130064901035054310035573c0046aae74004dd5000919319ab9c00100322322300237560026018446666aae7c004802c8c8cd402ccc03cc018d55ce80098029aab9e0013004357440066ae8400801448004c020894cd40045401c884d4008894cd4ccd5cd19b8f488120ee155ace9c40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e25000020080071300c001130060031220021220011220021221223300100400321223002003112200122123300100300223230010012300223300200200101\" }" diff --git a/cardano-testnet/src/Testnet/Ping.hs b/cardano-testnet/src/Testnet/Ping.hs index c92a9704e82..b70a08e2989 100644 --- a/cardano-testnet/src/Testnet/Ping.hs +++ b/cardano-testnet/src/Testnet/Ping.hs @@ -33,11 +33,11 @@ import Data.Either import Data.IORef import qualified Data.List as L import Data.Word (Word32) +import qualified Network.Mux as Mux import Network.Mux.Bearer (MakeBearer (..), makeSocketBearer) import Network.Mux.Timeout (TimeoutFn, withTimeoutSerial) import Network.Mux.Types (MiniProtocolDir (InitiatorDir), MiniProtocolNum (..), RemoteClockModel (RemoteClockModel), SDU (..), SDUHeader (..)) -import qualified Network.Mux as Mux import qualified Network.Mux.Types as Mux import Network.Socket (AddrInfo (..), PortNumber, StructLinger (..)) import qualified Network.Socket as Socket @@ -68,7 +68,7 @@ pingNode :: MonadIO m pingNode networkMagic sprocket = liftIO $ bracket (Socket.socket (Socket.addrFamily peer) Socket.Stream Socket.defaultProtocol) Socket.close - (\sd -> withTimeoutSerial $ \timeoutfn -> do + (\sd -> handle (pure . Left . PceException) $ withTimeoutSerial $ \timeoutfn -> do when (Socket.addrFamily peer /= Socket.AF_UNIX) $ do Socket.setSocketOption sd Socket.NoDelay 1 Socket.setSockOpt sd Socket.Linger @@ -195,6 +195,8 @@ data PingClientError !String -- ^ peer string ![NodeVersion] -- ^ requested versions ![NodeVersion] -- ^ received node versions + | PceException + !SomeException instance Error PingClientError where prettyError = \case @@ -204,5 +206,6 @@ instance Error PingClientError where [ pretty peerStr <+> "Version negotiation error: No overlapping versions with" <+> viaShow requestedVersions , "Received versions:" <+> viaShow receivedVersions ] + PceException exception -> "An unknown exception occurred:" <+> pretty (displayException exception) diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index 96055c7daad..8e3f9b414b5 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -117,7 +117,7 @@ startNode -- ^ The command to execute to start the node. -- @--socket-path@, @--port@, and @--host-addr@ gets added automatically. -> ExceptT NodeStartFailure m TestnetNode -startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do +startNode tp node ipv4 port _testnetMagic nodeCmd = GHC.withFrozenCallStack $ do let tempBaseAbsPath = makeTmpBaseAbsPath tp socketDir = makeSocketDir tp logDir = makeLogDir tp @@ -175,10 +175,11 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do -- Wait for socket to be created eSprocketError <- - Ping.waitForSprocket - 120 -- timeout - 0.2 -- check interval - sprocket + H.evalIO $ + Ping.waitForSprocket + 120 -- timeout + 0.2 -- check interval + sprocket -- If we do have anything on stderr, fail. stdErrContents <- liftIO $ IO.readFile nodeStderrFile @@ -193,8 +194,9 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do $ hoistEither eSprocketError -- Ping node and fail on error - Ping.pingNode (fromIntegral testnetMagic) sprocket - >>= (firstExceptT (NodeExecutableError . ("Ping error:" <+>) . prettyError) . hoistEither) + -- FIXME: pinging of the node is broken now, has the protocol changed? + -- Ping.pingNode (fromIntegral testnetMagic) sprocket + -- >>= (firstExceptT (NodeExecutableError . ("Ping error:" <+>) . prettyError) . hoistEither) pure $ TestnetNode { nodeName = node diff --git a/cardano-testnet/src/Testnet/Start/Byron.hs b/cardano-testnet/src/Testnet/Start/Byron.hs index a90116457e4..624cc0d9d6a 100644 --- a/cardano-testnet/src/Testnet/Start/Byron.hs +++ b/cardano-testnet/src/Testnet/Start/Byron.hs @@ -7,8 +7,6 @@ module Testnet.Start.Byron ( createByronGenesis - , createByronUpdateProposal - , createByronUpdateProposalVote , byronDefaultGenesisOptions ) where @@ -67,34 +65,3 @@ createByronGenesis testnetMagic' startTime testnetOptions pParamFp genOutputDir , "--genesis-output-dir", genOutputDir ] -createByronUpdateProposal - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => Int -> String -> String -> Int -> m () -createByronUpdateProposal testnetMagic' signingKeyFp updateProposalFp ptclMajorVersion = - withFrozenCallStack $ execCli_ - [ "byron", "governance", "create-update-proposal" - , "--filepath", updateProposalFp - , "--testnet-magic", show testnetMagic' - , "--signing-key", signingKeyFp - , "--protocol-version-major", show ptclMajorVersion - , "--protocol-version-minor", "0" - , "--protocol-version-alt", "0" - , "--application-name", "cardano-sl" - , "--software-version-num", "1" - , "--system-tag", "linux" - , "--installer-hash", "0" - ] - -createByronUpdateProposalVote - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => Int -> String -> String -> String -> m () -createByronUpdateProposalVote testnetMagic' updateProposalFp signingKey outputFp = - withFrozenCallStack $ execCli_ - [ "byron", "governance", "create-proposal-vote" - , "--proposal-filepath", updateProposalFp - , "--testnet-magic", show testnetMagic' - , "--signing-key", signingKey - , "--vote-yes" - , "--output-filepath", outputFp - ] - diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 7609da32952..3c3f6080130 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -54,7 +54,6 @@ import qualified GHC.Stack as GHC import qualified System.Directory as IO import System.FilePath (()) import qualified System.Info as OS -import Text.Printf (printf) import Testnet.Components.Configuration import qualified Testnet.Defaults as Defaults @@ -62,7 +61,6 @@ import Testnet.Filepath import Testnet.Process.Run (execCli', execCli_, mkExecConfig) import Testnet.Property.Assert (assertChainExtended, assertExpectedSposInLedgerState) import Testnet.Runtime as TR -import qualified Testnet.Start.Byron as Byron import Testnet.Start.Types import Testnet.Types as TR hiding (shelleyGenesis) @@ -130,11 +128,7 @@ getDefaultShelleyGenesis asbe maxSupply opts = do -- | Setup a number of credentials and nodes (SPOs and relays), like this: -- --- > ├── byron --- > │   └── genesis.json -- > ├── byron-gen-command --- > │   ├── delegate-keys.00{1,2}.key --- > │   ├── delegation-cert.00{1,2}.json -- > │   └── genesis-keys.00{0,1,2}.key -- > ├── delegate-keys -- > │   ├── delegate{1,2,3} @@ -187,6 +181,7 @@ getDefaultShelleyGenesis asbe maxSupply opts = do -- > │   │   └── utxo.{addr,skey,vkey} -- > │   └── README.md -- > ├── alonzo-genesis.json +-- > ├── byron.genesis.json -- > ├── byron.genesis.spec.json -- > ├── configuration.yaml -- > ├── conway-genesis.json @@ -215,7 +210,6 @@ cardanoTestnet , cardanoNumDReps=nDReps , cardanoNodes } = testnetOptions - startTime = sgSystemStart shelleyGenesis testnetMagic = fromIntegral $ sgNetworkMagic shelleyGenesis nPools = cardanoNumPools testnetOptions AnyShelleyBasedEra sbe <- pure asbe @@ -231,16 +225,6 @@ cardanoTestnet -- See all of the ad hoc file creation/renaming/dir creation etc below. H.failMessage GHC.callStack "Specifying node configuration files per node not supported yet." - H.lbsWriteFile (tmpAbsPath "byron.genesis.spec.json") - . encode $ Defaults.defaultByronProtocolParamsJsonValue - - Byron.createByronGenesis - testnetMagic - startTime - Byron.byronDefaultGenesisOptions - (tmpAbsPath "byron.genesis.spec.json") - (tmpAbsPath "byron-gen-command") - -- Write specification files. Those are the same as the genesis files -- used for launching the nodes, but omitting the content regarding stake, utxos, etc. -- They are used by benchmarking: as templates to CLI commands, @@ -296,16 +280,10 @@ cardanoTestnet let portNumbers = snd <$> portNumbersWithNodeOptions -- Byron related - forM_ (zip [1..] portNumbersWithNodeOptions) $ \(i, (nodeOptions, portNumber)) -> do - let iStr = printf "%03d" (i - 1) - nodeDataDir = tmpAbsPath Defaults.defaultNodeDataDir i - nodePoolKeysDir = tmpAbsPath Defaults.defaultSpoKeysDir i + forM_ (zip [1..] portNumbersWithNodeOptions) $ \(i, (_nodeOptions, portNumber)) -> do + let nodeDataDir = tmpAbsPath Defaults.defaultNodeDataDir i H.evalIO $ IO.createDirectoryIfMissing True nodeDataDir H.writeFile (nodeDataDir "port") (show portNumber) - when (isSpoNodeOptions nodeOptions) $ do - H.renameFile (tmpAbsPath "byron-gen-command" "delegate-keys." <> iStr <> ".key") (nodePoolKeysDir "byron-delegate.key") - H.renameFile (tmpAbsPath "byron-gen-command" "delegation-cert." <> iStr <> ".json") (nodePoolKeysDir "byron-delegation.cert") - -- Make Non P2P topology files forM_ (zip [1..] portNumbers) $ \(i, myPortNumber) -> do 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 837ca75a4e3..3ba4db33f7b 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 @@ -81,7 +81,7 @@ import qualified Hedgehog.Extras.Test.Golden as H -- | Test CLI queries -- Execute me with: --- @cabal test cardano-testnet-test --test-options '-p "/CliQueries/"'@ +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/CliQueries/"'@ -- If you want to recreate golden files, run the comment with -- RECREATE_GOLDEN_FILES=1 as its prefix hprop_cli_queries :: Property diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 0ef209cce41..cc60d11aa78 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -160,6 +160,9 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co , "--tx-file", stakeCertTxSignedFp ] + -- make sure that stake registration cert gets into a block + _ <- waitForBlocks epochStateView 1 + minGovActDeposit <- getMinGovActionDeposit epochStateView ceo ccColdKeys <- H.noteShowM $ diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs index 6107805897a..69563fa1372 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs @@ -125,6 +125,9 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te , "--tx-file", stakeCertTxSignedFp ] + -- make sure that stake registration cert gets into a block + _ <- waitForBlocks epochStateView 1 + -- Create a proposal (governanceActionTxId, _governanceActionIndex) <- makeActivityChangeProposal execConfig epochStateView ceo (baseDir "proposal") diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index 9c60c7707ae..dd8b3645b12 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -134,6 +134,9 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem , "--tx-file", stakeCertTxSignedFp ] + -- make sure that stake registration cert gets into a block + _ <- waitForBlocks epochStateView 1 + -- Create info action proposal void $ execCli' execConfig diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs index a86c447b519..43c101d428e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs @@ -126,6 +126,8 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs , "--tx-file", stakeCertTxSignedFp ] + -- make sure that stake registration cert gets into a block + _ <- waitForBlocks epochStateView 1 let propVotes :: [(String, Int)] propVotes = mkVotes [(1, "yes")] 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 773b85d24fa..e7ada7b0699 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 @@ -91,13 +91,15 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H H.lbsWriteFile (tempAbsPath' "byron.genesis.spec.json") . encode $ defaultByronProtocolParamsJsonValue + let byronGenesisOutputDir = tempAbsPath' "byron" + startTime <- H.noteShowIO DTC.getCurrentTime createByronGenesis testnetMagic' startTime byronDefaultGenesisOptions (tempAbsPath' "byron.genesis.spec.json") - (tempAbsPath' "byron") + byronGenesisOutputDir shelleyDir <- H.createDirectoryIfMissing $ tempAbsPath' "shelley" @@ -118,8 +120,9 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H , "--start-time", formatIso8601 startTime ] - byronGenesisHash <- getByronGenesisHash $ tempAbsPath' "byron/genesis.json" + byronGenesisHash <- getByronGenesisHash $ byronGenesisOutputDir "genesis.json" -- Move the files to the paths expected by 'defaultYamlHardforkViaConfig' below + H.renameFile (byronGenesisOutputDir "genesis.json") (tempAbsPath' defaultGenesisFilepath ByronEra) H.renameFile (tempAbsPath' "shelley/genesis.json") (tempAbsPath' defaultGenesisFilepath ShelleyEra) H.renameFile (tempAbsPath' "shelley/genesis.alonzo.json") (tempAbsPath' defaultGenesisFilepath AlonzoEra) H.renameFile (tempAbsPath' "shelley/genesis.conway.json") (tempAbsPath' defaultGenesisFilepath ConwayEra) diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json index ff31fb08fd1..a91b4167457 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json @@ -370,237 +370,303 @@ 1 ], "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, @@ -654,203 +720,35 @@ }, "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, - "stakePoolTargetNum": 100, - "treasuryCut": 0.1, - "txFeeFixed": 0, - "txFeePerByte": 1, - "utxoCostPerByte": 4310 - }, - "futurePParams": { - "tag": "NoPParamsUpdate" - }, - "nextRatifyState": { - "enactedGovActions": [], - "expiredGovActions": [], - "nextEnactState": { - "committee": { - "members": {}, - "threshold": 0 - }, - "constitution": { - "anchor": { - "dataHash": "0000000000000000000000000000000000000000000000000000000000000000", - "url": "" - } - }, - "curPParams": { - "collateralPercentage": 150, - "committeeMaxTermLength": 200, - "committeeMinSize": 0, - "costModels": { - "PlutusV1": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 57996947, - 18975, - 10 - ], - "PlutusV2": [ + "stakePoolTargetNum": 100, + "treasuryCut": 0.1, + "txFeeFixed": 0, + "txFeePerByte": 1, + "utxoCostPerByte": 4310 + }, + "futurePParams": { + "tag": "NoPParamsUpdate" + }, + "nextRatifyState": { + "enactedGovActions": [], + "expiredGovActions": [], + "nextEnactState": { + "committee": { + "members": {}, + "threshold": 0 + }, + "constitution": { + "anchor": { + "dataHash": "0000000000000000000000000000000000000000000000000000000000000000", + "url": "" + } + }, + "curPParams": { + "collateralPercentage": 150, + "committeeMaxTermLength": 200, + "committeeMinSize": 0, + "costModels": { + "PlutusV1": [ 205665, 812, 1, @@ -984,10 +882,6 @@ 0, 1, 1, - 1159724, - 392670, - 0, - 2, 806990, 30482, 4, @@ -1015,260 +909,498 @@ 43357, 32, 32247, - 32, - 38314, - 32, - 35892428, - 10, - 9462713, - 1021, - 10, - 38887044, - 32947, - 10, - 1292075, - 24469, - 74, - 0, - 1, - 936157, - 49601, - 237, - 0, - 1 - ], - "PlutusV3": [ - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, + 32, + 38314, + 32, + 57996947, + 18975, + 10 + ], + "PlutusV2": [ + 205665, + 812, + 1, + 1, + 1000, + 571, 0, + 1, + 1000, + 24177, + 4, + 1, + 1000, + 32, + 117366, + 10475, + 4, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 100, + 100, + 23000, + 100, + 19537, + 32, + 175354, + 32, + 46417, + 4, + 221973, + 511, 0, + 1, + 89141, + 32, + 497525, + 14068, + 4, + 2, + 196500, + 453240, + 220, 0, + 1, + 1, + 1000, + 28662, + 4, + 2, + 245000, + 216773, + 62, + 1, + 1060367, + 12586, + 1, + 208512, + 421, + 1, + 187000, + 1000, + 52998, + 1, + 80436, + 32, + 43249, + 32, + 1000, + 32, + 80556, + 1, + 57667, + 4, + 1000, + 10, + 197145, + 156, + 1, + 197145, + 156, + 1, + 204924, + 473, + 1, + 208896, + 511, + 1, + 52467, + 32, + 64832, + 32, + 65493, + 32, + 22558, + 32, + 16563, + 32, + 76511, + 32, + 196500, + 453240, + 220, 0, + 1, + 1, + 69522, + 11687, 0, + 1, + 60091, + 32, + 196500, + 453240, + 220, 0, + 1, + 1, + 196500, + 453240, + 220, 0, + 1, + 1, + 1159724, + 392670, 0, + 2, + 806990, + 30482, + 4, + 1927926, + 82523, + 4, + 265318, 0, + 4, 0, + 85931, + 32, + 205665, + 812, + 1, + 1, + 41182, + 32, + 212342, + 32, + 31220, + 32, + 32696, + 32, + 43357, + 32, + 32247, + 32, + 38314, + 32, + 35892428, + 10, + 9462713, + 1021, + 10, + 38887044, + 32947, + 10, + 1292075, + 24469, + 74, 0, + 1, + 936157, + 49601, + 237, 0, + 1 + ], + "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, @@ -1695,237 +1827,303 @@ 1 ], "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, @@ -1979,189 +2177,21 @@ }, "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, - "stakePoolTargetNum": 100, - "treasuryCut": 0.1, - "txFeeFixed": 0, - "txFeePerByte": 1, - "utxoCostPerByte": 4310 - } - }, - "ratificationDelayed": false - }, - "previousPParams": { - "collateralPercentage": 150, - "committeeMaxTermLength": 200, - "committeeMinSize": 0, - "costModels": { - "PlutusV1": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 57996947, - 18975, - 10 - ], - "PlutusV2": [ + "stakePoolTargetNum": 100, + "treasuryCut": 0.1, + "txFeeFixed": 0, + "txFeePerByte": 1, + "utxoCostPerByte": 4310 + } + }, + "ratificationDelayed": false + }, + "previousPParams": { + "collateralPercentage": 150, + "committeeMaxTermLength": 200, + "committeeMinSize": 0, + "costModels": { + "PlutusV1": [ 205665, 812, 1, @@ -2295,10 +2325,6 @@ 0, 1, 1, - 1159724, - 392670, - 0, - 2, 806990, 30482, 4, @@ -2329,257 +2355,495 @@ 32, 38314, 32, - 35892428, - 10, - 9462713, - 1021, - 10, - 38887044, - 32947, - 10, - 1292075, - 24469, - 74, - 0, - 1, - 936157, - 49601, - 237, - 0, - 1 + 57996947, + 18975, + 10 ], - "PlutusV3": [ - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, + "PlutusV2": [ + 205665, + 812, + 1, + 1, + 1000, + 571, 0, + 1, + 1000, + 24177, + 4, + 1, + 1000, + 32, + 117366, + 10475, + 4, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 23000, + 100, + 100, + 100, + 23000, + 100, + 19537, + 32, + 175354, + 32, + 46417, + 4, + 221973, + 511, 0, + 1, + 89141, + 32, + 497525, + 14068, + 4, + 2, + 196500, + 453240, + 220, 0, + 1, + 1, + 1000, + 28662, + 4, + 2, + 245000, + 216773, + 62, + 1, + 1060367, + 12586, + 1, + 208512, + 421, + 1, + 187000, + 1000, + 52998, + 1, + 80436, + 32, + 43249, + 32, + 1000, + 32, + 80556, + 1, + 57667, + 4, + 1000, + 10, + 197145, + 156, + 1, + 197145, + 156, + 1, + 204924, + 473, + 1, + 208896, + 511, + 1, + 52467, + 32, + 64832, + 32, + 65493, + 32, + 22558, + 32, + 16563, + 32, + 76511, + 32, + 196500, + 453240, + 220, 0, + 1, + 1, + 69522, + 11687, 0, + 1, + 60091, + 32, + 196500, + 453240, + 220, 0, + 1, + 1, + 196500, + 453240, + 220, 0, + 1, + 1, + 1159724, + 392670, 0, + 2, + 806990, + 30482, + 4, + 1927926, + 82523, + 4, + 265318, 0, + 4, 0, + 85931, + 32, + 205665, + 812, + 1, + 1, + 41182, + 32, + 212342, + 32, + 31220, + 32, + 32696, + 32, + 43357, + 32, + 32247, + 32, + 38314, + 32, + 35892428, + 10, + 9462713, + 1021, + 10, + 38887044, + 32947, + 10, + 1292075, + 24469, + 74, 0, + 1, + 936157, + 49601, + 237, 0, + 1 + ], + "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json index b66a0bee7ee..f5a86e40d9f 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json @@ -359,237 +359,303 @@ 1 ], "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt index b66a0bee7ee..f5a86e40d9f 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt @@ -359,237 +359,303 @@ 1 ], "PlutusV3": [ + 100788, + 420, + 1, + 1, + 1000, + 173, 0, + 1, + 1000, + 59957, + 4, + 1, + 11183, + 32, + 201305, + 8356, + 4, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 16000, + 100, + 100, + 100, + 16000, + 100, + 94375, + 32, + 132994, + 32, + 61462, + 4, + 72010, + 178, 0, + 1, + 22151, + 32, + 91189, + 769, + 4, + 2, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 1000, + 42921, + 4, + 2, + 24548, + 29498, + 38, + 1, + 898148, + 27279, + 1, + 51775, + 558, + 1, + 39184, + 1000, + 60594, + 1, + 141895, + 32, + 83150, + 32, + 15299, + 32, + 76049, + 1, + 13169, + 4, + 22100, + 10, + 28999, + 74, + 1, + 28999, + 74, + 1, + 43285, + 552, + 1, + 44749, + 541, + 1, + 33852, + 32, + 68246, + 32, + 72362, + 32, + 7243, + 32, + 7391, + 32, + 11546, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 90434, + 519, 0, + 1, + 74433, + 32, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 1, + 85848, + 123203, + 7305, + -900, + 1716, + 549, + 57, + 85848, 0, + 1, + 955506, + 213312, 0, + 2, + 270652, + 22588, + 4, + 1457325, + 64566, + 4, + 20467, + 1, + 4, 0, + 141992, + 32, + 100788, + 420, + 1, + 1, + 81663, + 32, + 59498, + 32, + 20142, + 32, + 24588, + 32, + 20744, + 32, + 25933, + 32, + 24623, + 32, + 43053543, + 10, + 53384111, + 14333, + 10, + 43574283, + 26308, + 10, + 16000, + 100, + 16000, + 100, + 962335, + 18, + 2780678, + 6, + 442008, + 1, + 52538055, + 3756, + 18, + 267929, + 18, + 76433006, + 8868, + 18, + 52948122, + 18, + 1995836, + 36, + 3227919, + 12, + 901022, + 1, + 166917843, + 4307, + 36, + 284546, + 36, + 158221314, + 26549, + 36, + 74698472, + 36, + 333849714, + 1, + 254006273, + 72, + 2174038, + 72, + 2261318, + 64571, + 4, + 207616, + 8310, + 4, + 1293828, + 28716, + 63, 0, + 1, + 1006041, + 43623, + 251, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 100181, + 726, + 719, 0, + 1, + 107878, + 680, 0, + 1, + 95336, + 1, + 281145, + 18848, 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, 0, + 1, + 159378, + 8813, 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] }, "dRepActivity": 100, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.json.golden b/cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.json.golden index fa3deeabecf..fa4b52b60a8 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.json.golden +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.json.golden @@ -4,7 +4,7 @@ "contents": { "era": "ShelleyBasedEraConway", "error": [ - "ConwayUtxowFailure (UtxoFailure (ValueNotConservedUTxO (MaryValue (Coin 0) (MultiAsset (fromList []))) (MaryValue (Coin 15000003000000) (MultiAsset (fromList [])))))", + "ConwayUtxowFailure (UtxoFailure (ValueNotConservedUTxO (Mismatch {mismatchSupplied = MaryValue (Coin 0) (MultiAsset (fromList [])), mismatchExpected = MaryValue (Coin 15000003000000) (MultiAsset (fromList []))})))", "ConwayUtxowFailure (UtxoFailure (BadInputsUTxO (fromList [TxIn (TxId {unTxId = SafeHash \"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\"}) (TxIx {unTxIx = 0})])))" ], "kind": "ShelleyTxValidationError" From 8ab0d4fdfe3390d102cb4e7241d8ee0700ea4dd3 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 30 Dec 2024 10:03:49 +0100 Subject: [PATCH 48/79] cardano-testnet | fix golden tests --- .../files/golden/allegra_node_default_config.json | 2 +- .../files/golden/alonzo_node_default_config.json | 2 +- .../files/golden/babbage_node_default_config.json | 2 +- .../files/golden/conway_node_default_config.json | 2 +- .../files/golden/mary_node_default_config.json | 2 +- .../files/golden/shelley_node_default_config.json | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json index 44f32c29f37..3cc01116914 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json index 3ce2f6076d3..45181624ec0 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json index d7ea49aeff9..d4dfdc1df27 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json index 72ced6105f5..3193a968fb4 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json index 9327a0bab20..2bc931764a9 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json index c547576caf0..0cd055788ac 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json @@ -1,6 +1,6 @@ { "AlonzoGenesisFile": "alonzo-genesis.json", - "ByronGenesisFile": "byron/genesis.json", + "ByronGenesisFile": "byron-genesis.json", "ConwayGenesisFile": "conway-genesis.json", "EnableLogMetrics": false, "EnableLogging": true, From 93be5e9bb19a386fde593e59d1c54e39a0a9cf45 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 2 Jan 2025 17:04:21 +0100 Subject: [PATCH 49/79] Increase version bounds for ouroboros-network packages --- bench/locli/locli.cabal | 2 +- cardano-node/cardano-node.cabal | 8 ++++---- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 4 ++-- cardano-tracer/cardano-tracer.cabal | 2 +- trace-dispatcher/trace-dispatcher.cabal | 2 +- trace-forward/trace-forward.cabal | 2 +- 7 files changed, 11 insertions(+), 11 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index d63619ad50e..f47a5b68ea7 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -119,7 +119,7 @@ library , hashable , optparse-applicative-fork >= 0.18.1 , ouroboros-consensus - , ouroboros-network-api ^>= 0.11 + , ouroboros-network-api ^>= 0.12 , sop-core , split , sqlite-easy >= 1.1.0.1 diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 4ff933b5300..e66aa769962 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -183,17 +183,17 @@ library , lobemo-backend-trace-forwarder , mtl , network - , network-mux >= 0.4 + , network-mux >= 0.5 , nothunks , optparse-applicative-fork >= 0.18.1 , ouroboros-consensus ^>= 0.21 , ouroboros-consensus-cardano ^>= 0.20 , ouroboros-consensus-diffusion ^>= 0.18 , ouroboros-consensus-protocol - , ouroboros-network-api ^>= 0.11 - , ouroboros-network ^>= 0.18 + , ouroboros-network-api ^>= 0.12 + , ouroboros-network ^>= 0.19 , ouroboros-network-framework - , ouroboros-network-protocols ^>= 0.12 + , ouroboros-network-protocols ^>= 0.13 , prettyprinter , prettyprinter-ansi-terminal , psqueues diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 4e5f55e7cd4..36550180740 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.18 + , ouroboros-network ^>= 0.19 , ouroboros-network-protocols , prometheus >= 2.2.4 , servant diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 1005ac04414..fbd71f6ca41 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -49,7 +49,7 @@ library , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley , cardano-node - , cardano-ping ^>= 0.6 + , cardano-ping ^>= 0.7 , contra-tracer , containers , data-default-class @@ -70,7 +70,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.18 + , ouroboros-network ^>= 0.19 , ouroboros-network-api , prettyprinter , process diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index c505b64dbe0..3c2bc1f8f10 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -178,7 +178,7 @@ library , mime-mail , network-mux , optparse-applicative - , ouroboros-network ^>= 0.18 + , ouroboros-network ^>= 0.19 , ouroboros-network-api , ouroboros-network-framework , signal diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 968074f642f..4fcad535774 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -61,7 +61,7 @@ library , network , network-mux , optparse-applicative-fork - , ouroboros-network ^>= 0.18 + , ouroboros-network ^>= 0.19 , ouroboros-network-api , ouroboros-network-framework , serialise diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 5edc9a0e647..d294e5aaf3b 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -67,7 +67,7 @@ library , network-mux , ouroboros-network-api , singletons ^>= 3.0 - , ouroboros-network-framework ^>= 0.14 + , ouroboros-network-framework ^>= 0.15 , serialise , stm , text From ee19c79e4dc4372a81d16e883bf77832e230e6ec Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 2 Jan 2025 22:08:27 +0100 Subject: [PATCH 50/79] Use ekg-forward-0.8 --- cardano-tracer/cardano-tracer.cabal | 2 +- trace-dispatcher/trace-dispatcher.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 3c2bc1f8f10..78c8e651187 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -170,7 +170,7 @@ library , contra-tracer , directory , ekg-core - , ekg-forward >= 0.5 + , ekg-forward >= 0.8 , ekg-wai , extra , filepath diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 4fcad535774..dfdab693e00 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -56,7 +56,7 @@ library , deepseq , ekg-wai , ekg-core - , ekg-forward >= 0.5 + , ekg-forward >= 0.8 , hostname , network , network-mux From 7951c0b941ee38e2d7897872dd23fe40321cd029 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Thu, 5 Dec 2024 15:34:27 +0100 Subject: [PATCH 51/79] update new tracing default config --- .../Node/Tracing/DefaultTraceConfig.hs | 115 +++++++++--------- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 4 +- .../cardano/mainnet-config-new-tracing.json | 26 ++-- 3 files changed, 73 insertions(+), 72 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/DefaultTraceConfig.hs b/cardano-node/src/Cardano/Node/Tracing/DefaultTraceConfig.hs index e2f748e1604..95fb8f52ca3 100644 --- a/cardano-node/src/Cardano/Node/Tracing/DefaultTraceConfig.hs +++ b/cardano-node/src/Cardano/Node/Tracing/DefaultTraceConfig.hs @@ -11,62 +11,63 @@ import qualified Data.Map.Strict as Map defaultCardanoConfig :: TraceConfig defaultCardanoConfig = emptyTraceConfig { - tcOptions = Map.fromList - [([], - [ ConfSeverity (SeverityF (Just Notice)) -- Means Silence - , ConfDetail DNormal - , ConfBackend [Stdout MachineFormat - , EKGBackend - , Forwarder - ]]) + tcMetricsPrefix = Just "cardano.node.metrics." + , tcOptions = Map.fromList + [([], + [ ConfSeverity (SeverityF (Just Notice)) -- Means Silence + , ConfDetail DNormal + , ConfBackend [Stdout MachineFormat + , EKGBackend + , Forwarder + ]]) --- more important tracers going here - ,(["BlockFetch", "Decision"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["ChainDB"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["ChainSync", "Client"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "ConnectionManager", "Remote"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "Subscription", "DNS"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Startup", "DiffusionInit"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "ErrorPolicy"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Forge", "Loop"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Forge", "StateInfo"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "InboundGovernor", "Remote"], - [ ConfSeverity (SeverityF (Just Info))]) - -- includes ["Net", "InboundGovernor", "Remote", "Transition"] - ,(["Net", "Subscription", "IP"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "ErrorPolicy", "Local"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Mempool"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "Mux", "Remote"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Net", "PeerSelection"], - [ ConfSeverity (SeverityF (Just Info))]) - ,(["Resources"], - [ ConfSeverity (SeverityF (Just Info))]) - --- Limiters - ,(["ChainDB","AddBlockEvent","AddedBlockToQueue"], - [ ConfLimiter 2.0]) - ,(["ChainDB","AddBlockEvent","AddedBlockToVolatileDB"], - [ ConfLimiter 2.0]) - ,(["ChainDB","AddBlockEvent","AddBlockValidation", "ValidCandidate"], - [ ConfLimiter 2.0]) - ,(["ChainDB", "CopyToImmutableDBEvent", "CopiedBlockToImmutableDB"], - [ ConfLimiter 2.0]) - ,(["ChainSync","Client","DownloadedHeader"], - [ ConfLimiter 2.0]) - ,(["BlockFetch", "Client", "CompletedBlockFetch"], - [ ConfLimiter 2.0]) - ] + -- more important tracers going here + ,(["BlockFetch", "Decision"], + [ ConfSeverity (SeverityF Nothing)]) + ,(["ChainDB"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["ChainDB", "AddBlockEvent", "AddBlockValidation"], + [ ConfSeverity (SeverityF Nothing)]) + ,(["ChainSync", "Client"], + [ ConfSeverity (SeverityF (Just Warning))]) + ,(["Net", "ConnectionManager", "Remote"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "Subscription", "DNS"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Startup", "DiffusionInit"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "ErrorPolicy"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Forge", "Loop"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Forge", "StateInfo"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "InboundGovernor", "Remote"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "Subscription", "IP"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "ErrorPolicy", "Local"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Mempool"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "Mux", "Remote"], + [ ConfSeverity (SeverityF (Just Info))]) + ,(["Net", "InboundGovernor"], + [ ConfSeverity (SeverityF (Just Warning))]) + ,(["Net", "PeerSelection"], + [ ConfSeverity (SeverityF Nothing)]) + ,(["Resources"], + [ ConfSeverity (SeverityF Nothing)]) + -- Limiters + ,(["ChainDB","AddBlockEvent","AddedBlockToQueue"], + [ ConfLimiter 2.0]) + ,(["ChainDB","AddBlockEvent","AddedBlockToVolatileDB"], + [ ConfLimiter 2.0]) + ,(["ChainDB","AddBlockEvent","AddBlockValidation", "ValidCandidate"], + [ ConfLimiter 2.0]) + ,(["ChainDB", "CopyToImmutableDBEvent", "CopiedBlockToImmutableDB"], + [ ConfLimiter 2.0]) + ,(["BlockFetch", "Client", "CompletedBlockFetch"], + [ ConfLimiter 2.0]) + ] } diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 7a548bbb2f4..67a5d2c51ab 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -1011,7 +1011,7 @@ instance LogFormatting PeerSelectionCounters where instance MetaTrace PeerSelectionCounters where namespaceFor PeerSelectionCounters {} = Namespace [] ["Counters"] - severityFor (Namespace _ ["Counters"]) _ = Just Info + severityFor (Namespace _ ["Counters"]) _ = Just Debug severityFor _ _ = Nothing documentFor (Namespace _ ["Counters"]) = Just @@ -1437,7 +1437,7 @@ instance MetaTrace (ConnectionManager.Trace addr severityFor (Namespace _ ["ConnectionCleanup"]) _ = Just Debug severityFor (Namespace _ ["ConnectionTimeWait"]) _ = Just Debug severityFor (Namespace _ ["ConnectionTimeWaitDone"]) _ = Just Info - severityFor (Namespace _ ["ConnectionManagerCounters"]) _ = Just Info + severityFor (Namespace _ ["ConnectionManagerCounters"]) _ = Just Debug severityFor (Namespace _ ["State"]) _ = Just Info severityFor (Namespace _ ["UnexpectedlyFalseAssertion"]) _ = Just Error severityFor _ _ = Nothing diff --git a/configuration/cardano/mainnet-config-new-tracing.json b/configuration/cardano/mainnet-config-new-tracing.json index ee731016f3b..b137deb9c86 100644 --- a/configuration/cardano/mainnet-config-new-tracing.json +++ b/configuration/cardano/mainnet-config-new-tracing.json @@ -19,10 +19,10 @@ "TurnOnLogMetrics": true, "UseTraceDispatcher": true, "TraceOptionForwarder": null, - "TraceOptionMetricsPrefix": null, - "TraceOptionNodeName": null, - "TraceOptionPeerFrequency": 3000, - "TraceOptionResourceFrequency": 5000, + "TraceOptionMetricsPrefix": "cardano.node.metrics.", + "TraceOptionNodeName": "mainnetsingle", + "TraceOptionPeerFrequency": 2000, + "TraceOptionResourceFrequency": 1000, "TraceOptions": { "": { "backends": [ @@ -42,7 +42,7 @@ "severity": "Silence" }, "ChainSync.Client": { - "severity": "Info" + "severity": "Warning" }, "Net.ConnectionManager.Remote": { "severity": "Info" @@ -74,17 +74,20 @@ "Mempool": { "severity": "Info" }, - "Mempool.Synced": { - "severity": "Silence" - }, "Net.Mux.Remote": { "severity": "Info" }, + "Net.InboundGovernor": { + "severity": "Warning" + }, "Net.PeerSelection": { - "severity": "Info" + "severity": "Silence" + }, + "Net.ConnectionManager.Remote.ConnectionManagerCounters": { + "severity": "Silence" }, "Resources": { - "severity": "Info" + "severity": "Silence" }, "ChainDB.AddBlockEvent.AddedBlockToQueue": { "maxFrequency": 2.0 @@ -98,9 +101,6 @@ "ChainDB.CopyToImmutableDBEvent.CopiedBlockToImmutableDB": { "maxFrequency": 2.0 }, - "ChainSync.Client.DownloadedHeader": { - "maxFrequency": 2.0 - }, "BlockFetch.Client.CompletedBlockFetch": { "maxFrequency": 2.0 } From 112c0ca656ba489720bfdff3fce690ad54aaf58d Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Fri, 13 Dec 2024 17:38:35 +0100 Subject: [PATCH 52/79] cardano-node: default to new tracing in config --- cardano-node/src/Cardano/Node/Configuration/POM.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index be72eda35c1..f491a33e65f 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -296,7 +296,7 @@ instance FromJSON PartialNodeConfiguration where -- Logging parameters pncLoggingSwitch' <- v .:? "TurnOnLogging" .!= True pncLogMetrics <- Last <$> v .:? "TurnOnLogMetrics" - useTraceDispatcher <- v .:? "UseTraceDispatcher" .!= False + useTraceDispatcher <- v .:? "UseTraceDispatcher" .!= True pncTraceConfig <- if pncLoggingSwitch' then do partialTraceSelection <- parseJSON $ Object v From ff3f6007ae85da93bd22011ff7f57a4c6c4fa620 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Tue, 3 Dec 2024 11:00:34 +0000 Subject: [PATCH 53/79] cardano-node: Change fallback node name for trace-forwarding. --- cardano-node/src/Cardano/Node/Startup.hs | 13 +++--- .../Tracer/Handlers/Notifications/Send.hs | 10 ++-- .../Tracer/Handlers/Notifications/Utils.hs | 9 ++-- .../src/Cardano/Tracer/MetaTrace.hs | 12 +++++ cardano-tracer/src/Cardano/Tracer/Types.hs | 5 +- cardano-tracer/src/Cardano/Tracer/Utils.hs | 46 +++++++++++++++---- .../test/Cardano/Tracer/Test/Acceptor.hs | 7 +-- 7 files changed, 76 insertions(+), 26 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 420ff47d5ac..0e820aef149 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -247,13 +247,12 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do Just aName -> return aName Nothing -> do -- The user didn't specify node's name in the configuration. - -- In this case we should form node's name as "host:port", where 'host' and 'port' - -- are taken from '--host-addr' and '--port' CLI-parameters correspondingly. - let SocketConfig hostIPv4 hostIPv6 port _ = ncSocketConfig nc - hostName <- case (show <$> hostIPv6) <> (show <$> hostIPv4) of - Last (Just addr) -> return addr - Last Nothing -> getHostName - return . pack $ hostName <> maybe "" ((":" ++) . show) (getLast port) + -- In this case we should form node's name as "host_port", + -- where 'host' is the machine's host name and 'port' is taken + -- from the '--port' CLI-parameter. + let SocketConfig{ncNodePortNumber = port} = ncSocketConfig nc + hostName <- getHostName + return . pack $ hostName <> "_" <> show (getLast port) -- | This information is taken from 'BasicInfoShelleyBased'. It is required for -- 'cardano-tracer' service (particularly, for RTView). diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs index 391489ae37d..9e5a918858c 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs @@ -4,7 +4,8 @@ module Cardano.Tracer.Handlers.Notifications.Send ( makeAndSendNotification ) where -import Cardano.Logging (showT) +import Cardano.Logging (Trace, showT) +import Cardano.Tracer.MetaTrace (TracerTrace(..)) import Cardano.Tracer.Handlers.Notifications.Email import Cardano.Tracer.Handlers.Notifications.Types import Cardano.Tracer.Types @@ -23,20 +24,21 @@ import Data.Time.Clock (UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) makeAndSendNotification - :: EmailSettings + :: Trace IO TracerTrace + -> EmailSettings -> ConnectedNodesNames -> DataPointRequestors -> Lock -> TVar UTCTime -> EventsQueue -> IO () -makeAndSendNotification emailSettings connectedNodesNames dpRequestors +makeAndSendNotification tracer emailSettings connectedNodesNames dpRequestors currentDPLock lastTime eventsQueue = do events <- atomically $ nub <$> flushTBQueue eventsQueue let (nodeIds, tss) = unzip $ nub [(nodeId, ts) | Event nodeId ts _ _ <- events] unless (null nodeIds) $ do nodeNames <- - forM nodeIds $ askNodeNameRaw connectedNodesNames dpRequestors currentDPLock + forM nodeIds $ askNodeNameRaw tracer connectedNodesNames dpRequestors currentDPLock lastEventTime <- readTVarIO lastTime let onlyNewEvents = filter (\(Event _ ts _ _) -> ts > lastEventTime) events sendNotification emailSettings onlyNewEvents $ zip nodeIds nodeNames diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs index a471c1f4c87..aee4e91a755 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs @@ -7,11 +7,13 @@ module Cardano.Tracer.Handlers.Notifications.Utils , updateNotificationsPeriods ) where +import Cardano.Logging (Trace) import Cardano.Tracer.Handlers.Notifications.Send import Cardano.Tracer.Handlers.Notifications.Settings import Cardano.Tracer.Handlers.Notifications.Timer import Cardano.Tracer.Handlers.Notifications.Types import Cardano.Tracer.Handlers.Utils +import Cardano.Tracer.MetaTrace (TracerTrace(..)) import Cardano.Tracer.Types import Control.Concurrent.Extra (Lock) @@ -23,12 +25,13 @@ import Control.Monad.Extra (unlessM, whenJust) import qualified Data.Map.Strict as M initEventsQueues - :: Maybe FilePath + :: Trace IO TracerTrace + -> Maybe FilePath -> ConnectedNodesNames -> DataPointRequestors -> Lock -> IO EventsQueues -initEventsQueues rtvSD nodesNames dpReqs curDPLock = do +initEventsQueues tracer rtvSD nodesNames dpReqs curDPLock = do emailSettings <- readSavedEmailSettings rtvSD newTVarIO . M.fromList =<< @@ -39,7 +42,7 @@ initEventsQueues rtvSD nodesNames dpReqs curDPLock = do let mkEventQueue ident (evsS, evsP) = do evsQ <- newTBQueueIO 2000 evsT <- mkTimer - (makeAndSendNotification emailSettings nodesNames dpReqs curDPLock lastTime evsQ) evsS evsP + (makeAndSendNotification tracer emailSettings nodesNames dpReqs curDPLock lastTime evsQ) evsS evsP pure (ident, (evsQ, evsT)) settings <- readSavedEventsSettings rtvSD diff --git a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs index 9abd834affc..6289be39873 100644 --- a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs +++ b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs @@ -23,6 +23,7 @@ module Cardano.Tracer.MetaTrace import Cardano.Logging import Cardano.Logging.Resources import Cardano.Tracer.Configuration +import Cardano.Tracer.Types (NodeId(..), NodeName) import Data.Aeson hiding (Error) import qualified Data.Aeson as AE @@ -49,6 +50,9 @@ data TracerTrace | TracerInitStarted | TracerInitEventQueues | TracerInitDone + | TracerAddNewNodeIdMapping + { ttBimapping :: !(NodeId, NodeName) + } | TracerStartedLogRotator | TracerStartedPrometheus { ttPrometheusEndpoint :: !Endpoint @@ -107,6 +111,11 @@ instance ToJSON TracerTrace where TracerInitDone -> concatPairs [ "kind" .= txt "TracerInitDone" ] + TracerAddNewNodeIdMapping (NodeId nodeId, nodeName) -> concatPairs + [ "kind" .= txt "TracerAddNewNodeIdMapping" + , "nodeId" .= txt nodeId + , "nodeName" .= txt nodeName + ] TracerStartedLogRotator -> concatPairs [ "kind" .= txt "TracerStartedLogRotator" ] @@ -204,6 +213,7 @@ instance MetaTrace TracerTrace where namespaceFor TracerInitStarted = Namespace [] ["InitStart"] namespaceFor TracerInitEventQueues = Namespace [] ["EventQueues"] namespaceFor TracerInitDone = Namespace [] ["InitDone"] + namespaceFor TracerAddNewNodeIdMapping {} = Namespace [] ["AddNewNodeIdMapping"] namespaceFor TracerStartedLogRotator = Namespace [] ["StartedLogRotator"] namespaceFor TracerStartedPrometheus{} = Namespace [] ["StartedPrometheus"] namespaceFor TracerStartedMonitoring{} = Namespace [] ["StartedMonitoring"] @@ -225,6 +235,7 @@ instance MetaTrace TracerTrace where severityFor (Namespace _ ["InitStart"]) _ = Just Info severityFor (Namespace _ ["EventQueues"]) _ = Just Info severityFor (Namespace _ ["InitDone"]) _ = Just Info + severityFor (Namespace _ ["AddNewNodeIdMapping"]) _ = Just Info severityFor (Namespace _ ["StartedLogRotator"]) _ = Just Info severityFor (Namespace _ ["StartedPrometheus"]) _ = Just Info severityFor (Namespace _ ["StartedMonitoring"]) _ = Just Info @@ -250,6 +261,7 @@ instance MetaTrace TracerTrace where , Namespace [] ["InitStart"] , Namespace [] ["EventQueues"] , Namespace [] ["InitDone"] + , Namespace [] ["AddNewNodeIdMapping"] , Namespace [] ["StartedLogRotator"] , Namespace [] ["StartedPrometheus"] , Namespace [] ["StartedMonitoring"] diff --git a/cardano-tracer/src/Cardano/Tracer/Types.hs b/cardano-tracer/src/Cardano/Tracer/Types.hs index ccd095c4b37..312958649c0 100644 --- a/cardano-tracer/src/Cardano/Tracer/Types.hs +++ b/cardano-tracer/src/Cardano/Tracer/Types.hs @@ -16,8 +16,10 @@ module Cardano.Tracer.Types import Cardano.Tracer.Configuration + import Control.Concurrent.MVar (MVar) import Control.Concurrent.STM.TVar (TVar) +import Data.Aeson (ToJSON) import Data.Bimap (Bimap) import Data.Kind import Data.Map.Strict (Map) @@ -32,7 +34,8 @@ import Trace.Forward.Utils.DataPoint (DataPointRequestor) -- | Unique identifier of connected node, based on 'remoteAddress' from -- 'ConnectionId', please see 'ouroboros-network'. newtype NodeId = NodeId Text - deriving (Eq, Ord, Show) + deriving stock (Eq, Ord, Show) + deriving newtype (ToJSON) type NodeName = Text diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index 39ca20b3964..b7d0db78177 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} #if !defined(mingw32_HOST_OS) #define UNIX @@ -45,9 +46,12 @@ import Cardano.Node.Startup (NodeInfo (..)) import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Utils +import qualified Cardano.Logging as Tracer (traceWith) +import Cardano.Tracer.MetaTrace hiding (traceWith) import Cardano.Tracer.Types import Ouroboros.Network.Socket (ConnectionId (..)) + #if MIN_VERSION_base(4,18,0) -- Do not know why. import Control.Applicative (liftA3) @@ -59,7 +63,7 @@ import Control.Concurrent.Async (Concurrently(..)) import Control.Concurrent.Extra (Lock) import Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_) import Control.Concurrent.STM (atomically) -import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVarIO) +import Control.Concurrent.STM.TVar (modifyTVar', stateTVar, readTVarIO, newTVarIO) import Control.Exception (SomeAsyncException (..), SomeException, finally, fromException, try, tryJust) import Control.Monad (forM_) @@ -67,7 +71,8 @@ import Control.Monad.Extra (whenJustM) import "contra-tracer" Control.Tracer (stdoutTracer, traceWith) import Data.Word (Word32) import qualified Data.Bimap as BM -import Data.Foldable (traverse_) +import Data.Bimap (Bimap) +import Data.Foldable (for_, traverse_) import Data.Functor ((<&>), void) import Data.List.Extra (dropPrefix, dropSuffix, replace) import qualified Data.Map.Strict as Map @@ -167,16 +172,17 @@ askNodeName :: TracerEnv -> NodeId -> IO NodeName -askNodeName TracerEnv{teConnectedNodesNames, teDPRequestors, teCurrentDPLock} = - askNodeNameRaw teConnectedNodesNames teDPRequestors teCurrentDPLock +askNodeName TracerEnv{teTracer, teConnectedNodesNames, teDPRequestors, teCurrentDPLock} = + askNodeNameRaw teTracer teConnectedNodesNames teDPRequestors teCurrentDPLock askNodeNameRaw - :: ConnectedNodesNames + :: Trace IO TracerTrace + -> ConnectedNodesNames -> DataPointRequestors -> Lock -> NodeId -> IO NodeName -askNodeNameRaw connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anId) = do +askNodeNameRaw tracer connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anId) = do nodesNames <- readTVarIO connectedNodesNames case BM.lookup nodeId nodesNames of Just nodeName -> return nodeName @@ -186,8 +192,32 @@ askNodeNameRaw connectedNodesNames dpRequestors currentDPLock nodeId@(NodeId anI askDataPoint dpRequestors currentDPLock nodeId "NodeInfo" >>= \case Nothing -> return anId Just NodeInfo{niName} -> return $ if T.null niName then anId else niName - -- Store it in for the future using. - atomically . modifyTVar' connectedNodesNames $ BM.insert nodeId nodeName + + -- Overlapping node names are considered a misconfiguration. + -- However using the unique node ID as a fallback still ensures no + -- trace messages or metrics get lost. + maybePair <- atomically do + stateTVar connectedNodesNames \oldBimap -> + let + maybePair :: Maybe (NodeId, T.Text) + maybePair + | BM.member nodeId oldBimap + = Nothing + | BM.memberR nodeName oldBimap + = Just (nodeId, anId) + | otherwise + = Just (nodeId, nodeName) + + newBimap :: Bimap NodeId NodeName + newBimap = maybe oldBimap (\(k, v) -> BM.insert k v oldBimap) maybePair + + in (maybePair, newBimap) + + for_ @Maybe maybePair \pair -> + Tracer.traceWith tracer TracerAddNewNodeIdMapping + { ttBimapping = pair + } + return nodeName askNodeId diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs index f55d0a0ded4..a55b8eb08a1 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs @@ -51,8 +51,11 @@ launchAcceptorsSimple mode localSock dpName = do #endif currentLogLock <- newLock currentDPLock <- newLock + + tr <- mkTracerTracer $ SeverityF $ Just Warning + #if RTVIEW - eventsQueues <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock + eventsQueues <- initEventsQueues tr Nothing connectedNodesNames dpRequestors currentDPLock chainHistory <- initBlockchainHistory resourcesHistory <- initResourcesHistory @@ -61,8 +64,6 @@ launchAcceptorsSimple mode localSock dpName = do rtViewPageOpened <- newTVarIO False #endif - tr <- mkTracerTracer $ SeverityF $ Just Warning - registry <- newRegistry let tracerEnv :: TracerEnv From d4789289de091400a60e00329063d055ce766b98 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Thu, 21 Nov 2024 11:12:19 +0100 Subject: [PATCH 54/79] fix timing issue in forwarder initialization --- .../src/Cardano/Benchmarking/Tracer.hs | 9 +++-- cardano-node/src/Cardano/Node/Tracing/API.hs | 26 +++++++----- cardano-tracer/src/Cardano/Tracer/Utils.hs | 1 - .../src/Cardano/Logging/Forwarding.hs | 40 +++++++++++++------ 4 files changed, 51 insertions(+), 25 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index f52fe4db709..b6427c938da 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} @@ -123,8 +124,8 @@ initTxGenTracers mbForwarding = do prepareForwardingTracer = forM mbForwarding $ \(iomgr, networkId, tracerSocket) -> do let forwardingConf = fromMaybe defaultForwarder (tcForwarder initialTraceConfig) - (forwardSink :: ForwardSink TraceObject, dpStore) <- - initForwarding iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator) + (forwardSink :: ForwardSink TraceObject, dpStore, kickoffForwarder) <- + initForwardingDelayed iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator) -- we need to provide NodeInfo DataPoint, to forward generator's name -- to the acceptor application (for example, 'cardano-tracer'). @@ -132,8 +133,10 @@ initTxGenTracers mbForwarding = do dpt :: Trace IO DataPoint dpt = dataPointTracer dpStore nodeInfoTracer <- mkDataPointTracer dpt - prepareGenInfo >>= traceWith nodeInfoTracer + !genInfo <- prepareGenInfo + traceWith nodeInfoTracer genInfo + kickoffForwarder pure $ forwardTracer forwardSink prepareGenInfo :: IO NodeInfo diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index cf8f182411b..34f6f853e9a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -33,6 +33,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress) import Prelude +import Control.DeepSeq (deepseq) import "contra-tracer" Control.Tracer (traceWith) import "trace-dispatcher" Control.Tracer (nullTracer) import Data.Bifunctor (first) @@ -61,7 +62,15 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do (unConfigPath $ ncConfigFile nc) defaultCardanoConfig - tracers <- mkTracers trConfig + (kickoffForwarder, tracers) <- mkTracers trConfig + + -- The NodeInfo DataPoint needs to be fully evaluated and stored + -- before it is queried for the first time by cardano-tracer. + -- Hence, we delay initiating the forwarding connection. + nodeInfo <- prepareNodeInfo nc p trConfig =<< getCurrentTime + nodeInfo `deepseq` traceWith (nodeInfoTracer tracers) nodeInfo + + kickoffForwarder traceWith (nodeStateTracer tracers) NodeTracingOnlineConfiguring @@ -74,8 +83,6 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do nodeKernel (fromMaybe 2000 (tcPeerFrequency trConfig)) - now <- getCurrentTime - prepareNodeInfo nc p trConfig now >>= traceWith (nodeInfoTracer tracers) pure tracers where @@ -88,21 +95,21 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do -- We should initialize forwarding only if 'Forwarder' backend -- is presented in the node's configuration. - (fwdTracer, dpTracer) <- + (fwdTracer, dpTracer, kickoffForwarder) <- if forwarderBackendEnabled then do -- TODO: check if this is the correct way to use withIOManager - (forwardSink, dpStore) <- withIOManager $ \iomgr -> do + (forwardSink, dpStore, kickoffForwarder) <- withIOManager $ \iomgr -> do let tracerSocketMode = Just . first unFile =<< ncTraceForwardSocket nc forwardingConf = fromMaybe defaultForwarder (tcForwarder trConfig) - initForwarding iomgr forwardingConf networkMagic (Just ekgStore) tracerSocketMode - pure (forwardTracer forwardSink, dataPointTracer dpStore) + initForwardingDelayed iomgr forwardingConf networkMagic (Just ekgStore) tracerSocketMode + pure (forwardTracer forwardSink, dataPointTracer dpStore, kickoffForwarder) else -- Since 'Forwarder' backend isn't enabled, there is no forwarding. -- So we use nullTracers to ignore 'TraceObject's and 'DataPoint's. - pure (Trace nullTracer, Trace nullTracer) + pure (Trace nullTracer, Trace nullTracer, pure ()) - mkDispatchTracers + (,) kickoffForwarder <$> mkDispatchTracers nodeKernel stdoutTrace fwdTracer @@ -111,6 +118,7 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do trConfig p2pMode p + where forwarderBackendEnabled = (any (any checkForwarder) . Map.elems) $ tcOptions trConfig diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index b7d0db78177..e4c0af37525 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} #if !defined(mingw32_HOST_OS) #define UNIX diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index 22927406140..b1367281f9a 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -12,6 +12,7 @@ module Cardano.Logging.Forwarding ( initForwarding + , initForwardingDelayed ) where import Cardano.Logging.Types @@ -65,20 +66,35 @@ initForwarding :: forall m. (MonadIO m) -> Maybe EKG.Store -> Maybe (FilePath, ForwarderMode) -> m (ForwardSink TraceObject, DataPointStore) -initForwarding iomgr config magic ekgStore tracerSocketMode = liftIO $ do +initForwarding iomgr config magic ekgStore tracerSocketMode = do + (a, b, kickoffForwarder) <- initForwardingDelayed iomgr config magic ekgStore tracerSocketMode + liftIO kickoffForwarder + pure (a, b) + +-- We allow for delayed initialization of the forwarding connection by +-- returning an IO action to do so. +initForwardingDelayed :: forall m. (MonadIO m) + => IOManager + -> TraceOptionForwarder + -> NetworkMagic + -> Maybe EKG.Store + -> Maybe (FilePath, ForwarderMode) + -> m (ForwardSink TraceObject, DataPointStore, IO ()) +initForwardingDelayed iomgr config magic ekgStore tracerSocketMode = liftIO $ do forwardSink <- initForwardSink tfConfig handleOverflow dpStore <- initDataPointStore - launchForwarders - iomgr - magic - ekgConfig - tfConfig - dpfConfig - ekgStore - forwardSink - dpStore - tracerSocketMode - pure (forwardSink, dpStore) + let + kickoffForwarder = launchForwarders + iomgr + magic + ekgConfig + tfConfig + dpfConfig + ekgStore + forwardSink + dpStore + tracerSocketMode + pure (forwardSink, dpStore, kickoffForwarder) where p = maybe "" fst tracerSocketMode connSize = tofConnQueueSize config From b6a71de74a2b9ad44c0dcade348c4b43acdbeea0 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 8 Jan 2025 13:36:39 +0100 Subject: [PATCH 55/79] trace-dispatcher: more strictness in frequency limiter --- .../src/Cardano/Logging/FrequencyLimiter.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs index 9a9a4afa8b9..92ba20dddf1 100644 --- a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs +++ b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs @@ -23,6 +23,9 @@ budgetLimit = 30.0 reminderPeriod :: Double reminderPeriod = 10.0 +data MaybeTuple' a b = Nothing' | Just' !a !b + deriving Show + data LimiterSpec = LimiterSpec { lsNs :: [Text] , lsName :: Text @@ -37,7 +40,7 @@ data FrequencyRec a = FrequencyRec { -- and stop limiting. When messages arrive in shorter frequency then -- by the given thresholdFrequency budget is earned, and if they -- arrive in a longer period budget is spend. - , frActive :: Maybe (Int, Double) + , frActive :: !(MaybeTuple' Int Double) -- ^ Just is active and carries the number -- of suppressed messages and the time of last send message } deriving (Show) @@ -81,7 +84,7 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do timeNow <- systemTimeToSeconds <$> liftIO getSystemTime foldTraceM (checkLimiting (1.0 / thresholdFrequency)) - (FrequencyRec Nothing timeNow 0.0 0.0 Nothing) + (FrequencyRec Nothing timeNow 0.0 0.0 Nothing') (Trace $ T.contramap unfoldTrace (unpackTrace (filterTraceMaybe vtracer))) where checkLimiting :: @@ -110,7 +113,7 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do let newBudget = min budgetLimit (max (-budgetLimit) (normaSpendReward + frBudget)) case frActive of - Nothing -> -- limiter not active + Nothing' -> -- limiter not active if normaSpendReward + frBudget >= budgetLimit then do -- start limiting traceWith @@ -121,7 +124,7 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do , frLastTime = timeNow , frLastRem = timeNow , frBudget = newBudget - , frActive = Just (0, timeNow) + , frActive = Just' 0 timeNow } else -- continue without limiting pure fs { frMessage = Just message @@ -129,7 +132,7 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do , frLastRem = 0.0 , frBudget = newBudget } - Just (nSuppressed, lastTimeSend) -> -- is active + Just' nSuppressed lastTimeSend -> -- is active if normaSpendReward + frBudget <= (- budgetLimit) then do -- stop limiting traceWith @@ -139,7 +142,7 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do pure fs { frMessage = Just message , frLastTime = timeNow , frBudget = newBudget - , frActive = Nothing + , frActive = Nothing' } else let lastPeriod = timeNow - lastTimeSend @@ -160,14 +163,14 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do , frLastTime = timeNow , frLastRem = newFrLastRem , frBudget = newBudget - , frActive = Just (nSuppressed, timeNow) + , frActive = Just' nSuppressed timeNow } else -- suppress pure fs { frMessage = Nothing , frLastTime = timeNow , frLastRem = newFrLastRem , frBudget = newBudget - , frActive = Just (nSuppressed + 1, lastTimeSend) + , frActive = Just' (nSuppressed + 1) lastTimeSend } unfoldTrace :: (LoggingContext, Either TraceControl (Folding a (FrequencyRec a))) From d7c78f3efa4b3d70d4d0757460395a59aa6fcf27 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Wed, 8 Jan 2025 20:40:35 +0100 Subject: [PATCH 56/79] Genesis config propagation, some tracer tweaks --- .../src/Cardano/Node/Configuration/POM.hs | 29 +++++++-- cardano-node/src/Cardano/Node/Orphans.hs | 19 +++++- cardano-node/src/Cardano/Node/Parsers.hs | 1 + cardano-node/src/Cardano/Node/Run.hs | 4 +- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 64 +++++++++++-------- .../Tracing/OrphanInstances/Consensus.hs | 25 ++++---- cardano-node/test/Test/Cardano/Node/POM.hs | 4 ++ 7 files changed, 99 insertions(+), 47 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index f491a33e65f..3b77283d991 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -35,11 +35,12 @@ import Cardano.Tracing.Config import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..)) -import Ouroboros.Consensus.Node (NodeDatabasePaths (..), - pattern DoDiskSnapshotChecksum) +import Ouroboros.Consensus.Node (NodeDatabasePaths (..), pattern DoDiskSnapshotChecksum) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) -import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag, - NumOfDiskSnapshots (..), SnapshotInterval (..)) +import Ouroboros.Consensus.Node.Genesis (GenesisConfig, GenesisConfigFlags (..), + defaultGenesisConfigFlags, mkGenesisConfig) +import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag, NumOfDiskSnapshots (..), + SnapshotInterval (..)) import Ouroboros.Network.Diffusion.Configuration as Configuration import Control.Monad (when) @@ -178,6 +179,9 @@ data NodeConfiguration -- Enable Peer Sharing , ncPeerSharing :: PeerSharing + + -- Ouroboros Genesis + , ncGenesisConfig :: GenesisConfig } deriving (Eq, Show) @@ -252,6 +256,9 @@ data PartialNodeConfiguration -- Peer Sharing , pncPeerSharing :: !(Last PeerSharing) + + -- Ouroboros Genesis + , pncGenesisConfigFlags :: !(Last GenesisConfigFlags) } deriving (Eq, Generic, Show) instance AdjustFilePaths PartialNodeConfiguration where @@ -360,6 +367,9 @@ instance FromJSON PartialNodeConfiguration where -- DISABLED BY DEFAULT pncPeerSharing <- Last <$> v .:? "PeerSharing" + -- pncConsensusMode determines whether Genesis is enabled in the first place. + pncGenesisConfigFlags <- Last <$> v .:? "LowLevelGenesisOptions" + pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath @@ -401,6 +411,7 @@ instance FromJSON PartialNodeConfiguration where , pncConsensusMode , pncEnableP2P , pncPeerSharing + , pncGenesisConfigFlags } where parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride @@ -584,6 +595,7 @@ defaultPartialNodeConfiguration = , pncConsensusMode = Last (Just defaultConsensusMode) , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just defaultPeerSharing) + , pncGenesisConfigFlags = Last (Just defaultGenesisConfigFlags) } where Configuration.PeerSelectionTargets { @@ -682,6 +694,14 @@ makeNodeConfiguration pnc = do lastToEither "Missing PeerSharing" $ pncPeerSharing pnc + mGenesisConfigFlags <- case ncConsensusMode of + PraosMode -> pure Nothing + GenesisMode -> + fmap Just + $ lastToEither "Missing GenesisConfigFlags" + $ pncGenesisConfigFlags pnc + let ncGenesisConfig = mkGenesisConfig mGenesisConfigFlags + -- TODO: This is not mandatory experimentalProtocols <- lastToEither "Missing ExperimentalProtocolsEnabled" $ @@ -736,6 +756,7 @@ makeNodeConfiguration pnc = do DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing , ncConsensusMode + , ncGenesisConfig } ncProtocol :: NodeConfiguration -> Protocol diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index eefa6e7b84b..6d30abd0211 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-} @@ -10,13 +10,14 @@ module Cardano.Node.Orphans () where import Cardano.Api () -import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag(..)) import Ouroboros.Consensus.Node -import qualified Data.Text as Text +import Ouroboros.Consensus.Node.Genesis (GenesisConfigFlags (..)) +import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (Flag (..)) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Data.Aeson.Types +import qualified Data.Text as Text import Text.Printf (PrintfArg (..)) deriving instance Eq NodeDatabasePaths @@ -60,3 +61,15 @@ instance FromJSON NodeDatabasePaths where deriving newtype instance FromJSON (Flag symbol) deriving newtype instance ToJSON (Flag symbol) + +instance FromJSON GenesisConfigFlags where + parseJSON = withObject "GenesisConfigFlags" $ \v -> + GenesisConfigFlags + <$> v .:? "EnableCSJ" .!= True + <*> v .:? "EnableLoEAndGDD" .!= True + <*> v .:? "EnableLoP" .!= True + <*> v .:? "BlockFetchGracePeriod" + <*> v .:? "BucketCapacity" + <*> v .:? "BucketRate" + <*> v .:? "CSJJumpSize" + <*> v .:? "GDDRateLimit" diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 8011e0e14c9..2378ad91855 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -133,6 +133,7 @@ nodeRunParser = do , pncConsensusMode = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty + , pncGenesisConfigFlags = mempty } parseSocketPath :: Text -> Parser SocketPath diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 7a5d2ee3d17..e627b75934d 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -454,7 +454,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do (const . pure $ ()) let nodeArgs = RunNodeArgs - { rnGenesisConfig = disableGenesisConfig + { rnGenesisConfig = ncGenesisConfig nc , rnTraceConsensus = consensusTracers tracers , rnTraceNTN = nodeToNodeTracers tracers , rnTraceNTC = nodeToClientTracers tracers @@ -545,7 +545,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do (length ipProducerAddrs) nodeArgs = RunNodeArgs - { rnGenesisConfig = disableGenesisConfig + { rnGenesisConfig = ncGenesisConfig nc , rnTraceConsensus = consensusTracers tracers , rnTraceNTN = nodeToNodeTracers tracers , rnTraceNTC = nodeToClientTracers tracers diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index e40a453120b..7fd49d4a615 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -73,7 +73,6 @@ import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound -import Network.TypedProtocol.Core import Control.Monad (guard) import Control.Monad.Class.MonadTime.SI (Time (..)) @@ -87,6 +86,7 @@ import qualified Data.List as List import qualified Data.Text as Text import Data.Time (DiffTime, NominalDiffTime) import Data.Word (Word32, Word64) +import Network.TypedProtocol.Core instance (LogFormatting adr, Show adr) => LogFormatting (ConnectionId adr) where @@ -336,30 +336,6 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) jumpInfoToPoint = AF.headPoint . jTheirFragment --- TODO @tweag-genesis -instance MetaTrace (Jumping.TraceEvent addr) where - namespaceFor RotatedDynamo{} = Namespace [] ["RotatedDynamo"] - - severityFor (Namespace [] ["RotatedDynamo"]) _ = Just Info - severityFor _ _ = Nothing - - documentFor (Namespace [] ["RotatedDynamo"]) = - Just "The dynamo rotated" - documentFor _ = Nothing - - allNamespaces = - [ Namespace [] ["RotatedDynamo"] ] - -instance Show addr => LogFormatting (Jumping.TraceEvent addr) where - forHuman (RotatedDynamo fromPeer toPeer) = - "Rotated the dynamo from " <> showT fromPeer <> " to " <> showT toPeer - forMachine _dtal (RotatedDynamo fromPeer toPeer) = - mconcat - [ "kind" .= String "RotatedDynamo" - , "from" .= showT fromPeer - , "to" .= showT toPeer - ] - tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object tipToObject = \case TipGenesis -> mconcat @@ -2262,6 +2238,44 @@ instance MetaTrace (TraceGsmEvent selection) where , Namespace [] ["GsmEventSyncingToPreSyncing"] ] +-------------------------------------------------------------------------------- +-- CSJ Tracer +-------------------------------------------------------------------------------- + +instance ( LogFormatting peer, Show peer + ) => LogFormatting (Jumping.TraceEvent peer) where + forMachine dtal = + \case + RotatedDynamo oldPeer newPeer -> + mconcat + [ "kind" .= String "RotatedDynamo" + , "oldPeer" .= forMachine dtal oldPeer + , "newPeer" .= forMachine dtal newPeer + ] + + forHuman (RotatedDynamo fromPeer toPeer) = + "Rotated the dynamo from " <> showT fromPeer <> " to " <> showT toPeer + +instance MetaTrace (Jumping.TraceEvent peer) where + namespaceFor = + \case + RotatedDynamo {} -> Namespace [] ["RotatedDynamo"] + + severityFor ns _ = + case ns of + Namespace _ ["RotatedDynamo"] -> Just Info + Namespace _ _ -> Nothing + + documentFor = \case + Namespace _ ["RotatedDynamo"] -> + Just "The ChainSync Jumping module has been asked to rotate its dynamo" + Namespace _ _ -> + Nothing + + allNamespaces = + [ Namespace [] ["RotatedDynamo"] + ] + -------------------------------------------------------------------------------- -- Chain tip tracer -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 781a7da684f..219ff94cf73 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -26,13 +26,13 @@ import Cardano.Slotting.Slot (fromWithOrigin) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Network () import Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderHeaderHash, - renderHeaderHashForVerbosity, renderPointAsPhrase, - renderPointForVerbosity, renderRealPoint, renderRealPointAsPhrase, - renderTipBlockNo, renderTipHash, renderWithOrigin) + renderHeaderHashForVerbosity, renderPointAsPhrase, renderPointForVerbosity, + renderRealPoint, renderRealPointAsPhrase, renderTipBlockNo, renderTipHash, + renderWithOrigin) import Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge, ConvertRawHash (..), ForgeStateUpdateError, GenesisWindow (..), GetHeader (..), - Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, - pointHash, realPointHash, realPointSlot, withOriginToMaybe) + Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, pointHash, + realPointHash, realPointSlot, withOriginToMaybe) import Ouroboros.Consensus.Block.SupportsSanityCheck import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), TraceGDDEvent (..)) @@ -79,7 +79,6 @@ import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) -import Network.TypedProtocol.Core import Control.Monad (guard) import Data.Aeson (Value (..)) @@ -92,6 +91,7 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Word (Word32) import GHC.Generics (Generic) +import Network.TypedProtocol.Core import Numeric (showFFloat) @@ -1420,19 +1420,18 @@ instance ( LedgerSupportsProtocol blk, , "ourFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jOurFragment info)) , "theirFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jTheirFragment info)) ] --- TODO @tweag-genesis instance HasPrivacyAnnotation (ChainSync.Client.TraceEvent peer) where instance HasSeverityAnnotation (ChainSync.Client.TraceEvent peer) where - getSeverityAnnotation _ = Info -instance Show peer => Transformable Text IO (ChainSync.Client.TraceEvent peer) where + getSeverityAnnotation _ = Debug +instance ToObject peer => Transformable Text IO (ChainSync.Client.TraceEvent peer) where trTransformer = trStructured -instance Show peer => ToObject (ChainSync.Client.TraceEvent peer) where - toObject _verb (ChainSync.Client.RotatedDynamo fromPeer toPeer) = +instance ToObject peer => ToObject (ChainSync.Client.TraceEvent peer) where + toObject verb (ChainSync.Client.RotatedDynamo oldPeer newPeer) = mconcat [ "kind" .= String "RotatedDynamo" - , "from" .= showT fromPeer - , "to" .= showT toPeer + , "oldPeer" .= toObject verb oldPeer + , "newPeer" .= toObject verb newPeer ] instance ConvertRawHash blk diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 9e7a7f84bc0..106bbc7d241 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -15,6 +15,7 @@ import Cardano.Tracing.Config (PartialTraceOptions (..), defaultPartia partialTraceSelectionToEither) import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) +import Ouroboros.Consensus.Node.Genesis (disableGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..), pattern DoDiskSnapshotChecksum) import Ouroboros.Network.Block (SlotNo (..)) @@ -151,6 +152,7 @@ testPartialYamlConfig = , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) , pncConsensusMode = mempty + , pncGenesisConfigFlags = mempty } -- | Example partial configuration theoretically created @@ -198,6 +200,7 @@ testPartialCliConfig = , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) , pncConsensusMode = Last (Just PraosMode) + , pncGenesisConfigFlags = mempty } -- | Expected final NodeConfiguration @@ -251,6 +254,7 @@ eExpectedConfig = do , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled , ncConsensusMode = PraosMode + , ncGenesisConfig = disableGenesisConfig } -- ----------------------------------------------------------------------------- From b43862933ac81207014597ecdf3a1b410867ed96 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 8 Jan 2025 18:15:37 -0700 Subject: [PATCH 57/79] ouroboros-consensus upgrade: increase version bounds --- cardano-node/cardano-node.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index e66aa769962..9874b9c8e3a 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -186,9 +186,9 @@ library , network-mux >= 0.5 , nothunks , optparse-applicative-fork >= 0.18.1 - , ouroboros-consensus ^>= 0.21 - , ouroboros-consensus-cardano ^>= 0.20 - , ouroboros-consensus-diffusion ^>= 0.18 + , ouroboros-consensus ^>= 0.22 + , ouroboros-consensus-cardano ^>= 0.21 + , ouroboros-consensus-diffusion ^>= 0.19 , ouroboros-consensus-protocol , ouroboros-network-api ^>= 0.12 , ouroboros-network ^>= 0.19 From 5722799f9d2b8497a9a40066cbe07808cdb8c667 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 8 Jan 2025 18:16:18 -0700 Subject: [PATCH 58/79] cardano-cli upgrade: increase version to 10.3 --- bench/tx-generator/tx-generator.cabal | 2 +- cardano-node-chairman/cardano-node-chairman.cabal | 2 +- cardano-submit-api/cardano-submit-api.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 009457d76f5..461282d831d 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -108,7 +108,7 @@ library , bytestring , cardano-api ^>= 10.6 , cardano-binary - , cardano-cli ^>= 10.1 + , cardano-cli ^>= 10.3 , cardano-crypto-class , cardano-crypto-wrapper , cardano-data diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 0d9a6c835f9..f6dfe27c2a1 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -89,5 +89,5 @@ test-suite chairman-tests ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" build-tool-depends: cardano-node:cardano-node - , cardano-cli:cardano-cli ^>= 10.1 + , cardano-cli:cardano-cli ^>= 10.3 , cardano-node-chairman:cardano-node-chairman diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index 36550180740..0126b62bcf6 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -41,7 +41,7 @@ library , bytestring , cardano-api ^>= 10.6 , cardano-binary - , cardano-cli ^>= 10.1 + , cardano-cli ^>= 10.3 , cardano-crypto-class ^>= 2.1.2 , http-media , iohk-monitoring diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index fbd71f6ca41..17104e2fc88 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -36,7 +36,7 @@ library , ansi-terminal , bytestring , cardano-api ^>= 10.6 - , cardano-cli ^>= 10.1 + , cardano-cli:{cardano-cli, cardano-cli-test-lib} ^>= 10.3 , cardano-crypto-class , cardano-crypto-wrapper , cardano-git-rev ^>= 0.2.2 From 6200cd6e85eb620d0488205074c71148c021aef0 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 8 Jan 2025 19:01:53 -0700 Subject: [PATCH 59/79] Disable Haddock in ouroboros-network due to a parse error with ghc810 At src/Ouroboros/Network/PeerSelection/LedgerPeers.hs:389 --- nix/haskell.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/nix/haskell.nix b/nix/haskell.nix index 71ee8f37b40..0d85d2415a4 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -127,6 +127,7 @@ let packages.cardano-protocol-tpraos.components.library.doHaddock = false; packages.ouroboros-consensus-cardano.components.library.doHaddock = false; packages.ouroboros-consensus.components.library.doHaddock = false; + packages.ouroboros-network.components.library.doHaddock = false; # Currently broken packages.plutus-ledger-api.components.library.doHaddock = false; }) ({ lib, pkgs, ...}: lib.mkIf (pkgs.stdenv.hostPlatform.isWindows) { From 923846fbb2cae479e4205326d1b1d43a6dcce714 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 9 Jan 2025 15:56:12 +0100 Subject: [PATCH 60/79] cardano-testnet | fix missing configuration option and chain extension check --- cardano-testnet/src/Testnet/Defaults.hs | 2 ++ cardano-testnet/src/Testnet/Property/Assert.hs | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index fdfb5c06fa4..bae90ad5282 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -76,6 +76,7 @@ import qualified Data.Text as Text import Data.Time (UTCTime) import qualified Data.Vector as Vector import Data.Word (Word64) +import GHC.Exts (IsList (..)) import Lens.Micro import Numeric.Natural import System.FilePath (()) @@ -161,6 +162,7 @@ defaultYamlHardforkViaConfig :: ShelleyBasedEra era -> Aeson.KeyMap Aeson.Value defaultYamlHardforkViaConfig sbe = defaultYamlConfig <> tracers + <> fromList [("TraceOptions", Aeson.Object mempty)] <> protocolVersions sbe <> hardforkViaConfig sbe where diff --git a/cardano-testnet/src/Testnet/Property/Assert.hs b/cardano-testnet/src/Testnet/Property/Assert.hs index 6b83481aef1..7b52c65e0ae 100644 --- a/cardano-testnet/src/Testnet/Property/Assert.hs +++ b/cardano-testnet/src/Testnet/Property/Assert.hs @@ -117,7 +117,7 @@ assertChainExtended deadline nodeLoggingFormat nodeStdoutFile = withFrozenCallSt case nodeLoggingFormat of NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdoutFile NodeLoggingFormatAsJson -> fileJsonGrep nodeStdoutFile $ \v -> - Aeson.parseMaybe (Aeson.parseJSON @(LogEntry Kind)) v == Just (LogEntry (Kind "TraceAddBlockEvent.AddedToCurrentChain")) + Aeson.parseMaybe (Aeson.parseJSON @(LogEntry Kind)) v == Just (LogEntry (Kind "AddedToCurrentChain")) newtype LogEntry a = LogEntry { unLogEntry :: a From fd21969f69a5aa6499d548ef78408cc0a70834cc Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 9 Jan 2025 17:58:06 +0100 Subject: [PATCH 61/79] cardano-testnet | fix shutdown on sigint test --- .../Cardano/Testnet/Test/Node/Shutdown.hs | 56 +++++++++++-------- 1 file changed, 33 insertions(+), 23 deletions(-) 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 e7ada7b0699..8aeed6e8466 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 @@ -17,6 +17,7 @@ import qualified Cardano.Testnet as Testnet import Prelude +import Control.Applicative (Alternative ((<|>))) import Control.Monad import Data.Aeson import Data.Aeson.Types @@ -227,10 +228,9 @@ hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synce mExitCodeRunning === Right ExitSuccess logs <- H.readFile (nodeStdout node) - slotTip <- case mapMaybe parseMsg $ reverse $ lines logs of - [] -> H.failMessage callStack "Could not find close DB message." - (Left err):_ -> H.failMessage callStack err - (Right s):_ -> return s + slotTip <- case findLastSlot . reverse $ lines logs of + Nothing -> H.failMessage callStack "Could not find close DB message." + Just s -> return s let epsilon = 50 H.assertWithinTolerance slotTip maxSlot epsilon @@ -264,22 +264,32 @@ hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tem other -> H.failMessage callStack $ "Unexpected exit status for the testnet process: " <> show other logs <- H.readFile nodeStdout - case mapMaybe parseMsg $ reverse $ lines logs of - [] -> H.failMessage callStack "Could not find close DB message." - (Left err):_ -> H.failMessage callStack err - (Right _):_ -> pure () - - -parseMsg :: String -> Maybe (Either String Integer) -parseMsg line = case decode $ LBS.pack line of - Nothing -> Just $ Left $ "Expected JSON formated log message, but got: " ++ line - Just obj -> Right <$> parseMaybe parseTipSlot obj - -parseTipSlot :: Object -> Parser Integer -parseTipSlot obj = do - body <- obj .: "data" - tip <- body .: "tip" - kind <- body .: "kind" - if kind == ("TraceOpenEvent.ClosedDB" :: String) - then tip .: "slot" - else mzero + case findLastSlot . reverse $ lines logs of + Nothing -> H.failMessage callStack "Could not find close DB message." + _ -> pure () + + +findLastSlot :: [String] -> Maybe Int +findLastSlot = go (False, Nothing) + where + go (_, mSlot) [] = mSlot + go (True, mSlot@(Just _)) _ = mSlot + go r@(isDbClosed, mSlot) (line:ls) = do + let mLineVal = decode $ LBS.pack line + case mLineVal of + -- ignore non-json lines + Nothing -> go r ls + Just obj -> do + let isDbClosed' = isDbClosed || (parseMaybe parseDbClosed obj == Just True) + mSlot' = mSlot <|> parseMaybe parseSlot obj + go (isDbClosed', mSlot') ls + + parseDbClosed obj = do + body <- obj .: "data" + kind <- body .: "kind" + pure $ kind == ("DBClosed" :: String) + + parseSlot obj = do + body <- obj .: "data" + body .: "slot" :: Parser Int + From e66ddecc58f6ad3c14122b8a2ac6806ff8c7cb4a Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 9 Jan 2025 10:01:38 -0700 Subject: [PATCH 62/79] Update golden config files --- .../files/golden/allegra_node_default_config.json | 1 + .../files/golden/alonzo_node_default_config.json | 1 + .../files/golden/babbage_node_default_config.json | 1 + .../files/golden/conway_node_default_config.json | 1 + .../files/golden/mary_node_default_config.json | 1 + .../files/golden/shelley_node_default_config.json | 1 + 6 files changed, 6 insertions(+) diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json index 3cc01116914..e35f4f2b149 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/allegra_node_default_config.json @@ -47,6 +47,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json index 45181624ec0..340be9c7af2 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/alonzo_node_default_config.json @@ -49,6 +49,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json index d4dfdc1df27..8525dc82b9d 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/babbage_node_default_config.json @@ -50,6 +50,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json index 3193a968fb4..6da59b1b9e5 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/conway_node_default_config.json @@ -51,6 +51,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json index 2bc931764a9..8cf9248d98b 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json @@ -48,6 +48,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json b/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json index 0cd055788ac..50494b46a98 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json @@ -46,6 +46,7 @@ "TraceLocalTxSubmissionServer": false, "TraceMempool": true, "TraceMux": false, + "TraceOptions": {}, "TracePeerSelection": true, "TracePeerSelectionActions": true, "TracePublicRootPeers": true, From 895ac523bc5301995f6dd166bd58cd11aaedd9ae Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 9 Jan 2025 10:12:39 -0700 Subject: [PATCH 63/79] Update mainnet-config.json --- configuration/cardano/mainnet-config.json | 1 - configuration/cardano/mainnet-config.yaml | 1 - 2 files changed, 2 deletions(-) diff --git a/configuration/cardano/mainnet-config.json b/configuration/cardano/mainnet-config.json index 3900717bafb..53e8e03d7b6 100644 --- a/configuration/cardano/mainnet-config.json +++ b/configuration/cardano/mainnet-config.json @@ -16,7 +16,6 @@ "RequiresNetworkMagic": "RequiresNoMagic", "ShelleyGenesisFile": "mainnet-shelley-genesis.json", "ShelleyGenesisHash": "1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81", - "ConsensusMode": "PraosMode", "TargetNumberOfActivePeers": 20, "TargetNumberOfEstablishedPeers": 40, "TargetNumberOfKnownPeers": 150, diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index c169516f7a5..1b40d514dc1 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -34,7 +34,6 @@ MaxKnownMajorProtocolVersion: 2 ##### Network Configuration ##### -ConsensusMode: PraosMode PeerSharing: True TargetNumberOfActivePeers: 20 TargetNumberOfEstablishedPeers: 40 From 45295f26f7d0fd764bc2c7d1d560ca83cd354928 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Thu, 9 Jan 2025 11:49:34 +0100 Subject: [PATCH 64/79] trace-dispatcher: sensible defaults for forwarding queue capacity --- .../cardano/mainnet-config-new-tracing.json | 5 +++- trace-dispatcher/src/Cardano/Logging/Types.hs | 25 +++++++++++++++---- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/configuration/cardano/mainnet-config-new-tracing.json b/configuration/cardano/mainnet-config-new-tracing.json index b137deb9c86..86a3c1fa7e7 100644 --- a/configuration/cardano/mainnet-config-new-tracing.json +++ b/configuration/cardano/mainnet-config-new-tracing.json @@ -18,11 +18,14 @@ "TurnOnLogging": true, "TurnOnLogMetrics": true, "UseTraceDispatcher": true, - "TraceOptionForwarder": null, "TraceOptionMetricsPrefix": "cardano.node.metrics.", "TraceOptionNodeName": "mainnetsingle", "TraceOptionPeerFrequency": 2000, "TraceOptionResourceFrequency": 1000, + "TraceOptionForwarder": { + "connQueueSize": 64, + "disconnQueueSize": 128 + }, "TraceOptions": { "": { "backends": [ diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index e2c21afe5ea..086613cb073 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -445,20 +445,35 @@ data TraceOptionForwarder = TraceOptionForwarder { , tofVerbosity :: Verbosity } deriving (Eq, Generic, Ord, Show, AE.ToJSON) +-- A word regarding queue sizes: +-- In case of a missing forwarding service consumer, traces messages will be +-- buffered. This mitigates short forwarding interruptions, or delays at startup time. +-- +-- The queue capacity should thus correlate to the expected log lines per second given +-- a particular tracing configuration - to avoid unnecessarily increasing memory footprint. +-- +-- The default values here are chosen to accomodate verbose tracing output +-- (i.e., buffering 1min worth of trace data given ~32 messages per second). A config +-- that results in less than 5 msgs per second should also provide TraceOptionForwarder +-- queue size values considerably lower. The `disconnQueueSize` is the hard limit in that case. +-- +-- The queue sizes tie in with the max number of trace objects cardano-tracer requests periodically, +-- the default for that being 100. Here, the basic queue can hold enough traces for 10 subsequent polls +-- by cardano-tracer. instance AE.FromJSON TraceOptionForwarder where parseJSON (AE.Object obj) = TraceOptionForwarder - <$> obj AE..:? "connQueueSize" AE..!= 2000 - <*> obj AE..:? "disconnQueueSize" AE..!= 200000 + <$> obj AE..:? "connQueueSize" AE..!= 1024 + <*> obj AE..:? "disconnQueueSize" AE..!= 2048 <*> obj AE..:? "verbosity" AE..!= Minimum parseJSON _ = mempty defaultForwarder :: TraceOptionForwarder defaultForwarder = TraceOptionForwarder { - tofConnQueueSize = 2000 - , tofDisconnQueueSize = 200000 - , tofVerbosity = Minimum + tofConnQueueSize = 1024 + , tofDisconnQueueSize = 2048 + , tofVerbosity = Minimum } instance AE.FromJSON ForwarderMode where From e54b37bef7b1ac489dba773c2f2b1b6a33cea90c Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 15 Jan 2025 11:22:50 -0700 Subject: [PATCH 65/79] Add testing support for QueryLedgerPeerSnapshotCmd --- .../cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs | 4 ++++ 1 file changed, 4 insertions(+) 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 3ba4db33f7b..aa316ce559c 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 @@ -443,6 +443,10 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- TODO @cardano-cli team pure () + TestQueryLedgerPeerSnapshotCmd -> do + -- TODO @cardano-cli team + pure () + where -- | Wait for the part of the epoch when futurePParams are known waitForFuturePParamsToStabilise From 52d5635e5a2d1c4bd16c5216177f90ed4dead4db Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 29 Oct 2024 12:05:17 +0100 Subject: [PATCH 66/79] Add security tool to PATH in Darwin nix This is needed when finding certificates --- flake.nix | 9 +++++++++ nix/haskell.nix | 7 ++++++- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/flake.nix b/flake.nix index 0d63226bc9f..5b253a234c1 100644 --- a/flake.nix +++ b/flake.nix @@ -89,6 +89,11 @@ inherit (iohkNix.lib) prefixNamesWith; removeRecurse = lib.filterAttrsRecursive (n: _: n != "recurseForDerivations"); + macOS-security = pkgs: + # make `/usr/bin/security` available in `PATH`, which is needed for stack + # on darwin which calls this binary to find certificates + pkgs.writeScriptBin "security" ''exec /usr/bin/security "$@"''; + supportedSystems = import ./nix/supported-systems.nix; defaultSystem = head supportedSystems; customConfig = recursiveUpdate @@ -145,6 +150,9 @@ inherit (pkgs.stdenv) hostPlatform; project = pkgs.cardanoNodeProject; + macOS-security = + utils.writeScriptBin "security" ''exec /usr/bin/security "$@"''; + # This is used by `nix develop .` to open a devShell devShells = let @@ -401,6 +409,7 @@ inherit (final) haskell-nix; inherit (std) incl; inherit CHaP; + macOS-security = macOS-security (final.pkgs); }).appendModule [ customConfig.haskellNix ]; diff --git a/nix/haskell.nix b/nix/haskell.nix index 0d85d2415a4..e9aca8fe2dc 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -4,6 +4,7 @@ { haskell-nix , incl , CHaP +, macOS-security }: let @@ -282,7 +283,11 @@ let unset TMPDIR export TMPDIR=$(mktemp -d) export TMP=$TMPDIR - ''; + '' + (if pkgs.stdenv.hostPlatform.isDarwin + then '' + export PATH=${macOS-security}/bin:$PATH + '' + else ''''); packages.cardano-testnet.components.tests.cardano-testnet-golden.preCheck = let # This define files included in the directory that will be passed to `H.getProjectBase` for this test: From 2f47cd9382388f60c8d4be42895b5a04acf04f2c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 23 Oct 2024 16:58:58 +0200 Subject: [PATCH 67/79] Update `hprop_ledger_events_info_action` to work with the new checks --- .gitattributes | 1 + cardano-testnet/cardano-testnet.cabal | 2 +- cardano-testnet/src/Testnet/Process/Run.hs | 12 ++++ .../Cardano/Testnet/Test/Gov/InfoAction.hs | 70 +++++++++++-------- .../files/sample-proposal-anchor | 5 ++ 5 files changed, 61 insertions(+), 29 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor diff --git a/.gitattributes b/.gitattributes index 6370e879f22..f0c6ee73bf2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5,3 +5,4 @@ configuration/cardano/mainnet-alonzo-genesis.json text eol=lf configuration/cardano/mainnet-byron-genesis.json text eol=lf configuration/cardano/mainnet-conway-genesis.json text eol=lf configuration/cardano/mainnet-shelley-genesis.json text eol=lf +cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor text eol=lf diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 17104e2fc88..9a7c289c3d5 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -220,7 +220,7 @@ test-suite cardano-testnet-test , base16-bytestring , bytestring , cardano-api:{cardano-api, internal} - , cardano-cli + , cardano-cli:{cardano-cli, cardano-cli-test-lib} , cardano-crypto-class , cardano-ledger-conway , cardano-ledger-core diff --git a/cardano-testnet/src/Testnet/Process/Run.hs b/cardano-testnet/src/Testnet/Process/Run.hs index 8c0be2f8612..87f160873f8 100644 --- a/cardano-testnet/src/Testnet/Process/Run.hs +++ b/cardano-testnet/src/Testnet/Process/Run.hs @@ -18,6 +18,7 @@ module Testnet.Process.Run , mkExecConfigOffline , ProcessError(..) , ExecutableError(..) + , addEnvVarsToConfig ) where import Prelude @@ -33,6 +34,7 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as LBS import Data.Function import qualified Data.List as List +import Data.Maybe (fromMaybe) import Data.Monoid (Last (..)) import Data.String (fromString) import qualified Data.Text as Text @@ -193,6 +195,16 @@ mkExecConfig tempBaseAbsPath sprocket networkId = do , H.execConfigCwd = Last $ Just tempBaseAbsPath } +-- | Adds environment variables to an 'ExecConfig' that may already +-- have some environment variables set. This is done by prepending the new +-- environment variables to the existing ones. +addEnvVarsToConfig :: H.ExecConfig -> [(String, String)] -> H.ExecConfig +addEnvVarsToConfig execConfig newEnvVars = + execConfig { H.execConfigEnv = Last $ Just $ newEnvVars <> prevEnvVars } + where + prevEnvVars :: [(String, String)] + prevEnvVars = fromMaybe [] . getLast $ H.execConfigEnv execConfig + -- | Creates an 'ExecConfig' that can be used to run a process offline. -- e.g cardano-cli without a node running. mkExecConfigOffline :: () diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index dd8b3645b12..4c961ba4e2c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -31,13 +31,15 @@ import Data.String import qualified Data.Text as Text import Data.Word import GHC.Stack +import System.Directory (makeAbsolute) import System.FilePath (()) +import Test.Cardano.CLI.Hash (serveFilesWhile) import Testnet.Components.Query import Testnet.Defaults import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) -import Testnet.Process.Run (execCli', mkExecConfig) +import Testnet.Process.Run (addEnvVarsToConfig, execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types import Testnet.Types @@ -85,15 +87,14 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem H.note_ $ "Foldblocks config file: " <> unFile configurationFile gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFile <- H.note $ work gov "sample-proposal-anchor" - infoActionFp <- H.note $ work gov "info.action" - -- pls configure your editors to trim trailing whitespace >.> - H.writeFile proposalAnchorFile $ - unlines [ "These are the reasons: " , "" , "1. First" , "2. Second " , "3. Third" ] + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + + infoActionFp <- H.note $ work gov "info.action" proposalAnchorDataHash <- execCli' execConfig - [ "hash", "anchor-data", "--file-text", proposalAnchorFile + [ "hash", "anchor-data", "--file-binary", proposalAnchorFile ] -- Register stake address @@ -137,31 +138,44 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem -- make sure that stake registration cert gets into a block _ <- waitForBlocks epochStateView 1 - -- Create info action proposal - - void $ execCli' execConfig - [ eraName, "governance", "action", "create-info" - , "--testnet" - , "--governance-action-deposit", show @Int 1_000_000 -- TODO: Get this from the node - , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys - , "--anchor-url", "https://tinyurl.com/3wrwb2as" - , "--anchor-data-hash", proposalAnchorDataHash - , "--out-file", infoActionFp - ] + let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash] txbodyFp <- H.note $ work "tx.body" txbodySignedFp <- H.note $ work "tx.body.signed" - txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 - - H.noteM_ $ execCli' execConfig - [ eraName, "transaction", "build" - , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 - , "--tx-in", Text.unpack $ renderTxIn txin2 - , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 - , "--proposal-file", infoActionFp - , "--out-file", txbodyFp - ] + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [(relativeUrl, proposalAnchorFile)] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + + void $ + execCli' + execConfig' + [ eraName, "governance", "action", "create-info" + , "--testnet" + , "--governance-action-deposit", show @Int 1_000_000 -- TODO: Get this from the node + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", proposalAnchorDataHash + , "--check-anchor-data" + , "--out-file", infoActionFp + ] + + txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + void $ + execCli' + execConfig' + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 + , "--proposal-file", infoActionFp + , "--out-file", txbodyFp + ] + ) void $ execCli' execConfig [ eraName, "transaction", "sign" diff --git a/cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor b/cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor new file mode 100644 index 00000000000..5ccd92f3867 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor @@ -0,0 +1,5 @@ +These are the reasons: + +1. First +2. Second +3. Third From 41c425e725dce4646af776136e25e66351f3a18f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 23 Oct 2024 18:23:12 +0200 Subject: [PATCH 68/79] Update `hprop_constitutional_committee_add_new` to work with the new checks --- .../Testnet/Test/Gov/CommitteeAddNew.hs | 70 +++++++++++-------- 1 file changed, 41 insertions(+), 29 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index cc60d11aa78..63fb3164dfb 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -33,8 +33,10 @@ import qualified Data.Text as Text import GHC.Exts (IsList (..)) import GHC.Stack import Lens.Micro +import System.Directory (makeAbsolute) import System.FilePath (()) +import Test.Cardano.CLI.Hash (serveFilesWhile) import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Defaults @@ -44,7 +46,7 @@ import Testnet.Process.Cli.Keys import qualified Testnet.Process.Cli.SPO as SPO import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction -import Testnet.Process.Run (execCli', mkExecConfig) +import Testnet.Process.Run (addEnvVarsToConfig, execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types (GenesisOptions (..), cardanoNumPools) import Testnet.Types @@ -106,17 +108,15 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co H.note_ $ "Foldblocks config file: " <> unFile configurationFile gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFp <- H.note $ gov "sample-proposal-anchor" - proposalDataFp <- H.note $ gov "sample-proposal-data" - updateCommitteeFp <- H.note $ gov "update-cc.action" - H.writeFile proposalAnchorFp $ - unlines [ "These are the reasons: " , "" , "1. First" , "2. Second " , "3. Third" ] - H.writeFile proposalDataFp "dummy proposal data" + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + + updateCommitteeFp <- H.note $ gov "update-cc.action" proposalAnchorDataHash <- execCli' execConfig [ "hash", "anchor-data" - , "--file-text", proposalAnchorFp + , "--file-text", proposalAnchorFile ] let ccColdSKeyFp n = gov "cc-" <> show n <> "-cold.skey" @@ -183,30 +183,42 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co EpochNo epochNo <- H.noteShowM $ getCurrentEpochNo epochStateView let ccExpiryEpoch = epochNo + 200 - _ <- execCli' execConfig $ - [ eraName, "governance", "action" , "update-committee" - , "--testnet" - , "--anchor-url", "https://tinyurl.com/3wrwb2as" - , "--anchor-data-hash", proposalAnchorDataHash - , "--governance-action-deposit", show minGovActDeposit - , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys - , "--threshold", "0.2" - , "--out-file", updateCommitteeFp - ] - <> concatMap - (\fp -> ["--add-cc-cold-verification-key-file", fp, "--epoch", show ccExpiryEpoch]) - ccColdKeyFps + let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash] txbodyFp <- H.note $ work "tx.body" txin1' <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 - void $ execCli' execConfig - [ eraName, "transaction", "build" - , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 - , "--tx-in", Text.unpack $ renderTxIn txin1' - , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 - , "--proposal-file", updateCommitteeFp - , "--out-file", txbodyFp - ] + + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [(relativeUrl, proposalAnchorFile)] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + + void $ execCli' execConfig' $ + [ eraName, "governance", "action" , "update-committee" + , "--testnet" + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", proposalAnchorDataHash + , "--check-anchor-data" + , "--governance-action-deposit", show minGovActDeposit + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys + , "--threshold", "0.2" + , "--out-file", updateCommitteeFp + ] + <> concatMap + (\fp -> ["--add-cc-cold-verification-key-file", fp, "--epoch", show ccExpiryEpoch]) + ccColdKeyFps + + void $ execCli' execConfig' + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", Text.unpack $ renderTxIn txin1' + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 + , "--proposal-file", updateCommitteeFp + , "--out-file", txbodyFp + ] + ) -- double check that we're starting with an empty committee committeeMembers <- getCommitteeMembers epochStateView ceo From 4fb6c08d928d733c77384a18a34133d36b95cbb8 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 23 Oct 2024 18:51:03 +0200 Subject: [PATCH 69/79] Update `hprop_ledger_events_propose_new_constitution` to work with the new checks --- .gitattributes | 1 + .../Test/Gov/ProposeNewConstitution.hs | 81 +++++++++++-------- .../files/sample-constitution-anchor | 50 ++++++++++++ 3 files changed, 99 insertions(+), 33 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/sample-constitution-anchor diff --git a/.gitattributes b/.gitattributes index f0c6ee73bf2..5a706b986af 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6,3 +6,4 @@ configuration/cardano/mainnet-byron-genesis.json text eol=lf configuration/cardano/mainnet-conway-genesis.json text eol=lf configuration/cardano/mainnet-shelley-genesis.json text eol=lf cardano-testnet/test/cardano-testnet-test/files/sample-proposal-anchor text eol=lf +cardano-testnet/test/cardano-testnet-test/files/sample-constitution-anchor text eol=lf diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index de60bc4d1cd..716c46c8ba9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -30,8 +30,10 @@ import Data.String import qualified Data.Text as Text import GHC.Exts (IsList (..)) import Lens.Micro +import System.Directory (makeAbsolute) import System.FilePath (()) +import Test.Cardano.CLI.Hash (serveFilesWhile) import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Defaults @@ -40,7 +42,7 @@ import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction -import Testnet.Process.Run (execCli', mkExecConfig) +import Testnet.Process.Run (addEnvVarsToConfig, execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types import Testnet.Types @@ -102,21 +104,19 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new -- Create Conway constitution gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFile <- H.note $ gov "sample-proposal-anchor" - constitutionFile <- H.note $ gov "sample-constitution" constitutionActionFp <- H.note $ gov "constitution.action" - H.writeFile proposalAnchorFile $ - unlines [ "These are the reasons: " , "" , "1. First" , "2. Second " , "3. Third" ] - H.copyFile - "test/cardano-testnet-test/files/input/sample-constitution.txt" - constitutionFile + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + let constitutionAnchorDataIpfsHash = "QmXGkenkhh3NsotVwbNGToGsPuvJLgRT9aAz5ToyKAqdWP" + constitutionAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + constitutionHash <- execCli' execConfig - [ "hash", "anchor-data", "--file-text", constitutionFile + [ "hash", "anchor-data", "--file-binary", constitutionAnchorFile ] proposalAnchorDataHash <- execCli' execConfig - [ "hash", "anchor-data", "--file-text", proposalAnchorFile + [ "hash", "anchor-data", "--file-binary", proposalAnchorFile ] -- Register stake address @@ -169,33 +169,48 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new , "--script-file", guardRailScriptFp ] - minDRepDeposit <- getMinDRepDeposit epochStateView ceo - void $ execCli' execConfig - [ "conway", "governance", "action", "create-constitution" - , "--testnet" - , "--governance-action-deposit", show minDRepDeposit - , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys - , "--anchor-url", "https://tinyurl.com/3wrwb2as" - , "--anchor-data-hash", proposalAnchorDataHash - , "--constitution-url", "https://tinyurl.com/2pahcy6z" - , "--constitution-hash", constitutionHash - , "--constitution-script-hash", constitutionScriptHash - , "--out-file", constitutionActionFp - ] + let relativeUrlProposal = ["ipfs", proposalAnchorDataIpfsHash] + relativeUrlConstitution = ["ipfs", constitutionAnchorDataIpfsHash] txbodyFp <- H.note $ work "tx.body" + minDRepDeposit <- getMinDRepDeposit epochStateView ceo - H.noteShowM_ $ waitForBlocks epochStateView 1 - txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 - - void $ execCli' execConfig - [ "conway", "transaction", "build" - , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 - , "--tx-in", Text.unpack $ renderTxIn txin2 - , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 - , "--proposal-file", constitutionActionFp - , "--out-file", txbodyFp + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [ (relativeUrlProposal, proposalAnchorFile) + , (relativeUrlConstitution, constitutionAnchorFile) ] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + + void $ execCli' execConfig' + [ "conway", "governance", "action", "create-constitution" + , "--testnet" + , "--governance-action-deposit", show minDRepDeposit + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", proposalAnchorDataHash + , "--check-anchor-data" + , "--constitution-url", "ipfs://" ++ constitutionAnchorDataIpfsHash + , "--constitution-hash", constitutionHash + , "--check-constitution-hash" + , "--constitution-script-hash", constitutionScriptHash + , "--out-file", constitutionActionFp + ] + + H.noteShowM_ $ waitForBlocks epochStateView 1 + txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + void $ execCli' execConfig' + [ "conway", "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 + , "--proposal-file", constitutionActionFp + , "--out-file", txbodyFp + ] + ) signedProposalTx <- signTx execConfig cEra gov "signed-proposal" (File txbodyFp) [Some $ paymentKeyInfoPair wallet1] diff --git a/cardano-testnet/test/cardano-testnet-test/files/sample-constitution-anchor b/cardano-testnet/test/cardano-testnet-test/files/sample-constitution-anchor new file mode 100644 index 00000000000..4dbb452e8e6 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/sample-constitution-anchor @@ -0,0 +1,50 @@ +Preamble + +We, the zaniest inhabitants of the peculiar and bewildering land of Barataria, in honor of our illustrious Governor, Sancho Panza, renowned for his comically charming ordinances, do hereby present this Constitution to tickle your fancy and uphold the values of laughter, merriment, and the pursuit of hilarity for all our citizens. + +Article I: The Right to Absurdity + +Wine-Watering Rights: Every Baratarian shall have the inalienable right to water down their wine as they see fit, provided they can still manage a tipsy jig. + +Fashion Freedom: Citizens are encouraged to dress inappropriately for the sheer joy of it, as long as it does not involve the use of sharp objects, poisonous animals, or explosives. + +Article II: The Role of Government: Keeping It Lighthearted + +Official Clown: There shall be an official court jester whose duty is to make the Governor laugh at least once a day. Failure to amuse may result in banishment to a neighboring kingdom. + +Puns and Pranks: All government proceedings shall include at least one pun and one harmless prank per session to maintain the mirthful spirit of Barataria. + +Article III: The Economic Circus + +Foolish Redistribution: The government shall engage in a monthly "wealth lottery," redistributing riches by catapulting bags of gold into the air and letting them fall where they may. + +Tax Deductions for Silly Hats: Citizens who wear absurd hats shall receive generous tax deductions, fostering creativity and fashion-forward thinking. + +Article IV: Justice, Comedy, and the Absurd + +Trial by Tickling: In the interest of justice and merriment, all trials shall include a "tickle test" to determine guilt or innocence. Giggles are considered a sign of innocence. + +Innocent Until Proven Clueless: It shall be presumed that every Baratarian is innocent of any wrongdoing until they can convincingly demonstrate their utter cluelessness in court. + +Article V: Education and Clown Colleges + +Clown Colleges for All: Barataria shall establish Clown Colleges to ensure that every citizen has the opportunity to master the art of clowning and perform slapstick humor. + +Silly Science: Research grants shall be awarded to projects that explore the science of whoopee cushions, banana peels, and rubber chickens. + +Article VI: Defense and Pranks + +Pillow Fort Defense: Barataria's defense strategy shall revolve around building impregnable pillow forts and inviting would-be invaders to epic pillow fights to resolve conflicts. + +War Declarations through Whoopie Cushions: Before declaring war, Barataria shall send a diplomatic envoy to the offending nation armed only with whoopee cushions to express our discontent. + +Article VII: Amendments and Clown-novations + +Whimsical Amendments: Amendments to this Constitution shall be proposed in the form of a joke or a riddle, and they must receive a hearty laugh from at least three-quarters of the citizens to be adopted. +Article VIII: Final Pratfalls + +Ratification with a Pie in the Face: This Constitution shall be ratified in a grand ceremony involving a pie in the face of the official ratifier, ensuring a silly and sticky beginning for Barataria. + +Effective Clowning Date: This Constitution shall come into effect immediately upon the eruption of the first uncontrollable fit of laughter. + +In witness whereof, we, the undersigned jesters, pranksters, and merrymakers, do hereby establish and adopt this Constitution to make Barataria a haven of hilarity, where laughter reigns supreme, and seriousness is only allowed on April Fool's Day. \ No newline at end of file From 8d41ce9284507ac77f4b2abbc11ae4a21d11fd95 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 24 Oct 2024 13:14:51 +0200 Subject: [PATCH 70/79] Update `makeActivityChangeProposal` to work with the new checks --- cardano-testnet/cardano-testnet.cabal | 2 + .../src/Testnet/Process/Cli/DRep.hs | 72 +++++++++++-------- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 5 +- 3 files changed, 47 insertions(+), 32 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 9a7c289c3d5..5a4f6e1615f 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -65,6 +65,7 @@ library , hedgehog-extras ^>= 0.6.4 , lens-aeson , microlens + , monad-control , mono-traversable , mtl , network @@ -240,6 +241,7 @@ test-suite cardano-testnet-test , lens , lens-aeson , microlens + , monad-control , mtl , process , regex-compat diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index cf3a1ba7c31..5f3b5e3f4e7 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -26,6 +27,7 @@ import Prelude import Control.Monad (forM, void) import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Lens as AL import Data.Text (Text) @@ -35,11 +37,13 @@ import Data.Word (Word16) import GHC.Exts (fromString) import GHC.Stack import Lens.Micro ((^?)) +import System.Directory (makeAbsolute) import System.FilePath (()) +import Test.Cardano.CLI.Hash (serveFilesWhile) import Testnet.Components.Query import Testnet.Process.Cli.Transaction -import Testnet.Process.Run (execCli', execCliStdoutToJson) +import Testnet.Process.Run (addEnvVarsToConfig, execCli', execCliStdoutToJson) import Testnet.Types import Hedgehog (MonadTest, evalMaybe) @@ -339,7 +343,7 @@ getLastPParamUpdateActionId execConfig = do -- | Create a proposal to change the DRep activity interval. -- Return the transaction id and the index of the governance action. makeActivityChangeProposal - :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, Typeable era) + :: (HasCallStack, MonadBaseControl IO m, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, Typeable era) => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -- using the 'getEpochStateView' function. @@ -361,44 +365,52 @@ makeActivityChangeProposal execConfig epochStateView ceo work baseDir <- H.createDirectoryIfMissing work - proposalAnchorFile <- H.note $ baseDir "sample-proposal-anchor" - H.writeFile proposalAnchorFile $ - unlines [ "These are the reasons: " , "" , "1. First" , "2. Second " , "3. Third" ] - + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" proposalAnchorDataHash <- execCli' execConfig - [ "hash", "anchor-data", "--file-text", proposalAnchorFile + [ "hash", "anchor-data", "--file-binary", proposalAnchorFile ] - minDRepDeposit <- getMinDRepDeposit epochStateView ceo + proposalFile <- H.note $ baseDir "proposa-file" - proposalFile <- H.note $ baseDir "sample-proposal-anchor" + minDRepDeposit <- getMinDRepDeposit epochStateView ceo - void $ execCli' execConfig $ - [ "conway", "governance", "action", "create-protocol-parameters-update" - , "--testnet" - , "--governance-action-deposit", show @Integer minDRepDeposit - , "--deposit-return-stake-verification-key-file", stakeVkeyFp - ] ++ concatMap (\(prevGovernanceActionTxId, prevGovernanceActionIndex) -> - [ "--prev-governance-action-tx-id", prevGovernanceActionTxId - , "--prev-governance-action-index", show prevGovernanceActionIndex - ]) prevGovActionInfo ++ - [ "--drep-activity", show (unEpochInterval drepActivity) - , "--anchor-url", "https://tinyurl.com/3wrwb2as" - , "--anchor-data-hash", proposalAnchorDataHash - , "--out-file", proposalFile - ] + let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash] proposalBody <- H.note $ baseDir "tx.body" txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet - void $ execCli' execConfig - [ "conway", "transaction", "build" - , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet - , "--tx-in", Text.unpack $ renderTxIn txIn - , "--proposal-file", proposalFile - , "--out-file", proposalBody - ] + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [(relativeUrl, proposalAnchorFile)] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + void $ execCli' execConfig' $ + [ "conway", "governance", "action", "create-protocol-parameters-update" + , "--testnet" + , "--governance-action-deposit", show @Integer minDRepDeposit + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + ] ++ concatMap (\(prevGovernanceActionTxId, prevGovernanceActionIndex) -> + [ "--prev-governance-action-tx-id", prevGovernanceActionTxId + , "--prev-governance-action-index", show prevGovernanceActionIndex + ]) prevGovActionInfo ++ + [ "--drep-activity", show (unEpochInterval drepActivity) + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", proposalAnchorDataHash + , "--check-anchor-data" + , "--out-file", proposalFile + ] + + void $ execCli' execConfig' + [ "conway", "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet + , "--tx-in", Text.unpack $ renderTxIn txIn + , "--proposal-file", proposalFile + , "--out-file", proposalBody + ] + ) signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal" (File proposalBody) [Some $ paymentKeyInfoPair wallet] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index 20eb2b5c9a5..a1f499356f5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -24,6 +24,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl) import Data.Data (Typeable) import Data.Default.Class import qualified Data.Map as Map @@ -197,8 +198,8 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- and issues the specified votes using default DReps. Optionally, it also -- waits checks the expected effect of the proposal. activityChangeProposalTest - :: forall m t era . (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t, Typeable era, - EraGov (ShelleyLedgerEra era), ConwayEraPParams (ShelleyLedgerEra era)) + :: forall m t era . (HasCallStack, MonadBaseControl IO m, MonadTest m, MonadIO m, H.MonadAssertion m, + MonadCatch m, Foldable t, Typeable era, EraGov (ShelleyLedgerEra era), ConwayEraPParams (ShelleyLedgerEra era)) => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained -- using the 'getEpochStateView' function. From 56a90760e7f207aac9af73a23eb03e45ca36fac2 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 24 Oct 2024 13:28:44 +0200 Subject: [PATCH 71/79] Update `hprop_ledger_events_treasury_withdrawal` to work with the new checks --- .../Testnet/Test/Gov/TreasuryWithdrawal.hs | 71 +++++++++++-------- 1 file changed, 41 insertions(+), 30 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index 6415f302200..586948cba13 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -35,13 +35,15 @@ import qualified Data.Map.Strict as M import qualified Data.Text as Text import GHC.Stack import Lens.Micro +import System.Directory (makeAbsolute) import System.FilePath (()) +import Test.Cardano.CLI.Hash (serveFilesWhile) import Testnet.Components.Query import Testnet.Defaults import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) -import Testnet.Process.Run (execCli', mkExecConfig) +import Testnet.Process.Run (addEnvVarsToConfig, execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types import Testnet.Types @@ -88,15 +90,14 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury H.note_ $ "Foldblocks config file: " <> unFile configurationFile gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFile <- H.note $ work gov "sample-proposal-anchor" - treasuryWithdrawalActionFp <- H.note $ work gov "treasury-withdrawal.action" - -- pls configure your editors to trim trailing whitespace >.> - H.writeFile proposalAnchorFile $ - unlines [ "These are the reasons: " , "" , "1. First" , "2. Second " , "3. Third" ] + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + + treasuryWithdrawalActionFp <- H.note $ work gov "treasury-withdrawal.action" proposalAnchorDataHash <- execCli' execConfig - [ "hash", "anchor-data", "--file-text", proposalAnchorFile + [ "hash", "anchor-data", "--file-binary", proposalAnchorFile ] txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 @@ -142,35 +143,45 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury -- {{{ Create treasury withdrawal let withdrawalAmount = 3_300_777 :: Integer govActionDeposit <- getMinDRepDeposit epochStateView ceo - void $ execCli' execConfig - [ eraName, "governance", "action", "create-treasury-withdrawal" - , "--testnet" - , "--anchor-url", "https://tinyurl.com/3wrwb2as" - , "--anchor-data-hash", proposalAnchorDataHash - , "--governance-action-deposit", show govActionDeposit - , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys - , "--transfer", show withdrawalAmount - , "--funds-receiving-stake-verification-key-file", verificationKeyFp stakeKeys - , "--out-file", treasuryWithdrawalActionFp - ] + let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash] txbodyFp <- H.note $ work "tx.body" txbodySignedFp <- H.note $ work "tx.body.signed" - -- wait for one block before using wallet0 again - _ <- waitForBlocks epochStateView 1 - txin3 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 - - void $ execCli' execConfig - [ eraName, "transaction", "build" - , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 - , "--tx-in", Text.unpack $ renderTxIn txin3 - , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 5_000_000 - , "--proposal-file", treasuryWithdrawalActionFp - , "--out-file", txbodyFp - ] + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [(relativeUrl, proposalAnchorFile)] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + void $ execCli' execConfig' + [ eraName, "governance", "action", "create-treasury-withdrawal" + , "--testnet" + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", proposalAnchorDataHash + , "--governance-action-deposit", show govActionDeposit + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys + , "--transfer", show withdrawalAmount + , "--funds-receiving-stake-verification-key-file", verificationKeyFp stakeKeys + , "--out-file", treasuryWithdrawalActionFp + ] + + -- wait for one block before using wallet0 again + _ <- waitForBlocks epochStateView 1 + + txin3 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + void $ execCli' execConfig' + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", Text.unpack $ renderTxIn txin3 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 5_000_000 + , "--proposal-file", treasuryWithdrawalActionFp + , "--out-file", txbodyFp + ] + ) void $ execCli' execConfig [ eraName, "transaction", "sign" From 551d5eb63a4988a2995491207604b09c19a1198d Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 24 Oct 2024 16:25:15 +0200 Subject: [PATCH 72/79] Add test to check `transaction build` fails with wrong hash --- cardano-testnet/cardano-testnet.cabal | 1 + .../Test/Gov/TransactionBuildWrongHash.hs | 175 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 3 files changed, 178 insertions(+) create mode 100644 cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 5a4f6e1615f..1a24820be5d 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -205,6 +205,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.PredefinedAbstainDRep Cardano.Testnet.Test.Gov.ProposeNewConstitution Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO + Cardano.Testnet.Test.Gov.TransactionBuildWrongHash Cardano.Testnet.Test.Gov.TreasuryDonation Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs new file mode 100644 index 00000000000..661402485fd --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Gov.TransactionBuildWrongHash + ( hprop_transaction_build_wrong_hash + ) where + +import Cardano.Api as Api + +import Cardano.Testnet + +import Prelude + +import Control.Monad +import Data.Default.Class +import qualified Data.Text as Text +import GHC.IO.Exception (ExitCode (ExitFailure)) +import System.Directory (makeAbsolute) +import System.FilePath (()) + +import Test.Cardano.CLI.Hash (serveFilesWhile, tamperBase16Hash) +import Testnet.Components.Query +import Testnet.Process.Cli.Keys +import Testnet.Process.Run (addEnvVarsToConfig, execCli', execCliAny, mkExecConfig) +import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Start.Types +import Testnet.Types + +import Hedgehog +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +-- | Execute me with: +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Transaction Build Wrong Hash/'@ +hprop_transaction_build_wrong_hash :: Property +hprop_transaction_build_wrong_hash = integrationRetryWorkspace 2 "wrong-hash" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + + conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo + asbe = AnyShelleyBasedEra sbe + eraName = eraToString sbe + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def { genesisEpochLength = 200 } + + TestnetRuntime + { testnetMagic + , testnetNodes + , wallets=wallet0:wallet1:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf + + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + let socketPath = nodeSocketPath node + + epochStateView <- getEpochStateView configurationFile socketPath + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> unFile socketPath + H.note_ $ "Foldblocks config file: " <> unFile configurationFile + + gov <- H.createDirectoryIfMissing $ work "governance" + + let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz" + proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" "cardano-testnet-test" "files" "sample-proposal-anchor" + + infoActionFp <- H.note $ work gov "info.action" + + proposalAnchorDataHash <- execCli' execConfig + [ "hash", "anchor-data", "--file-binary", proposalAnchorFile + ] + + let stakeVkeyFp = gov "stake.vkey" + stakeSKeyFp = gov "stake.skey" + stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File stakeVkeyFp + , signingKey = File stakeSKeyFp + } + + cliStakeAddressKeyGen stakeKeys + + -- Register stake address + + void $ execCli' execConfig + [ eraName, "stake-address", "registration-certificate" + , "--stake-verification-key-file", stakeVkeyFp + , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? + , "--out-file", stakeCertFp + ] + + stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" + stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" + + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + void $ execCli' execConfig + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 10_000_000 + , "--certificate-file", stakeCertFp + , "--witness-override", show @Int 2 + , "--out-file", stakeCertTxBodyFp + ] + + void $ execCli' execConfig + [ eraName, "transaction", "sign" + , "--tx-body-file", stakeCertTxBodyFp + , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet0 + , "--signing-key-file", stakeSKeyFp + , "--out-file", stakeCertTxSignedFp + ] + + void $ execCli' execConfig + [ eraName, "transaction", "submit" + , "--tx-file", stakeCertTxSignedFp + ] + + let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash] + + txbodyFp <- H.note $ work "tx.body" + + tamperedHash <- H.evalMaybe $ tamperBase16Hash proposalAnchorDataHash + + -- Create temporary HTTP server with files required by the call to `cardano-cli` + -- In this case, the server emulates an IPFS gateway + serveFilesWhile + [(relativeUrl, proposalAnchorFile)] + ( \port -> do + let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + + void $ + execCli' + execConfig' + [ eraName, "governance", "action", "create-info" + , "--testnet" + , "--governance-action-deposit", show @Int 1_000_000 -- TODO: Get this from the node + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash + , "--anchor-data-hash", tamperedHash + , "--out-file", infoActionFp + ] + + txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + (exitCode, _, stderrOutput) <- + execCliAny + execConfig' + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 + , "--proposal-file", infoActionFp + , "--out-file", txbodyFp + ] + + exitCode H.=== ExitFailure 1 + + H.note_ stderrOutput + + H.assert ("Hashes do not match!" `Text.isInfixOf` Text.pack stderrOutput) + ) 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 8e993360147..74ac4d3038f 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -20,6 +20,7 @@ import qualified Cardano.Testnet.Test.Gov.GovActionTimeout as Gov import qualified Cardano.Testnet.Test.Gov.InfoAction as LedgerEvents import qualified Cardano.Testnet.Test.Gov.PParamChangeFailsSPO as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov +import qualified Cardano.Testnet.Test.Gov.TransactionBuildWrongHash 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 @@ -68,6 +69,7 @@ tests = do , ignoreOnMacAndWindows "Treasury Withdrawal" Gov.hprop_ledger_events_treasury_withdrawal , ignoreOnWindows "PParam change fails for SPO" Gov.hprop_check_pparam_fails_spo , ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action + , ignoreOnWindows "Transaction Build Wrong Hash" WrongHash.hprop_transaction_build_wrong_hash ] , T.testGroup "Plutus" [ ignoreOnWindows "PlutusV3" Cardano.Testnet.Test.Cli.Conway.Plutus.hprop_plutus_v3] From c106b663da799da67a454dc69b7321a5f2cd40bc Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 29 Oct 2024 18:18:09 +0100 Subject: [PATCH 73/79] Renamed `TransactionBuildWrongHash` to `Transaction.HashMismatch` --- cardano-testnet/cardano-testnet.cabal | 2 +- .../HashMismatch.hs} | 2 +- .../test/cardano-testnet-test/cardano-testnet-test.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) rename cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/{TransactionBuildWrongHash.hs => Transaction/HashMismatch.hs} (99%) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 1a24820be5d..1ecdb19c2c6 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -205,7 +205,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.PredefinedAbstainDRep Cardano.Testnet.Test.Gov.ProposeNewConstitution Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO - Cardano.Testnet.Test.Gov.TransactionBuildWrongHash + Cardano.Testnet.Test.Gov.Transaction.HashMismatch Cardano.Testnet.Test.Gov.TreasuryDonation Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs similarity index 99% rename from cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs rename to cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs index 661402485fd..d29cb6124e8 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TransactionBuildWrongHash.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module Cardano.Testnet.Test.Gov.TransactionBuildWrongHash +module Cardano.Testnet.Test.Gov.Transaction.HashMismatch ( hprop_transaction_build_wrong_hash ) where 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 74ac4d3038f..0afabc4625c 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -20,7 +20,7 @@ import qualified Cardano.Testnet.Test.Gov.GovActionTimeout as Gov import qualified Cardano.Testnet.Test.Gov.InfoAction as LedgerEvents import qualified Cardano.Testnet.Test.Gov.PParamChangeFailsSPO as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov -import qualified Cardano.Testnet.Test.Gov.TransactionBuildWrongHash as WrongHash +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 From 3edf39146d4d299c5fe447c5195488f212f61ec0 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 15 Nov 2024 11:55:44 +0100 Subject: [PATCH 74/79] Use `assertWith` instead of `assert` --- .../Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs index d29cb6124e8..76dbef6bd28 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs @@ -171,5 +171,5 @@ hprop_transaction_build_wrong_hash = integrationRetryWorkspace 2 "wrong-hash" $ H.note_ stderrOutput - H.assert ("Hashes do not match!" `Text.isInfixOf` Text.pack stderrOutput) + H.assertWith (Text.pack stderrOutput) ("Hashes do not match!" `Text.isInfixOf`) ) From 964ff1b4f745902638963bb78c9ff151a3802b2e Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 15 Nov 2024 12:38:20 +0100 Subject: [PATCH 75/79] Use `getKeyDeposit` instead of hard-coded `0` --- .../Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs index 76dbef6bd28..09684a1db8a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs @@ -10,6 +10,7 @@ module Cardano.Testnet.Test.Gov.Transaction.HashMismatch ) where import Cardano.Api as Api +import Cardano.Api.Ledger (Coin (unCoin)) import Cardano.Testnet @@ -93,11 +94,12 @@ hprop_transaction_build_wrong_hash = integrationRetryWorkspace 2 "wrong-hash" $ cliStakeAddressKeyGen stakeKeys -- Register stake address + keyDeposit <- getKeyDeposit epochStateView ceo void $ execCli' execConfig [ eraName, "stake-address", "registration-certificate" , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? + , "--key-reg-deposit-amt", show $ unCoin keyDeposit , "--out-file", stakeCertFp ] From 7fc64a9986c44627f3fd60e2f5b3c31be1d824bb Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 15 Nov 2024 12:48:04 +0100 Subject: [PATCH 76/79] Use `getMinGovActionDeposit` instead of hard-coded value --- .../Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs index 09684a1db8a..02acf3cef06 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs @@ -144,12 +144,14 @@ hprop_transaction_build_wrong_hash = integrationRetryWorkspace 2 "wrong-hash" $ ( \port -> do let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + minDepositAmount <- getMinGovActionDeposit epochStateView ceo + void $ execCli' execConfig' [ eraName, "governance", "action", "create-info" , "--testnet" - , "--governance-action-deposit", show @Int 1_000_000 -- TODO: Get this from the node + , "--governance-action-deposit", show minDepositAmount , "--deposit-return-stake-verification-key-file", stakeVkeyFp , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash , "--anchor-data-hash", tamperedHash From c3114a97ebc996ba796be4da8de9f9a6b3cf795d Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 15 Nov 2024 13:14:35 +0100 Subject: [PATCH 77/79] Reduce test workspace prefix length --- .../Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 a27e01a1f89..d864f61db17 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 @@ -40,7 +40,7 @@ import qualified Hedgehog.Extras as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/register deregister stake address in transaction build/"'@ hprop_tx_register_deregister_stake_address :: Property -hprop_tx_register_deregister_stake_address = integrationWorkspace "register-deregister-stake-address" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do +hprop_tx_register_deregister_stake_address = integrationWorkspace "register-deregister-stake-addr" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath From bbc3fd0ba622d0f4cd12e49e44932b7e0baa24ec Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 15 Jan 2025 21:23:57 +0100 Subject: [PATCH 78/79] Remove deprecated function --- .../Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs index 02acf3cef06..25e9e2eed2c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/Transaction/HashMismatch.hs @@ -47,7 +47,7 @@ hprop_transaction_build_wrong_hash = integrationRetryWorkspace 2 "wrong-hash" $ work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - sbe = conwayEraOnwardsToShelleyBasedEra ceo + sbe = convert ceo asbe = AnyShelleyBasedEra sbe eraName = eraToString sbe fastTestnetOptions = def { cardanoNodeEra = asbe } From 91cf3f1a7e925e255215ea196b25ac8411504e82 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 17 Jan 2025 12:46:15 -0700 Subject: [PATCH 79/79] Update hedgehog-extras constraints --- bench/locli/locli.cabal | 2 +- cardano-node-chairman/cardano-node-chairman.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index f47a5b68ea7..7649407e988 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -189,7 +189,7 @@ test-suite test-locli build-depends: cardano-prelude , containers , hedgehog - , hedgehog-extras ^>= 0.6.4 + , hedgehog-extras ^>= 0.7 , locli , text diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index f6dfe27c2a1..b5b350234ca 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.6.4 + , hedgehog-extras ^>= 0.7 , network , process , random diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 1ecdb19c2c6..6a4eb37efb4 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -62,7 +62,7 @@ library , exceptions , filepath , hedgehog - , hedgehog-extras ^>= 0.6.4 + , hedgehog-extras ^>= 0.7 , lens-aeson , microlens , monad-control