From 390dda5c895cf9ac139286a06f5d15aacf295441 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 19 May 2026 21:26:56 -0600 Subject: [PATCH 1/7] Add NFData instances for the associated types in `VRFAlgorithm FakeVRF` --- libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal | 1 + .../testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal index 601402310eb..28e99397fdf 100644 --- a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal +++ b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal @@ -109,6 +109,7 @@ library testlib cardano-protocol-tpraos, cardano-strict-containers, containers, + deepseq, generic-random, microlens, nothunks, diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs index dd3a4e6a168..a05f479d8a5 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs @@ -41,6 +41,7 @@ import Cardano.Ledger.Binary.Crypto ( encodeSignKeyVRF, encodeVerKeyVRF, ) +import Control.DeepSeq (NFData (..)) import Data.Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BS @@ -101,14 +102,14 @@ instance VRFAlgorithm FakeVRF where newtype VerKeyVRF FakeVRF = VerKeyFakeVRF Word64 deriving stock (Show, Generic) - deriving newtype (Eq, Ord, NoThunks) + deriving newtype (Eq, Ord, NFData, NoThunks) newtype SignKeyVRF FakeVRF = SignKeyFakeVRF Word64 deriving stock (Show, Generic) - deriving newtype (Eq, Ord, NoThunks) + deriving newtype (Eq, Ord, NFData, NoThunks) data CertVRF FakeVRF = CertFakeVRF !Word64 !Word16 !(OutputVRF FakeVRF) deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NoThunks) + deriving anyclass (NFData, NoThunks) genKeyVRF seed = SignKeyFakeVRF $ runMonadRandomWithSeed seed getRandomWord64 deriveVerKeyVRF (SignKeyFakeVRF n) = VerKeyFakeVRF n From 5ff0c08825a824dcd2e9888e3f6c33ffce8125f6 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 19 May 2026 21:47:10 -0600 Subject: [PATCH 2/7] Relax Cabal bounds on `cardano-crypto-class` --- eras/mary/impl/cardano-ledger-mary.cabal | 2 +- eras/shelley/impl/cardano-ledger-shelley.cabal | 2 +- libs/cardano-ledger-binary/cardano-ledger-binary.cabal | 2 +- libs/cardano-ledger-core/cardano-ledger-core.cabal | 2 +- libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index e4dd8ab3457..7d9ea7263aa 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -84,7 +84,7 @@ library base >=4.18 && <5, base16-bytestring, bytestring, - cardano-crypto-class >=2.3 && <2.5, + cardano-crypto-class >=2.3 && <2.6, cardano-data ^>=1.3, cardano-ledger-allegra ^>=1.10, cardano-ledger-binary >=1.4, diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index d0fe2b48c70..008dc617152 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -118,7 +118,7 @@ library base >=4.18 && <5, bytestring, cardano-base >=0.1.1.0, - cardano-crypto-class >=2.3 && <2.5, + cardano-crypto-class >=2.3 && <2.6, cardano-crypto-wrapper, cardano-data ^>=1.3, cardano-ledger-binary ^>=1.9, diff --git a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal index 1b90596be44..eef95194f4c 100644 --- a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal +++ b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal @@ -57,7 +57,7 @@ library bytestring, cardano-base >=0.1.2, cardano-binary >=1.7.3, - cardano-crypto-class >=2.3 && <2.5, + cardano-crypto-class >=2.3 && <2.6, cardano-crypto-praos >=2.2.2, cardano-slotting >=0.2, cardano-strict-containers >=0.1.2, diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index eca350c6759..28202a9a0c7 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -119,7 +119,7 @@ library bytestring >=0.10 && <0.11.3 || >=0.11.4, cardano-base >=0.1.2, cardano-crypto, - cardano-crypto-class ^>=2.4, + cardano-crypto-class >=2.4 && <2.6, cardano-crypto-wrapper, cardano-data >=1.3, cardano-ledger-binary ^>=1.9, diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal index 28e99397fdf..1f73ae931b5 100644 --- a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal +++ b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal @@ -43,7 +43,7 @@ library base >=4.18 && <5, bytestring, cardano-base >=0.1.2, - cardano-crypto-class >=2.3 && <2.5, + cardano-crypto-class >=2.3 && <2.6, cardano-crypto-praos ^>=2.2, cardano-ledger-allegra >=1.10, cardano-ledger-alonzo >=1.16, From 7ab703cc0eeba65bd496a5ca8595cd59abf5f322 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 19 May 2026 21:47:57 -0600 Subject: [PATCH 3/7] Use an srp for `cardano-base` --- cabal.project | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cabal.project b/cabal.project index 7c83b91838f..1aec6cb6ad0 100644 --- a/cabal.project +++ b/cabal.project @@ -182,3 +182,13 @@ if impl(ghc >=9.14) , universe-base:base , universe-base:containers , uuid-types:template-haskell + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-base.git + --sha256: sha256-qpShH6TD09thz4Nar6iKsrwWLkzzigVcuOLzxf+ZkDc= + tag: 6ed7596ecb5739689fada36a4fed0b06045a7f22 + subdir: + cardano-base + cardano-crypto-class + cardano-crypto-praos From 783129fe3b54d8ecd4640e16c3230259b599022e Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 16 May 2026 07:18:27 -0600 Subject: [PATCH 4/7] Add Ord instances for predicate failures --- .../src/Cardano/Ledger/Allegra/Rules/Utxo.hs | 11 +++++-- .../src/Cardano/Ledger/Allegra/Scripts.hs | 4 +-- .../Cardano/Ledger/Alonzo/Plutus/Context.hs | 6 +++- .../Cardano/Ledger/Alonzo/Plutus/TxInfo.hs | 2 +- .../src/Cardano/Ledger/Alonzo/Rules/Bbody.hs | 4 +++ .../src/Cardano/Ledger/Alonzo/Rules/Utxo.hs | 8 +++++ .../src/Cardano/Ledger/Alonzo/Rules/Utxos.hs | 22 +++++++++----- .../src/Cardano/Ledger/Alonzo/Rules/Utxow.hs | 7 +++++ .../impl/src/Cardano/Ledger/Alonzo/Scripts.hs | 8 +++++ .../impl/src/Cardano/Ledger/Alonzo/Tx.hs | 2 +- .../impl/src/Cardano/Ledger/Alonzo/TxOut.hs | 6 ++-- .../src/Cardano/Ledger/Babbage/Rules/Utxo.hs | 10 +++++++ .../src/Cardano/Ledger/Babbage/Rules/Utxos.hs | 2 +- .../src/Cardano/Ledger/Babbage/Rules/Utxow.hs | 12 +++++++- .../impl/src/Cardano/Ledger/Babbage/TxInfo.hs | 4 +++ .../impl/src/Cardano/Ledger/Babbage/TxOut.hs | 4 +++ .../src/Byron/Spec/Chain/STS/Block.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/BBody.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/Bupi.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/Chain.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/Epoch.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/Pbft.hs | 2 +- .../src/Byron/Spec/Chain/STS/Rule/SigCnt.hs | 2 +- .../src/Byron/Spec/Ledger/Delegation.hs | 14 ++++----- .../src/Byron/Spec/Ledger/STS/UTXO.hs | 2 +- .../src/Byron/Spec/Ledger/STS/UTXOW.hs | 2 +- .../src/Byron/Spec/Ledger/STS/UTXOWS.hs | 2 +- .../src/Byron/Spec/Ledger/Update.hs | 30 +++++++++---------- .../Spec/Ledger/Delegation/Properties.hs | 2 +- .../Byron/Spec/Ledger/Update/Properties.hs | 2 +- .../Ledger/Conway/Governance/Procedures.hs | 4 +-- .../src/Cardano/Ledger/Conway/Rules/Bbody.hs | 4 +++ .../src/Cardano/Ledger/Conway/Rules/Cert.hs | 7 +++++ .../src/Cardano/Ledger/Conway/Rules/Certs.hs | 4 +++ .../src/Cardano/Ledger/Conway/Rules/Deleg.hs | 2 +- .../src/Cardano/Ledger/Conway/Rules/Gov.hs | 2 +- .../Cardano/Ledger/Conway/Rules/GovCert.hs | 2 +- .../src/Cardano/Ledger/Conway/Rules/Ledger.hs | 8 +++++ .../Cardano/Ledger/Conway/Rules/Mempool.hs | 6 ++-- .../src/Cardano/Ledger/Conway/Rules/Utxo.hs | 10 +++++++ .../src/Cardano/Ledger/Conway/Rules/Utxos.hs | 7 +++++ .../src/Cardano/Ledger/Conway/Rules/Utxow.hs | 6 ++++ .../impl/src/Cardano/Ledger/Conway/Scripts.hs | 4 +++ .../impl/src/Cardano/Ledger/Conway/TxInfo.hs | 9 ++++++ .../Ledger/Dijkstra/BlockBody/Internal.hs | 2 +- .../Cardano/Ledger/Dijkstra/Rules/Bbody.hs | 4 +++ .../src/Cardano/Ledger/Dijkstra/Rules/Gov.hs | 2 +- .../Cardano/Ledger/Dijkstra/Rules/GovCert.hs | 2 +- .../Cardano/Ledger/Dijkstra/Rules/Ledger.hs | 9 ++++++ .../Cardano/Ledger/Dijkstra/Rules/Mempool.hs | 4 +++ .../Cardano/Ledger/Dijkstra/Rules/SubCert.hs | 7 +++++ .../Cardano/Ledger/Dijkstra/Rules/SubCerts.hs | 3 ++ .../Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs | 2 +- .../Cardano/Ledger/Dijkstra/Rules/SubGov.hs | 2 +- .../Ledger/Dijkstra/Rules/SubGovCert.hs | 2 +- .../Ledger/Dijkstra/Rules/SubLedger.hs | 7 +++++ .../Ledger/Dijkstra/Rules/SubLedgers.hs | 3 ++ .../Cardano/Ledger/Dijkstra/Rules/SubPool.hs | 2 +- .../Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs | 9 ++++++ .../Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs | 6 ++++ .../src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs | 10 +++++++ .../Cardano/Ledger/Dijkstra/Rules/Utxow.hs | 6 ++++ .../src/Cardano/Ledger/Dijkstra/Scripts.hs | 4 +-- .../src/Cardano/Ledger/Dijkstra/TxInfo.hs | 8 +++++ .../Test/Cardano/Ledger/Dijkstra/Imp.hs | 1 - .../impl/src/Cardano/Ledger/Mary/Value.hs | 10 ++++++- .../src/Cardano/Ledger/Shelley/Governance.hs | 6 ++++ .../src/Cardano/Ledger/Shelley/PParams.hs | 2 ++ .../src/Cardano/Ledger/Shelley/Rules/Bbody.hs | 6 ++++ .../src/Cardano/Ledger/Shelley/Rules/Deleg.hs | 2 +- .../Cardano/Ledger/Shelley/Rules/Delegs.hs | 4 +++ .../src/Cardano/Ledger/Shelley/Rules/Delpl.hs | 6 ++++ .../Cardano/Ledger/Shelley/Rules/Ledger.hs | 7 +++++ .../Cardano/Ledger/Shelley/Rules/Ledgers.hs | 6 ++++ .../src/Cardano/Ledger/Shelley/Rules/Pool.hs | 2 +- .../src/Cardano/Ledger/Shelley/Rules/Ppup.hs | 4 +-- .../src/Cardano/Ledger/Shelley/Rules/Utxo.hs | 9 +++++- .../src/Cardano/Ledger/Shelley/Rules/Utxow.hs | 6 ++++ .../src/Cardano/Ledger/Shelley/Scripts.hs | 4 +-- .../impl/src/Cardano/Ledger/Shelley/TxOut.hs | 2 ++ .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 2 +- .../Ledger/Shelley/Generator/Trace/TxCert.hs | 4 +++ .../Cardano/Ledger/Shelley/Rules/Chain.hs | 8 +++++ libs/cardano-data/src/Data/Map/NonEmpty.hs | 2 +- libs/cardano-data/src/Data/Set/NonEmpty.hs | 2 +- .../src/Cardano/Ledger/Address.hs | 4 +-- .../src/Cardano/Ledger/Coin.hs | 2 +- .../src/Cardano/Ledger/Compactible.hs | 1 + .../src/Cardano/Ledger/Core.hs | 3 ++ .../src/Cardano/Ledger/Keys/Internal.hs | 5 ++++ .../src/Cardano/Ledger/MemoBytes/Internal.hs | 5 ++++ .../src/Cardano/Ledger/Plutus/ExUnits.hs | 4 +-- .../src/Cardano/Ledger/Plutus/TxInfo.hs | 2 +- .../src/Cardano/Ledger/State/Governance.hs | 2 ++ .../src/Cardano/Ledger/State/Stake.hs | 2 +- .../src/Cardano/Ledger/Val.hs | 2 +- .../Test/Cardano/Ledger/Generic/MockChain.hs | 4 ++- .../Test/Cardano/Ledger/Generic/Properties.hs | 2 +- .../src/Cardano/Protocol/TPraos/API.hs | 4 +++ .../src/Cardano/Protocol/TPraos/BHeader.hs | 2 +- .../Cardano/Protocol/TPraos/Rules/OCert.hs | 2 +- .../Cardano/Protocol/TPraos/Rules/Overlay.hs | 4 +++ .../Cardano/Protocol/TPraos/Rules/Prtcl.hs | 6 +++- .../src/Cardano/Protocol/TPraos/Rules/Updn.hs | 2 +- .../src/Control/State/Transition/Extended.hs | 4 +-- .../State/Transition/Examples/CommitReveal.hs | 2 +- .../State/Transition/Examples/GlobalSum.hs | 2 +- .../Control/State/Transition/Examples/Sum.hs | 2 +- .../Test/Control/State/Transition/Trace.hs | 4 +-- 109 files changed, 414 insertions(+), 102 deletions(-) diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs index 0ece3e8aadc..63348cdc5a0 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs @@ -110,6 +110,13 @@ deriving stock instance ) => Eq (AllegraUtxoPredFailure era) +deriving stock instance + ( Ord (TxOut era) + , Ord (Value era) + , Ord (EraRuleFailure "PPUP" era) + ) => + Ord (AllegraUtxoPredFailure era) + instance ( Era era , NFData (TxOut era) @@ -151,7 +158,7 @@ utxoTransition :: , EraCertState era , ShelleyEraTxBody era , AllegraEraTxBody era - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , Embed (EraRule "PPUP" era) (EraRule "UTXO" era) , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era @@ -291,7 +298,7 @@ instance , State (EraRule "PPUP" era) ~ ShelleyGovState era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , AtMostEra "Babbage" era - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , EraRule "UTXO" era ~ AllegraUTXO era , GovState era ~ ShelleyGovState era diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs index d28d04ba69b..0a9c82f2db0 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs @@ -175,7 +175,7 @@ data TimelockRaw era | -- Note that the Int may be negative in which case (TimelockMOf (-2) [..]) is always True TimelockTimeStart !SlotNo -- The start time | TimelockTimeExpire !SlotNo -- The time it expires - deriving (Eq, Generic, NFData) + deriving (Eq, Ord, Generic, NFData) class ShelleyEraScript era => AllegraEraScript era where mkTimeStart :: SlotNo -> NativeScript era @@ -242,7 +242,7 @@ instance Era era => DecCBOR (Annotator (TimelockRaw era)) where -- ================================================================= newtype Timelock era = MkTimelock (MemoBytes (TimelockRaw era)) - deriving (Eq, Generic) + deriving (Eq, Ord, Generic) deriving newtype (ToCBOR, NFData, SafeToHash) instance Era era => MemPack (Timelock era) where diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs index 892e35294fe..539b159796d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs @@ -187,7 +187,7 @@ toPlutusTxInfoForPurpose proxy lti sp = class ( AlonzoEraScript era - , Eq (ContextError era) + , Ord (ContextError era) , Show (ContextError era) , NFData (ContextError era) , EncCBOR (ContextError era) @@ -352,6 +352,10 @@ deriving instance (AlonzoEraScript era, Eq (ContextError era)) => Eq (CollectError era) +deriving instance + (AlonzoEraScript era, Ord (ContextError era)) => + Ord (CollectError era) + deriving instance (AlonzoEraScript era, Show (ContextError era)) => Show (CollectError era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs index e12143845d3..ee8dcfb4b80 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs @@ -211,7 +211,7 @@ instance EraPlutusContext AlonzoEra where data AlonzoContextError era = TranslationLogicMissingInput TxIn | TimeTranslationPastHorizon Text - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) instance Era era => NFData (AlonzoContextError era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs index a59006d0d52..71a0fabcd48 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs @@ -127,6 +127,10 @@ deriving instance (Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) => Eq (AlonzoBbodyPredFailure era) +deriving instance + (Era era, Ord (PredicateFailure (EraRule "LEDGERS" era))) => + Ord (AlonzoBbodyPredFailure era) + instance (Era era, EncCBOR (PredicateFailure (EraRule "LEDGERS" era))) => EncCBOR (AlonzoBbodyPredFailure era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs index 9acee522793..c97fddae40a 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -206,6 +206,14 @@ deriving stock instance ) => Eq (AlonzoUtxoPredFailure era) +deriving stock instance + ( Era era + , Ord (Value era) + , Ord (TxOut era) + , Ord (PredicateFailure (EraRule "UTXOS" era)) + ) => + Ord (AlonzoUtxoPredFailure era) + instance ( Era era , NFData (Value era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs index 73392730581..4aa7f1ed62d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs @@ -106,7 +106,7 @@ instance , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , EncCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure, - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , EraPlutusContext era , EraCertState era @@ -166,7 +166,7 @@ utxosTransition :: , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , Embed (EraRule "PPUP" era) (AlonzoUTXOS era) , EncCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , EraPlutusContext era , EraCertState era @@ -295,7 +295,7 @@ invalidEnd = intercalate "," ["[LEDGER][SCRIPTS_NOT_VALIDATE_TRANSITION]", "END" data FailureDescription = PlutusFailure Text BS.ByteString - deriving (Show, Eq, Generic, NoThunks) + deriving (Show, Eq, Ord, Generic, NoThunks) instance NFData FailureDescription @@ -329,7 +329,7 @@ scriptFailureToFailureDescription (ScriptFailure msg pwc) = data TagMismatchDescription = PassedUnexpectedly | FailedUnexpectedly (NonEmpty FailureDescription) - deriving (Show, Eq, Generic, NoThunks) + deriving (Show, Eq, Ord, Generic, NoThunks) instance NFData TagMismatchDescription @@ -411,7 +411,6 @@ deriving stock instance ( AlonzoEraScript era , Show (TxCert era) , Show (ContextError era) - , Show (Shelley.UTxOState era) , Show (EraRuleFailure "PPUP" era) ) => Show (AlonzoUtxosPredFailure era) @@ -420,16 +419,25 @@ deriving stock instance ( AlonzoEraScript era , Eq (TxCert era) , Eq (ContextError era) - , Eq (Shelley.UTxOState era) , Eq (EraRuleFailure "PPUP" era) ) => Eq (AlonzoUtxosPredFailure era) +deriving stock instance + ( AlonzoEraScript era + , Ord (TxCert era) + , Ord (ContextError era) + , Ord (GovState era) + , Ord (InstantStake era) + , Ord (EraRuleFailure "PPUP" era) + , EraTxOut era + ) => + Ord (AlonzoUtxosPredFailure era) + instance ( AlonzoEraScript era , NFData (TxCert era) , NFData (ContextError era) - , NFData (Shelley.UTxOState era) , NFData (EraRuleFailure "PPUP" era) ) => NFData (AlonzoUtxosPredFailure era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index 7e090ec3a6b..039f7f4ce52 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -151,6 +151,13 @@ deriving instance ) => Eq (AlonzoUtxowPredFailure era) +deriving instance + ( AlonzoEraScript era + , Ord (TxCert era) + , Ord (PredicateFailure (EraRule "UTXO" era)) + ) => + Ord (AlonzoUtxowPredFailure era) + instance ( AlonzoEraScript era , NFData (TxCert era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs index baffd5b4778..f25ef8cb5d5 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs @@ -131,6 +131,7 @@ class , NFData (PlutusScript era) , SafeToHash (PlutusScript era) , Eq (PlutusPurpose AsItem era) + , Ord (PlutusPurpose AsItem era) , Show (PlutusPurpose AsItem era) , EncCBOR (PlutusPurpose AsItem era) , DecCBOR (PlutusPurpose AsItem era) @@ -146,6 +147,7 @@ class , NoThunks (PlutusPurpose AsIx era) , NFData (PlutusPurpose AsIx era) , Eq (PlutusPurpose AsIxItem era) + , Ord (PlutusPurpose AsIxItem era) , Show (PlutusPurpose AsIxItem era) , NoThunks (PlutusPurpose AsIxItem era) , NFData (PlutusPurpose AsIxItem era) @@ -322,12 +324,16 @@ instance NoThunks (AlonzoPlutusPurpose AsIx era) deriving instance Eq (TxCert era) => Eq (AlonzoPlutusPurpose AsItem era) +deriving instance Ord (TxCert era) => Ord (AlonzoPlutusPurpose AsItem era) + deriving instance Show (TxCert era) => Show (AlonzoPlutusPurpose AsItem era) instance NoThunks (TxCert era) => NoThunks (AlonzoPlutusPurpose AsItem era) deriving instance Eq (TxCert era) => Eq (AlonzoPlutusPurpose AsIxItem era) +deriving instance Ord (TxCert era) => Ord (AlonzoPlutusPurpose AsIxItem era) + deriving instance Show (TxCert era) => Show (AlonzoPlutusPurpose AsIxItem era) instance NoThunks (TxCert era) => NoThunks (AlonzoPlutusPurpose AsIxItem era) @@ -463,6 +469,8 @@ instance deriving instance (Eq (PlutusScript era), Eq (NativeScript era)) => Eq (AlonzoScript era) +deriving instance (Ord (PlutusScript era), Ord (NativeScript era)) => Ord (AlonzoScript era) + instance (Era era, NoThunks (PlutusScript era), NoThunks (NativeScript era)) => NoThunks (AlonzoScript era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs index 3594daf0c2e..1e422f95b10 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -142,7 +142,7 @@ import NoThunks.Class (InspectHeap (..), NoThunks) -- | Tag indicating whether non-native scripts in this transaction are expected -- to validate. This is added by the block creator when constructing the block. newtype IsValid = IsValid Bool - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving newtype (NoThunks, NFData, ToCBOR, EncCBOR, DecCBOR, ToJSON, FromJSON) data AlonzoTx l era where diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs index 4542bde2425..9fc6fa383c7 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs @@ -100,7 +100,7 @@ data Addr28Extra {-# UNPACK #-} !Word64 -- Payment Addr {-# UNPACK #-} !Word64 -- Payment Addr {-# UNPACK #-} !Word64 -- Payment Addr (32bits) + ... + 0/1 for Testnet/Mainnet + 0/1 Script/Pubkey - deriving (Eq, Show, Generic, NoThunks) + deriving (Eq, Ord, Show, Generic, NoThunks) instance MemPack Addr28Extra where packedByteCount _ = 32 @@ -115,7 +115,7 @@ data DataHash32 {-# UNPACK #-} !Word64 -- DataHash {-# UNPACK #-} !Word64 -- DataHash {-# UNPACK #-} !Word64 -- DataHash - deriving (Eq, Show, Generic, NoThunks) + deriving (Eq, Ord, Show, Generic, NoThunks) instance MemPack DataHash32 where packedByteCount _ = 32 @@ -197,6 +197,8 @@ instance (Era era, MemPack (CompactForm (Value era))) => MemPack (AlonzoTxOut er deriving stock instance (Eq (Value era), Compactible (Value era)) => Eq (AlonzoTxOut era) +deriving stock instance (Ord (Value era), Compactible (Value era)) => Ord (AlonzoTxOut era) + deriving instance Generic (AlonzoTxOut era) -- | Already in NF diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs index e02e117c278..4b5d3fe0cf3 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs @@ -139,6 +139,16 @@ deriving instance ) => Eq (BabbageUtxoPredFailure era) +deriving instance + ( Era era + , Ord (Alonzo.AlonzoUtxoPredFailure era) + , Ord (PredicateFailure (EraRule "UTXO" era)) + , Ord (TxOut era) + , Ord (Script era) + , Ord TxIn + ) => + Ord (BabbageUtxoPredFailure era) + instance ( Era era , NFData (Value era) diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs index f2f12550b9e..20af8f2be06 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs @@ -74,7 +74,7 @@ instance , State (EraRule "PPUP" era) ~ ShelleyGovState era , Signal (BabbageUTXOS era) ~ StAnnTx TopTx era , EncCBOR (EraRuleFailure "PPUP" era) - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , InjectRuleFailure "UTXOS" Alonzo.AlonzoUtxosPredFailure era , InjectRuleEvent "UTXOS" Alonzo.AlonzoUtxosEvent era diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs index 8477db17435..45f1eeed2fa 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs @@ -140,6 +140,16 @@ deriving instance ) => Eq (BabbageUtxowPredFailure era) +deriving instance + ( AlonzoEraScript era + , Ord (Shelley.ShelleyUtxowPredFailure era) + , Ord (PredicateFailure (EraRule "UTXO" era)) + , Ord (PredicateFailure (EraRule "UTXOS" era)) + , Ord (TxOut era) + , Ord (TxCert era) + ) => + Ord (BabbageUtxowPredFailure era) + instance ( AlonzoEraScript era , EncCBOR (PredicateFailure (EraRule "UTXO" era)) @@ -398,7 +408,7 @@ instance , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era - , Eq (PredicateFailure (EraRule "UTXOS" era)) + , Ord (PredicateFailure (EraRule "UTXOS" era)) , Show (PredicateFailure (EraRule "UTXOS" era)) , EraCertState era ) => diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxInfo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxInfo.hs index 9d8fa606186..161d1affd58 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxInfo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxInfo.hs @@ -258,6 +258,10 @@ deriving instance (Eq (AlonzoContextError era), Eq (PlutusPurpose AsIx era)) => Eq (BabbageContextError era) +deriving instance + (Ord (AlonzoContextError era), Ord (PlutusPurpose AsIx era)) => + Ord (BabbageContextError era) + deriving instance (Show (AlonzoContextError era), Show (PlutusPurpose AsIx era)) => Show (BabbageContextError era) diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs index f910b8f9f9d..794da136f43 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs @@ -318,6 +318,10 @@ deriving stock instance (Era era, Eq (Script era), Eq (CompactForm (Value era))) => Eq (BabbageTxOut era) +deriving stock instance + (Era era, Ord (Script era), Ord (CompactForm (Value era))) => + Ord (BabbageTxOut era) + -- | Already in NF instance NFData (BabbageTxOut era) where rnf = rwhnf diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Block.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Block.hs index 04eb27312ca..29403ec59ec 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Block.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Block.hs @@ -45,7 +45,7 @@ data BlockHeader = BlockHeader , _bhUpdHash :: !Hash -- ^ Update payload hash } - deriving (Eq, Generic, Show, Data) + deriving (Eq, Ord, Show, Generic, Data) -- TODO: BlockVersion – the protocol (block) version that created the block -- TODO: SoftwareVersion – the software version that created the block diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/BBody.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/BBody.hs index 8e125012592..cac30ab3a99 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/BBody.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/BBody.hs @@ -54,7 +54,7 @@ data BbodyPredicateFailure | BUPIFailure (PredicateFailure BUPI) | DelegationFailure (PredicateFailure DELEG) | UTXOWSFailure (PredicateFailure UTXOWS) - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS BBODY where type diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Bupi.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Bupi.hs index f6208eb355d..0f3ac29c08d 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Bupi.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Bupi.hs @@ -36,7 +36,7 @@ data BupiPredicateFailure = UPIREGFailure (PredicateFailure UPIREG) | UPIVOTESFailure (PredicateFailure UPIVOTES) | UPIENDFailure (PredicateFailure UPIEND) - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS BUPI where type Environment BUPI = UPIEnv diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs index f6a4d46c4dc..4a33e801ed7 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs @@ -56,7 +56,7 @@ data ChainPredicateFailure | MaximumBlockSize Natural Natural | LedgerDelegationFailure (PredicateFailure DELEG) | LedgerUTxOFailure (PredicateFailure UTXOWS) - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS CHAIN where type diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Epoch.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Epoch.hs index 137f677145a..b77ebb4d63d 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Epoch.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Epoch.hs @@ -29,7 +29,7 @@ data EPOCH deriving (Data) data EpochPredicateFailure = UPIECFailure (PredicateFailure UPIEC) - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS EPOCH where type diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Pbft.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Pbft.hs index 90768818a35..5e125c2d7fe 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Pbft.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Pbft.hs @@ -23,7 +23,7 @@ data PbftPredicateFailure | PrevHashNotMatching Hash Hash | InvalidHeaderSignature VKey (Sig Hash) | SigCountFailure (PredicateFailure SIGCNT) - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS PBFT where type diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/SigCnt.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/SigCnt.hs index 9d5e57896da..2aa868604c8 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/SigCnt.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/SigCnt.hs @@ -27,7 +27,7 @@ data SigcntPredicateFailure TooManyIssuedBlocks VKeyGenesis | -- | The key signing the block is not a delegate of a genesis key. NotADelegate - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS SIGCNT where type diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs index cd7fb40a46b..d7d4c478dd0 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs @@ -323,7 +323,7 @@ dIStateDState = data SDELEG deriving (Data) data EpochDiff = EpochDiff {currentEpoch :: Epoch, certEpoch :: Epoch} - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) -- | These `PredicateFailure`s are all "throwable". The disjunction of the -- rules' preconditions is not `True` - the `PredicateFailure`s represent @@ -335,7 +335,7 @@ data SdelegPredicateFailure | HasAlreadyDelegated | IsAlreadyScheduled | DoesNotVerify - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS SDELEG where type State SDELEG = DSState @@ -421,7 +421,7 @@ data AdelegPredicateFailure | S_NoLastDelegation | S_AfterExistingDelegation | S_AlreadyADelegateOf VKey VKeyGenesis - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) -- | Delegation rules data ADELEG deriving (Data) @@ -492,7 +492,7 @@ data SDELEGS deriving (Data) data SdelegsPredicateFailure = SDelegFailure (PredicateFailure SDELEG) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS SDELEGS where type State SDELEGS = DSState @@ -524,7 +524,7 @@ data ADELEGS deriving (Data) data AdelegsPredicateFailure = ADelegFailure (PredicateFailure ADELEG) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS ADELEGS where type State ADELEGS = DState @@ -560,7 +560,7 @@ data DELEG deriving (Data) data DelegPredicateFailure = SDelegSFailure (PredicateFailure SDELEGS) | ADelegSFailure (PredicateFailure ADELEGS) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS DELEG where type State DELEG = DIState @@ -674,7 +674,7 @@ randomDCertGen env = do data MSDELEG deriving (Data) data MsdelegPredicateFailure = SDELEGFailure (PredicateFailure SDELEG) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS MSDELEG where type Environment MSDELEG = DSEnv diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXO.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXO.hs index 8c25a44b4a2..6cf4590615f 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXO.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXO.hs @@ -66,7 +66,7 @@ data UtxoPredicateFailure | IncreasedTotalBalance | InputsNotInUTxO | NonPositiveOutputs - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UTXO where type Environment UTXO = UTxOEnv diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOW.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOW.hs index b921d78a6c5..f068c4a6d22 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOW.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOW.hs @@ -63,7 +63,7 @@ data UTXOW deriving (Data) data UtxowPredicateFailure = UtxoFailure (PredicateFailure UTXO) | InsufficientWitnesses - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UTXOW where type Environment UTXOW = UTxOEnv diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOWS.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOWS.hs index 9d983e4799e..b3fbb170318 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOWS.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/STS/UTXOWS.hs @@ -40,7 +40,7 @@ data UTXOWS deriving (Data) data UtxowsPredicateFailure = UtxowFailure (PredicateFailure UTXOW) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UTXOWS where type State UTXOWS = UTxOState diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs index ef32c9c9076..dc563bafd8c 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs @@ -392,7 +392,7 @@ data UpsvvPredicateFailure | CannotFollowSv | InvalidApplicationName | InvalidSystemTags - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPSVV where type Environment UPSVV = Map ApName (ApVer, Core.Slot, Metadata) @@ -427,7 +427,7 @@ data UppvvPredicateFailure = CannotFollowPv | CannotUpdatePv [UpdateConstraintViolation] | AlreadyProposedPv - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPPVV where type @@ -462,7 +462,7 @@ data UpvPredicateFailure | AVChangedInPVUpdate ApName ApVer (Maybe (ApVer, Slot, Metadata)) | ParamsChangedInSVUpdate | PVChangedInSVUpdate - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPV where type @@ -532,7 +532,7 @@ data UpregPredicateFailure = UPVFailure (PredicateFailure UPV) | NotGenesisDelegate | DoesNotVerify - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPREG where type @@ -603,7 +603,7 @@ data AddvotePredicateFailure | NoUpdateProposal UpId | VoteByNonGenesisDelegate VKey | RepeatVoteByGenesisDelegate VKey - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS ADDVOTE where type @@ -647,7 +647,7 @@ data UpvotePredicateFailure | S_HigherThanThdAndNotAlreadyConfirmed | S_CfmThdNotReached | S_AlreadyConfirmed - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPVOTE where type @@ -708,7 +708,7 @@ instance Embed ADDVOTE UPVOTE where data FADS deriving (Generic, Data) data FadsPredicateFailure - deriving (Eq, Show, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance STS FADS where type Environment FADS = () @@ -753,7 +753,7 @@ data UpendPredicateFailure | CannotAdopt ProtVer | NotADelegate VKey | UnconfirmedProposal UpId - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPEND where type @@ -988,7 +988,7 @@ data UPIREG deriving (Generic, Data) data UpiregPredicateFailure = UPREGFailure (PredicateFailure UPREG) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPIREG where type Environment UPIREG = UPIEnv @@ -1386,7 +1386,7 @@ data UPIVOTE deriving (Generic, Data) data UpivotePredicateFailure = UPVOTEFailure (PredicateFailure UPVOTE) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPIVOTE where type Environment UPIVOTE = UPIEnv @@ -1448,7 +1448,7 @@ data APPLYVOTES deriving (Generic, Data) data ApplyVotesPredicateFailure = UpivoteFailure (PredicateFailure UPIVOTE) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS APPLYVOTES where type Environment APPLYVOTES = UPIEnv @@ -1476,7 +1476,7 @@ data UPIVOTES deriving (Generic, Data) data UpivotesPredicateFailure = ApplyVotesFailure (PredicateFailure APPLYVOTES) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPIVOTES where type Environment UPIVOTES = UPIEnv @@ -1625,7 +1625,7 @@ data UPIEND deriving (Generic, Data) data UpiendPredicateFailure = UPENDFailure (PredicateFailure UPEND) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPIEND where type Environment UPIEND = UPIEnv @@ -1700,7 +1700,7 @@ data PVBUMP deriving (Generic, Data) -- PVBUMP has no predicate failures data PvbumpPredicateFailure = NoPVBUMPFailure - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS PVBUMP where type @@ -1734,7 +1734,7 @@ data UPIEC deriving (Generic, Data) data UpiecPredicateFailure = PVBUMPFailure (PredicateFailure PVBUMP) - deriving (Eq, Show, Data, Generic, NoThunks) + deriving (Eq, Ord, Show, Data, Generic, NoThunks) instance STS UPIEC where type diff --git a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Delegation/Properties.hs b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Delegation/Properties.hs index 3d4aaa70287..7e038686f87 100644 --- a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Delegation/Properties.hs +++ b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Delegation/Properties.hs @@ -146,7 +146,7 @@ makeLenses ''DBlock data DBlockPredicateFailure = DPF (PredicateFailure DELEG) | NotIncreasingBlockSlot - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) -- | This corresponds to a state-transition rule where blocks with increasing -- slot-numbers are produced. diff --git a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Update/Properties.hs b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Update/Properties.hs index ed9423202f6..904a129cf6d 100644 --- a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Update/Properties.hs +++ b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Update/Properties.hs @@ -345,7 +345,7 @@ data UBlockPredicateFailure | UPIVOTESFailure (PredicateFailure UPIVOTES) | UPIENDFailure (PredicateFailure UPIEND) | NotIncreasingBlockSlot - deriving (Eq, Show, Data) + deriving (Eq, Ord, Show, Data) instance STS UBLOCK where type Environment UBLOCK = UPIEnv diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs index f535898f607..fb57dc32c50 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs @@ -400,7 +400,7 @@ instance EncCBOR Vote where newtype VotingProcedures era = VotingProcedures { unVotingProcedures :: Map Voter (Map GovActionId (VotingProcedure era)) } - deriving stock (Generic, Eq, Show) + deriving stock (Generic, Eq, Ord, Show) deriving newtype (NoThunks, EncCBOR, ToJSON) deriving newtype instance Era era => NFData (VotingProcedures era) @@ -447,7 +447,7 @@ data VotingProcedure era = VotingProcedure { vProcVote :: !Vote , vProcAnchor :: !(StrictMaybe Anchor) } - deriving (Generic, Eq, Show) + deriving (Generic, Eq, Ord, Show) instance NoThunks (VotingProcedure era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs index 56b8391b677..a1b210c6a7c 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs @@ -112,6 +112,10 @@ deriving instance (Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) => Eq (ConwayBbodyPredFailure era) +deriving instance + (Era era, Ord (PredicateFailure (EraRule "LEDGERS" era))) => + Ord (ConwayBbodyPredFailure era) + deriving anyclass instance (Era era, NFData (PredicateFailure (EraRule "LEDGERS" era))) => NFData (ConwayBbodyPredFailure era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs index 0a568850460..e70219d3c1e 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs @@ -134,6 +134,13 @@ deriving stock instance ) => Eq (ConwayCertPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "DELEG" era)) + , Ord (PredicateFailure (EraRule "POOL" era)) + , Ord (PredicateFailure (EraRule "GOVCERT" era)) + ) => + Ord (ConwayCertPredFailure era) + instance ( NFData (PredicateFailure (EraRule "DELEG" era)) , NFData (PredicateFailure (EraRule "POOL" era)) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs index 7992d4e59de..8388c3e6e6d 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs @@ -140,6 +140,10 @@ deriving stock instance Eq (PredicateFailure (EraRule "CERT" era)) => Eq (ConwayCertsPredFailure era) +deriving stock instance + Ord (PredicateFailure (EraRule "CERT" era)) => + Ord (ConwayCertsPredFailure era) + deriving stock instance Show (PredicateFailure (EraRule "CERT" era)) => Show (ConwayCertsPredFailure era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 0a0bde00aa8..4845730be8c 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -111,7 +111,7 @@ data ConwayDelegPredFailure era | DelegateeStakePoolNotRegisteredDELEG (KeyHash StakePool) | DepositIncorrectDELEG (Mismatch RelEQ Coin) | RefundIncorrectDELEG (Mismatch RelEQ Coin) - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) type instance EraRuleFailure "DELEG" ConwayEra = ConwayDelegPredFailure ConwayEra diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs index 057f5f19cc3..dd3de540adc 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs @@ -215,7 +215,7 @@ data ConwayGovPredFailure era TreasuryWithdrawalReturnAccountsDoNotExist (NonEmpty AccountAddress) | -- | Disallow votes by unelected committee members UnelectedCommitteeVoters (NonEmpty (Credential HotCommitteeRole)) - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) {-# DEPRECATED InvalidPolicyHash "In favor of `InvalidGuardrailsScriptHash`" #-} pattern InvalidPolicyHash :: diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs index 9e56f906095..c583cc9124b 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs @@ -115,7 +115,7 @@ data ConwayGovCertPredFailure era -- attempted. Current Constitutional Committee and all available proposals will be -- searched before reporting this predicate failure. ConwayCommitteeIsUnknown (Credential ColdCommitteeRole) - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) type instance EraRuleFailure "GOVCERT" ConwayEra = ConwayGovCertPredFailure ConwayEra diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs index 757df277a6b..d5342b4f073 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs @@ -202,6 +202,14 @@ deriving instance ) => Eq (ConwayLedgerPredFailure era) +deriving instance + ( Era era + , Ord (PredicateFailure (EraRule "UTXOW" era)) + , Ord (PredicateFailure (EraRule "CERTS" era)) + , Ord (PredicateFailure (EraRule "GOV" era)) + ) => + Ord (ConwayLedgerPredFailure era) + deriving instance ( Era era , Show (PredicateFailure (EraRule "UTXOW" era)) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs index 9ba6412a567..53597f30d98 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs @@ -68,9 +68,9 @@ instance , EraCertState era , Embed (EraRule "LEDGER" era) (ConwayMEMPOOL era) , State (EraRule "LEDGER" era) ~ LedgerState era - , Eq (PredicateFailure (EraRule "CERTS" era)) - , Eq (PredicateFailure (EraRule "GOV" era)) - , Eq (PredicateFailure (EraRule "UTXOW" era)) + , Ord (PredicateFailure (EraRule "CERTS" era)) + , Ord (PredicateFailure (EraRule "GOV" era)) + , Ord (PredicateFailure (EraRule "UTXOW" era)) , Show (PredicateFailure (EraRule "CERTS" era)) , Show (PredicateFailure (EraRule "GOV" era)) , Show (PredicateFailure (EraRule "UTXOW" era)) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs index 00956430927..43f1ba33631 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs @@ -189,6 +189,16 @@ deriving instance ) => Eq (ConwayUtxoPredFailure era) +deriving instance + ( Era era + , Ord (Value era) + , Ord (PredicateFailure (EraRule "UTXOS" era)) + , Ord (TxOut era) + , Ord (Script era) + , Ord TxIn + ) => + Ord (ConwayUtxoPredFailure era) + instance ( Era era , NFData (Value era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs index 288b356e4e0..d3cfd4f5b17 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs @@ -163,6 +163,13 @@ deriving stock instance ) => Eq (ConwayUtxosPredFailure era) +deriving stock instance + ( ConwayEraScript era + , Ord (TxCert era) + , Ord (ContextError era) + ) => + Ord (ConwayUtxosPredFailure era) + instance ( ConwayEraScript era , NFData (TxCert era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs index f596587ce23..e36856a385b 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs @@ -154,6 +154,12 @@ deriving instance ) => Eq (ConwayUtxowPredFailure era) +deriving instance + ( ConwayEraScript era + , Ord (PredicateFailure (EraRule "UTXO" era)) + ) => + Ord (ConwayUtxowPredFailure era) + instance ( ConwayEraScript era , NFData (TxCert era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs index 07142d47853..d61dec89bc6 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs @@ -218,6 +218,8 @@ instance NoThunks (ConwayPlutusPurpose AsIx era) deriving instance (Eq (TxCert era), EraPParams era) => Eq (ConwayPlutusPurpose AsItem era) +deriving instance (Ord (TxCert era), EraPParams era) => Ord (ConwayPlutusPurpose AsItem era) + deriving instance (Show (TxCert era), EraPParams era) => Show (ConwayPlutusPurpose AsItem era) instance (NoThunks (TxCert era), EraPParams era) => NoThunks (ConwayPlutusPurpose AsItem era) @@ -245,6 +247,8 @@ deriving via deriving instance (Eq (TxCert era), EraPParams era) => Eq (ConwayPlutusPurpose AsIxItem era) +deriving instance (Ord (TxCert era), EraPParams era) => Ord (ConwayPlutusPurpose AsIxItem era) + deriving instance (Show (TxCert era), EraPParams era) => Show (ConwayPlutusPurpose AsIxItem era) instance (NoThunks (TxCert era), EraPParams era) => NoThunks (ConwayPlutusPurpose AsIxItem era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs index a40d58640d2..6f1cbc2a69c 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs @@ -192,6 +192,15 @@ deriving instance ) => Eq (ConwayContextError era) +deriving instance + ( Ord (BabbageContextError era) + , Ord (TxCert era) + , Ord (PlutusPurpose AsItem era) + , Ord (PlutusPurpose AsIx era) + , EraPParams era + ) => + Ord (ConwayContextError era) + deriving instance ( Show (BabbageContextError era) , Show (TxCert era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs index 945172694b0..9d4ce3f71ba 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs @@ -247,7 +247,7 @@ alignedValidFlags n invalidSet = -- -- NOTE: The real type will be brought from 'cardano-base' once it's ready. newtype PerasCert = PerasCert ByteArray - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving newtype (EncCBOR, DecCBOR) instance NoThunks PerasCert diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs index 34d7107a003..3da7b591129 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs @@ -93,6 +93,10 @@ deriving instance (Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) => Eq (DijkstraBbodyPredFailure era) +deriving instance + (Era era, Ord (PredicateFailure (EraRule "LEDGERS" era))) => + Ord (DijkstraBbodyPredFailure era) + instance ( Era era , EncCBOR (PredicateFailure (EraRule "LEDGERS" era)) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs index 8d7a279e511..8a34a7d2e4f 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs @@ -111,7 +111,7 @@ data DijkstraGovPredFailure era TreasuryWithdrawalReturnAccountsDoNotExist (NonEmpty AccountAddress) | -- | Disallow votes by unelected committee members UnelectedCommitteeVoters (NonEmpty (Credential HotCommitteeRole)) - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) {-# DEPRECATED InvalidPolicyHash "In favor of `InvalidGuardrailsScriptHash`" #-} pattern InvalidPolicyHash :: diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs index 0dfe43c4b25..3eb1b82e65b 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs @@ -60,7 +60,7 @@ data DijkstraGovCertPredFailure era -- attempted. Current Constitutional Committee and all available proposals will be -- searched before reporting this predicate failure. DijkstraCommitteeIsUnknown (Credential ColdCommitteeRole) - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) type instance EraRuleFailure "GOVCERT" DijkstraEra = DijkstraGovCertPredFailure DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs index d0f6fc2c74e..02ff2889264 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs @@ -185,6 +185,15 @@ deriving instance ) => Eq (DijkstraLedgerPredFailure era) +deriving instance + ( Era era + , Ord (PredicateFailure (EraRule "UTXOW" era)) + , Ord (PredicateFailure (EraRule "CERTS" era)) + , Ord (PredicateFailure (EraRule "GOV" era)) + , Ord (PredicateFailure (EraRule "SUBLEDGERS" era)) + ) => + Ord (DijkstraLedgerPredFailure era) + deriving instance ( Era era , Show (PredicateFailure (EraRule "UTXOW" era)) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs index 32628206b32..14aaf19bd70 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs @@ -96,6 +96,10 @@ deriving instance Eq (PredicateFailure (EraRule "LEDGER" era)) => Eq (DijkstraMempoolPredFailure era) +deriving instance + Ord (PredicateFailure (EraRule "LEDGER" era)) => + Ord (DijkstraMempoolPredFailure era) + deriving instance Show (PredicateFailure (EraRule "LEDGER" era)) => Show (DijkstraMempoolPredFailure era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs index bcefe09fcb7..2dda6d06f56 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs @@ -65,6 +65,13 @@ deriving stock instance ) => Eq (DijkstraSubCertPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "SUBDELEG" era)) + , Ord (PredicateFailure (EraRule "SUBPOOL" era)) + , Ord (PredicateFailure (EraRule "SUBGOVCERT" era)) + ) => + Ord (DijkstraSubCertPredFailure era) + deriving stock instance ( Show (PredicateFailure (EraRule "SUBDELEG" era)) , Show (PredicateFailure (EraRule "SUBPOOL" era)) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs index 407b080c71f..7092c9487c5 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs @@ -53,6 +53,9 @@ newtype DijkstraSubCertsPredFailure era = SubCertFailure (PredicateFailure (EraR deriving stock instance Eq (PredicateFailure (EraRule "SUBCERT" era)) => Eq (DijkstraSubCertsPredFailure era) +deriving stock instance + Ord (PredicateFailure (EraRule "SUBCERT" era)) => Ord (DijkstraSubCertsPredFailure era) + deriving stock instance Show (PredicateFailure (EraRule "SUBCERT" era)) => Show (DijkstraSubCertsPredFailure era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs index f6d6e8a634e..0c8f437c791 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs @@ -47,7 +47,7 @@ import Data.Void (Void) import GHC.Generics (Generic) newtype DijkstraSubDelegPredFailure era = DijkstraSubDelegPredFailure (Conway.ConwayDelegPredFailure era) - deriving (Generic, Eq, Show, NFData, EncCBOR, DecCBOR) + deriving (Generic, Eq, Ord, Show, NFData, EncCBOR, DecCBOR) type instance EraRuleFailure "SUBDELEG" DijkstraEra = DijkstraSubDelegPredFailure DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs index 0d452980f58..476128d5cbc 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs @@ -41,7 +41,7 @@ import Control.State.Transition.Extended import GHC.Generics (Generic) newtype DijkstraSubGovPredFailure era = DijkstraSubGovPredFailure (DijkstraGovPredFailure era) - deriving (Generic, Eq, Show, NFData, EncCBOR, DecCBOR) + deriving (Generic, Eq, Ord, Show, NFData, EncCBOR, DecCBOR) type instance EraRuleFailure "SUBGOV" DijkstraEra = DijkstraSubGovPredFailure DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs index 10f680627a0..1ae227eb283 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs @@ -52,7 +52,7 @@ import GHC.Generics (Generic) newtype DijkstraSubGovCertPredFailure era = DijkstraSubGovCertPredFailure (DijkstraGovCertPredFailure era) - deriving (Show, Eq, Generic, NFData, EncCBOR, DecCBOR) + deriving (Show, Eq, Ord, Generic, NFData, EncCBOR, DecCBOR) type instance EraRuleFailure "SUBGOVCERT" DijkstraEra = DijkstraSubGovCertPredFailure DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs index a6158b72fef..87fc93a1fc3 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs @@ -113,6 +113,13 @@ deriving stock instance ) => Eq (DijkstraSubLedgerPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "SUBGOV" era)) + , Ord (PredicateFailure (EraRule "SUBCERTS" era)) + , Ord (PredicateFailure (EraRule "SUBUTXOW" era)) + ) => + Ord (DijkstraSubLedgerPredFailure era) + deriving stock instance ( Show (PredicateFailure (EraRule "SUBGOV" era)) , Show (PredicateFailure (EraRule "SUBCERTS" era)) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs index 3b2d59db38d..be561818e27 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs @@ -55,6 +55,9 @@ newtype DijkstraSubLedgersPredFailure era deriving stock instance Eq (PredicateFailure (EraRule "SUBLEDGER" era)) => Eq (DijkstraSubLedgersPredFailure era) +deriving stock instance + Ord (PredicateFailure (EraRule "SUBLEDGER" era)) => Ord (DijkstraSubLedgersPredFailure era) + deriving stock instance Show (PredicateFailure (EraRule "SUBLEDGER" era)) => Show (DijkstraSubLedgersPredFailure era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs index bb6b8855042..4163e41962c 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs @@ -48,7 +48,7 @@ import Control.State.Transition.Extended ( import GHC.Generics (Generic) newtype DijkstraSubPoolPredFailure era = DijkstraSubPoolPredFailure (Shelley.ShelleyPoolPredFailure era) - deriving (Eq, Show, Generic, DecCBOR, EncCBOR, NFData) + deriving (Eq, Ord, Show, Generic, DecCBOR, EncCBOR, NFData) type instance EraRuleFailure "SUBPOOL" DijkstraEra = DijkstraSubPoolPredFailure DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs index ec63c09721c..43d8f5a64fe 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs @@ -118,6 +118,15 @@ deriving stock instance ) => Eq (DijkstraSubUtxoPredFailure era) +deriving stock instance + ( Era era + , Ord (Value era) + , Ord (TxOut era) + , Ord (Script era) + , Ord TxIn + ) => + Ord (DijkstraSubUtxoPredFailure era) + deriving stock instance ( Era era , Show (Value era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs index 57ced4ebc84..6659bb9d12c 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs @@ -116,6 +116,12 @@ deriving stock instance ) => Eq (DijkstraSubUtxowPredFailure era) +deriving stock instance + ( ConwayEraScript era + , Ord (PredicateFailure (EraRule "SUBUTXO" era)) + ) => + Ord (DijkstraSubUtxowPredFailure era) + deriving stock instance ( ConwayEraScript era , Show (PredicateFailure (EraRule "SUBUTXO" era)) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs index ff2517d8113..6a601fbce4f 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs @@ -225,6 +225,16 @@ deriving instance ) => Eq (DijkstraUtxoPredFailure era) +deriving instance + ( Era era + , Ord (Value era) + , Ord (PredicateFailure (EraRule "UTXOS" era)) + , Ord (TxOut era) + , Ord (Script era) + , Ord TxIn + ) => + Ord (DijkstraUtxoPredFailure era) + instance ( Era era , NFData (Value era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs index af18b16be06..e9b2e94932c 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs @@ -187,6 +187,12 @@ deriving instance ) => Eq (DijkstraUtxowPredFailure era) +deriving instance + ( ConwayEraScript era + , Ord (PredicateFailure (EraRule "UTXO" era)) + ) => + Ord (DijkstraUtxowPredFailure era) + instance ( ConwayEraScript era , NFData (TxCert era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs index bebf7c6a035..538087cd35e 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs @@ -231,7 +231,7 @@ data DijkstraNativeScriptRaw era | DijkstraTimeStart !SlotNo | DijkstraTimeExpire !SlotNo | DijkstraRequireGuard (Credential Guard) - deriving (Eq, Generic, NFData) + deriving (Eq, Ord, Generic, NFData) deriving instance Show (DijkstraNativeScriptRaw era) @@ -262,7 +262,7 @@ instance Era era => DecCBOR (Annotator (DijkstraNativeScriptRaw era)) where decRaw n = Invalid n newtype DijkstraNativeScript era = MkDijkstraNativeScript (MemoBytes (DijkstraNativeScriptRaw era)) - deriving (Eq, Generic) + deriving (Eq, Ord, Generic) deriving newtype (ToCBOR, NFData, SafeToHash) deriving instance Show (DijkstraNativeScript era) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs index 685dd615b12..79cd96a494f 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs @@ -118,6 +118,14 @@ deriving instance ) => Eq (DijkstraContextError era) +deriving instance + ( AlonzoEraScript era + , EraTxCert era + , EraTxOut era + , Ord (ContextError era) + ) => + Ord (DijkstraContextError era) + deriving instance ( AlonzoEraScript era , EraTxCert era diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Imp.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Imp.hs index 7fd151f9032..aeb7a5749f3 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Imp.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Imp.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs index 86519416434..3582875df15 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs @@ -92,6 +92,7 @@ import Data.Maybe (fromJust) import Data.MemPack import Data.MemPack.Buffer (byteArrayFromShortByteString, byteArrayToShortByteString) import qualified Data.Monoid as M (Sum (Sum, getSum)) +import Data.Ord (comparing) import qualified Data.Primitive.ByteArray as BA import Data.Proxy (Proxy (..)) import qualified Data.Semigroup as Semigroup (Sum (..)) @@ -185,6 +186,10 @@ data MaryValue = MaryValue !Coin !MultiAsset instance Eq MaryValue where x == y = pointwise (==) x y +instance Ord MaryValue where + -- This is slightly inefficient, but pointwise requires (Integer -> Integer -> Bool) + x <= y = pointwise (<=) x y + instance NFData MaryValue where rnf (MaryValue c m) = c `deepseq` rnf m @@ -401,7 +406,7 @@ instance ToJSONKey AssetName where instance Compactible MaryValue where newtype CompactForm MaryValue = CompactValue CompactValue - deriving (Eq, Show, NoThunks, EncCBOR, DecCBOR, NFData, MemPack) + deriving (Eq, Ord, Show, NoThunks, EncCBOR, DecCBOR, NFData, MemPack) toCompact x = CompactValue <$> to x fromCompact (CompactValue x) = from x @@ -467,6 +472,9 @@ instance NFData CompactValue where instance Eq CompactValue where a == b = from a == from b +instance Ord CompactValue where + compare = comparing from + deriving via OnlyCheckWhnfNamed "CompactValue" CompactValue instance diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs index 3b6a926ac5b..2b055c86576 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Governance.hs @@ -93,6 +93,12 @@ deriving instance ) => Eq (ShelleyGovState era) +deriving instance + ( Ord (PParamsUpdate era) + , Ord (PParams era) + ) => + Ord (ShelleyGovState era) + instance ( NFData (PParamsUpdate era) , NFData (PParams era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs index 2e7e79b2756..5ef6cf0c913 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs @@ -273,6 +273,8 @@ newtype ProposedPPUpdates era deriving instance Eq (PParamsUpdate era) => Eq (ProposedPPUpdates era) +deriving instance Ord (PParamsUpdate era) => Ord (ProposedPPUpdates era) + deriving instance NFData (PParamsUpdate era) => NFData (ProposedPPUpdates era) deriving instance Show (PParamsUpdate era) => Show (ProposedPPUpdates era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs index 3fc484373a9..1f26819f89c 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs @@ -180,6 +180,12 @@ deriving stock instance ) => Eq (ShelleyBbodyPredFailure era) +deriving stock instance + ( Era era + , Ord (PredicateFailure (EraRule "LEDGERS" era)) + ) => + Ord (ShelleyBbodyPredFailure era) + instance ( EraBlockBody era , EraRule "BBODY" era ~ ShelleyBBODY era diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs index 4f77276b6e7..819590f58a3 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -120,7 +120,7 @@ data ShelleyDelegPredFailure era | -- | Target pool which is not registered DelegateeNotRegisteredDELEG (KeyHash StakePool) - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) type instance EraRuleFailure "DELEG" ShelleyEra = ShelleyDelegPredFailure ShelleyEra diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs index 0c573f03329..86d7d20ad57 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs @@ -113,6 +113,10 @@ deriving stock instance Eq (PredicateFailure (EraRule "DELPL" era)) => Eq (ShelleyDelegsPredFailure era) +deriving stock instance + Ord (PredicateFailure (EraRule "DELPL" era)) => + Ord (ShelleyDelegsPredFailure era) + instance NFData (PredicateFailure (EraRule "DELPL" era)) => NFData (ShelleyDelegsPredFailure era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs index d255a15bdf3..f24233ce519 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs @@ -96,6 +96,12 @@ deriving stock instance ) => Eq (ShelleyDelplPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "DELEG" era)) + , Ord (PredicateFailure (EraRule "POOL" era)) + ) => + Ord (ShelleyDelplPredFailure era) + deriving stock instance ( Show (PredicateFailure (EraRule "DELEG" era)) , Show (PredicateFailure (EraRule "POOL" era)) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs index 0b0bd31f2f0..d83eb993c86 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs @@ -203,6 +203,13 @@ deriving stock instance ) => Eq (ShelleyLedgerPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "DELEGS" era)) + , Ord (PredicateFailure (EraRule "UTXOW" era)) + , Era era + ) => + Ord (ShelleyLedgerPredFailure era) + instance ( NFData (PredicateFailure (EraRule "DELEGS" era)) , NFData (PredicateFailure (EraRule "UTXOW" era)) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs index 42a8fb5f694..be5ac8b7370 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs @@ -145,6 +145,12 @@ deriving stock instance ) => Eq (ShelleyLedgersPredFailure era) +deriving stock instance + ( Era era + , Ord (PredicateFailure (EraRule "LEDGER" era)) + ) => + Ord (ShelleyLedgersPredFailure era) + instance ( Era era , EncCBOR (PredicateFailure (EraRule "LEDGER" era)) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs index 8b6aeeb5954..5369f06c252 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs @@ -112,7 +112,7 @@ data ShelleyPoolPredFailure era (KeyHash StakePool) -- | VRF key attempted to use, that has already been registered (VRFVerKeyHash StakePoolVRF) - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) type instance EraRuleFailure "POOL" ShelleyEra = ShelleyPoolPredFailure ShelleyEra diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs index c7c5b3f680b..a5cbabb9c5a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs @@ -66,7 +66,7 @@ import NoThunks.Class (NoThunks (..)) data PpupEnv era = PPUPEnv SlotNo (PParams era) GenDelegs data VotingPeriod = VoteForThisEpoch | VoteForNextEpoch - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) instance NoThunks VotingPeriod @@ -105,7 +105,7 @@ data ShelleyPpupPredFailure era -- version by exactly one. PVCannotFollowPPUP ProtVer - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) type instance EraRuleFailure "PPUP" ShelleyEra = ShelleyPpupPredFailure ShelleyEra diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs index a6a8931db0b..ac5e9052046 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs @@ -209,6 +209,13 @@ deriving stock instance ) => Eq (ShelleyUtxoPredFailure era) +deriving stock instance + ( Ord (Value era) + , Ord (TxOut era) + , Ord (EraRuleFailure "PPUP" era) + ) => + Ord (ShelleyUtxoPredFailure era) + instance ( Era era , NFData (Value era) @@ -271,7 +278,7 @@ instance , Environment (EraRule "PPUP" era) ~ PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , State (EraRule "PPUP" era) ~ ShelleyGovState era - , Eq (EraRuleFailure "PPUP" era) + , Ord (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , EraRule "UTXO" era ~ ShelleyUTXO era , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs index bf155dbcab0..e641137dad0 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs @@ -162,6 +162,12 @@ deriving stock instance ) => Eq (ShelleyUtxowPredFailure era) +deriving stock instance + ( Ord (PredicateFailure (EraRule "UTXO" era)) + , Era era + ) => + Ord (ShelleyUtxowPredFailure era) + deriving stock instance ( Show (PredicateFailure (EraRule "UTXO" era)) , Era era diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs index 00c1916e483..0cb1cef36a2 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs @@ -90,7 +90,7 @@ data MultiSigRaw era MultiSigAnyOf !(StrictSeq (MultiSig era)) | -- | Require M of the given sub-terms to be satisfied. MultiSigMOf !Int !(StrictSeq (MultiSig era)) - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving anyclass (NoThunks) class EraScript era => ShelleyEraScript era where @@ -109,7 +109,7 @@ class EraScript era => ShelleyEraScript era where instance NFData (MultiSigRaw era) newtype MultiSig era = MkMultiSig (MemoBytes (MultiSigRaw era)) - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving newtype (ToCBOR, NoThunks, SafeToHash) instance Memoized (MultiSig era) where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs index b0932c85999..65d145d07ff 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs @@ -123,6 +123,8 @@ instance (Era era, Val (Value era)) => Show (ShelleyTxOut era) where deriving instance Eq (CompactForm (Value era)) => Eq (ShelleyTxOut era) +deriving instance Ord (CompactForm (Value era)) => Ord (ShelleyTxOut era) + instance NFData (ShelleyTxOut era) where rnf = (`seq` ()) diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 24828439e3c..e5e925ac5a0 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -467,7 +467,7 @@ class , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , State (EraRule "LEDGER" era) ~ LedgerState era , Environment (EraRule "LEDGER" era) ~ LedgerEnv era - , Eq (PredicateFailure (EraRule "LEDGER" era)) + , Ord (PredicateFailure (EraRule "LEDGER" era)) , Show (PredicateFailure (EraRule "LEDGER" era)) , ToExpr (PredicateFailure (EraRule "LEDGER" era)) , NFData (PredicateFailure (EraRule "LEDGER" era)) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs index d4f0b002caa..5e63e281080 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs @@ -84,6 +84,10 @@ deriving stock instance Eq (PredicateFailure (Core.EraRule "DELPL" era)) => Eq (CertsPredicateFailure era) +deriving stock instance + Ord (PredicateFailure (Core.EraRule "DELPL" era)) => + Ord (CertsPredicateFailure era) + deriving stock instance Show (PredicateFailure (Core.EraRule "DELPL" era)) => Show (CertsPredicateFailure era) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs index 14829a4e742..8645e4cbee5 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs @@ -166,6 +166,14 @@ deriving stock instance ) => Eq (TestChainPredicateFailure era) +deriving stock instance + ( Era era + , Ord (PredicateFailure (EraRule "BBODY" era)) + , Ord (PredicateFailure (EraRule "TICK" era)) + , Ord (PredicateFailure (EraRule "TICKN" era)) + ) => + Ord (TestChainPredicateFailure era) + -- | Creates a valid initial chain state initialShelleyState :: forall era. diff --git a/libs/cardano-data/src/Data/Map/NonEmpty.hs b/libs/cardano-data/src/Data/Map/NonEmpty.hs index 87fae42fb10..e194189ccef 100644 --- a/libs/cardano-data/src/Data/Map/NonEmpty.hs +++ b/libs/cardano-data/src/Data/Map/NonEmpty.hs @@ -21,7 +21,7 @@ import NoThunks.Class (NoThunks) import Prelude hiding (map) newtype NonEmptyMap k v = NonEmptyMap (Map k v) - deriving stock (Show, Eq) + deriving stock (Show, Eq, Ord) deriving newtype (EncCBOR, NoThunks, NFData, ToJSON) instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (NonEmptyMap k v) where diff --git a/libs/cardano-data/src/Data/Set/NonEmpty.hs b/libs/cardano-data/src/Data/Set/NonEmpty.hs index 9eea52d8a72..3e7e3834cf5 100644 --- a/libs/cardano-data/src/Data/Set/NonEmpty.hs +++ b/libs/cardano-data/src/Data/Set/NonEmpty.hs @@ -21,7 +21,7 @@ import Data.Typeable (Typeable) import NoThunks.Class (NoThunks) newtype NonEmptySet a = NonEmptySet (Set a) - deriving stock (Show, Eq) + deriving stock (Show, Eq, Ord) deriving newtype (EncCBOR, NoThunks, NFData, ToJSON) instance (Ord a, FromJSON a) => FromJSON (NonEmptySet a) where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Address.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Address.hs index ea40ed76122..158ec3e3991 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Address.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Address.hs @@ -978,7 +978,7 @@ fromBoostrapCompactAddress = UnsafeCompactAddr . Byron.unsafeGetCompactAddress -- | This is called @wdrl@ in the spec. newtype Withdrawals = Withdrawals {unWithdrawals :: Map AccountAddress Coin} - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) deriving newtype (NoThunks, NFData, EncCBOR, DecCBOR) instance Semigroup Withdrawals where @@ -989,7 +989,7 @@ instance Monoid Withdrawals where -- | Direct deposits to account addresses. newtype DirectDeposits = DirectDeposits {unDirectDeposits :: Map AccountAddress Coin} - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) deriving newtype (NoThunks, NFData, EncCBOR, DecCBOR) instance Semigroup DirectDeposits where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs index 0e25066ee21..fd319150559 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs @@ -167,7 +167,7 @@ instance MemPack (CompactForm Coin) where instance Compactible DeltaCoin where newtype CompactForm DeltaCoin = CompactDeltaCoin Word64 - deriving (Eq, Show, NoThunks, NFData, ToJSON, Prim) + deriving (Eq, Ord, Show, NoThunks, NFData, ToJSON, Prim) toCompact (DeltaCoin dc) = CompactDeltaCoin <$> integerToWord64 dc fromCompact (CompactDeltaCoin cdc) = DeltaCoin (unCoin (word64ToCoin cdc)) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Compactible.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Compactible.hs index db1a9d414ad..1b0f93fd630 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Compactible.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Compactible.hs @@ -27,6 +27,7 @@ import NoThunks.Class (NoThunks) class ( Show (CompactForm a) , Eq (CompactForm a) + , Ord (CompactForm a) , EncCBOR (CompactForm a) , NoThunks (CompactForm a) ) => diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs index 964cf6a51ec..eafa24e3eb4 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs @@ -304,6 +304,7 @@ class , NFData (TxOut era) , Show (TxOut era) , Eq (TxOut era) + , Ord (TxOut era) , MemPack (TxOut era) , EraPParams era ) => @@ -550,6 +551,7 @@ class ( Era era , Show (Script era) , Eq (Script era) + , Ord (Script era) , EqRaw (Script era) , ToCBOR (Script era) , EncCBOR (Script era) @@ -557,6 +559,7 @@ class , NoThunks (Script era) , SafeToHash (Script era) , Eq (NativeScript era) + , Ord (NativeScript era) , Show (NativeScript era) , NFData (NativeScript era) , NoThunks (NativeScript era) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Internal.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Internal.hs index a6402d2a481..63b5bfc7da3 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Internal.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Internal.hs @@ -46,6 +46,7 @@ import Cardano.Ledger.Orphans () import Control.DeepSeq (NFData) import Data.Coerce (Coercible, coerce) import Data.Kind (Type) +import Data.Ord (comparing) import Data.Typeable (Typeable) import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..)) @@ -115,6 +116,10 @@ type DSignable = DSIGN.Signable DSIGN newtype VKey (kd :: KeyRole) = VKey {unVKey :: DSIGN.VerKeyDSIGN DSIGN} deriving (Generic, Eq, NFData, NoThunks, DecCBOR, EncCBOR) +instance Ord (VKey kd) where + -- VerKeyDSIGN specifically disallows direct Ord + compare = comparing (DSIGN.rawSerialiseVerKeyDSIGN . unVKey) + deriving via Quiet (VKey kd) instance Show (VKey kd) instance HasKeyRole VKey diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes/Internal.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes/Internal.hs index d0d7bbcf7da..b825421ed37 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes/Internal.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes/Internal.hs @@ -93,6 +93,7 @@ import qualified Data.ByteString.Short as SBS (length) import Data.Coerce import Data.MemPack import Data.MemPack.Buffer (Buffer) +import Data.Ord (comparing) import qualified Data.Text as T import Data.Typeable import GHC.Base (Type) @@ -182,6 +183,10 @@ instance instance Eq t => Eq (MemoBytes t) where x == y = mbBytes x == mbBytes y && mbRawType x == mbRawType y +-- | Both binary representation and Haskell types are compared. +instance Ord t => Ord (MemoBytes t) where + compare = comparing mbBytes <> comparing mbRawType + instance Show t => Show (MemoBytes t) where show (MemoBytes y _ h) = show y diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs index 37fa6befcbb..27b5c0f913e 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs @@ -80,7 +80,7 @@ data ExUnits' a = ExUnits' { exUnitsMem' :: !a , exUnitsSteps' :: !a } - deriving (Eq, Generic, Show, Functor) + deriving (Eq, Ord, Generic, Show, Functor) -- It is deliberate that there is no Ord instance, use `pointWiseExUnits` instead. deriving (Measure, BoundedMeasure) @@ -100,7 +100,7 @@ deriving instance FromJSON a => FromJSON (ExUnits' a) -- | This newtype wrapper of ExUnits' is used to hide -- an implementation detail inside the ExUnits pattern. newtype ExUnits = WrapExUnits {unWrapExUnits :: ExUnits' Natural} - deriving (Eq, Generic, Show) + deriving (Eq, Ord, Generic, Show) deriving newtype (Monoid, Semigroup) instance NoThunks ExUnits diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/TxInfo.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/TxInfo.hs index 1d8beae7928..9dda5bbf706 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/TxInfo.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/TxInfo.hs @@ -90,7 +90,7 @@ import qualified PlutusLedgerApi.V3 as PV3 data TxOutSource = TxOutFromInput !TxIn | TxOutFromOutput !TxIx - deriving (Eq, Show, Generic, NoThunks) + deriving (Eq, Ord, Show, Generic, NoThunks) instance NFData TxOutSource where rnf = rwhnf diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs index af8c2a681ca..7b85f897b80 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs @@ -141,6 +141,8 @@ solidifyFuturePParams = \case deriving stock instance Eq (PParams era) => Eq (FuturePParams era) +deriving stock instance Ord (PParams era) => Ord (FuturePParams era) + deriving stock instance Show (PParams era) => Show (FuturePParams era) deriving via AllowThunk (FuturePParams era) instance NoThunks (FuturePParams era) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Stake.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Stake.hs index e1403c02872..030329afa83 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Stake.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Stake.hs @@ -168,7 +168,7 @@ sumCredentialsCompactActiveStake (ActiveStake m) = class ( EraAccounts era - , Eq (InstantStake era) + , Ord (InstantStake era) , Show (InstantStake era) , Monoid (InstantStake era) , Default (InstantStake era) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs index f85f05f03b9..81cda28b93c 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Val.hs @@ -39,7 +39,7 @@ class , ToJSON t , NFData t , Show t - , Eq t + , Ord t ) => Val t where diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs index 31ed703a098..edd7b5575fe 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs @@ -125,7 +125,7 @@ instance , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , Environment (EraRule "LEDGER" era) ~ Shelley.LedgerEnv era , State (EraRule "LEDGER" era) ~ LedgerState era - , Eq (PredicateFailure (EraRule "LEDGER" era)) + , Ord (PredicateFailure (EraRule "LEDGER" era)) , Show (PredicateFailure (EraRule "LEDGER" era)) ) => STS (MOCKCHAIN era) @@ -202,6 +202,8 @@ deriving instance Show (Shelley.ShelleyLedgersPredFailure era) => Show (MockChai deriving instance Eq (Shelley.ShelleyLedgersPredFailure era) => Eq (MockChainFailure era) +deriving instance Ord (Shelley.ShelleyLedgersPredFailure era) => Ord (MockChainFailure era) + ppMockChainState :: (Reflect era, ShelleyEraTest era) => MockChainState era -> diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs index e020b122f40..9485a6e4bd7 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs @@ -283,7 +283,7 @@ adaIsPreservedInEachEpoch :: , ToExpr (PredicateFailure (EraRule "NEWEPOCH" era)) , ToExpr (PredicateFailure (EraRule "RUPD" era)) , ToExpr (PredicateFailure (EraRule "LEDGER" era)) - , Eq (PredicateFailure (EraRule "LEDGER" era)) + , Ord (PredicateFailure (EraRule "LEDGER" era)) , Show (PredicateFailure (EraRule "LEDGER" era)) ) => GenSize -> diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs index 673dd98b6e7..bbb16bbebb5 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs @@ -386,6 +386,10 @@ deriving stock instance Eq (PredicateFailure (EraRule "TICKF" era)) => Eq (FutureLedgerViewError era) +deriving stock instance + Ord (PredicateFailure (EraRule "TICKF" era)) => + Ord (FutureLedgerViewError era) + deriving stock instance Show (PredicateFailure (EraRule "TICKF" era)) => Show (FutureLedgerViewError era) diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs index bf9a68f488e..32daffb9001 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs @@ -434,7 +434,7 @@ data LastAppliedBlock = LastAppliedBlock , labSlotNo :: !SlotNo , labHash :: !HashHeader } - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) instance NoThunks LastAppliedBlock diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs index a8067ac22fa..6d044dcd99a 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs @@ -49,7 +49,7 @@ data OcertPredicateFailure String -- error message given by Consensus Layer | NoCounterForKeyHashOCERT (KeyHash BlockIssuer) -- stake pool key hash - deriving (Show, Eq, Generic) + deriving (Eq, Ord, Show, Generic) instance NoThunks OcertPredicateFailure diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs index 7da9ebef973..551b4cb7737 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs @@ -153,6 +153,10 @@ deriving instance VRF.VRFAlgorithm (VRF c) => Eq (OverlayPredicateFailure c) +deriving instance + VRF.VRFAlgorithm (VRF c) => + Ord (OverlayPredicateFailure c) + instance VRF.VRFAlgorithm (VRF c) => NoThunks (OverlayPredicateFailure c) diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs index 4e9028baeee..89c05c5b7ff 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs @@ -117,6 +117,10 @@ deriving instance VRF.VRFAlgorithm (VRF c) => Eq (PrtclPredicateFailure c) +deriving instance + VRF.VRFAlgorithm (VRF c) => + Ord (PrtclPredicateFailure c) + instance Crypto c => NoThunks (PrtclPredicateFailure c) instance @@ -211,7 +215,7 @@ data PrtlSeqFailure PrevHash -- | Current block's previous hash PrevHash - deriving (Show, Eq, Generic) + deriving (Show, Eq, Ord, Generic) instance NoThunks PrtlSeqFailure diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs index 5bea14c498c..7934d978f2f 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs @@ -30,7 +30,7 @@ data UpdnState = UpdnState Nonce Nonce deriving (Show, Eq) data UpdnPredicateFailure c -- No predicate failures - deriving (Generic, Show, Eq) + deriving (Eq, Ord, Show, Generic) instance NoThunks (UpdnPredicateFailure c) diff --git a/libs/small-steps/src/Control/State/Transition/Extended.hs b/libs/small-steps/src/Control/State/Transition/Extended.hs index 16fdf110794..d53d267a525 100644 --- a/libs/small-steps/src/Control/State/Transition/Extended.hs +++ b/libs/small-steps/src/Control/State/Transition/Extended.hs @@ -207,7 +207,7 @@ instance Exception AssertionException -- | State transition system. class - ( Eq (PredicateFailure a) + ( Ord (PredicateFailure a) , Show (PredicateFailure a) , Monad (BaseM a) , Typeable a @@ -823,7 +823,7 @@ newtype Threshold a = Threshold a data STUB (e :: Type) (st :: Type) (si :: Type) (f :: Type) (m :: Type -> Type) instance - ( Eq f + ( Ord f , Monad m , Show f , Typeable e diff --git a/libs/small-steps/test/Test/Control/State/Transition/Examples/CommitReveal.hs b/libs/small-steps/test/Test/Control/State/Transition/Examples/CommitReveal.hs index dc145a208e5..04c0559ada9 100644 --- a/libs/small-steps/test/Test/Control/State/Transition/Examples/CommitReveal.hs +++ b/libs/small-steps/test/Test/Control/State/Transition/Examples/CommitReveal.hs @@ -120,7 +120,7 @@ newtype Id = Id {getId :: Int} data CRPredicateFailure hashAlgo (hashToDataMap :: Type -> Type -> Type) commitData = InvalidReveal Data | AlreadyComitted (Hash hashAlgo Data) - deriving (Eq, Show) + deriving (Eq, Ord, Show) instance ( HashAlgorithm hashAlgo diff --git a/libs/small-steps/test/Test/Control/State/Transition/Examples/GlobalSum.hs b/libs/small-steps/test/Test/Control/State/Transition/Examples/GlobalSum.hs index 0dc9d9c8fb6..3c44159a4c1 100644 --- a/libs/small-steps/test/Test/Control/State/Transition/Examples/GlobalSum.hs +++ b/libs/small-steps/test/Test/Control/State/Transition/Examples/GlobalSum.hs @@ -24,7 +24,7 @@ data GSUM newtype GSUMEvent = ErrorEvent Void deriving (Eq, Show) -data NoFailure = NoFailure deriving (Eq, Show) +data NoFailure = NoFailure deriving (Eq, Ord, Show) instance STS GSUM where type Environment GSUM = () diff --git a/libs/small-steps/test/Test/Control/State/Transition/Examples/Sum.hs b/libs/small-steps/test/Test/Control/State/Transition/Examples/Sum.hs index 3c82260a5bd..ea01e29bdac 100644 --- a/libs/small-steps/test/Test/Control/State/Transition/Examples/Sum.hs +++ b/libs/small-steps/test/Test/Control/State/Transition/Examples/Sum.hs @@ -16,7 +16,7 @@ import Test.QuickCheck (Property, arbitrary, shrink, withMaxSuccess) data SUM -data NoFailure = NoFailure deriving (Eq, Show) +data NoFailure = NoFailure deriving (Eq, Ord, Show) instance STS SUM where type Environment SUM = () diff --git a/libs/small-steps/testlib/Test/Control/State/Transition/Trace.hs b/libs/small-steps/testlib/Test/Control/State/Transition/Trace.hs index 4bb38e3aca3..f9858fd783e 100644 --- a/libs/small-steps/testlib/Test/Control/State/Transition/Trace.hs +++ b/libs/small-steps/testlib/Test/Control/State/Transition/Trace.hs @@ -146,7 +146,7 @@ mkTrace env initState sigs = Trace env initState sigs' -- >>> import Control.State.Transition.Extended (STS (..)) -- >>> :{ -- data DUMMY --- data DummyPredicateFailure = CeciNEstPasUnePredicateFailure deriving (Eq, Show) +-- data DummyPredicateFailure = CeciNEstPasUnePredicateFailure deriving (Eq, Ord, Show) -- instance STS DUMMY where -- type Environment DUMMY = Bool -- type State DUMMY = Int @@ -357,7 +357,7 @@ preStatesAndSignals NewestFirst tr = -- >>> import Data.Functor.Identity -- >>> :{ -- data ADDER --- data AdderPredicateFailure = NoFailuresPossible deriving (Eq, Show) +-- data AdderPredicateFailure = NoFailuresPossible deriving (Eq, Ord, Show) -- instance STS ADDER where -- type Environment ADDER = () -- type State ADDER = Int From d8323c99955e9692c505bbe05ca1bd51f54df182 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Wed, 20 May 2026 07:39:20 -0600 Subject: [PATCH 5/7] fixup! Use an srp --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 1aec6cb6ad0..2fff04ee305 100644 --- a/cabal.project +++ b/cabal.project @@ -187,7 +187,7 @@ source-repository-package type: git location: https://github.com/IntersectMBO/cardano-base.git --sha256: sha256-qpShH6TD09thz4Nar6iKsrwWLkzzigVcuOLzxf+ZkDc= - tag: 6ed7596ecb5739689fada36a4fed0b06045a7f22 + tag: 9a18592565cf15b900329095d699997b763b6bd3 subdir: cardano-base cardano-crypto-class From 0ade1278585b9465e25a7773a598f637ed97b8be Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 16 May 2026 10:41:52 -0600 Subject: [PATCH 6/7] Implement submitFailingTxSubset{,M} --- .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 32 +++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index e5e925ac5a0..b7308b47e7a 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -59,6 +59,8 @@ module Test.Cardano.Ledger.Shelley.ImpTest ( submitTxAnn_, submitFailingTx, submitFailingTxM, + submitFailingTxSubset, + submitFailingTxSubsetM, trySubmitTx, submitBlock_, submitBlock, @@ -1340,6 +1342,36 @@ submitFailingTxM tx mkExpectedFailures = do expectedFailures <- mkExpectedFailures fixedUpTx predFailures `shouldBeExpr` expectedFailures +-- | Submit a transaction that is expected to be rejected with at least the given predicate failures. +-- The inputs and outputs are automatically balanced. +submitFailingTxSubset :: + ( HasCallStack + , ShelleyEraImp era + ) => + Tx TopTx era -> + NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> + ImpTestM era () +submitFailingTxSubset tx = submitFailingTxSubsetM tx . const . pure + +-- | Submit a transaction that is expected to be rejected, and compute +-- the expected subset of predicate failures from the fixed-up tx using the supplied action. +-- The inputs and outputs are automatically balanced. +submitFailingTxSubsetM :: + ( HasCallStack + , ShelleyEraImp era + ) => + Tx TopTx era -> + (Tx TopTx era -> ImpTestM era (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))) -> + ImpTestM era () +submitFailingTxSubsetM tx mkExpectedFailures = do + (predFailures, fixedUpTx) <- expectLeftDeepExpr =<< trySubmitTx tx + expectedFailures <- mkExpectedFailures fixedUpTx + let + predSet = Set.fromList $ toList predFailures + expectedSet = Set.fromList $ toList expectedFailures + significantSet = predSet `Set.intersection` expectedSet + significantSet `shouldBeExpr` expectedSet + -- * Submitting blocks -- | Submit a list of transactions as a block that's expected to succeed. From 0d42a1f03507b8aaff104cf42397794e33d9886a Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 16 May 2026 10:42:29 -0600 Subject: [PATCH 7/7] Make Conway CERTS test era-generic --- .../conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs | 3 +-- .../testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs | 8 ++++---- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index 70c21c48c70..bbe029958fd 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -49,6 +49,7 @@ spec era = do Babbage.spec era describe "ConwayEra Onwards" $ withImpInitEachEraVersion era $ do BBODY.spec + CERTS.spec DELEG.spec ENACT.spec EPOCH.spec @@ -64,6 +65,4 @@ spec era = do conwayEraSpecificSpec :: Spec conwayEraSpecificSpec = do describe "ConwayEra Specific" $ withImpInitEachEraVersion (Proxy @ConwayEra) $ do - -- TODO: move to `spec` when ready: https://github.com/IntersectMBO/cardano-ledger/issues/5805 - CERTS.spec UTXO.conwayEraSpecificSpec diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs index a1129e064d6..4d33fc20577 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs @@ -51,7 +51,7 @@ spec = describe "CERTS" $ do in submitBootstrapAware (submitTx_ tx) - (submitFailingTx tx) + (submitFailingTxSubset tx) ( FailBootstrapAndPostBootstrap $ FailBoth { bootstrapFailures = [notInRewardsFailure] @@ -78,7 +78,7 @@ spec = describe "CERTS" $ do in submitBootstrapAware (submitTx_ tx) - (submitFailingTx tx) + (submitFailingTxSubset tx) ( FailBootstrapAndPostBootstrap $ FailBoth { bootstrapFailures = [notInRewardsFailure] @@ -97,7 +97,7 @@ spec = describe "CERTS" $ do (accountAddress2, reward2, stakeKey2) <- setupAccountAddress void $ delegateToDRep (KeyHashObj stakeKey1) (Coin 1_000_000) DRepAlwaysAbstain void $ delegateToDRep (KeyHashObj stakeKey2) (Coin 1_000_000) DRepAlwaysAbstain - submitFailingTx + submitFailingTxSubset ( mkBasicTx $ mkBasicTxBody & withdrawalsTxBodyL @@ -117,7 +117,7 @@ spec = describe "CERTS" $ do Withdrawals [(accountAddress1, reward1 <+> Coin 1)] ] - submitFailingTx + submitFailingTxSubset ( mkBasicTx $ mkBasicTxBody & withdrawalsTxBodyL