Make it build with ghc-9.10

Author: erikd

cabal.project

@@ -14,9 +14,9 @@ repository cardano-haskell-packages
 -- update either of these.
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2024-06-23T23:01:13Z
+  , hackage.haskell.org 2024-07-23T00:03:37Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-07-02T04:22:05Z
+  , cardano-haskell-packages 2024-07-24T06:25:44Z
 
 packages:
   ouroboros-consensus
@@ -38,3 +38,18 @@ import: ./asserts.cabal
 if(os(windows))
   constraints:
     bitvec -simd
+
+if impl(ghc >= 9.10)
+  allow-newer:
+    -- All these cardano-ledger packages have been fixed on master but not
+    -- yet released to CHaP and according to the team will not be released
+    -- until after the Chang hardfork.
+    , cardano-ledger-alonzo:plutus-ledger-api
+    , cardano-ledger-alonzo-test:plutus-ledger-api
+    , cardano-ledger-babbage:plutus-ledger-api
+    , cardano-ledger-binary:plutus-ledger-api
+    , cardano-ledger-conway:plutus-ledger-api
+
+  constraints:
+    -- Earlier versions do not compile with ghc-9.10
+    , plutus-ledger-api ^>=1.31

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -127,7 +127,7 @@ library
     Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder
 
   build-depends:
-    base >=4.14 && <4.20,
+    base >=4.14 && <4.21,
     base-deriving-via,
     bytestring >=0.10 && <0.13,
     cardano-binary,
@@ -190,7 +190,7 @@ library unstable-byronspec
     Ouroboros.Consensus.ByronSpec.Ledger.Rules
 
   build-depends:
-    base >=4.14 && <4.20,
+    base >=4.14 && <4.21,
     bimap >=0.4 && <0.6,
     byron-spec-chain,
     byron-spec-ledger,
@@ -515,7 +515,7 @@ library unstable-cardano-tools
 
   build-depends:
     aeson,
-    base >=4.14 && <4.20,
+    base >=4.14 && <4.21,
     base16-bytestring >=1.0,
     bytestring >=0.10 && <0.13,
     cardano-crypto,

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs

@@ -14,7 +14,7 @@ import qualified Cardano.Ledger.Shelley.BlockChain as SL (bBodySize)
 import qualified Cardano.Protocol.TPraos.BHeader as SL
 import           Control.Exception
 import           Control.Monad.Except
