Merge branch 'master' into karknu/adj_trace

Author: karknu

.github/workflows/release-ghcr.yaml

@@ -93,7 +93,15 @@ jobs:
         echo "Latest release tag is: $LATEST_TAG"
 
     - name: Tagging intersectmbo container latest
-      if: ${{ github.event.release.tag_name == steps.latest-tag.outputs.LATEST_TAG }}
+      # Github releases are checked for latest tag in the first `or` operand of
+      # the if statement. However, promoted pre-releases or changed full
+      # releases do not count as a `published` event and so won't trigger
+      # this workflow.  For those use cases a manual workflow must be run
+      # from the matching release tag which the second `or` operand checks
+      # for.
+      if: |
+        (github.event_name == 'release' && github.event.release.tag_name == steps.latest-tag.outputs.LATEST_TAG) ||
+        (github.event_name == 'workflow_dispatch' && github.ref == format('refs/tags/{0}', steps.latest-tag.outputs.LATEST_TAG))
       run: |
         echo "::group::Tagging latest for intersectmbo/cardano-node"
         skopeo copy docker-archive:./result-node docker://ghcr.io/intersectmbo/cardano-node:latest

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2025-04-16T18:30:40Z
-  , cardano-haskell-packages 2025-04-22T10:01:33Z
+  , cardano-haskell-packages 2025-04-29T14:14:35Z
 
 packages:
   cardano-node
@@ -90,4 +90,3 @@ if impl (ghc >= 9.12)
     -- https://github.com/haskell-servant/servant/pull/1810
     , servant:base
     , servant-server:base
-

cardano-node-chairman/cardano-node-chairman.cabal

@@ -45,7 +45,7 @@ executable cardano-node-chairman
                       , cardano-crypto-class
                       , cardano-git-rev ^>= 0.2.2
                       , cardano-ledger-core ^>= 1.17
-                      , cardano-node ^>= 10.3
+                      , cardano-node ^>= 10.4
                       , cardano-prelude
                       , containers
                       , contra-tracer

cardano-node/ChangeLog.md

