From dca8ef8a258e50259f52605bac222862b39ddf48 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 4 Dec 2025 11:20:46 +1100 Subject: [PATCH 1/2] cabal.project: Update index-state --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index fcdbe06513..008764856f 100644 --- a/cabal.project +++ b/cabal.project @@ -15,10 +15,10 @@ repository cardano-haskell-packages -- repeat the index-state for hackage to work around haskell.nix parsing limitation index-state: -- Bump this if you need newer packages from Hackage - , hackage.haskell.org 2025-11-10T01:36:00Z + , hackage.haskell.org 2025-12-03T21:21:06Z -- Bump this if you need newer packages from CHaP - , cardano-haskell-packages 2025-11-07T15:42:47Z + , cardano-haskell-packages 2025-12-01T07:41:27Z packages: ./cardano-ping ./monoidal-synchronisation From d619ecde5068e44a9e2734c4350344d52ec4daec Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 4 Dec 2025 11:24:18 +1100 Subject: [PATCH 2/2] Preliminary ghc-9.14 support Currently using ghc-9.14.0.20251128 (-rc3). --- acts-generic/src/Data/Act/Generic.hs | 9 +- cabal.project | 152 ++++++++++++++++++ .../lib/Test/Cardano/Network/PeerSelection.hs | 15 +- cardano-ping/cardano-ping.cabal | 2 +- dmq-node/dmq-node.cabal | 2 +- network-mux/src/Network/Mux.hs | 5 + network-mux/src/Network/Mux/Ingress.hs | 5 + ntp-client/ntp-client.cabal | 4 +- .../api/lib/Ouroboros/Network/Block.hs | 6 + .../api/tests/Test/Ouroboros/Network/Chain.hs | 9 +- .../lib/Ouroboros/Network/Snocket.hs | 8 +- .../Ouroboros/Network/ConnectionManager.hs | 12 +- .../Ouroboros/Network/OrphanInstances.hs | 40 ++++- ouroboros-network/ouroboros-network.cabal | 2 +- .../Network/Protocol/LocalStateQuery/Codec.hs | 5 + .../Network/Protocol/LocalStateQuery/Type.hs | 10 +- .../Network/Protocol/PeerSharing/Codec.hs | 8 +- .../Network/Protocol/PeerSharing/Type.hs | 9 +- .../Network/Protocol/ChainSync/Test.hs | 25 ++- 19 files changed, 301 insertions(+), 27 deletions(-) diff --git a/acts-generic/src/Data/Act/Generic.hs b/acts-generic/src/Data/Act/Generic.hs index f30c9d667c..cc7da4aaf2 100644 --- a/acts-generic/src/Data/Act/Generic.hs +++ b/acts-generic/src/Data/Act/Generic.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -68,7 +69,13 @@ instance (GAct s f, GAct s g) => GAct s (f :+: g) where -- newtype GenericAct s a = GenericAct { getGenericAct :: a } -instance (Generic s, Generic a, GAct s (Rep a), Semigroup s) => Act s (GenericAct s a) where +instance ( +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + Generic s, +#endif + Generic a, GAct s (Rep a), Semigroup s) => Act s (GenericAct s a) where act s (GenericAct a) = GenericAct (s `gact` a) diff --git a/cabal.project b/cabal.project index 008764856f..49706252ee 100644 --- a/cabal.project +++ b/cabal.project @@ -62,3 +62,155 @@ source-repository-package tag: 6d0f51fba415d3c641a8a8da37130e7adfc3ea01 --sha256: sha256-qM8RgmKOGBMlizPtXw2YOboYIzM6T3kvG9/Rp1F+bYQ= subdir: kes-agent-crypto + +if impl (ghc >= 9.14) + constraints: + , containers > 0.7 + , foldl >= 1.4.18 + -- Newest version causes Arbitrary instance clashes in quickcheck-instances. + , QuickCheck < 2.17.0.0 + +-- cabal-allow-newer +if impl (ghc >= 9.14) + allow-newer: + , OneTuple:base + , aeson:QuickCheck + , aeson:base + , aeson:bytestring + , aeson:containers + , aeson:deepseq + , aeson:ghc-prim + , aeson:template-haskell + , aeson:text-iso8601 + , aeson:text-short + , aeson:time + , aeson:time-compat + , aeson:witherable + , assoc:base + , async:base + , base:ghc-prim + , bifunctors:template-haskell + , bifunctors:th-abstraction + , binary:containers + , binary-orphans:base + , boring:base + , canonical-json:containers + , cardano-diffusion:cborg + , cardano-diffusion:io-classes + , cardano-diffusion:typed-protocols + , cardano-ping:io-classes + , cardano-ping:time + , cardano-prelude:canonical-json + , cborg:base + , cborg:bytestring + , cborg:containers + , criterion:microstache + , data-fix:base + , directory:time + , dmq-node:io-classes + , dmq-node:time + , exceptions:mtl + , filepath:base + , free:base + , free:exceptions + , free:mtl + , free:template-haskell + , generic-data:base + , generically:base + , ghc-heap:containers + , hashable:base + , hashable:containers + , hashable:ghc-bignum + , hsc2hs:base + , indexed-traversable:base + , indexed-traversable:containers + , indexed-traversable-instances:base + , integer-conversion:base + , integer-logarithms:base + , integer-logarithms:ghc-bignum + , io-classes:async + , io-classes:base + , io-sim:base + , io-sim:io-classes + , kes-agent-crypto:base + , microstache:aeson + , microstache:base + , microstache:containers + , network-mux:containers + , network-mux:io-classes + , network-mux:time + , network-uri:th-compat + , nothunks:base + , nothunks:bytestring + , nothunks:time + , ntp-client:time + , os-string:bytestring + , os-string:exceptions + , os-string:template-haskell + , ouroboros-network:io-classes + , ouroboros-network:time + , parallel:array + , parallel:base + , parsec:bytestring + , primitive:base + , process:base + , quickcheck-instances:base + , quickcheck-instances:bytestring + , quickcheck-instances:containers + , recursion-schemes:containers + , recursion-schemes:data-fix + , recursion-schemes:free + , recursion-schemes:template-haskell + , scientific:base + , scientific:containers + , scientific:integer-logarithms + , scientific:template-haskell + , semialign:base + , semialign:containers + , semigroupoids:bifunctors + , serialise:base + , serialise:bytestring + , serialise:containers + , serialise:ghc-prim + , serialise:hashable + , serialise:these + , serialise:time + , singletons:base + , splitmix:base + , statistics:parallel + , stm:array + , strict-checked-vars:io-classes + , tagged:template-haskell + , tdigest:base + , text:binary + , text-iso8601:time + , text-short:base + , text-short:ghc-prim + , text-short:template-haskell + , th-abstraction:template-haskell + , th-compat:template-haskell + , these:base + , time-compat:base + , time-compat:hashable + , time-compat:time + , tree-diff:aeson + , tree-diff:base + , tree-diff:containers + , tree-diff:deepseq + , tree-diff:scientific + , tree-diff:tagged + , tree-diff:time + , tree-diff:uuid-types + , typed-protocols:base + , typed-protocols:io-classes + , typed-protocols:singletons + , unix:base + , unordered-containers:base + , unordered-containers:hashable + , unordered-containers:template-haskell + , uuid-types:template-haskell + , vector-th-unbox:base + , vector-th-unbox:template-haskell + , wherefrom-compat:base + , with-utf8:base + , witherable:containers diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs index a88e5336ef..e0ca130447 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs @@ -1074,7 +1074,11 @@ prop_governor_peershare_1hr env@GovernorMockEnvironment { ) in counterexample ( intercalate "\n" . map (ppSimEvent 20 20 20) - . takeWhile (\e -> seTime e <= Time (60*60)) + . takeWhile (\e -> + case e of + SimEvent {seTime} -> seTime < Time (60*60) + SimPOREvent {seTime} -> seTime < Time (60*60) + _ -> False) . Trace.toList $ ioSimTrace) $ subsetProperty found reachable @@ -3555,7 +3559,14 @@ prop_governor_target_established_local (MaxTime maxTime) env = id promotionOpportunities - in counterexample (ppTrace_ (Trace.takeWhile (\e -> seTime e <= maxTime) trace)) $ + in counterexample (ppTrace_ (Trace.takeWhile + (\e -> + case e of + SimEvent {seTime} -> seTime < maxTime + SimPOREvent {seTime} -> seTime < maxTime + _ -> False) trace)) $ + + counterexample ("\nSignal key: (local root peers, established peers, " ++ "recent failures, opportunities, ignored too long)") $ diff --git a/cardano-ping/cardano-ping.cabal b/cardano-ping/cardano-ping.cabal index 0baca74160..e7e96c46e3 100644 --- a/cardano-ping/cardano-ping.cabal +++ b/cardano-ping/cardano-ping.cabal @@ -37,7 +37,7 @@ library network-mux ^>=0.9, tdigest ^>=0.3, text >=1.2.4 && <2.2, - time >=1.9.1 && <1.16, + time >=1.9.1 && <1.14, transformers >=0.5 && <0.7, if flag(asserts) diff --git a/dmq-node/dmq-node.cabal b/dmq-node/dmq-node.cabal index 8e53316f15..0bead3ab44 100644 --- a/dmq-node/dmq-node.cabal +++ b/dmq-node/dmq-node.cabal @@ -112,7 +112,7 @@ library random ^>=1.2, singletons, text >=1.2.4 && <2.2, - time >=1.12 && <1.16, + time ^>=1.12, typed-protocols:{typed-protocols, cborg} ^>=1.1, hs-source-dirs: src diff --git a/network-mux/src/Network/Mux.hs b/network-mux/src/Network/Mux.hs index ed06fc0edf..2115e25ea3 100644 --- a/network-mux/src/Network/Mux.hs +++ b/network-mux/src/Network/Mux.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} @@ -66,7 +67,11 @@ import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Maybe (isNothing) import Data.Monoid.Synchronisation (FirstToFinish (..)) +#if __GLASGOW_HASKELL__ < 914 import Data.Strict.Tuple (pattern (:!:)) +#else +import Data.Strict.Tuple (data (:!:)) +#endif import Control.Applicative import Control.Concurrent.Class.MonadSTM.Strict diff --git a/network-mux/src/Network/Mux/Ingress.hs b/network-mux/src/Network/Mux/Ingress.hs index 263d31517c..65df607d48 100644 --- a/network-mux/src/Network/Mux/Ingress.hs +++ b/network-mux/src/Network/Mux/Ingress.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} @@ -17,7 +18,11 @@ import Data.ByteString.Builder.Internal (lazyByteStringInsert, lazyByteStringThreshold) import Data.ByteString.Lazy qualified as BL import Data.List (nub) +#if __GLASGOW_HASKELL__ < 914 import Data.Strict.Tuple (pattern (:!:)) +#else +import Data.Strict.Tuple (data (:!:)) +#endif import Control.Concurrent.Class.MonadSTM.Strict import Control.Monad diff --git a/ntp-client/ntp-client.cabal b/ntp-client/ntp-client.cabal index 100ac26b75..9bf6fc32ef 100644 --- a/ntp-client/ntp-client.cabal +++ b/ntp-client/ntp-client.cabal @@ -36,7 +36,7 @@ library contra-tracer >=0.1 && <0.2, network ^>=3.2.7, stm >=2.4 && <2.6, - time >=1.9.1 && <1.16, + time >=1.9.1 && <1.14, hs-source-dirs: src default-language: Haskell2010 @@ -67,7 +67,7 @@ test-suite test binary >=0.8 && <0.11, tasty, tasty-quickcheck, - time >=1.9.1 && <1.16, + time >=1.9.1 && <1.14, default-language: Haskell2010 default-extensions: ImportQualifiedPost diff --git a/ouroboros-network/api/lib/Ouroboros/Network/Block.hs b/ouroboros-network/api/lib/Ouroboros/Network/Block.hs index e39f8608ff..82296b2f39 100644 --- a/ouroboros-network/api/lib/Ouroboros/Network/Block.hs +++ b/ouroboros-network/api/lib/Ouroboros/Network/Block.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} @@ -40,8 +41,13 @@ module Ouroboros.Network.Block , pointHash , castPoint , blockPoint +#if __GLASGOW_HASKELL__ < 914 , pattern GenesisPoint , pattern BlockPoint +#else + , data GenesisPoint + , data BlockPoint +#endif , atSlot , withHash , Tip (..) diff --git a/ouroboros-network/api/tests/Test/Ouroboros/Network/Chain.hs b/ouroboros-network/api/tests/Test/Ouroboros/Network/Chain.hs index 79ec206cc7..3d0473c0bd 100644 --- a/ouroboros-network/api/tests/Test/Ouroboros/Network/Chain.hs +++ b/ouroboros-network/api/tests/Test/Ouroboros/Network/Chain.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -15,7 +16,13 @@ import Test.QuickCheck import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) -import Ouroboros.Network.Block (blockPrevHash, pattern GenesisPoint, pointHash) +import Ouroboros.Network.Block (blockPrevHash, +#if __GLASGOW_HASKELL__ < 914 + pattern GenesisPoint, +#else + data GenesisPoint, +#endif + pointHash) import Ouroboros.Network.Mock.Chain (Chain (..)) import Ouroboros.Network.Mock.Chain qualified as Chain import Ouroboros.Network.Mock.ChainGenerators hiding (tests) diff --git a/ouroboros-network/framework/lib/Ouroboros/Network/Snocket.hs b/ouroboros-network/framework/lib/Ouroboros/Network/Snocket.hs index 01f21ac9c4..6e826d563f 100644 --- a/ouroboros-network/framework/lib/Ouroboros/Network/Snocket.hs +++ b/ouroboros-network/framework/lib/Ouroboros/Network/Snocket.hs @@ -251,9 +251,15 @@ data AddressFamily addr where -- TestFamily :: AddressFamily (TestAddress addr) +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 deriving instance Eq addr => Eq (AddressFamily addr) deriving instance Show addr => Show (AddressFamily addr) - +#else +deriving instance Eq (AddressFamily addr) +deriving instance Show (AddressFamily addr) +#endif -- | Abstract communication interface that can be used by more than -- 'Socket'. Snockets are polymorphic over monad which is used, this feature diff --git a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs index 9a25eab1f0..9456428810 100644 --- a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs +++ b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs @@ -504,10 +504,14 @@ mkSnocket scheduleMap = do , show (remoteAddr, seIdx se) ])) return se - case seConnDelay se of - Left d -> threadDelay d - >> throwIO (ioe (show (remoteAddr, seIdx se))) - Right d -> threadDelay d + case se of + ScheduleOutbound {} -> + case seConnDelay se of + Left d -> threadDelay d + >> throwIO (ioe (show (remoteAddr, seIdx se))) + Right d -> threadDelay d + ScheduleInbound {} -> + pure () where ioe :: String -> IOException ioe ioe_description = diff --git a/ouroboros-network/orphan-instances/Ouroboros/Network/OrphanInstances.hs b/ouroboros-network/orphan-instances/Ouroboros/Network/OrphanInstances.hs index 8eb49ea336..606a7834f7 100644 --- a/ouroboros-network/orphan-instances/Ouroboros/Network/OrphanInstances.hs +++ b/ouroboros-network/orphan-instances/Ouroboros/Network/OrphanInstances.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -387,7 +388,13 @@ instance ToJSON KnownPeerInfo where instance ToJSON PeerStatus where toJSON = String . pack . show -instance (ToJSON extraFlags, ToJSONKey peerAddr, ToJSON peerAddr, Ord peerAddr) +instance (ToJSON extraFlags, ToJSONKey peerAddr, +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + ToJSON peerAddr, +#endif + Ord peerAddr) => ToJSON (LocalRootPeers extraFlags peerAddr) where toJSON lrp = kindObject "LocalRootPeers" [ "groups" .= toJSONList (LocalRootPeers.toGroups lrp) ] @@ -834,7 +841,11 @@ instance ToJSON Time where instance ( ToJSON extraDebugState , ToJSON extraFlags +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 , ToJSON extraPeers +#endif , ToJSON extraTracer , ToJSON peerAddr , ToJSONKey peerAddr @@ -1264,7 +1275,12 @@ instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) , "command" .= show cerr ] -instance (Show addr, Show versionNumber, Show agreedOptions, +instance (Show addr, Show versionNumber, +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + Show agreedOptions, +#endif ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) => ToJSON (ConnMgr.Trace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where toJSON = \case @@ -1406,7 +1422,13 @@ instance (Show addr, Show versionNumber, Show agreedOptions, , "info" .= String (pack . show $ info) ] -instance (Show addr, ToJSON addr) +instance ( +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + Show addr, +#endif + ToJSON addr) => ToJSON (ConnMgr.AbstractTransitionTrace addr) where toJSON (ConnMgr.TransitionTrace addr tr) = object @@ -1432,7 +1454,13 @@ instance ToJSON AcceptConnectionsPolicyTrace where , "numberOfConnection" .= show numOfConnections ] -instance (Show addr, ToJSON addr) +instance ( +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + Show addr, +#endif + ToJSON addr) => ToJSON (Server.Trace addr) where toJSON (Server.TrAcceptConnection connId) = object [ "kind" .= String "AcceptConnection" @@ -1700,7 +1728,11 @@ instance (ToJSON tx, ToJSON reason) => ToJSON (AnyMessage (LocalTxSubmission tx ] instance ( ToJSON txid +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 , ToJSON tx +#endif , Show txid , Show tx ) diff --git a/ouroboros-network/ouroboros-network.cabal b/ouroboros-network/ouroboros-network.cabal index f7831a0a0f..55650b9609 100644 --- a/ouroboros-network/ouroboros-network.cabal +++ b/ouroboros-network/ouroboros-network.cabal @@ -851,7 +851,7 @@ library ouroboros-network-tests-lib tasty-hunit, tasty-quickcheck, text, - time >=1.9.1 && <1.16, + time >=1.9.1 && <1.14, typed-protocols, exposed-modules: diff --git a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs index ea4bfa37db..87840e33ba 100644 --- a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs +++ b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -39,7 +40,11 @@ data Some (f :: k -> Type) where codecLocalStateQuery :: forall block point query m. ( MonadST m +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 , ShowQuery query +#endif ) => LocalStateQueryVersion -- ^ eg whether to allow 'ImmutableTip' in @'MsgAcquire' diff --git a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs index d37bcc2a41..ecc15656ad 100644 --- a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs +++ b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -102,8 +103,13 @@ instance StateTokenI (StQuerying (result :: Type)) instance StateTokenI StDone where stateToken = SingDone -instance (forall result. Show (query result)) - => Show (SingLocalStateQuery (k :: LocalStateQuery block point query)) where +instance +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + (forall result. Show (query result)) => +#endif + Show (SingLocalStateQuery (k :: LocalStateQuery block point query)) where show SingIdle = "SingIdle" show SingAcquiring = "SingAcuiring" show SingAcquired = "SingAcquired" diff --git a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Codec.hs b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Codec.hs index 2c15fb4c3c..8aa69e16c7 100644 --- a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Codec.hs +++ b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Codec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -106,8 +107,13 @@ codecPeerSharingId = Codec encodeMsg decodeMsg encodeMsg = AnyMessage decodeMsg :: forall (st :: PeerSharing peerAddress). +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 ActiveState st - => StateToken st + => +#endif + StateToken st -> m (DecodeStep (AnyMessage (PeerSharing peerAddress)) CodecFailure m (SomeMessage st)) decodeMsg stok = return $ DecodePartial $ \bytes -> return $ diff --git a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Type.hs b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Type.hs index eb7af529e9..9bfc98e1dc 100644 --- a/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Type.hs +++ b/ouroboros-network/protocols/lib/Ouroboros/Network/Protocol/PeerSharing/Type.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} @@ -104,6 +105,12 @@ instance Show peer => Show (Message (PeerSharing peer) from to) where show (MsgSharePeers resp) = "MsgSharePeers " ++ show resp show MsgDone = "MsgDone" +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 deriving instance (Show peerAddress) => Show (PeerSharing peerAddress) - deriving instance (Eq peerAddress) => Eq (PeerSharing peerAddress) +#else +deriving instance Show (PeerSharing peerAddress) +deriving instance Eq (PeerSharing peerAddress) +#endif diff --git a/ouroboros-network/protocols/tests-lib/Ouroboros/Network/Protocol/ChainSync/Test.hs b/ouroboros-network/protocols/tests-lib/Ouroboros/Network/Protocol/ChainSync/Test.hs index 4a0c128b0f..8c7ad5dca9 100644 --- a/ouroboros-network/protocols/tests-lib/Ouroboros/Network/Protocol/ChainSync/Test.hs +++ b/ouroboros-network/protocols/tests-lib/Ouroboros/Network/Protocol/ChainSync/Test.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,9 +32,17 @@ import Network.TypedProtocol.Proofs (connect, connectPipelined) import Ouroboros.Network.Channel import Ouroboros.Network.Driver -import Ouroboros.Network.Block (BlockNo, Serialised (..), StandardHash, - Tip (..), decodeTip, encodeTip, pattern BlockPoint, - pattern GenesisPoint, unwrapCBORinCBOR, wrapCBORinCBOR) +import Ouroboros.Network.Block (BlockNo, Serialised (..), + Tip (..), decodeTip, encodeTip, +#if __GLASGOW_HASKELL__ < 914 + StandardHash , + pattern BlockPoint, + pattern GenesisPoint, +#else + data BlockPoint, + data GenesisPoint, +#endif + unwrapCBORinCBOR, wrapCBORinCBOR) import Ouroboros.Network.Mock.Chain (Chain, Point) import Ouroboros.Network.Mock.Chain qualified as Chain import Ouroboros.Network.Mock.ChainGenerators () @@ -443,8 +452,14 @@ instance Arbitrary (Serialised BlockHeader) where serialiseBlock :: BlockHeader -> Serialised BlockHeader serialiseBlock = Serialised . S.serialise -instance ( StandardHash header - , Eq header +instance ( +#if __GLASGOW_HASKELL__ < 914 + -- These constraints are REQUIRED for ghc < 9.14 but REDUNDANT for ghc >= 9.14 + -- See https://gitlab.haskell.org/ghc/ghc/-/issues/26381#note_637863 + StandardHash header + , +#endif + Eq header , Eq point , Eq tip ) => Eq (AnyMessage (ChainSync header point tip)) where