Fmaste/dmq node traces

cabal.project

@@ -15,11 +15,19 @@ repository cardano-haskell-packages
 -- repeat the index-state for hackage to work around haskell.nix parsing limitation
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2025-06-17T07:53:04Z
+  , hackage.haskell.org 2025-07-16T09:24:19Z
 
   -- Bump this if you need newer packages from CHaP
   , cardano-haskell-packages 2025-02-15T18:39:38Z
 
+-- `trace-dispatcher` from repo "cardano-node" branch "fmaste/dmq-node".
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-node.git
+  subdir: trace-dispatcher
+  tag: 9d25e72454269ecca5f138ee2abf3cbbfa619428
+  --sha256: 1asb9gx7w50p31wv6hnac7hcmvs3h2m5zrm57p1dpmb70h38xz74
+
 packages: ./cardano-ping
           ./monoidal-synchronisation
           ./network-mux
@@ -32,6 +40,7 @@ packages: ./cardano-ping
           ./ntp-client
           ./cardano-client
           ./decentralized-message-queue
+          ./quickcheck-monoids
 
 tests: True
 benchmarks: True
@@ -53,7 +62,3 @@ package network-mux
 
 package ouroboros-network
   flags: +asserts +cddl
-
-allow-newer: aeson:QuickCheck,
-             tree-diff:QuickCheck,
-             quickcheck-instances:QuickCheck

cardano-client/cardano-client.cabal

@@ -29,7 +29,7 @@ library
     io-classes:si-timers ^>=1.8.0.1,
     network-mux ^>=0.9,
     ouroboros-network ^>=0.22,
-    ouroboros-network-api ^>=0.15,
+    ouroboros-network-api ^>=0.16,
     ouroboros-network-framework ^>=0.19,
 
   ghc-options:

cardano-ping/src/Cardano/Network/Ping.hs

@@ -153,6 +153,7 @@ supportedNodeToClientVersions magic =
   , NodeToClientVersionV19 magic
   , NodeToClientVersionV20 magic
   , NodeToClientVersionV21 magic
+  , NodeToClientVersionV22 magic
   ]
 
 data InitiatorOnly = InitiatorOnly | InitiatorAndResponder
@@ -191,6 +192,7 @@ data NodeVersion
   | NodeToClientVersionV19 Word32
   | NodeToClientVersionV20 Word32
   | NodeToClientVersionV21 Word32
+  | NodeToClientVersionV22 Word32
   | NodeToNodeVersionV1    Word32
   | NodeToNodeVersionV2    Word32
   | NodeToNodeVersionV3    Word32
@@ -223,6 +225,7 @@ instance ToJSON NodeVersion where
       NodeToClientVersionV19 m -> go2 "NodeToClientVersionV19" m
       NodeToClientVersionV20 m -> go2 "NodeToClientVersionV20" m
       NodeToClientVersionV21 m -> go2 "NodeToClientVersionV21" m
+      NodeToClientVersionV22 m -> go2 "NodeToClientVersionV22" m
       NodeToNodeVersionV1    m -> go2 "NodeToNodeVersionV1" m
       NodeToNodeVersionV2    m -> go2 "NodeToNodeVersionV2" m
       NodeToNodeVersionV3    m -> go2 "NodeToNodeVersionV3" m
@@ -371,6 +374,9 @@ handshakeReqEnc versions query =
     encodeVersion (NodeToClientVersionV21 magic) =
           CBOR.encodeWord (21 `setBit` nodeToClientVersionBit)
       <>  nodeToClientDataWithQuery magic
+    encodeVersion (NodeToClientVersionV22 magic) =
+          CBOR.encodeWord (22 `setBit` nodeToClientVersionBit)
+      <>  nodeToClientDataWithQuery magic
 
     -- node-to-node
     encodeVersion (NodeToNodeVersionV1 magic) =
@@ -521,6 +527,7 @@ handshakeDec = do
         (19, True)  -> Right . NodeToClientVersionV19 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         (20, True)  -> Right . NodeToClientVersionV20 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         (21, True)  -> Right . NodeToClientVersionV21 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
+        (22, True)  -> Right . NodeToClientVersionV22 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         _           -> return $ Left $ UnknownVersionInRsp version
 
     decodeWithMode :: (Word32 -> InitiatorOnly -> NodeVersion) -> CBOR.Decoder s (Either HandshakeFailure NodeVersion)