-import           Data.List (foldl')
+import           Data.List as List (foldl')
 import qualified Data.Sequence.Strict as Seq
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
@@ -98,5 +98,5 @@ forgeShelleyBlock
       = return ()
 
     estimatedBodySize, actualBodySize :: Int
-    estimatedBodySize = fromIntegral $ foldl' (+) 0 $ map (txInBlockSize . txForgetValidated) txs
+    estimatedBodySize = fromIntegral $ List.foldl' (+) 0 $ map (txInBlockSize . txForgetValidated) txs
     actualBodySize    = SL.bBodySize protocolVersion body

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs

@@ -29,7 +29,7 @@ import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.RewardUpdate as SL
 import           Cardano.Tools.DBAnalyser.HasAnalysis
 import qualified Data.Aeson as Aeson
-import           Data.Foldable (foldl', toList)
+import           Data.Foldable as Foldable (foldl', toList)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, maybeToList)
 import           Data.Maybe.Strict
@@ -91,7 +91,7 @@ instance ( ShelleyCompatible proto era
       , decimal $ sum    $ blockTxSizes blk
       ]
       ++
-      [ decimal $ foldl' (\acc tx -> acc + f tx) 0 txs
+      [ decimal $ Foldable.foldl' (\acc tx -> acc + f tx) 0 txs
       | f <- maybeToList txExUnitsSteps
       ]
     where

ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal

@@ -77,7 +77,7 @@ library
     Ouroboros.Consensus.Node.Run,
 
   build-depends:
-    base >=4.14 && <4.20,
+    base >=4.14 && <4.21,
     bytestring >=0.10 && <0.13,
     cardano-slotting,
     cborg ^>=0.2.2,

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs

@@ -1361,7 +1361,7 @@ directedEdgeInner registry clock (version, blockVersion) (cfg, calcMessageDelay)
       _         -> retry
 
     flattenPairs :: forall a. NE.NonEmpty (a, a) -> NE.NonEmpty a
-    flattenPairs = uncurry (<>) . NE.unzip
+    flattenPairs = uncurry (<>) . neUnzip
 
     neverReturns :: forall x void. String -> x -> void
     neverReturns s !_ = error $ s <> " never returns!"
@@ -1721,3 +1721,12 @@ data TxGenFailure = TxGenFailure Int   -- ^ how many times it failed
   deriving (Show)
 
 instance Exception TxGenFailure
+
+-- In [email protected] the Data.List.NonEmpty.unzip is deprecated and suggests that
+-- Data.Function.unzip should be used instead,but base versions earlier than
+-- 4.20 do not have that.
+-- Neatest solution is to cargo cult it here and switch to Data.Function.unzip
+-- later.
+neUnzip :: Functor f => f (a,b) -> (f a, f b)
+neUnzip xs = (fst <$> xs, snd <$> xs)
+

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Ref/PBFT.hs

@@ -27,7 +27,7 @@ module Test.ThreadNet.Ref.PBFT (
 import           Control.Applicative ((<|>))
 import           Control.Arrow ((&&&))
 import           Control.Monad (guard)
-import           Data.Foldable (foldl', toList)
+import           Data.Foldable as Foldable (foldl', toList)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Sequence (Seq)
@@ -609,7 +609,7 @@ nextLeader params State{nextSlot} = mkLeaderOf params nextSlot
 fillOut :: PBftParams -> NodeJoinPlan -> SlotNo -> NodeJoinPlan
 fillOut params (NodeJoinPlan m) s =
     NodeJoinPlan $
-    foldl' (\acc i -> Map.insert i j acc) m $
+    Foldable.foldl' (\acc i -> Map.insert i j acc) m $
     CoreNodeId <$> [i0 .. iN]
   where
     iN       = oneN params - 1

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util/Expectations.hs

@@ -5,7 +5,7 @@ module Test.ThreadNet.Util.Expectations (
   , determineForkLength
   ) where
 
-import           Data.Foldable (foldl')
+import           Data.Foldable as Foldable (foldl')
 import qualified Data.Map.Strict as Map
 import           Data.Word (Word64)
 import           Ouroboros.Consensus.Block
@@ -99,7 +99,7 @@ determineForkLength ::
   -> LeaderSchedule
   -> NumBlocks
 determineForkLength k (NodeJoinPlan joinPlan) (LeaderSchedule sched) =
-    prj $ foldl' step initial (Map.toAscList sched)
+    prj $ Foldable.foldl' step initial (Map.toAscList sched)
   where
     prj Acc{maxForkLength} = NumBlocks maxForkLength
 

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs

@@ -15,7 +15,7 @@ import           Cardano.Slotting.Time (SlotLength, getSlotLength,
                      slotLengthFromSec)
 import           Control.Monad (replicateM)
 import qualified Control.Monad.Except as Exn
-import           Data.List (foldl')
+import           Data.List as List (foldl')
 import           Data.Proxy (Proxy (..))
 import           Data.Time.Clock (DiffTime, secondsToDiffTime)
 import qualified Data.Vector.Unboxed as Vector
@@ -137,7 +137,7 @@ genChainsWithExtraHonestPeers genNumExtraHonest genNumForks = do
     -- values carry no special meaning. Someone needs to think about what values
     -- would make for interesting tests.
     gtCSJParams = CSJParams $ fromIntegral scg,
-    gtBlockTree = foldl' (flip BT.addBranch') (BT.mkTrunk goodChain) $ zipWith (genAdversarialFragment goodBlocks) [1..] alternativeChainSchemas,
+    gtBlockTree = List.foldl' (flip BT.addBranch') (BT.mkTrunk goodChain) $ zipWith (genAdversarialFragment goodBlocks) [1..] alternativeChainSchemas,
     gtExtraHonestPeers,
     gtSchedule = ()
     }
@@ -158,7 +158,7 @@ genChainsWithExtraHonestPeers genNumExtraHonest genNumForks = do
 
     mkTestBlocks :: [TestBlock] -> [S] -> Int -> [TestBlock]
     mkTestBlocks pre active forkNo =
-      fst (foldl' folder ([], 0) active)
+      fst (List.foldl' folder ([], 0) active)
       where
         folder (chain, inc) s | S.test S.notInverted s = (issue inc chain, 0)
                               | otherwise = (chain, inc + 1)

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/StateDiagram.hs

@@ -27,7 +27,7 @@ import           Control.Monad.State.Strict (State, gets, modify', runState,
                      state)
 import           Control.Tracer (Tracer (Tracer), debugTracer, traceWith)
 import           Data.Bifunctor (first)
-import           Data.Foldable (foldl', foldr')
+import           Data.Foldable as Foldable (foldl', foldr')
 import           Data.List (find, intersperse, mapAccumL, sort, transpose)
 import           Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, (<|))
 import qualified Data.List.NonEmpty as NonEmpty
@@ -416,7 +416,7 @@ commonRange branch segment = do
   pure (Range (slotInt l + (if overFork then 0 else 1)) (slotInt u + 1), overFork)
   where
     findLower preB preS =
-      foldl' step Nothing (zip preB preS)
+      Foldable.foldl' step Nothing (zip preB preS)
     step prev (b1, b2) | b1 == b2 = Just b1
                        | otherwise = prev
 
@@ -476,7 +476,7 @@ addTipPoint _ _ treeSlots = treeSlots
 
 addPoints :: Map PeerId (NodeState TestBlock) -> TreeSlots -> TreeSlots
 addPoints peerPoints treeSlots =
-  foldl' step treeSlots (Map.toList peerPoints)
+  Foldable.foldl' step treeSlots (Map.toList peerPoints)
   where
     step z (pid, ap) = addTipPoint pid (nsTip ap) z
 
@@ -619,7 +619,7 @@ slotWidth =
 
 contiguous :: [(Int, Bool, a)] -> [[(Int, a)]]
 contiguous ((i0, _, a0) : rest) =
-  result (foldl' step (pure (i0, a0), []) rest)
+  result (Foldable.foldl' step (pure (i0, a0), []) rest)
   where
     result (cur, res) = reverse (reverse (toList cur) : res)
 
@@ -791,7 +791,7 @@ renderSlotWidth ellipsisWidth = \case
 
 breakLines :: RenderConfig -> [RenderSlot] -> [[RenderSlot]]
 breakLines RenderConfig {lineWidth, ellipsis} =
-  result . foldl' step (0, [], [])
+  result . Foldable.foldl' step (0, [], [])
   where
     result (_, cur, res) = reverse (reverse cur : res)
     step (w, cur, res) slot
@@ -851,7 +851,7 @@ peerSimStateDiagramWith config PeerSimState {pssBlockTree, pssSelection, pssCand
       treeCells $
       addPoints pssPoints $
       addForks $
-      flip (foldl' addCandidateRange) (Map.toList pssCandidates) $
+      flip (Foldable.foldl' addCandidateRange) (Map.toList pssCandidates) $
       addFragRange Selection pssSelection $
       initTree pssBlockTree