Merge pull request #1968 from IntersectMBO/erikd/ghc-9.12

Make it build with ghc-9.12

Author: kderme

.github/workflows/haskell.yml

@@ -20,7 +20,7 @@ jobs:
       matrix:
         os: [ubuntu-latest]
         # TODO: Add ghc910 when input-output-hk/devx is fixed
-        compiler-nix-name: [ghc810, ghc96, ghc98]
+        compiler-nix-name: [ghc810, ghc96, ghc98, ghc912]
         include:
           # We want a single job, because macOS runners are scarce.
           - os: macos-latest

cabal.project

@@ -10,8 +10,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2024-10-10T00:52:24Z
-  , cardano-haskell-packages 2024-11-26T16:00:26Z
+  , hackage.haskell.org 2025-05-23T06:30:40Z
+  , cardano-haskell-packages 2025-05-16T20:03:45Z
 
 packages:
   cardano-db
@@ -67,34 +67,35 @@ package snap-server
   -- only if the `cardano-node` is compiled with `+rtview`.
   flags: -openssl
 
-allow-newer:
-  , swagger2:aeson
-  -- The version of ouroboros-consensus specified by cardano-node uses an earlier version of
-  -- quickcheck-state-machine that does not compile with ghc-9.10 so we allow a never version
-  -- that builds with ghc-9.10 (and earlier).
-  , ouroboros-consensus:quickcheck-state-machine
+-- ---------------------------------------------------------
 
 constraints:
-  -- STM 2.5.2 is broken: https://github.com/haskell/stm/issues/76
-  , stm >= 2.5.3.1
-  -- Earlier versions do not compile with ghc-9.10.
-  , quickcheck-state-machine ^>= 0.10
+  -- esqueleto >= 3.6 has API chamges
+  , esqueleto ^>= 3.5.11.2
 
--- ---------------------------------------------------------
+  -- New version of `text` exposes a `show` function and in the `node`
+  -- code,`Data.Text` is being imported unqualified (bad idea IMO) which
+  -- then clashes with the `show` in `Prelude`.
+  , text < 2.1.2
+
+  , cardano-node ^>= 10.3
+
+if impl (ghc >= 9.12)
+  allow-newer:
+    -- https://github.com/kapralVV/Unique/issues/11
+    , Unique:hashable
+
+    -- https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/pull/70
+    , pipes-safe:base
+
+    -- https://github.com/haskellari/postgresql-simple/issues/152
+    , postgresql-simple:base
+    , postgresql-simple:template-haskell
+    
+    -- https://github.com/haskell-hvr/int-cast/issues/10
+    , int-cast:base
 
 -- The two following one-liners will cut off / restore the remainder of this file (for nix-shell users):
 -- 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: 36871ba0cd3e86a5dbcfd6878cdb7168bb4e56a1
-  --sha256: sha256-v0q8qHdI6LKc8mP43QZt3UGdTNDQXE0aF6QapvZsTvU=
-  subdir:
-    cardano-node
-    cardano-submit-api
-    trace-dispatcher
-    trace-forward
-    trace-resources

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

@@ -75,6 +75,7 @@ library
                       , cardano-ledger-shelley >= 1.12.3.0
                       , cardano-ledger-mary
                       , cardano-prelude
+                      , cardano-protocol-tpraos
                       , cardano-slotting
                       , cardano-strict-containers
                       , cborg
@@ -85,6 +86,7 @@ library
                       , extra
                       , mtl
                       , microlens
+                      , network-mux
                       , nothunks
                       , ouroboros-consensus
                       , ouroboros-consensus-cardano
@@ -101,6 +103,7 @@ library
                       , strict-stm
                       , text
                       , typed-protocols
+                      , typed-protocols-stateful
 
 test-suite cardano-chain-gen
   type:                 exitcode-stdio-1.0
@@ -182,6 +185,7 @@ test-suite cardano-chain-gen
                       , esqueleto
                       , extra
                       , filepath