@@ -845,6 +852,7 @@ isSameVersionAndMagic v1 v2 = extract v1 == extract v2
         extract (NodeToClientVersionV19 m) = (-19, m)
         extract (NodeToClientVersionV20 m) = (-20, m)
         extract (NodeToClientVersionV21 m) = (-21, m)
+        extract (NodeToClientVersionV22 m) = (-22, m)
         extract (NodeToNodeVersionV1 m)    = (1, m)
         extract (NodeToNodeVersionV2 m)    = (2, m)
         extract (NodeToNodeVersionV3 m)    = (3, m)

decentralized-message-queue/decentralized-message-queue.cabal

@@ -89,7 +89,7 @@ library
     nothunks ^>=0.1.4 || ^>=0.2,
     optparse-applicative ^>=0.18,
     ouroboros-network:{ouroboros-network, orphan-instances} ^>=0.22,
-    ouroboros-network-api ^>=0.15,
+    ouroboros-network-api ^>=0.16,
     ouroboros-network-framework ^>=0.19,
     ouroboros-network-protocols ^>=0.15,
     random ^>=1.2,

decentralized-message-queue/src/DMQ/Configuration.hs

@@ -22,8 +22,8 @@ import GHC.Generics (Generic)
 import Network.Socket (AddrInfo (..), AddrInfoFlag (..), SockAddr,
            SocketType (..), defaultHints, getAddrInfo)
 
