Skip to content

Commit 09904a0

Browse files
erikdcootjasagredo
committed
Continuation of 'Make it build with ghc-9.12'
Co-Authored-By: Marcin Szamotulski <[email protected]> Co-Authored-By: Javier Sagredo <[email protected]>
1 parent 75bc06d commit 09904a0

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

76 files changed

+980
-952
lines changed

‎cabal.project

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,8 @@ repository cardano-haskell-packages
1010
d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
1111

1212
index-state:
13-
, hackage.haskell.org 2025-04-15T19:49:23Z
14-
, cardano-haskell-packages 2025-04-16T08:24:34Z
13+
, hackage.haskell.org 2025-05-07T06:09:46Z
14+
, cardano-haskell-packages 2025-04-29T20:52:57Z
1515

1616
packages:
1717
cardano-db
@@ -110,6 +110,9 @@ if impl (ghc >= 9.12)
110110
-- https://github.com/haskellari/postgresql-simple/issues/152
111111
, postgresql-simple:base
112112
, postgresql-simple:template-haskell
113+
114+
-- https://github.com/haskell-hvr/int-cast/issues/10
115+
, int-cast:base
113116

114117
-- The two following one-liners will cut off / restore the remainder of this file (for nix-shell users):
115118
-- when using the "cabal" wrapper script provided by nix-shell.

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,7 @@ library
7575
, cardano-ledger-shelley >= 1.12.3.0
7676
, cardano-ledger-mary
7777
, cardano-prelude
78+
, cardano-protocol-tpraos
7879
, cardano-slotting
7980
, cardano-strict-containers
8081
, cborg
@@ -85,6 +86,7 @@ library
8586
, extra
8687
, mtl
8788
, microlens
89+
, network-mux
8890
, nothunks
8991
, ouroboros-consensus
9092
, ouroboros-consensus-cardano
@@ -101,6 +103,7 @@ library
101103
, strict-stm
102104
, text
103105
, typed-protocols
106+
, typed-protocols-stateful
104107

105108
test-suite cardano-chain-gen
106109
type: exitcode-stdio-1.0
@@ -182,6 +185,7 @@ test-suite cardano-chain-gen
182185
, esqueleto
183186
, extra
184187
, filepath
188+
, int-cast
185189
, silently
186190
, stm
187191
, strict-stm

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ replaceGenesisDB chainDB st = chainDB {cchain = Genesis st}
6262
extendChainDB :: LedgerSupportsProtocol block => ChainDB block -> block -> ChainDB block
6363
extendChainDB chainDB blk = do
6464
let !chain = cchain chainDB
65-
!st = tickThenReapply (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain)
65+
!st = tickThenReapply ComputeLedgerEvents (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain)
6666
in chainDB {cchain = chain :> (blk, st)}
6767

6868
findFirstPoint :: HasHeader block => [Point block] -> ChainDB block -> Maybe (Point block)

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

