diff --git a/cabal.project b/cabal.project index b4dfaf52d1b..b3edd412de3 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: 9a18592565cf15b900329095d699997b763b6bd3 + subdir: + cardano-base + cardano-crypto-class + cardano-crypto-praos 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..a9ac4a5a35e 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs @@ -35,7 +35,7 @@ module Cardano.Ledger.Alonzo.Rules.Utxos ( import Cardano.Ledger.Alonzo.Core import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoUTXOS) -import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext) +import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext) import Cardano.Ledger.Alonzo.Plutus.Evaluate ( CollectError (..), collectPlutusScriptsWithContext, @@ -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 @@ -382,7 +382,7 @@ instance InjectRuleFailure "UTXOS" Shelley.ShelleyPpupPredFailure AlonzoEra wher instance ( EraTxCert era , AlonzoEraScript era - , EncCBOR (ContextError era) + , EncCBOR (CollectError era) , EncCBOR (EraRuleFailure "PPUP" era) ) => EncCBOR (AlonzoUtxosPredFailure era) @@ -395,7 +395,7 @@ instance instance ( EraTxCert era , AlonzoEraScript era - , DecCBOR (ContextError era) + , DecCBOR (CollectError era) , DecCBOR (EraRuleFailure "PPUP" era) ) => DecCBOR (AlonzoUtxosPredFailure era) @@ -410,8 +410,7 @@ instance deriving stock instance ( AlonzoEraScript era , Show (TxCert era) - , Show (ContextError era) - , Show (Shelley.UTxOState era) + , Show (CollectError era) , Show (EraRuleFailure "PPUP" era) ) => Show (AlonzoUtxosPredFailure era) @@ -419,17 +418,26 @@ deriving stock instance deriving stock instance ( AlonzoEraScript era , Eq (TxCert era) - , Eq (ContextError era) - , Eq (Shelley.UTxOState era) + , Eq (CollectError era) , Eq (EraRuleFailure "PPUP" era) ) => Eq (AlonzoUtxosPredFailure era) +deriving stock instance + ( AlonzoEraScript era + , Ord (TxCert era) + , Ord (CollectError 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 (CollectError 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..83f49ae78bf 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -75,7 +75,7 @@ import Cardano.Ledger.Alonzo.PParams ( getLanguageView, ppPricesL, ) -import Cardano.Ledger.Alonzo.Plutus.Context (CollectError, ContextError) +import Cardano.Ledger.Alonzo.Plutus.Context (CollectError) import Cardano.Ledger.Alonzo.Scripts ( AlonzoEraScript (..), CostModel, @@ -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 @@ -485,19 +485,19 @@ data AlonzoStAnnTx l era where deriving instance ( AlonzoEraScript era - , Eq (Tx l era) + , Eq (Tx TopTx era) , Eq (ScriptsNeeded era) , Eq (ScriptsProvided era) - , Eq (ContextError era) + , Eq (CollectError era) ) => Eq (AlonzoStAnnTx l era) deriving instance ( AlonzoEraScript era - , Show (Tx l era) + , Show (Tx TopTx era) , Show (ScriptsNeeded era) , Show (ScriptsProvided era) - , Show (ContextError era) + , Show (CollectError era) ) => Show (AlonzoStAnnTx l era) @@ -512,7 +512,7 @@ instance , NFData (Tx l era) , NFData (ScriptsNeeded era) , NFData (ScriptsProvided era) - , NFData (ContextError era) + , NFData (CollectError era) ) => NFData (AlonzoStAnnTx 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..2dc608c9308 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs @@ -23,7 +23,7 @@ module Cardano.Ledger.Conway.Rules.Utxos ( alonzoToConwayUtxosEvent, ) where -import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext) +import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext) import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..)) import Cardano.Ledger.Alonzo.Rules ( AlonzoUtxoEvent (..), @@ -127,7 +127,7 @@ alonzoToConwayUtxosEvent = \case instance ( EraTxCert era , ConwayEraScript era - , EncCBOR (ContextError era) + , EncCBOR (CollectError era) ) => EncCBOR (ConwayUtxosPredFailure era) where @@ -139,7 +139,7 @@ instance instance ( EraTxCert era , ConwayEraScript era - , DecCBOR (ContextError era) + , DecCBOR (CollectError era) ) => DecCBOR (ConwayUtxosPredFailure era) where @@ -152,21 +152,28 @@ instance deriving stock instance ( ConwayEraScript era , Show (TxCert era) - , Show (ContextError era) + , Show (CollectError era) ) => Show (ConwayUtxosPredFailure era) deriving stock instance ( ConwayEraScript era , Eq (TxCert era) - , Eq (ContextError era) + , Eq (CollectError era) ) => Eq (ConwayUtxosPredFailure era) +deriving stock instance + ( ConwayEraScript era + , Ord (TxCert era) + , Ord (CollectError era) + ) => + Ord (ConwayUtxosPredFailure era) + instance ( ConwayEraScript era , NFData (TxCert era) - , NFData (ContextError era) + , NFData (CollectError era) ) => NFData (ConwayUtxosPredFailure 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/Tx.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs index f8629a2cec1..416ad693d02 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs @@ -28,7 +28,7 @@ module Cardano.Ledger.Dijkstra.Tx ( ) where import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..), StrictMaybe) -import Cardano.Ledger.Alonzo.Plutus.Context (CollectError, ContextError, TxInfoResult) +import Cardano.Ledger.Alonzo.Plutus.Context (CollectError, TxInfoResult) import Cardano.Ledger.Alonzo.Tx ( AlonzoEraTx, IsValid (..), @@ -393,22 +393,22 @@ data DijkstraStAnnTx l era where deriving instance ( DijkstraEraScript era - , Eq (Tx l era) + , Eq (Tx TopTx era) , Eq (Tx SubTx era) , Eq (ScriptsNeeded era) , Eq (ScriptsProvided era) - , Eq (ContextError era) + , Eq (CollectError era) , Eq (TxInfoResult era) ) => Eq (DijkstraStAnnTx l era) deriving instance ( DijkstraEraScript era - , Show (Tx l era) + , Show (Tx TopTx era) , Show (Tx SubTx era) , Show (ScriptsNeeded era) , Show (ScriptsProvided era) - , Show (ContextError era) + , Show (CollectError era) , Show (TxInfoResult era) ) => Show (DijkstraStAnnTx l 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..1f24b2ba483 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs @@ -115,9 +115,19 @@ deriving instance , EraTxCert era , EraTxOut era , Eq (ContextError era) + , era ~ DijkstraEra -- Remove when GHC bug is fixed ) => Eq (DijkstraContextError era) +deriving instance + ( AlonzoEraScript era + , EraTxCert era + , EraTxOut era + , Ord (ContextError era) + , era ~ DijkstraEra -- Remove when GHC bug is fixed + ) => + 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/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/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/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/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-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 d267d8ff832..0c0edd4fd1a 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-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/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal index 601402310eb..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, @@ -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/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/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 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