+                      , int-cast
                       , silently
                       , stm
                       , strict-stm

cardano-chain-gen/src/Cardano/Mock/ChainDB.hs

@@ -62,7 +62,7 @@ replaceGenesisDB chainDB st = chainDB {cchain = Genesis st}
 extendChainDB :: LedgerSupportsProtocol block => ChainDB block -> block -> ChainDB block
 extendChainDB chainDB blk = do
   let !chain = cchain chainDB
-      !st = tickThenReapply (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain)
+      !st = tickThenReapply ComputeLedgerEvents (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain)
    in chainDB {cchain = chain :> (blk, st)}
 
 findFirstPoint :: HasHeader block => [Point block] -> ChainDB block -> Maybe (Point block)

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -48,11 +49,14 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
 import Data.Void (Void)
-import Network.TypedProtocol.Core (Peer (..))
+import qualified Network.Mux as Mux
+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)
 import Ouroboros.Consensus.Ledger.Query (BlockQuery, ShowQuery)
-import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx)
+import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, TxId)
 import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
 import Ouroboros.Consensus.Network.NodeToClient (Apps (..), Codecs' (..), DefaultCodecs)
 import qualified Ouroboros.Consensus.Network.NodeToClient as NTC
@@ -83,10 +87,11 @@ 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 Ouroboros.Network.Magic (NetworkMagic)
-import Ouroboros.Network.Mux (MuxMode (..), OuroborosApplicationWithMinimalCtx)
+import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx)
 import Ouroboros.Network.NodeToClient (NodeToClientVersionData (..))
 import qualified Ouroboros.Network.NodeToClient as NodeToClient
 import Ouroboros.Network.NodeToNode (Versions)
@@ -98,9 +103,10 @@ import Ouroboros.Network.Protocol.ChainSync.Server (
   chainSyncServerPeer,
  )
 import Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions)
+import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
 import Ouroboros.Network.Snocket (LocalAddress, LocalSnocket, LocalSocket (..))
 import qualified Ouroboros.Network.Snocket as Snocket
-import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy)
+import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
 
 {- HLINT ignore "Use readTVarIO" -}
 
@@ -157,6 +163,7 @@ type MockServerConstraint blk =
   , ShowProxy (GenTx blk)
   , SupportedNetworkProtocolVersion blk
   , EncodeDisk blk blk
+  , ShowProxy (TxId (GenTx blk))
   )
 
 forkServerThread ::
@@ -216,15 +223,15 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
       Versions
         NodeToClientVersion
         NodeToClientVersionData
-        (OuroborosApplicationWithMinimalCtx 'ResponderMode LocalAddress ByteString IO Void ())
+        (OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode LocalAddress ByteString IO Void ())
     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)
-            (NTC.responder version $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
+            (\versionData -> NTC.responder version versionData $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
 
     mkApps ::
       StrictTVar IO (ChainProducerState blk) ->
@@ -268,11 +275,12 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
           Channel IO ByteString ->
           IO ((), Maybe ByteString)
         stateQueryServer _them channel =
-          runPeer
+          St.runPeer
             nullTracer
             (cStateQueryCodec codecs)
             channel
-            (Effect (forever $ threadDelay 3_600_000_000))
+            LocalStateQuery.StateIdle
+            (St.Effect (forever $ threadDelay 3_600_000_000))
 
         txMonitorServer ::
           localPeer ->
@@ -281,7 +289,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
         txMonitorServer _them channel =
           runPeer
             nullTracer
-            (cStateQueryCodec codecs)
+            (cTxMonitorCodec codecs)
             channel
             (Effect (forever $ threadDelay 3_600_000_000))
 

cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs

@@ -33,7 +33,6 @@ module Cardano.Mock.Forging.Interpreter (
 ) where
 
 import Cardano.Ledger.Core (txIdTx)
-import Cardano.Ledger.Crypto (StandardCrypto)
 import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger
 import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..))
 import qualified Cardano.Ledger.TxIn as Ledger
