Skip to content

Make it build with ghc-9.12 #1968

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 10 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/haskell.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
51 changes: 26 additions & 25 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
4 changes: 4 additions & 0 deletions cardano-chain-gen/cardano-chain-gen.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -85,6 +86,7 @@ library
, extra
, mtl
, microlens
, network-mux
, nothunks
, ouroboros-consensus
, ouroboros-consensus-cardano
Expand All @@ -101,6 +103,7 @@ library
, strict-stm
, text
, typed-protocols
, typed-protocols-stateful

test-suite cardano-chain-gen
type: exitcode-stdio-1.0
Expand Down Expand Up @@ -182,6 +185,7 @@ test-suite cardano-chain-gen
, esqueleto
, extra
, filepath
, int-cast
, silently
, stm
, strict-stm
Expand Down
2 changes: 1 addition & 1 deletion cardano-chain-gen/src/Cardano/Mock/ChainDB.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
26 changes: 17 additions & 9 deletions cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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" -}

Expand Down Expand Up @@ -157,6 +163,7 @@ type MockServerConstraint blk =
, ShowProxy (GenTx blk)
, SupportedNetworkProtocolVersion blk
, EncodeDisk blk blk
, ShowProxy (TxId (GenTx blk))
)

forkServerThread ::
Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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 ->
Expand All @@ -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))

Expand Down
30 changes: 16 additions & 14 deletions cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 (
Expand All @@ -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,
Expand Down Expand Up @@ -362,6 +363,7 @@ forgeNextLeaders interpreter txes possibleLeaders = do
let tickedLedgerSt :: Ticked (LedgerState CardanoBlock)
!tickedLedgerSt =
applyChainTick
ComputeLedgerEvents
(configLedger cfg)
currentSlot
(ledgerState . currentState $ istChain interState)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 =
Expand Down
Loading
Loading