@@ -29,6 +29,9 @@
   }
   ```
 
+- KeepAlive client tracing: dropped `KeepAliveClient` from `kind` of
+  `AddSample` messages in the legacy tracing system.
+
 ## 10.2 -- January 2025
 
 - Use p2p network stack by default, warn when using the legacy network stack.

cardano-node/cardano-node.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:                   cardano-node
-version:                10.3.1
+version:                10.4.1
 synopsis:               The cardano full node
 description:            The cardano full node.
 category:               Cardano,
@@ -190,7 +190,7 @@ library
                       , network-mux >= 0.5
                       , nothunks
                       , optparse-applicative-fork >= 0.18.1
-                      , ouroboros-consensus ^>= 0.26
+                      , ouroboros-consensus ^>= 0.26.0.1
                       , ouroboros-consensus-cardano ^>= 0.25
                       , ouroboros-consensus-diffusion ^>= 0.22
                       , ouroboros-consensus-protocol

cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs

@@ -68,14 +68,11 @@ import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
 import           Ouroboros.Network.BlockFetch.Decision
 import           Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..))
 import           Ouroboros.Network.ConnectionId (ConnectionId (..))
-import           Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..))
-import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
 import           Ouroboros.Network.SizeInBytes (SizeInBytes (..))
 import           Ouroboros.Network.TxSubmission.Inbound hiding (txId)
 import           Ouroboros.Network.TxSubmission.Outbound
 
 import           Control.Monad (guard)
-import           Control.Monad.Class.MonadTime.SI (Time (..))
 import           Data.Aeson (ToJSON, Value (Number, String), toJSON, (.=))
 import qualified Data.Aeson as Aeson
 import           Data.Foldable (Foldable (toList))
@@ -84,7 +81,7 @@ import           Data.IntPSQ (IntPSQ)
 import qualified Data.IntPSQ as Pq
 import qualified Data.List as List
 import qualified Data.Text as Text
-import           Data.Time (DiffTime, NominalDiffTime)
+import           Data.Time (NominalDiffTime)
 import           Data.Word (Word32, Word64)
 import           Network.TypedProtocol.Core
 
@@ -2163,41 +2160,6 @@ instance MetaTrace (TraceBlockchainTimeEvent t) where
     , Namespace [] ["SystemClockMovedBack"]
     ]
 
---------------------------------------------------------------------------------
--- KeepAliveClient Tracer
---------------------------------------------------------------------------------
-
-instance Show remotePeer => LogFormatting (TraceKeepAliveClient remotePeer) where
-    forMachine _dtal (AddSample peer rtt pgsv) =
-        mconcat
-          [ "kind" .= String "AddSample"
-          , "address" .= show peer
-          , "rtt" .= rtt
-          , "sampleTime" .= show (dTime $ sampleTime pgsv)
-          , "outboundG" .= (realToFrac $ gGSV (outboundGSV pgsv) :: Double)
-          , "inboundG" .= (realToFrac $ gGSV (inboundGSV pgsv) :: Double)
-          ]
-        where
-          gGSV :: GSV -> DiffTime
-          gGSV (GSV g _ _) = g
-
-          dTime :: Time -> Double
-          dTime (Time d) = realToFrac d
-
-    forHuman = showT
-
-instance MetaTrace (TraceKeepAliveClient remotePeer) where
-  namespaceFor AddSample {} = Namespace [] ["KeepAliveClient"]
-
-  severityFor (Namespace _ ["KeepAliveClient"]) Nothing = Just Info
-  severityFor _ _ = Nothing
-
-  documentFor (Namespace _ ["KeepAliveClient"]) = Just
-    "A server read has occurred, either for an add block or a rollback"
-  documentFor _ = Just ""
-
-  allNamespaces = [Namespace [] ["KeepAliveClient"]]
-
 --------------------------------------------------------------------------------
 -- Gsm Tracer
 --------------------------------------------------------------------------------

cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs

@@ -20,14 +20,18 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, HasTxId, Has
                    LedgerSupportsMempool, extractTxs, txId)
 import           Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize)
 import           Ouroboros.Network.Block (Point, Serialised (..), blockHash)
+import           Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..))
+import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
 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 qualified Ouroboros.Network.Protocol.PeerSharing.Type as PS
 import           Ouroboros.Network.SizeInBytes (SizeInBytes (..))
 
+import           Control.Monad.Class.MonadTime.SI (Time (..))
 import           Data.Aeson (ToJSON (..), Value (String), (.=))
 import           Data.Proxy (Proxy (..))
+import           Data.Time (DiffTime)
 import           Data.Text (pack)
 import           Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency))
 
@@ -427,3 +431,38 @@ instance MetaTrace (AnyMessage (PS.PeerSharing addr)) where
       , Namespace [] ["PeerShareResult"]
       , Namespace [] ["PeerShareDone"]
       ]
+
+--------------------------------------------------------------------------------
+-- KeepAliveClient Tracer
+--------------------------------------------------------------------------------
+
+instance Show remotePeer => LogFormatting (TraceKeepAliveClient remotePeer) where
+    forMachine _dtal (AddSample peer rtt pgsv) =
+        mconcat
+          [ "kind" .= String "AddSample"
+          , "address" .= show peer
+          , "rtt" .= rtt
+          , "sampleTime" .= show (dTime $ sampleTime pgsv)
+          , "outboundG" .= (realToFrac $ gGSV (outboundGSV pgsv) :: Double)
+          , "inboundG" .= (realToFrac $ gGSV (inboundGSV pgsv) :: Double)
+          ]
+        where
+          gGSV :: GSV -> DiffTime
+          gGSV (GSV g _ _) = g
+
+          dTime :: Time -> Double
+          dTime (Time d) = realToFrac d
+
+    forHuman = showT
+
+instance MetaTrace (TraceKeepAliveClient remotePeer) where
+  namespaceFor AddSample {} = Namespace [] ["KeepAliveClient"]
+
+  severityFor (Namespace _ ["KeepAliveClient"]) Nothing = Just Info
+  severityFor _ _ = Nothing
+
+  documentFor (Namespace _ ["KeepAliveClient"]) = Just
+    "A server read has occurred, either for an add block or a rollback"
+  documentFor _ = Just ""
+
+  allNamespaces = [Namespace [] ["KeepAliveClient"]]

cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs

@@ -1526,7 +1526,7 @@ instance (Show txid, Show tx)
 instance Show remotePeer => ToObject (TraceKeepAliveClient remotePeer) where
   toObject _verb (AddSample peer rtt pgsv) =
     mconcat
-      [ "kind" .= String "KeepAliveClient AddSample"
+      [ "kind" .= String "AddSample"
       , "address" .= show peer
       , "rtt" .= rtt
       , "sampleTime" .= show (dTime $ sampleTime pgsv)

cardano-node/src/Cardano/Tracing/Tracers.hs

@@ -1564,18 +1564,17 @@ traceConnectionManagerTraceMetrics (OnOff True) (Just ekgDirect) = cmtTracer
   where
     cmtTracer :: Tracer IO (ConnectionManager.Trace peerAddr handlerTrace)
     cmtTracer = Tracer $ \case
-      (ConnectionManager.TrConnectionManagerCounters
-                (ConnectionManagerCounters
-                  prunableConns
-                  duplexConns
-                  unidirectionalConns
-                  incomingConns
-                  outgoingConns
-                )
-              ) -> do
+      ConnectionManager.TrConnectionManagerCounters
+          ConnectionManagerCounters {
+            fullDuplexConns,
+            duplexConns,
+            unidirectionalConns,
+            inboundConns,
+            outboundConns
+          } -> do
         sendEKGDirectInt ekgDirect
-                         "cardano.node.metrics.connectionManager.prunableConns"
-                         prunableConns
+                         "cardano.node.metrics.connectionManager.fullDuplexConns"
+                         fullDuplexConns
         sendEKGDirectInt ekgDirect
                          "cardano.node.metrics.connectionManager.duplexConns"
                          duplexConns
@@ -1584,10 +1583,10 @@ traceConnectionManagerTraceMetrics (OnOff True) (Just ekgDirect) = cmtTracer
                          unidirectionalConns
         sendEKGDirectInt ekgDirect
                          "cardano.node.metrics.connectionManager.incomingConns"
-                         incomingConns
+                         inboundConns
         sendEKGDirectInt ekgDirect
                          "cardano.node.metrics.connectionManager.outgoingConns"
-                         outgoingConns
+                         outboundConns
       _ -> return ()
 
 

cardano-testnet/cardano-testnet.cabal

@@ -185,12 +185,13 @@ test-suite cardano-testnet-test
 
   main-is:              cardano-testnet-test.hs
 
-  other-modules:        Cardano.Testnet.Test.Cli.Conway.Plutus
-                        Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
+  other-modules:        Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
                         Cardano.Testnet.Test.Cli.KesPeriodInfo
                         Cardano.Testnet.Test.Cli.LeadershipSchedule
                         Cardano.Testnet.Test.Cli.Query
                         Cardano.Testnet.Test.Cli.QuerySlotNumber
+                        Cardano.Testnet.Test.Cli.Plutus.Scripts
+                        Cardano.Testnet.Test.Cli.Plutus.CostCalculation
                         Cardano.Testnet.Test.Cli.StakeSnapshot
                         Cardano.Testnet.Test.Cli.Transaction
                         Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress

cardano-testnet/src/Testnet/Components/Query.hs

@@ -39,26 +39,31 @@ module Testnet.Components.Query
   , getGovActionLifetime
   , getKeyDeposit
   , getDelegationState
+  , getTxIx
   ) where
 
 import           Cardano.Api as Api
 import           Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole))
 import           Cardano.Api.Shelley (ShelleyLedgerEra)
+import qualified Cardano.Api.Ledger as L
 
+import           Cardano.Crypto.Hash (hashToStringAsHex)
 import           Cardano.Ledger.Api (ConwayGovState)
 import qualified Cardano.Ledger.Api as L
-import qualified Cardano.Ledger.Coin as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UMap as L
 
+import           Prelude
+
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad
 import           Control.Monad.Trans.Resource
 import           Control.Monad.Trans.State.Strict (put)
 import           Data.IORef
 import           Data.List (sortOn)
+import qualified Data.Map as Map
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import           Data.Maybe
@@ -74,10 +79,10 @@ import           Lens.Micro (Lens', to, (^.))
 import           Testnet.Property.Assert
 import           Testnet.Types
 
+import           Hedgehog
 import qualified Hedgehog as H
 import           Hedgehog.Extras (MonadAssertion)
 import qualified Hedgehog.Extras as H
-import           Hedgehog.Internal.Property (MonadTest)
 
 -- | Block and wait for the desired epoch.
 waitUntilEpoch
@@ -592,3 +597,15 @@ getDelegationState epochStateView = do
                  . L.dsUnifiedL
 
   pure $ L.toStakeCredentials pools
+
+-- | Returns the transaction index of a transaction with a given amount and ID.
+getTxIx :: forall m era. HasCallStack => MonadTest m => ShelleyBasedEra era -> String -> L.Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int)
+getTxIx sbe txId amount (AnyNewEpochState sbe' _ tbs, _, _) = do
+  Refl <- H.leftFail $ assertErasEqual sbe sbe'
+  shelleyBasedEraConstraints sbe' $ do
+    return $ Map.foldlWithKey (\acc (TxIn (TxId thisTxId) (TxIx thisTxIx)) (TxOut _ txOutValue _ _) ->
+      case acc of
+        Nothing | hashToStringAsHex thisTxId == txId &&
+                  txOutValueToLovelace txOutValue == amount -> Just $ fromIntegral thisTxIx
+                | otherwise -> Nothing
+        x -> x) Nothing $ getLedgerTablesUTxOValues sbe' tbs