Port kupo to the cardano-node 11.1 stack (Dijkstra groundwork)

.gitignore

@@ -18,3 +18,7 @@ dist-newstyle
 /dist
 *.tar.gz
 /cabal.project.local
+
+## Local dev scripts (patch-nix-deps.sh stays tracked)
+/scripts/*
+!/scripts/patch-nix-deps.sh

cabal.project

@@ -10,8 +10,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2025-09-11T07:59:00Z
-  , cardano-haskell-packages 2025-09-11T08:36:14Z
+  , hackage.haskell.org 2026-08-14T13:38:07Z
+  , cardano-haskell-packages 2026-09-16T23:53:07Z
 
 packages:
   ./
@@ -46,36 +46,42 @@ package direct-sqlite
   flags: +nomutex
 
 constraints:
-  , any.cardano-node == 10.5.1
+  , any.cardano-node == 11.1.1
 
-  , any.cardano-ledger-core == 1.17.0.0
-  , any.cardano-ledger-shelley == 1.16.0.0
-  , any.cardano-ledger-conway == 1.19.0.0
+  , any.cardano-ledger-conway >= 1.23
 
-  , any.ouroboros-consensus == 0.27.0.0
-  , any.ouroboros-consensus-cardano == 0.25.1.0
-  , any.ouroboros-network == 0.21.3.0
+  , any.ouroboros-consensus ^>= 4.2.1
+  , any.ouroboros-network ^>= 1.2
 
-  , any.io-classes == 1.5.0.0
-  , any.io-classes-mtl == 0.1.2.0
+  , any.io-classes ^>= 1.8
   , any.formatting == 7.2.0
   , any.text source
 
+  -- Use serial block IO instead of io_uring to avoid requiring liburing
+  , any.blockio +serialblockio
+
   , direct-sqlite == 2.3.29.1
   , sqlite-simple == 0.4.19.0.1
 
 allow-newer:
   *:formatting
+  , katip:Win32
+  , io-sim:time
+  , io-classes:time
 
 -- NOTE update hash using
--- nix-prefetch-git https://github.com/CardanoSolutions/ogmios.git --rev <tag> --fetch-submodules --quiet | jq '.hash' | tail -c +9 | head -c -2
+-- nix-prefetch-git https://github.com/IntersectMBO/ogmios.git --rev <tag> --fetch-submodules --quiet | jq '.hash' | tail -c +9 | head -c -2
+--
+-- contra-tracers is taken from here rather than Hackage until a release with the
+-- `Monad m` fix for contra-tracer >= 0.2 is published (see 1.0.1 in its CHANGELOG).
 source-repository-package
   type: git
-  location: https://github.com/CardanoSolutions/ogmios
-  tag: ae876badb138f42dcd6d2389734b0c15502684ed
-  --sha256: xkOfOdX6Dxi7+VW78Tk3n3MoguIg39pKdxiNVfdeEwE=
+  location: https://github.com/IntersectMBO/ogmios
+  --sha256: sha256-1VptE6HSuT2U+NMw7HLb5X1PqqrYpsOkl4tWHk5ygG4=
+  tag: 42c2bacd2d9c00087b5e29c98ee96c43ee857424
   subdir:
     server/modules/fast-bech32
+    server/modules/contra-tracers
 
 source-repository-package
   type: git

package.yaml

@@ -93,13 +93,13 @@ library:
     - modern-uri
     - network-mux
     - optparse-applicative
+    - cardano-diffusion
     - ouroboros-consensus
-    - ouroboros-consensus-cardano
-    - ouroboros-consensus-diffusion
-    - ouroboros-network
-    - ouroboros-network-api
-    - ouroboros-network-framework
-    - ouroboros-network-protocols
+    - ouroboros-consensus:cardano
+    - ouroboros-consensus:diffusion
+    - ouroboros-network:api
+    - ouroboros-network:framework
+    - ouroboros-network:protocols
     - prometheus
     - relude
     - resource-pool
@@ -146,7 +146,7 @@ tests:
     - QuickCheck
     - quickcheck-state-machine
     - relude
-    - si-timers
+    - io-classes:si-timers
     - sqlite-simple
     - stm
     - temporary

src/Kupo/App/Http.hs

@@ -50,7 +50,8 @@ import Kupo.Control.MonadSTM
     ( MonadSTM (..)
     )
 import Kupo.Control.MonadThrow
-    ( throwIO
+    ( bracket
+    , throwIO
     )
 import Kupo.Control.MonadTime
     ( DiffTime
@@ -196,6 +197,7 @@ import qualified Kupo.Data.Http.QuantityEncoding as QuantityEncoding
 import qualified Network.HTTP.Types.Header as Http
 import qualified Network.HTTP.Types.Status as Http
 import qualified Network.HTTP.Types.URI as Http
+import qualified Network.Socket as Socket
 import qualified Network.Wai.Handler.Warp as Warp
 
 --
@@ -219,15 +221,22 @@ httpServer
     -> Int
     -> IO ()
 httpServer tr networkParameters withDatabase forceRollback fetchBlock patternsVar readHealth host port =
-    Warp.runSettings settings
-        $ tracerMiddleware tr
-        $ app
-            networkParameters
-            withDatabaseWrapped
-            forceRollback
-            fetchBlock
-            patternsVar
-            readHealth
+    -- We deliberately own the listening socket via `bracket` rather than letting
+    -- `Warp.runSettings` open it internally. When kupo is cancelled mid-test
+    -- (via `race_`), warp's own teardown can fail to release the port promptly,
+    -- leaving the next stage's `bindPortTCP` to fail with EADDRINUSE. Bracketing
+    -- the socket here guarantees the fd is closed synchronously on any exit
+    -- path, including async cancel.
+    bracket (openListeningSocket host port) Socket.close $ \sock ->
+        Warp.runSettingsSocket settings sock
+            $ tracerMiddleware tr
+            $ app
+                networkParameters
+                withDatabaseWrapped
+                forceRollback
+                fetchBlock
+                patternsVar
+                readHealth
   where
     settings = Warp.defaultSettings
         & Warp.setPort port
@@ -262,6 +271,21 @@ httpServer tr networkParameters withDatabase forceRollback fetchBlock patternsVa
                 logWith tr $ HttpFailedToAcquireDatabaseConnection { attempts, retryingIn }
                 threadDelay retryingIn >> retrying (next attempts) (2 * retryingIn) io
 
+-- | Open a TCP listening socket bound to host:port with SO_REUSEADDR set, so
+-- that the port can be rebound immediately after the socket is closed.
+openListeningSocket :: String -> Int -> IO Socket.Socket
+openListeningSocket host port = do
+    let hints = Socket.defaultHints
+            { Socket.addrFlags = [Socket.AI_PASSIVE, Socket.AI_NUMERICSERV]
+            , Socket.addrSocketType = Socket.Stream
+            }
+    addr : _ <- Socket.getAddrInfo (Just hints) (Just host) (Just (show port))
+    sock <- Socket.socket (Socket.addrFamily addr) Socket.Stream Socket.defaultProtocol
+    Socket.setSocketOption sock Socket.ReuseAddr 1
+    Socket.bind sock (Socket.addrAddress addr)
+    Socket.listen sock 1024
+    pure sock
+
 --
 -- Router
 --

src/Kupo/Control/MonadLog.hs

@@ -41,6 +41,7 @@ import Control.Monad.Class.MonadTime
     )
 import Control.Tracer
     ( Tracer (..)
+    , mkTracer
     , natTracer
     , nullTracer
     , traceWith
@@ -135,7 +136,7 @@ withTracers h version tracers action = do
         :: Writer
         -> TMVar IO ()
         -> Tracer IO SomeMsg
-    tracer say lock = Tracer $ \someMsg@(SomeMsg minSeverity _ msg) -> do
+    tracer say lock = mkTracer $ \someMsg@(SomeMsg minSeverity _ msg) -> do
         let severity = getSeverityAnnotation msg
         when (severity >= minSeverity) $ liftIO $ withTMVar lock $ \() -> do
             threadId <- myThreadId

src/Kupo/Control/MonadOuroboros.hs

@@ -34,6 +34,7 @@ import Kupo.Control.MonadThrow
     )
 import Network.Mux
     ( StartOnDemandOrEagerly (..)
+    , nullTracers
     )
 import Ouroboros.Consensus.Byron.Ledger.Config
     ( CodecConfig (..)
@@ -74,7 +75,7 @@ import Ouroboros.Network.Mux
     , OuroborosApplication (..)
     , RunMiniProtocol (..)
     )
-import Ouroboros.Network.NodeToClient
+import Cardano.Network.NodeToClient
     ( NetworkConnectTracers (..)
     , NodeToClientVersion (..)
     , NodeToClientVersionData (..)
@@ -119,7 +120,7 @@ instance MonadOuroboros IO where
             connectTo (mkLocalSnocket iocp) tracers versions socket >>= either throwIO return
       where
         tracers = NetworkConnectTracers
-            { nctMuxTracer = nullTracer
+            { nctMuxTracers = nullTracers
             , nctHandshakeTracer = nullTracer
             }
 
@@ -167,7 +168,7 @@ codecs epochSlots nodeToClientV =
     supportedVersions =
         supportedNodeToClientVersions (Proxy @(BlockT IO))
     cfg =
-        CardanoCodecConfig byron shelley allegra mary alonzo babbage conway
+        CardanoCodecConfig byron shelley allegra mary alonzo babbage conway dijkstra
       where
         byron    = ByronCodecConfig epochSlots
         shelley  = ShelleyCodecConfig
@@ -176,3 +177,4 @@ codecs epochSlots nodeToClientV =
         alonzo   = ShelleyCodecConfig
         babbage  = ShelleyCodecConfig
         conway   = ShelleyCodecConfig
+        dijkstra = ShelleyCodecConfig

src/Kupo/Data/Cardano.hs

@@ -99,7 +99,6 @@ import Kupo.Data.Cardano.Value
 
 import qualified Cardano.Chain.UTxO as Ledger.Byron
 import qualified Cardano.Ledger.Alonzo.Core as Ledger
-import qualified Cardano.Ledger.Alonzo.Tx as Ledger
 import qualified Cardano.Ledger.Alonzo.TxWits as Ledger
 import qualified Cardano.Ledger.Babbage.Core as Ledger
 import qualified Cardano.Ledger.Block as Ledger
@@ -184,17 +183,17 @@ instance IsBlock Block where
              in
                 foldrWithIndex ignoreProtocolTxs result (extractTxs blk)
         BlockShelley (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionShelley) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionShelley) result (txs ^. Ledger.txSeqBlockBodyL)
         BlockAllegra (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionAllegra) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionAllegra) result (txs ^. Ledger.txSeqBlockBodyL)
         BlockMary (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionMary) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionMary) result (txs ^. Ledger.txSeqBlockBodyL)
         BlockAlonzo (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionAlonzo) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionAlonzo) result (txs ^. Ledger.txSeqBlockBodyL)
         BlockBabbage (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionBabbage) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionBabbage) result (txs ^. Ledger.txSeqBlockBodyL)
         BlockConway (ShelleyBlock (Ledger.Block _ txs) _) ->
-            foldrWithIndex (\ix -> fn ix . TransactionConway) result (Ledger.fromTxSeq txs)
+            foldrWithIndex (\ix -> fn ix . TransactionConway) result (txs ^. Ledger.txSeqBlockBodyL)
 
     spentInputs
         :: Transaction
@@ -209,22 +208,22 @@ instance IsBlock Block where
         TransactionMary tx ->
             tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL
         TransactionAlonzo tx ->
-            case tx ^. Ledger.isValidTxL of
-                Ledger.IsValid True ->
+            case tx ^. Ledger.isPhase2ValidTxL of
+                Ledger.Phase2Valid ->
                     tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL
-                Ledger.IsValid False ->
+                Ledger.Phase2Invalid ->
                     tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL
         TransactionBabbage tx ->
-            case tx ^. Ledger.isValidTxL of
-                Ledger.IsValid True ->
+            case tx ^. Ledger.isPhase2ValidTxL of
+                Ledger.Phase2Valid ->
                     tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL
-                Ledger.IsValid False ->
+                Ledger.Phase2Invalid ->
                     tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL
         TransactionConway tx ->
-            case tx ^. Ledger.isValidTxL of
-                Ledger.IsValid True ->
+            case tx ^. Ledger.isPhase2ValidTxL of
+                Ledger.Phase2Valid ->
                     tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL
-                Ledger.IsValid False ->
+                Ledger.Phase2Invalid ->
                     tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL
       where
         transformByron (Ledger.Byron.TxInUtxo txId ix) =
@@ -274,10 +273,10 @@ instance IsBlock Block where
                 outs = body ^. Ledger.outputsTxBodyL
                 meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromAlonzoMetadata
              in
-                case tx ^. Ledger.isValidTxL of
-                    Ledger.IsValid True ->
+                case tx ^. Ledger.isPhase2ValidTxL of
+                    Ledger.Phase2Valid ->
                         traverseAndTransform fromAlonzoOutput txId meta 0 outs
-                    Ledger.IsValid False ->
+                    Ledger.Phase2Invalid ->
                         []
         TransactionBabbage tx ->
             let
@@ -286,10 +285,10 @@ instance IsBlock Block where
                 outs = body ^. Ledger.outputsTxBodyL
                 meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromBabbageMetadata
              in
-                case tx ^. Ledger.isValidTxL of
-                    Ledger.IsValid True ->
+                case tx ^. Ledger.isPhase2ValidTxL of
+                    Ledger.Phase2Valid ->
                         traverseAndTransform fromBabbageOutput txId meta 0 outs
-                    Ledger.IsValid False ->
+                    Ledger.Phase2Invalid ->
                         -- From Babbage's formal specification:
                         --
                         --   Note that the new collOuts function generates a single output
@@ -307,10 +306,10 @@ instance IsBlock Block where
                 outs = body ^. Ledger.outputsTxBodyL
                 meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromConwayMetadata
              in
-                case tx ^. Ledger.isValidTxL of
-                    Ledger.IsValid True ->
+                case tx ^. Ledger.isPhase2ValidTxL of
+                    Ledger.Phase2Valid ->
                         traverseAndTransform identity txId meta 0 outs
-                    Ledger.IsValid False ->
+                    Ledger.Phase2Invalid ->
                         -- From Conway formal specification:
                         --
                         --   Note that the new collOuts function generates a single output

src/Kupo/Data/Cardano/HeaderHash.hs

@@ -62,5 +62,5 @@ unsafeHeaderHashFromBytes
     :: ByteString
     -> HeaderHash Block
 unsafeHeaderHashFromBytes =
-    fromRawHash (Proxy @Block)
+    unsafeFromRawHash (Proxy @Block)
 {-# INLINABLE unsafeHeaderHashFromBytes #-}