Network tracing instances for fetch decisions

bench/locli/locli.cabal

@@ -113,7 +113,7 @@ library
                       , hashable
                       , optparse-applicative-fork >= 0.18.1
                       , ouroboros-consensus
-                      , ouroboros-network-api ^>= 0.10
+                      , ouroboros-network-api ^>= 0.11
                       , sop-core
                       , split
                       , statistics
@@ -158,7 +158,7 @@ test-suite test-locli
   build-depends:        cardano-prelude
                       , containers
                       , hedgehog
-                      , hedgehog-extras ^>= 0.6.4
+                      , hedgehog-extras >= 0.6.4 && <0.6.5.1
                       , locli
                       , text
 

bench/plutus-scripts-bench/plutus-scripts-bench.cabal

@@ -82,10 +82,10 @@ library
   -- IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api             ^>=10.1
-    , plutus-ledger-api       ^>=1.36
-    , plutus-tx               ^>=1.36
-    , plutus-tx-plugin        ^>=1.36
+    , cardano-api             ^>=10.4
+    , plutus-ledger-api       ^>=1.37
+    , plutus-tx               ^>=1.37
+    , plutus-tx-plugin        ^>=1.37
 
   ------------------------
   -- Non-IOG dependencies

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,8 @@ 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)
 
@@ -45,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 (..))
@@ -84,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,
@@ -94,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
@@ -114,7 +120,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)

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)

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,15 +140,15 @@ 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
           pure $ SendMsgDone ()
         (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

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

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

bench/tx-generator/tx-generator.cabal

@@ -106,7 +106,7 @@ library
                       , attoparsec-aeson
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 10.1
+                      , cardano-api ^>= 10.4
                       , cardano-binary
                       , cardano-cli ^>= 10.1
                       , cardano-crypto-class
@@ -158,6 +158,7 @@ library
                       , transformers-except
                       , unordered-containers
                       , yaml
+                      , microlens
 
   default-language:     Haskell2010
   default-extensions:   OverloadedStrings

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 2024-10-30T10:23:17Z
+  , hackage.haskell.org 2024-12-10T16:20:07Z
+  , cardano-haskell-packages 2024-12-18T14:29:04Z
 
 packages:
   cardano-node
@@ -60,11 +60,65 @@ package plutus-scripts-bench
 constraints:
   , wai-extra < 3.1.15
   , Cabal < 3.14
+  , hedgehog-extras <0.6.5.1
 
 allow-newer:
   , katip:Win32
   , ekg-wai:time
+  , *:hedgehog-extras
 
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-network.git
+  tag: 4920b7a8e1a639e6b6a85611bef6d541e21d012a
+  --sha256: sha256-mrGXtC/mStln5KqoXlruKYl2vHYZhgw3biRlZm82h7A=
+  subdir:
+    cardano-client
+    cardano-ping
+    monoidal-synchronisation
+    network-mux
+    ntp-client
+    ouroboros-network
+    ouroboros-network-api
+    ouroboros-network-framework
+    ouroboros-network-mock
+    ouroboros-network-protocols
+    ouroboros-network-testing
+    quickcheck-monoids
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus.git
+  tag: f2d134da6d6d4f7bcbfb85ba94b30f49b3f2b7c6
+  --sha256: sha256-4Lu716WX9S+5dguxa8lUjAgeCQYsxj9QZZ9xLyyjivQ=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-protocol
+    ouroboros-consensus-diffusion
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api.git
+  tag: 04ac6b36284ea823da0a7b88210c03b586f7f808
+  --sha256: sha256-LcZe9GcH2qRvNCk4leJHMLEX0KMiqbkYP4xACBE/znE=
+  subdir:
+    cardano-api
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-cli.git
+  tag: e2940caf43f5ba3194173523369553c93c2340b7
+  --sha256: sha256-Bzic7wIBU8Md/vzj87d9kgdpOGfTXOtjBYLyTR/rZ5g=
+  subdir:
+    cardano-cli
+
+source-repository-package
+  type: git
+  location: https://github.com/neilmayhew/ekg-forward.git
+  tag: 4ba8bb693093f6cf54d43d6e9bbce1e08b0457dd
+  --sha256: sha256-g0gYqzRGjmZwxEzihJ4JifJe+GRfdLIMzaot7rUcjlI=

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.6.4 && <0.6.5.1
                       , network
                       , process
                       , random

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.