Merge pull request #2046 from IntersectMBO/kderme/10.6.1

Update to node 10.6.1

Author: kderme

cabal.project

@@ -10,8 +10,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2025-08-03T21:32:16Z
-  , cardano-haskell-packages 2025-07-30T14:13:57Z
+  , hackage.haskell.org 2025-10-17T00:26:22Z
+  , cardano-haskell-packages 2025-11-20T19:55:27Z
 
 packages:
   cardano-db
@@ -75,8 +75,6 @@ constraints:
   -- then clashes with the `show` in `Prelude`.
   , text < 2.1.2
 
-  , cardano-node ^>= 10.4
-
 if impl (ghc >= 9.12)
   allow-newer:
     -- https://github.com/kapralVV/Unique/issues/11
@@ -86,3 +84,14 @@ if impl (ghc >= 9.12)
 -- when using the "cabal" wrapper script provided by nix-shell.
 -- --------------------------- 8< --------------------------
 -- Please do not put any `source-repository-package` clause above this line.
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-node
+  tag: 0c220b27a9b612bb94b557017452be4a97b640d4
+  --sha256: sha256-rsm/3pyU5a5gwMWuig9sJOA36otpgQpMbmh+sRzfoOo=
+  subdir:
+    cardano-node
+    trace-dispatcher
+    trace-forward
+    trace-resources

cardano-chain-gen/cardano-chain-gen.cabal

@@ -83,7 +83,7 @@ library
                       , extra
                       , mtl
                       , microlens
-                      , network-mux
+                      , network
                       , nothunks
                       , ouroboros-consensus
                       , ouroboros-consensus-cardano
@@ -97,10 +97,10 @@ library
                       , plutus-ledger-api:{plutus-ledger-api-testlib}
                       , serialise
                       , strict-sop-core
-                      , strict-stm
+                      , io-classes:strict-stm
                       , text
                       , typed-protocols
-                      , typed-protocols-stateful
+                      , typed-protocols:stateful
 
 test-suite cardano-chain-gen
   type:                 exitcode-stdio-1.0
@@ -183,9 +183,9 @@ test-suite cardano-chain-gen
                       , extra
                       , filepath
                       , int-cast
+                      , io-classes:strict-stm
                       , silently
                       , stm
-                      , strict-stm
                       , tasty
                       , tasty-quickcheck
                       , text

cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs

@@ -44,14 +44,12 @@ import Control.Concurrent.Class.MonadSTM.Strict (
  )
 import Control.Exception (bracket)
 import Control.Monad (forever)
-import Control.Tracer (nullTracer)
+import Control.Tracer
 import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
-import Data.Void (Void)
-import qualified Network.Mux as Mux
+import qualified Network.Socket as Socket
 import Network.TypedProtocol.Peer (Peer (..))
-import Network.TypedProtocol.Stateful.Codec ()
 import qualified Network.TypedProtocol.Stateful.Peer as St
 import Ouroboros.Consensus.Block (CodecConfig, HasHeader, Point, StandardHash, castPoint)
 import Ouroboros.Consensus.Config (TopLevelConfig, configCodec)
@@ -65,7 +63,6 @@ import Ouroboros.Consensus.Node.DbMarker ()
 import Ouroboros.Consensus.Node.InitStorage ()
 import Ouroboros.Consensus.Node.NetworkProtocolVersion (
   BlockNodeToClientVersion,
-  NodeToClientVersion,
   SupportedNetworkProtocolVersion,
   latestReleasedNodeVersion,
   supportedNodeToClientVersions,
@@ -87,25 +84,22 @@ import Ouroboros.Network.Block (
  )
 import Ouroboros.Network.Channel (Channel)
 import Ouroboros.Network.Driver.Simple (runPeer)
-import qualified Ouroboros.Network.Driver.Stateful as St (runPeer)
-import Ouroboros.Network.IOManager (IOManager)
-import qualified Ouroboros.Network.IOManager as IOManager
+import qualified Ouroboros.Network.Driver.Stateful as Stateful
 import Ouroboros.Network.Magic (NetworkMagic)
-import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx)
-import Ouroboros.Network.NodeToClient (NodeToClientVersionData (..))
-import qualified Ouroboros.Network.NodeToClient as NodeToClient
-import Ouroboros.Network.NodeToNode (Versions)
+import Ouroboros.Network.NodeToClient
 import Ouroboros.Network.Protocol.ChainSync.Server (
   ChainSyncServer (..),
   ServerStIdle (..),
   ServerStIntersect (..),
   ServerStNext (SendMsgRollBackward, SendMsgRollForward),
   chainSyncServerPeer,
  )
-import Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions)
+import Ouroboros.Network.Protocol.Handshake
 import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
-import Ouroboros.Network.Snocket (LocalAddress, LocalSnocket, LocalSocket (..))
+import Ouroboros.Network.Server.Simple as Server
+import Ouroboros.Network.Snocket
 import qualified Ouroboros.Network.Snocket as Snocket
+import Ouroboros.Network.Socket
 import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
 
 {- HLINT ignore "Use readTVarIO" -}
@@ -212,33 +206,41 @@ runLocalServer ::
   FilePath ->
   StrictTVar IO (ChainProducerState blk) ->
   IO ()
-runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
-  withSnocket iom localDomainSock $ \localSocket localSnocket -> do
-    networkState <- NodeToClient.newNetworkMutableState
-    _ <-
-      NodeToClient.withServer
-        localSnocket
-        NodeToClient.nullNetworkServerTracers -- debuggingNetworkServerTracers
-        networkState
-        localSocket
-        (versions chainProdState)
-        NodeToClient.networkErrorPolicies
-    pure ()
+runLocalServer iom codecConfig netMagic localDomainSock chainProdState = do
+  _ <-
+    Server.with
+      (Snocket.socketSnocket iom)
+      makeSocketBearer
+      (\_ _ -> pure ())
+      (Socket.SockAddrUnix localDomainSock)
+      ( HandshakeArguments
+          { haHandshakeTracer = nullTracer -- showTracing stdoutTracer
+          , haBearerTracer = nullTracer -- showTracing stdoutTracer
+          , haHandshakeCodec = codecHandshake nodeToClientVersionCodec
+          , haVersionDataCodec = cborTermVersionDataCodec nodeToClientCodecCBORTerm
+          , haAcceptVersion = acceptableVersion
+          , haQueryVersion = queryVersion
+          , haTimeLimits = noTimeLimitsHandshake
+          }
+      )
+      (versions chainProdState)
+      (\_ serverAsync -> wait serverAsync)
+  pure ()
   where
     versions ::
       StrictTVar IO (ChainProducerState blk) ->
       Versions
         NodeToClientVersion
         NodeToClientVersionData
-        (OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode LocalAddress ByteString IO Void ())
+        (SomeResponderApplication Socket.SockAddr ByteString IO ())
     versions state =
       let version = fromJust $ snd $ latestReleasedNodeVersion (Proxy @blk)
           allVersions = supportedNodeToClientVersions (Proxy @blk)
           blockVersion = fromJust $ Map.lookup version allVersions
        in simpleSingletonVersions
             version
             (NodeToClientVersionData netMagic False)
-            (\versionData -> NTC.responder version versionData $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
+            (\versionData' -> SomeResponderApplication $ NTC.responder version versionData' $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
 
     mkApps ::
       StrictTVar IO (ChainProducerState blk) ->
@@ -260,11 +262,10 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
           IO ((), Maybe ByteString)
         chainSyncServer' _them channel =
           runPeer
-            nullTracer -- TODO add a tracer!
+            nullTracer -- (showTracing stdoutTracer)
             (cChainSyncCodec codecs)
             channel
-            $ chainSyncServerPeer
-            $ chainSyncServer state codecConfig blockVersion
+            (chainSyncServerPeer $ chainSyncServer state codecConfig blockVersion)
 
         txSubmitServer ::
           localPeer ->
@@ -277,13 +278,9 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
             channel
             (Effect (forever $ threadDelay 3_600_000_000))
 
-        stateQueryServer ::
-          localPeer ->
-          Channel IO ByteString ->
-          IO ((), Maybe ByteString)
         stateQueryServer _them channel =
-          St.runPeer
-            nullTracer
+          Stateful.runPeer
+            nullTracer -- (showTracing stdoutTracer)
             (cStateQueryCodec codecs)
             channel
             LocalStateQuery.StateIdle
@@ -354,8 +351,7 @@ chainSyncServer state codec _blockVersion =
       (Tip blk, ChainUpdate blk blk) ->
       ServerStNext (Serialised blk) (Point blk) (Tip blk) m ()
     sendNext r (tip, AddBlock b) =
-      -- SendMsgRollForward  -- (Serialised $ toLazyByteString $ encodeNodeToClient codec blockVersion b) tip (idle' r)
-      SendMsgRollForward (mkSerialised (encodeDisk codec) b) tip (idle' r) -- encodeNodeToClient codec blockVersion -- mkSerialised encode b
+      SendMsgRollForward (mkSerialised (encodeDisk codec) b) tip (idle' r)
     sendNext r (tip, RollBack p) = SendMsgRollBackward (castPoint p) tip (idle' r)
 
     newFollower :: m FollowerId
@@ -404,36 +400,3 @@ chainSyncServer state codec _blockVersion =
             writeTVar state cps'
             let chain = chainDB cps'
             pure (castTip (headTip chain), u)
-
-withSnocket ::
-  forall a.
-  IOManager ->
-  FilePath ->
-  (LocalSocket -> LocalSnocket -> IO a) ->
-  IO a
-withSnocket iocp localDomainSock k =
-  bracket localServerInit localServerCleanup localServerBody
-  where
-    localServerInit :: IO (LocalSocket, LocalSnocket)
-    localServerInit = do
-      let sn = Snocket.localSnocket iocp
-      sd <-
-        Snocket.open
-          sn
-          ( Snocket.addrFamily sn $
-              Snocket.localAddressFromPath localDomainSock
-          )
-      pure (sd, sn)
-
-    -- We close the socket here, even if it was provided for us.
-    localServerCleanup :: (LocalSocket, LocalSnocket) -> IO ()
-    localServerCleanup (sd, sn) = Snocket.close sn sd
-
-    localServerBody :: (LocalSocket, LocalSnocket) -> IO a
-    localServerBody (sd, sn) = do
-      Snocket.bind sn sd (Snocket.localAddressFromPath localDomainSock)
-      Snocket.listen sn sd
-      k sd sn
-
-withIOManager :: (IOManager -> IO a) -> IO a
-withIOManager = IOManager.withIOManager