@@ -75,11 +74,11 @@ import Ouroboros.Consensus.Block (
  )
 import qualified Ouroboros.Consensus.Block as Block
 import Ouroboros.Consensus.Cardano.Block (
+  AlonzoEra,
+  BabbageEra,
+  ConwayEra,
   LedgerState (..),
-  StandardAlonzo,
-  StandardBabbage,
-  StandardConway,
-  StandardShelley,
+  ShelleyEra,
  )
 import Ouroboros.Consensus.Cardano.CanHardFork ()
 import Ouroboros.Consensus.Config (
@@ -88,12 +87,14 @@ import Ouroboros.Consensus.Config (
   configLedger,
   topLevelConfigLedger,
  )
+
 import Ouroboros.Consensus.Forecast (Forecast (..))
 import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
 import Ouroboros.Consensus.HardFork.Combinator.Ledger ()
 import qualified Ouroboros.Consensus.HardFork.Combinator.Mempool as Consensus
 import Ouroboros.Consensus.HeaderValidation (headerStateChainDep)
 import Ouroboros.Consensus.Ledger.Abstract (TickedLedgerState, applyChainTick)
+import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..))
 import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, headerState, ledgerState)
 import Ouroboros.Consensus.Ledger.SupportsMempool (
   ApplyTxErr,
@@ -362,6 +363,7 @@ forgeNextLeaders interpreter txes possibleLeaders = do
           let tickedLedgerSt :: Ticked (LedgerState CardanoBlock)
               !tickedLedgerSt =
                 applyChainTick
+                  ComputeLedgerEvents
                   (configLedger cfg)
                   currentSlot
                   (ledgerState . currentState $ istChain interState)
@@ -493,7 +495,7 @@ getCurrentSlot interp = istSlot <$> readTVarIO (interpState interp)
 
 withBabbageLedgerState ::
   Interpreter ->
-  (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError a) ->
+  (LedgerState (ShelleyBlock PraosStandard BabbageEra) -> Either ForgingError a) ->
   IO a
 withBabbageLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -505,7 +507,7 @@ withBabbageLedgerState inter mk = do
 
 withConwayLedgerState ::
   Interpreter ->
-  (LedgerState (ShelleyBlock PraosStandard StandardConway) -> Either ForgingError a) ->
+  (LedgerState (ShelleyBlock PraosStandard ConwayEra) -> Either ForgingError a) ->
   IO a
 withConwayLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -517,7 +519,7 @@ withConwayLedgerState inter mk = do
 
 withAlonzoLedgerState ::
   Interpreter ->
-  (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError a) ->
+  (LedgerState (ShelleyBlock TPraosStandard AlonzoEra) -> Either ForgingError a) ->
   IO a
 withAlonzoLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -529,7 +531,7 @@ withAlonzoLedgerState inter mk = do
 
 withShelleyLedgerState ::
   Interpreter ->
-  (LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError a) ->
+  (LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -> Either ForgingError a) ->
   IO a
 withShelleyLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -539,13 +541,13 @@ withShelleyLedgerState inter mk = do
       Left err -> throwIO err
     _ -> throwIO ExpectedShelleyState
 
-mkTxId :: TxEra -> Ledger.TxId StandardCrypto
+mkTxId :: TxEra -> Ledger.TxId
 mkTxId txe =
   case txe of
-    TxAlonzo tx -> txIdTx @StandardAlonzo tx
-    TxBabbage tx -> txIdTx @StandardBabbage tx
-    TxConway tx -> txIdTx @StandardConway tx
-    TxShelley tx -> txIdTx @StandardShelley tx
+    TxAlonzo tx -> txIdTx @AlonzoEra tx
+    TxBabbage tx -> txIdTx @BabbageEra tx
+    TxConway tx -> txIdTx @ConwayEra tx
+    TxShelley tx -> txIdTx @ShelleyEra tx
 
 mkValidated :: TxEra -> Validated (Consensus.GenTx CardanoBlock)
 mkValidated txe =