Lines changed: 18 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,12 @@
22
{-# LANGUAGE ConstraintKinds #-}
33
{-# LANGUAGE DataKinds #-}
44
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
56
{-# LANGUAGE NumericUnderscores #-}
67
{-# LANGUAGE RankNTypes #-}
78
{-# LANGUAGE ScopedTypeVariables #-}
89
{-# LANGUAGE TypeApplications #-}
10+
{-# OPTIONS_GHC -Wno-orphans #-}
911

1012
module Cardano.Mock.ChainSync.Server (
1113
-- * server
@@ -48,11 +50,14 @@ import Data.ByteString.Lazy.Char8 (ByteString)
4850
import qualified Data.Map.Strict as Map
4951
import Data.Maybe (fromJust)
5052
import Data.Void (Void)
51-
import Network.TypedProtocol.Core (Peer (..))
53+
import qualified Network.Mux as Mux
54+
import Network.TypedProtocol.Peer (Peer (..))
55+
import Network.TypedProtocol.Stateful.Codec ()
56+
import qualified Network.TypedProtocol.Stateful.Peer as St
5257
import Ouroboros.Consensus.Block (CodecConfig, HasHeader, Point, StandardHash, castPoint)
5358
import Ouroboros.Consensus.Config (TopLevelConfig, configCodec)
5459
import Ouroboros.Consensus.Ledger.Query (BlockQuery, ShowQuery)
55-
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx)
60+
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, TxId)
5661
import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
5762
import Ouroboros.Consensus.Network.NodeToClient (Apps (..), Codecs' (..), DefaultCodecs)
5863
import qualified Ouroboros.Consensus.Network.NodeToClient as NTC
@@ -83,10 +88,11 @@ import Ouroboros.Network.Block (
8388
)
8489
import Ouroboros.Network.Channel (Channel)
8590
import Ouroboros.Network.Driver.Simple (runPeer)
91+
import qualified Ouroboros.Network.Driver.Stateful as St (runPeer)
8692
import Ouroboros.Network.IOManager (IOManager)
8793
import qualified Ouroboros.Network.IOManager as IOManager
8894
import Ouroboros.Network.Magic (NetworkMagic)
89-
import Ouroboros.Network.Mux (MuxMode (..), OuroborosApplicationWithMinimalCtx)
95+
import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx)
9096
import Ouroboros.Network.NodeToClient (NodeToClientVersionData (..))
9197
import qualified Ouroboros.Network.NodeToClient as NodeToClient
9298
import Ouroboros.Network.NodeToNode (Versions)
@@ -98,9 +104,10 @@ import Ouroboros.Network.Protocol.ChainSync.Server (
98104
chainSyncServerPeer,
99105
)
100106
import Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions)
107+
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
101108
import Ouroboros.Network.Snocket (LocalAddress, LocalSnocket, LocalSocket (..))
102109
import qualified Ouroboros.Network.Snocket as Snocket
103-
import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy)
110+
import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
104111

105112
{- HLINT ignore "Use readTVarIO" -}
106113

@@ -157,6 +164,7 @@ type MockServerConstraint blk =
157164
, ShowProxy (GenTx blk)
158165
, SupportedNetworkProtocolVersion blk
159166
, EncodeDisk blk blk
167+
, ShowProxy (TxId (GenTx blk))
160168
)
161169

162170
forkServerThread ::
@@ -216,15 +224,15 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
216224
Versions
217225
NodeToClientVersion
218226
NodeToClientVersionData
219-
(OuroborosApplicationWithMinimalCtx 'ResponderMode LocalAddress ByteString IO Void ())
227+
(OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode LocalAddress ByteString IO Void ())
220228
versions state =
221229
let version = fromJust $ snd $ latestReleasedNodeVersion (Proxy @blk)
222230
allVersions = supportedNodeToClientVersions (Proxy @blk)
223231
blockVersion = fromJust $ Map.lookup version allVersions
224232
in simpleSingletonVersions
225233
version
226234
(NodeToClientVersionData netMagic False)
227-
(NTC.responder version $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
235+
(\versionData -> NTC.responder version versionData $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
228236

229237
mkApps ::
230238
StrictTVar IO (ChainProducerState blk) ->
@@ -268,11 +276,12 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
268276
Channel IO ByteString ->
269277
IO ((), Maybe ByteString)
270278
stateQueryServer _them channel =
271-
runPeer
279+
St.runPeer
272280
nullTracer
273281
(cStateQueryCodec codecs)
274282
channel
275-
(Effect (forever $ threadDelay 3_600_000_000))
283+
LocalStateQuery.StateIdle
284+
(St.Effect (forever $ threadDelay 3_600_000_000))
276285

277286
txMonitorServer ::
278287
localPeer ->
@@ -281,7 +290,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
281290
txMonitorServer _them channel =
282291
runPeer
283292
nullTracer
284-
(cStateQueryCodec codecs)
293+
(cTxMonitorCodec codecs)
285294
channel
286295
(Effect (forever $ threadDelay 3_600_000_000))
287296

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

Lines changed: 16 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@ module Cardano.Mock.Forging.Interpreter (
3333
) where
3434

3535
import Cardano.Ledger.Core (txIdTx)
36-
import Cardano.Ledger.Crypto (StandardCrypto)
3736
import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger
3837
import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..))
3938
import qualified Cardano.Ledger.TxIn as Ledger
@@ -75,11 +74,11 @@ import Ouroboros.Consensus.Block (
7574
)
7675
import qualified Ouroboros.Consensus.Block as Block
7776
import Ouroboros.Consensus.Cardano.Block (
77+
AlonzoEra,
78+
BabbageEra,
79+
ConwayEra,
7880
LedgerState (..),
79-
StandardAlonzo,
80-
StandardBabbage,
81-
StandardConway,
82-
StandardShelley,
81+
ShelleyEra,
8382
)
8483
import Ouroboros.Consensus.Cardano.CanHardFork ()
8584
import Ouroboros.Consensus.Config (
@@ -88,12 +87,14 @@ import Ouroboros.Consensus.Config (
8887
configLedger,
8988
topLevelConfigLedger,
9089
)
90+
9191
import Ouroboros.Consensus.Forecast (Forecast (..))
9292
import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
9393
import Ouroboros.Consensus.HardFork.Combinator.Ledger ()
9494
import qualified Ouroboros.Consensus.HardFork.Combinator.Mempool as Consensus
9595
import Ouroboros.Consensus.HeaderValidation (headerStateChainDep)
9696
import Ouroboros.Consensus.Ledger.Abstract (TickedLedgerState, applyChainTick)
97+
import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..))
9798
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, headerState, ledgerState)
9899
import Ouroboros.Consensus.Ledger.SupportsMempool (
99100
ApplyTxErr,
@@ -362,6 +363,7 @@ forgeNextLeaders interpreter txes possibleLeaders = do
362363
let tickedLedgerSt :: Ticked (LedgerState CardanoBlock)
363364
!tickedLedgerSt =
364365
applyChainTick
366+
ComputeLedgerEvents
365367
(configLedger cfg)
366368
currentSlot
367369
(ledgerState . currentState $ istChain interState)
@@ -493,7 +495,7 @@ getCurrentSlot interp = istSlot <$> readTVarIO (interpState interp)
493495

494496
withBabbageLedgerState ::
495497
Interpreter ->
496-
(LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError a) ->
498+
(LedgerState (ShelleyBlock PraosStandard BabbageEra) -> Either ForgingError a) ->
497499
IO a
498500
withBabbageLedgerState inter mk = do
499501
st <- getCurrentLedgerState inter
@@ -505,7 +507,7 @@ withBabbageLedgerState inter mk = do
505507

506508
withConwayLedgerState ::
507509
Interpreter ->
508-
(LedgerState (ShelleyBlock PraosStandard StandardConway) -> Either ForgingError a) ->
510+
(LedgerState (ShelleyBlock PraosStandard ConwayEra) -> Either ForgingError a) ->
509511
IO a
510512
withConwayLedgerState inter mk = do
511513
st <- getCurrentLedgerState inter
@@ -517,7 +519,7 @@ withConwayLedgerState inter mk = do
517519

518520
withAlonzoLedgerState ::
519521
Interpreter ->
520-
(LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError a) ->
522+
(LedgerState (ShelleyBlock TPraosStandard AlonzoEra) -> Either ForgingError a) ->
521523
IO a
522524
withAlonzoLedgerState inter mk = do
523525
st <- getCurrentLedgerState inter
@@ -529,7 +531,7 @@ withAlonzoLedgerState inter mk = do
529531

530532
withShelleyLedgerState ::
531533
Interpreter ->
532-
(LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError a) ->
534+
(LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -> Either ForgingError a) ->
533535
IO a
534536
withShelleyLedgerState inter mk = do
535537
st <- getCurrentLedgerState inter
@@ -539,13 +541,13 @@ withShelleyLedgerState inter mk = do
539541
Left err -> throwIO err
540542
_ -> throwIO ExpectedShelleyState
541543

542-
mkTxId :: TxEra -> Ledger.TxId StandardCrypto
544+
mkTxId :: TxEra -> Ledger.TxId
543545
mkTxId txe =
544546
case txe of
545-
TxAlonzo tx -> txIdTx @StandardAlonzo tx
546-
TxBabbage tx -> txIdTx @StandardBabbage tx
547-
TxConway tx -> txIdTx @StandardConway tx
548-
TxShelley tx -> txIdTx @StandardShelley tx
547+
TxAlonzo tx -> txIdTx @AlonzoEra tx
548+
TxBabbage tx -> txIdTx @BabbageEra tx
549+
TxConway tx -> txIdTx @ConwayEra tx
550+
TxShelley tx -> txIdTx @ShelleyEra tx
549551

550552
mkValidated :: TxEra -> Validated (Consensus.GenTx CardanoBlock)
551553
mkValidated txe =

0 commit comments

Comments
 (0)