-import Ouroboros.Network.Diffusion.Configuration
-           (defaultAcceptedConnectionsLimit, defaultDeadlineChurnInterval,
+import Ouroboros.Network.Diffusion.Configuration (BlockProducerOrRelay (..),
+           defaultAcceptedConnectionsLimit, defaultDeadlineChurnInterval,
            defaultDeadlineTargets, defaultProtocolIdleTimeout,
            defaultTimeWaitTimeout)
 import Ouroboros.Network.Diffusion.Topology (NetworkTopology (..),
@@ -59,53 +59,56 @@ data Configuration ntnFd ntnAddr ntcFd ntcAddr =
 
 instance FromJSON (Configuration ntnFd ntnAddr ntcFd ntcAddr) where
   parseJSON = withObject "DMQConfiguration" $ \v -> do
-    dmqcAcceptedConnectionsLimit <- v .:? "AcceptedConnectionsLimit"
-                                      .!= defaultAcceptedConnectionsLimit
-
-    dmqcDiffusionMode <- v .:? "DiffusionMode"
-                           .!= InitiatorAndResponderDiffusionMode
-
-    dmqcTargetOfRootPeers                 <- v .:? "TargetNumberOfRootPeers"
-                                               .!= targetNumberOfRootPeers defaultDeadlineTargets
-    dmqcTargetOfKnownPeers                <- v .:? "TargetNumberOfKnownPeers"
-                                               .!= targetNumberOfKnownPeers defaultDeadlineTargets
-    dmqcTargetOfEstablishedPeers          <- v .:? "TargetNumberOfEstablishedPeers"
-                                               .!= targetNumberOfEstablishedPeers defaultDeadlineTargets
-    dmqcTargetOfActivePeers               <- v .:? "TargetNumberOfActivePeers"
-                                               .!= targetNumberOfActivePeers defaultDeadlineTargets
-    dmqcTargetOfKnownBigLedgerPeers       <- v .:? "TargetNumberOfKnownBigLedgerPeers"
-                                               .!= targetNumberOfKnownBigLedgerPeers defaultDeadlineTargets
-    dmqcTargetOfEstablishedBigLedgerPeers <- v .:? "TargetNumberOfEstablishedBigLedgerPeers"
-                                               .!= targetNumberOfEstablishedBigLedgerPeers defaultDeadlineTargets
-    dmqcTargetOfActiveBigLedgerPeers      <- v .:? "TargetNumberOfActiveBigLedgerPeers"
-                                               .!= targetNumberOfActiveBigLedgerPeers defaultDeadlineTargets
-
-    dmqcProtocolIdleTimeout <- v .:? "ProtocolIdleTimeout"
-                                 .!= defaultProtocolIdleTimeout
-
-    dmqcChurnInterval <- v .:? "ChurnInterval"
-                           .!= defaultDeadlineChurnInterval
-
-    dmqcPeerSharing <- v .:? "PeerSharing"
-                         .!= PeerSharingEnabled
-    networkMagic <- v .: "NetworkMagic"
-
-    pure $
-      Configuration
-        { dmqcAcceptedConnectionsLimit
-        , dmqcDiffusionMode
-        , dmqcTargetOfRootPeers
-        , dmqcTargetOfKnownPeers
-        , dmqcTargetOfEstablishedPeers
-        , dmqcTargetOfActivePeers
-        , dmqcTargetOfKnownBigLedgerPeers
-        , dmqcTargetOfEstablishedBigLedgerPeers
-        , dmqcTargetOfActiveBigLedgerPeers
-        , dmqcProtocolIdleTimeout
-        , dmqcChurnInterval
-        , dmqcPeerSharing
-        , dmqcNetworkMagic = NetworkMagic networkMagic
-        }
+      dmqcAcceptedConnectionsLimit <- v .:? "AcceptedConnectionsLimit"
+                                        .!= defaultAcceptedConnectionsLimit
+
+      dmqcDiffusionMode <- v .:? "DiffusionMode"
+                             .!= InitiatorAndResponderDiffusionMode
+
+      dmqcTargetOfRootPeers                 <- v .:? "TargetNumberOfRootPeers"
+                                                 .!= targetNumberOfRootPeers deadlineTargets
+      dmqcTargetOfKnownPeers                <- v .:? "TargetNumberOfKnownPeers"
+                                                 .!= targetNumberOfKnownPeers deadlineTargets
+      dmqcTargetOfEstablishedPeers          <- v .:? "TargetNumberOfEstablishedPeers"
+                                                 .!= targetNumberOfEstablishedPeers deadlineTargets
+      dmqcTargetOfActivePeers               <- v .:? "TargetNumberOfActivePeers"
+                                                 .!= targetNumberOfActivePeers deadlineTargets
+      dmqcTargetOfKnownBigLedgerPeers       <- v .:? "TargetNumberOfKnownBigLedgerPeers"
+                                                 .!= targetNumberOfKnownBigLedgerPeers deadlineTargets
+      dmqcTargetOfEstablishedBigLedgerPeers <- v .:? "TargetNumberOfEstablishedBigLedgerPeers"
+                                                 .!= targetNumberOfEstablishedBigLedgerPeers deadlineTargets
+      dmqcTargetOfActiveBigLedgerPeers      <- v .:? "TargetNumberOfActiveBigLedgerPeers"
+                                                 .!= targetNumberOfActiveBigLedgerPeers deadlineTargets
+
+      dmqcProtocolIdleTimeout <- v .:? "ProtocolIdleTimeout"
+                                   .!= defaultProtocolIdleTimeout
+
+      dmqcChurnInterval <- v .:? "ChurnInterval"
+                             .!= defaultDeadlineChurnInterval
+
+      dmqcPeerSharing <- v .:? "PeerSharing"
+                           .!= PeerSharingEnabled
+      networkMagic <- v .: "NetworkMagic"
+
+      pure $
+        Configuration
+          { dmqcAcceptedConnectionsLimit
+          , dmqcDiffusionMode
+          , dmqcTargetOfRootPeers
+          , dmqcTargetOfKnownPeers
+          , dmqcTargetOfEstablishedPeers
+          , dmqcTargetOfActivePeers
+          , dmqcTargetOfKnownBigLedgerPeers
+          , dmqcTargetOfEstablishedBigLedgerPeers
+          , dmqcTargetOfActiveBigLedgerPeers
+          , dmqcProtocolIdleTimeout
+          , dmqcChurnInterval
+          , dmqcPeerSharing
+          , dmqcNetworkMagic = NetworkMagic networkMagic
+          }
+    where
+      -- TODO: use DMQ's own default values
+      deadlineTargets = defaultDeadlineTargets Relay
 
 -- | Read the `DMQConfiguration` from the specified file.
 --

network-mux/network-mux.cabal

@@ -112,6 +112,30 @@ library
     -Wredundant-constraints
     -Wunused-packages
 
+library traces
+  build-depends:
+    aeson,
+    base >=4.14 && <4.22,
+    formatting,
+    network-mux,
+    trace-dispatcher ^>= 2.10.0
+  hs-source-dirs: traces
+  visibility: public
+  exposed-modules:
+    Network.Mux.Traces
+  default-language: Haskell2010
+  default-extensions: ImportQualifiedPost
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Widentities
+    -Wincomplete-record-updates
+    -Wincomplete-uni-patterns
+    -Wno-unticked-promoted-constructors
+    -Wpartial-fields
+    -Wredundant-constraints
+    -Wunused-packages
+
 test-suite test
   type: exitcode-stdio-1.0
   hs-source-dirs: test