diff --git a/eras/allegra/impl/CHANGELOG.md b/eras/allegra/impl/CHANGELOG.md index 53f290c9712..1cb4d4675ac 100644 --- a/eras/allegra/impl/CHANGELOG.md +++ b/eras/allegra/impl/CHANGELOG.md @@ -1,8 +1,9 @@ # Version history for `cardano-ledger-allegra` -## 1.2.1.2 +## 1.2.2.0 -* +* Add `EqRaw` instance for `Timelock`, `AllegraTxAuxData` and `AllegraTxBody` +* Add `ToExpr` instance for `AllegraTxAuxData` ## 1.2.1.1 diff --git a/eras/allegra/impl/cardano-ledger-allegra.cabal b/eras/allegra/impl/cardano-ledger-allegra.cabal index cf87c32ae34..6d926a4f7e0 100644 --- a/eras/allegra/impl/cardano-ledger-allegra.cabal +++ b/eras/allegra/impl/cardano-ledger-allegra.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-allegra -version: 1.2.1.2 +version: 1.2.2.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -52,8 +52,8 @@ library bytestring, cardano-crypto-class, cardano-ledger-binary >=1.0, - cardano-ledger-core >=1.5 && <1.7, - cardano-ledger-shelley >=1.5 && <1.6, + cardano-ledger-core >=1.6 && <1.7, + cardano-ledger-shelley >=1.5.1 && <1.6, cardano-strict-containers, cardano-slotting, cborg, diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs index 75dbde774d6..54bab3cf812 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs @@ -64,6 +64,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto, HASH) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness)) import Cardano.Ledger.MemoBytes ( + EqRaw (..), Mem, MemoBytes (Memo), Memoized (..), @@ -211,6 +212,9 @@ instance Crypto c => EraScript (AllegraEra c) where phaseScript PhaseOneRep timelock = Just (Phase1Script timelock) phaseScript PhaseTwoRep _ = Nothing +instance EqRaw (Timelock era) where + eqRaw = eqTimelockRaw + deriving via Mem TimelockRaw era instance diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs index cc4f36b1b45..a7180e5ae05 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs @@ -43,6 +43,7 @@ import Cardano.Ledger.Core ( import Cardano.Ledger.Crypto (Crypto (HASH)) import Cardano.Ledger.Hashes (EraIndependentTxAuxData) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes, MemoHashIndex, @@ -107,6 +108,8 @@ newtype AllegraTxAuxData era = AuxiliaryDataWithBytes (MemoBytes AllegraTxAuxDat deriving (Generic) deriving newtype (Eq, ToCBOR, SafeToHash) +instance ToExpr (AllegraTxAuxData era) + instance Memoized AllegraTxAuxData where type RawType AllegraTxAuxData = AllegraTxAuxDataRaw @@ -123,6 +126,8 @@ deriving newtype instance Era era => NoThunks (AllegraTxAuxData era) deriving newtype instance NFData (AllegraTxAuxData era) +instance EqRaw (AllegraTxAuxData era) + pattern AllegraTxAuxData :: Era era => Map Word64 Metadatum -> diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs index 0154c7de4f5..ec6e6f8b63a 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs @@ -61,6 +61,7 @@ import Cardano.Ledger.Compactible (Compactible (..)) import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto, StandardCrypto) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes, MemoHashIndex, @@ -354,3 +355,7 @@ instance Crypto c => AllegraEraTxBody (AllegraEra c) where lensMemoRawType atbrValidityInterval $ \txBodyRaw vldt -> txBodyRaw {atbrValidityInterval = vldt} {-# INLINEABLE vldtTxBodyL #-} + +instance + (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) => + EqRaw (AllegraTxBody era) diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxWits.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxWits.hs index aa85f54112a..22b887aab6c 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxWits.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxWits.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs b/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs index 4924441a236..f92bc93e288 100644 --- a/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs +++ b/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs @@ -3,10 +3,9 @@ module Test.Cardano.Ledger.Allegra.BinarySpec (spec) where import Cardano.Ledger.Allegra -import Cardano.Ledger.Allegra.TxAuxData import Test.Cardano.Ledger.Allegra.Arbitrary () import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Core.Binary as UpgradeSpec spec :: Spec -spec = specUpgrade @Allegra @AllegraTxAuxData True +spec = specUpgrade @Allegra True diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index 0fcfe1eb25b..4052935855c 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -1,8 +1,11 @@ # Version history for `cardano-ledger-alonzo` -## 1.4.0.1 +## 1.4.1.0 -* +* Made `isPlutusScript` more general. +* Add `alonzoEqTxRaw` and `alonzoEqTxWitsRaw` +* Add `EqRaw` instance for `AlonzoScript`, `AlonzoTxWits`, `AlonzoTxAuxData`, + `AlonzoTxBody` and `AlonzoTx` ## 1.4.0.0 diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index 15cbce4447e..29ecfa19b34 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-alonzo -version: 1.4.0.1 +version: 1.4.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -67,7 +67,7 @@ library cardano-ledger-allegra >=1.1, cardano-crypto-class, cardano-ledger-binary >=1.0.1, - cardano-ledger-core >=1.5 && <1.7, + cardano-ledger-core >=1.6 && <1.7, cardano-ledger-mary >=1.1, cardano-ledger-shelley ^>=1.5, cardano-slotting, diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs index a388d7598aa..ceb0084cffd 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs @@ -100,6 +100,7 @@ import Cardano.Ledger.Language ( mkLanguageEnum, nonNativeLanguages, ) +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Cardano.Ledger.SafeHash (SafeToHash (..)) import Cardano.Ledger.Shelley.Scripts (nativeMultiSigTag) import Cardano.Ledger.TreeDiff (Expr (App), ToExpr (..), defaultExprViaShow) @@ -202,9 +203,11 @@ type instance SomeScript 'PhaseOne (AlonzoEra c) = Timelock (AlonzoEra c) type instance SomeScript 'PhaseTwo (AlonzoEra c) = (Language, ShortByteString) -isPlutusScript :: AlonzoScript era -> Bool -isPlutusScript (PlutusScript _) = True -isPlutusScript (TimelockScript _) = False +isPlutusScript :: forall era. EraScript era => Script era -> Bool +isPlutusScript x = + case phaseScript @era PhaseTwoRep x of + Just _ -> True + Nothing -> False instance Crypto c => EraScript (AlonzoEra c) where type Script (AlonzoEra c) = AlonzoScript (AlonzoEra c) @@ -222,6 +225,9 @@ instance Crypto c => EraScript (AlonzoEra c) where PlutusScript (Plutus PlutusV2 _) -> "\x02" PlutusScript (Plutus PlutusV3 _) -> "\x03" +instance EqRaw (AlonzoScript era) where + eqRaw = eqAlonzoScriptRaw + instance Era era => ToJSON (AlonzoScript era) where toJSON = String . serializeAsHexText diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs index 14170547b78..217c4e0cd6a 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -74,6 +74,7 @@ module Cardano.Ledger.Alonzo.Tx ( -- Other toCBORForSizeComputation, toCBORForMempoolSubmission, + alonzoEqTxRaw, ) where @@ -130,7 +131,9 @@ import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto (HASH), StandardCrypto) import Cardano.Ledger.Language (nonNativeLanguages) import Cardano.Ledger.Mary.Value (AssetName, MaryValue (..), MultiAsset (..), PolicyID (..)) +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash (..), hashAnnotated) +import Cardano.Ledger.Shelley.Tx (shelleyEqTxRaw) import Cardano.Ledger.Shelley.TxBody (Withdrawals (..), unWithdrawals) import Cardano.Ledger.TxIn (TxIn (..)) import qualified Cardano.Ledger.UTxO as Shelley @@ -194,6 +197,9 @@ instance Crypto c => EraTx (AlonzoEra c) where getMinFeeTx = alonzoMinFeeTx {-# INLINE getMinFeeTx #-} +instance (Tx era ~ AlonzoTx era, AlonzoEraTx era) => EqRaw (AlonzoTx era) where + eqRaw = alonzoEqTxRaw + class (EraTx era, AlonzoEraTxBody era, AlonzoEraTxWits era) => AlonzoEraTx era where isValidTxL :: Lens' (Tx era) IsValid @@ -599,3 +605,7 @@ isTwoPhaseScriptAddressFromMap hashScriptMap addr = Just hash -> any ok hashScriptMap where ok script = hashScript @era script == hash && not (isNativeScript @era script) + +alonzoEqTxRaw :: AlonzoEraTx era => Tx era -> Tx era -> Bool +alonzoEqTxRaw tx1 tx2 = + shelleyEqTxRaw tx1 tx2 && (tx1 ^. isValidTxL == tx2 ^. isValidTxL) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs index 6d4390ad72c..dd7312462e1 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs @@ -58,6 +58,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto (HASH)) import Cardano.Ledger.Language (Language (..), Plutus (..), guardPlutus) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes (..), MemoHashIndex, @@ -237,6 +238,8 @@ instance Memoized AlonzoTxAuxData where instance ToExpr (AlonzoTxAuxData era) +instance EqRaw (AlonzoTxAuxData era) + type AuxiliaryData era = AlonzoTxAuxData era {-# DEPRECATED AuxiliaryData "Use `AlonzoTxAuxData` instead" #-} diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 337ef7c00a6..e451b12c2b5 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -96,6 +96,7 @@ import Cardano.Ledger.Crypto import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Ledger.Mary.Value (MaryValue (MaryValue), MultiAsset (..), policies, policyID) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes, MemoHashIndex, @@ -404,6 +405,10 @@ scriptIntegrityHash' = atbrScriptIntegrityHash . getMemoRawType txnetworkid' = atbrTxNetworkId . getMemoRawType +instance + (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) => + EqRaw (AlonzoTxBody era) + -------------------------------------------------------------------------------- -- Serialisation -------------------------------------------------------------------------------- diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index ef03609f71d..3604459edf6 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -48,6 +48,7 @@ module Cardano.Ledger.Alonzo.TxWits ( hashDataTxWitsL, unTxDats, nullDats, + alonzoEqTxWitsRaw, ) where @@ -75,16 +76,18 @@ import Cardano.Ledger.Keys (KeyRole (Witness)) import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness) import Cardano.Ledger.Language (Language (..), Plutus (..), guardPlutus) import Cardano.Ledger.MemoBytes ( + EqRaw (..), Mem, MemoBytes, Memoized (..), + eqRawType, getMemoRawType, lensMemoRawType, mkMemoized, ) import Cardano.Ledger.SafeHash (SafeToHash (..)) import Cardano.Ledger.Shelley.TxBody (WitVKey) -import Cardano.Ledger.Shelley.TxWits (keyBy) +import Cardano.Ledger.Shelley.TxWits (keyBy, shelleyEqTxWitsRaw) import Control.DeepSeq (NFData) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -434,6 +437,9 @@ instance (EraScript (AlonzoEra c), Crypto c) => AlonzoEraTxWits (AlonzoEra c) wh rdmrsTxWitsL = rdmrsAlonzoTxWitsL {-# INLINE rdmrsTxWitsL #-} +instance (TxWits era ~ AlonzoTxWits era, AlonzoEraTxWits era) => EqRaw (AlonzoTxWits era) where + eqRaw = alonzoEqTxWitsRaw + -- | This is a convenience Lens that will hash the `Data` when it is being added to the -- `TxWits`. See `datsTxWitsL` for a version that aloows setting `TxDats` instead. hashDataTxWitsL :: AlonzoEraTxWits era => Lens (TxWits era) (TxWits era) (TxDats era) [Data era] @@ -603,3 +609,9 @@ deriving via instance (EraScript era, Script era ~ AlonzoScript era) => DecCBOR (Annotator (AlonzoTxWits era)) + +alonzoEqTxWitsRaw :: AlonzoEraTxWits era => TxWits era -> TxWits era -> Bool +alonzoEqTxWitsRaw txWits1 txWits2 = + shelleyEqTxWitsRaw txWits1 txWits2 + && eqRawType (txWits1 ^. datsTxWitsL) (txWits2 ^. datsTxWitsL) + && eqRawType (txWits1 ^. rdmrsTxWitsL) (txWits2 ^. rdmrsTxWitsL) diff --git a/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs b/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs index 81f2c87bdd1..8f7c4187e49 100644 --- a/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs +++ b/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs @@ -11,4 +11,4 @@ spec :: Spec spec = -- Scripts are not upgradeable from Mary through their CBOR instances, since Mary had no -- concept of a prefix. - specUpgrade @Alonzo @AlonzoTxAuxData False + specUpgrade @Alonzo False diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 9b1e6a35a99..3627b0a1a46 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -1,8 +1,8 @@ # Version history for `cardano-ledger-babbage` -## 1.4.3.1 +## 1.4.4.0 -* +* Add `EqRaw` instance for `BabbageTxBody` ## 1.4.3.0 diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal index 2e9fc90a355..f196da23115 100644 --- a/eras/babbage/impl/cardano-ledger-babbage.cabal +++ b/eras/babbage/impl/cardano-ledger-babbage.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-babbage -version: 1.4.3.1 +version: 1.4.4.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -60,9 +60,9 @@ library cardano-crypto-class, cardano-data >=1.0, cardano-ledger-allegra >=1.1, - cardano-ledger-alonzo ^>=1.4, + cardano-ledger-alonzo ^>=1.4.1, cardano-ledger-binary >=1.0, - cardano-ledger-core >=1.5 && <1.7, + cardano-ledger-core >=1.6 && <1.7, cardano-ledger-mary >=1.1, cardano-ledger-shelley ^>=1.5, cardano-slotting, diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Scripts.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Scripts.hs index a0015a48c28..b3c332d6e46 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Scripts.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Scripts.hs @@ -20,7 +20,11 @@ where import Cardano.Ledger.Allegra.Scripts (Timelock) import Cardano.Ledger.Alonzo.Language -import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..), translateAlonzoScript) +import Cardano.Ledger.Alonzo.Scripts ( + AlonzoScript (..), + isPlutusScript, + translateAlonzoScript, + ) import Cardano.Ledger.Babbage.Era import Cardano.Ledger.Core import Cardano.Ledger.Crypto @@ -51,9 +55,3 @@ instance Crypto c => EraScript (BabbageEra c) where phaseScript PhaseOneRep (TimelockScript s) = Just (Phase1Script s) phaseScript PhaseTwoRep (PlutusScript plutus) = Just (Phase2Script plutus) phaseScript _ _ = Nothing - -isPlutusScript :: forall era. EraScript era => Script era -> Bool -isPlutusScript x = - case phaseScript @era PhaseTwoRep x of - Just _ -> True - Nothing -> False diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs index ab0bf858ad8..22c7c2df538 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs @@ -64,7 +64,7 @@ instance Crypto c => EraTx (BabbageEra c) where sizeTxF = sizeAlonzoTxF {-# INLINE sizeTxF #-} - validateScript (Phase1Script script) tx = validateTimelock @(BabbageEra c) script tx + validateScript (Phase1Script script) = validateTimelock @(BabbageEra c) script {-# INLINE validateScript #-} getMinFeeTx = alonzoMinFeeTx diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs index 2951e748a99..24c69e736a2 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs @@ -140,6 +140,7 @@ import Cardano.Ledger.Crypto import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Ledger.Mary.Value (MaryValue (MaryValue), MultiAsset, policies, policyID) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes, MemoHashIndex, @@ -471,6 +472,10 @@ instance Crypto c => BabbageEraTxBody (BabbageEra c) where allSizedOutputsTxBodyF = allSizedOutputsBabbageTxBodyF {-# INLINE allSizedOutputsTxBodyF #-} +instance + (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) => + EqRaw (BabbageTxBody era) + deriving newtype instance (Era era, Eq (TxOut era), Eq (TxCert era), Eq (PParamsUpdate era)) => Eq (BabbageTxBody era) diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxWits.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxWits.hs index 69d3554150a..df96be6b708 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxWits.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxWits.hs @@ -25,10 +25,10 @@ import Cardano.Ledger.Alonzo.TxWits as BabbageTxWitsReExport ( import Cardano.Ledger.Babbage.Era (BabbageEra) import Cardano.Ledger.Babbage.TxBody () import Cardano.Ledger.Core -import qualified Cardano.Ledger.Crypto as CC +import Cardano.Ledger.Crypto -instance CC.Crypto c => EraTxWits (BabbageEra c) where - {-# SPECIALIZE instance EraTxWits (BabbageEra CC.StandardCrypto) #-} +instance Crypto c => EraTxWits (BabbageEra c) where + {-# SPECIALIZE instance EraTxWits (BabbageEra StandardCrypto) #-} type TxWits (BabbageEra c) = AlonzoTxWits (BabbageEra c) @@ -43,8 +43,8 @@ instance CC.Crypto c => EraTxWits (BabbageEra c) where scriptTxWitsL = scriptAlonzoTxWitsL {-# INLINE scriptTxWitsL #-} -instance CC.Crypto c => AlonzoEraTxWits (BabbageEra c) where - {-# SPECIALIZE instance AlonzoEraTxWits (BabbageEra CC.StandardCrypto) #-} +instance Crypto c => AlonzoEraTxWits (BabbageEra c) where + {-# SPECIALIZE instance AlonzoEraTxWits (BabbageEra StandardCrypto) #-} datsTxWitsL = datsAlonzoTxWitsL {-# INLINE datsTxWitsL #-} diff --git a/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs b/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs index 715f04c75d0..72abcd119be 100644 --- a/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs +++ b/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs @@ -8,4 +8,4 @@ import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Core.Binary as UpgradeSpec spec :: Spec -spec = specUpgrade @Babbage @AlonzoTxAuxData True +spec = specUpgrade @Babbage True diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 19aca5172c4..4d88ca85a9b 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -5,6 +5,9 @@ * Add "minCommitteeSize" `PParam` validation for `NewCommittee` `GovAction` #3668 * Add `committeeMembersL` and `committeeQuorumL` lenses for `Committee` * Add `NewCommitteeSizeTooSmall` `PredicateFailure` in `GOV` +* Add `EqRaw` instance for `ConwayTxBody` +* Add `ToExpr` instance for `Delegatee`, `ConwayDelegCert`, `ConwayGovCert` and + `ConwayTxCert` * Implement expiry for governance proposals #3664 * Update `ppGovActionExpiration` to be an `EpochNo` * Add `gasExpiresAfter :: !EpochNo` to `GovActionState` diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 830275b130c..5a6a4046b16 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -69,7 +69,7 @@ library cardano-crypto-class, cardano-ledger-binary >=1.1, cardano-ledger-allegra >=1.1, - cardano-ledger-alonzo ^>=1.4, + cardano-ledger-alonzo ^>=1.4.1, cardano-ledger-babbage >=1.4.1, cardano-ledger-core ^>=1.6, cardano-ledger-mary >=1.1, @@ -126,7 +126,6 @@ test-suite tests build-depends: base, cardano-ledger-core:testlib, - cardano-ledger-alonzo, cardano-ledger-conway, cardano-ledger-core, containers, diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs index fc1f5afed28..122b2dd1e56 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs @@ -14,7 +14,11 @@ where import Cardano.Ledger.Allegra.Scripts (Timelock) import Cardano.Ledger.Alonzo.Language (Language) -import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..), isPlutusScript, translateAlonzoScript) +import Cardano.Ledger.Alonzo.Scripts ( + AlonzoScript (..), + isPlutusScript, + translateAlonzoScript, + ) import Cardano.Ledger.Babbage.Scripts (babbageScriptPrefixTag) import Cardano.Ledger.Conway.Era import Cardano.Ledger.Core diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs index 57162caec4b..5320df635ca 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs @@ -88,6 +88,7 @@ import Cardano.Ledger.Mary.Value ( policies, ) import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes (..), MemoHashIndex, @@ -399,6 +400,10 @@ instance Crypto c => ConwayEraTxBody (ConwayEra c) where lensMemoRawType ctbrTreasuryDonation (\txb x -> txb {ctbrTreasuryDonation = x}) {-# INLINE treasuryDonationTxBodyL #-} +instance + (EraPParams era, Eq (TxOut era), Eq (TxCert era)) => + EqRaw (ConwayTxBody era) + pattern ConwayTxBody :: ConwayEraTxBody era => Set (TxIn (EraCrypto era)) -> diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs index d773e4fea45..693f8f3a762 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs @@ -81,6 +81,7 @@ import Cardano.Ledger.Shelley.TxCert ( pattern RetirePoolTxCert, pattern UnRegTxCert, ) +import Cardano.Ledger.TreeDiff (ToExpr) import Cardano.Ledger.Val (Val (..)) import Control.DeepSeq (NFData) import GHC.Generics (Generic) @@ -327,6 +328,8 @@ instance NFData (Delegatee c) instance NoThunks (Delegatee c) +instance ToExpr (Delegatee c) + -- | Certificates for registration and delegation of stake to Pools and DReps. Comparing -- to previous eras, there is now ability to: -- @@ -357,6 +360,8 @@ instance NFData (ConwayDelegCert c) instance NoThunks (ConwayDelegCert c) +instance ToExpr (ConwayDelegCert c) + data ConwayGovCert c = ConwayRegDRep !(Credential 'DRepRole c) !Coin !(StrictMaybe (Anchor c)) | ConwayUnRegDRep !(Credential 'DRepRole c) !Coin @@ -369,6 +374,8 @@ instance Crypto c => NFData (ConwayGovCert c) instance NoThunks (ConwayGovCert c) +instance ToExpr (ConwayGovCert c) + data ConwayTxCert era = ConwayTxCertDeleg !(ConwayDelegCert (EraCrypto era)) | ConwayTxCertPool !(PoolCert (EraCrypto era)) @@ -379,6 +386,8 @@ instance Crypto (EraCrypto era) => NFData (ConwayTxCert era) instance NoThunks (ConwayTxCert era) +instance ToExpr (ConwayTxCert c) + instance ( ShelleyEraTxCert era , TxCert era ~ ConwayTxCert era diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxWits.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxWits.hs index 9bfc3c24ef0..60645d7bc71 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxWits.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxWits.hs @@ -21,10 +21,10 @@ import Cardano.Ledger.Alonzo.TxWits as BabbageTxWitsReExport ( import Cardano.Ledger.Conway.Era (ConwayEra) import Cardano.Ledger.Conway.Scripts () import Cardano.Ledger.Core -import qualified Cardano.Ledger.Crypto as CC +import Cardano.Ledger.Crypto -instance CC.Crypto c => EraTxWits (ConwayEra c) where - {-# SPECIALIZE instance EraTxWits (ConwayEra CC.StandardCrypto) #-} +instance Crypto c => EraTxWits (ConwayEra c) where + {-# SPECIALIZE instance EraTxWits (ConwayEra StandardCrypto) #-} type TxWits (ConwayEra c) = AlonzoTxWits (ConwayEra c) @@ -39,8 +39,8 @@ instance CC.Crypto c => EraTxWits (ConwayEra c) where scriptTxWitsL = scriptAlonzoTxWitsL {-# INLINE scriptTxWitsL #-} -instance CC.Crypto c => AlonzoEraTxWits (ConwayEra c) where - {-# SPECIALIZE instance AlonzoEraTxWits (ConwayEra CC.StandardCrypto) #-} +instance Crypto c => AlonzoEraTxWits (ConwayEra c) where + {-# SPECIALIZE instance AlonzoEraTxWits (ConwayEra StandardCrypto) #-} datsTxWitsL = datsAlonzoTxWitsL {-# INLINE datsTxWitsL #-} diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs index dca225b89fc..fa9f93038bc 100644 --- a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs +++ b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs @@ -2,11 +2,10 @@ module Test.Cardano.Ledger.Conway.BinarySpec (spec) where -import Cardano.Ledger.Alonzo.TxAuxData import Cardano.Ledger.Conway import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Core.Binary as UpgradeSpec spec :: Spec -spec = specUpgrade @Conway @AlonzoTxAuxData True +spec = specUpgrade @Conway True diff --git a/eras/mary/impl/CHANGELOG.md b/eras/mary/impl/CHANGELOG.md index 9f703812c0e..7c094edfc62 100644 --- a/eras/mary/impl/CHANGELOG.md +++ b/eras/mary/impl/CHANGELOG.md @@ -1,8 +1,8 @@ # Version history for `cardano-ledger-mary` -## 1.3.2.1 +## 1.3.3.0 -* +* Add `EqRaw` instance for `MaryTxBody` ## 1.3.2.0 diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index 30e5b03a9d8..0118d23b895 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-mary -version: 1.3.2.1 +version: 1.3.3.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -59,8 +59,8 @@ library cardano-data, cardano-ledger-allegra >=1.1, cardano-ledger-binary >=1.0, - cardano-ledger-core >=1.5 && <1.7, - cardano-ledger-shelley >=1.5 && <1.6, + cardano-ledger-core >=1.6 && <1.7, + cardano-ledger-shelley >=1.5.1 && <1.6, containers, deepseq, groups, @@ -116,6 +116,5 @@ test-suite tests cardano-data:{cardano-data, testlib}, cardano-ledger-binary:testlib >=1.1, cardano-ledger-core:{cardano-ledger-core, testlib}, - cardano-ledger-allegra, cardano-ledger-mary, testlib diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs index 2a78654df36..bf94ebea999 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs @@ -52,7 +52,7 @@ instance Crypto c => EraTx (MaryEra c) where sizeTxF = sizeShelleyTxF {-# INLINE sizeTxF #-} - validateScript (Phase1Script script) tx = validateTimelock @(MaryEra c) script tx + validateScript (Phase1Script script) = validateTimelock @(MaryEra c) script {-# INLINE validateScript #-} getMinFeeTx = shelleyMinFeeTx diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/TxBody.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/TxBody.hs index ac572656158..a85156d8a44 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/TxBody.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/TxBody.hs @@ -45,6 +45,7 @@ import Cardano.Ledger.Mary.TxCert () import Cardano.Ledger.Mary.TxOut () import Cardano.Ledger.Mary.Value import Cardano.Ledger.MemoBytes ( + EqRaw, Mem, MemoBytes (Memo), MemoHashIndex, @@ -95,6 +96,10 @@ newtype MaryTxBody era = TxBodyConstr (MemoBytes MaryTxBodyRaw era) -- | Encodes memoized bytes created upon construction. instance Era era => EncCBOR (MaryTxBody era) +instance + (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) => + EqRaw (MaryTxBody era) + instance AllegraEraTxBody era => DecCBOR (Annotator (MaryTxBodyRaw era)) where decCBOR = pure <$> decCBOR diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/TxWits.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/TxWits.hs index e85872242ef..fa6e888dab3 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/TxWits.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/TxWits.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs index d33ca15c101..cc87fef8a6c 100644 --- a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs +++ b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs @@ -2,11 +2,10 @@ module Test.Cardano.Ledger.Mary.BinarySpec (spec) where -import Cardano.Ledger.Allegra.TxAuxData import Cardano.Ledger.Mary import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Core.Binary as UpgradeSpec import Test.Cardano.Ledger.Mary.Arbitrary () spec :: Spec -spec = specUpgrade @Mary @AllegraTxAuxData True +spec = specUpgrade @Mary True diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 638451d753a..9ccb0d2f02f 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -1,8 +1,11 @@ # Version history for `cardano-ledger-shelley` -## 1.5.0.1 +## 1.5.1.0 -* +* Add `eqMultiSigRaw`, `shelleyEqTxRaw` and `shelleyEqTxWitsRaw` +* Add `EqRaw` instance for `MultiSig`, `ShelleyTxWits`, `ShelleyTxAuxData`, `TxBody` and `Tx` +* Add `ToExpr` instance for `GenesisDelegCert`, `MIRPot`, `MirTarget`, `MIRCert`, + `ShelleyTxCert`, `ShelleyDelegCert`, `MultiSig` and `MultiSigRaw` ## 1.5.0.0 diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index e52925388bf..9ec4e666cfd 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-shelley -version: 1.5.0.1 +version: 1.5.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -105,7 +105,7 @@ library cardano-data >=1.0, cardano-ledger-binary >=1.0, cardano-ledger-byron, - cardano-ledger-core >=1.5 && <1.7, + cardano-ledger-core >=1.6 && <1.7, cardano-slotting, vector-map >=1.0, containers, diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs index 1e8a279d9fc..0dbff6c5bef 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Scripts.hs @@ -24,6 +24,7 @@ module Cardano.Ledger.Shelley.Scripts ( ), ScriptHash (..), nativeMultiSigTag, + eqMultiSigRaw, ) where @@ -41,15 +42,20 @@ import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto, HASH) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness)) import Cardano.Ledger.MemoBytes ( + EqRaw (..), Mem, MemoBytes, + Memoized (..), + getMemoRawType, memoBytes, pattern Memo, ) import Cardano.Ledger.SafeHash (SafeToHash (..)) import Cardano.Ledger.Shelley.Era +import Cardano.Ledger.TreeDiff (ToExpr) import Control.DeepSeq (NFData) import qualified Data.ByteString as BS +import Data.Functor.Classes (Eq1 (liftEq)) import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..)) @@ -84,10 +90,15 @@ deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (MultiSigRaw era) instance NFData (MultiSigRaw era) +instance ToExpr (MultiSigRaw era) + newtype MultiSig era = MultiSigConstr (MemoBytes MultiSigRaw era) deriving (Eq, Generic) deriving newtype (ToCBOR, NoThunks, SafeToHash) +instance Memoized MultiSig where + type RawType MultiSig = MultiSigRaw + deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (MultiSig era) -- | Magic number "memorialized" in the ValidateScript class under the method: @@ -116,6 +127,11 @@ deriving via instance Era era => DecCBOR (Annotator (MultiSig era)) +instance ToExpr (MultiSig era) + +instance EqRaw (MultiSig era) where + eqRaw = eqMultiSigRaw + pattern RequireSignature :: Era era => KeyHash 'Witness (EraCrypto era) -> MultiSig era pattern RequireSignature akh <- MultiSigConstr (Memo (RequireSignature' akh) _) @@ -164,3 +180,14 @@ instance Era era => DecCBOR (Annotator (MultiSigRaw era)) where multiSigs <- sequence <$> decCBOR pure (3, RequireMOf' m <$> multiSigs) k -> invalidKey k + +-- | Check the equality of two underlying types, while ignoring their binary +-- representation, which `Eq` instance normally does. This is used for testing. +eqMultiSigRaw :: MultiSig era -> MultiSig era -> Bool +eqMultiSigRaw t1 t2 = go (getMemoRawType t1) (getMemoRawType t2) + where + go (RequireSignature' kh1) (RequireSignature' kh2) = kh1 == kh2 + go (RequireAllOf' ts1) (RequireAllOf' ts2) = liftEq eqMultiSigRaw ts1 ts2 + go (RequireAnyOf' ts1) (RequireAnyOf' ts2) = liftEq eqMultiSigRaw ts1 ts2 + go (RequireMOf' n1 ts1) (RequireMOf' n2 ts2) = n1 == n2 && liftEq eqMultiSigRaw ts1 ts2 + go _ _ = False diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs index 9812c914782..627e00e2911 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs @@ -41,6 +41,7 @@ module Cardano.Ledger.Shelley.Tx ( minfee, shelleyMinFeeTx, witsFromTxWitnesses, + shelleyEqTxRaw, -- * Re-exports ShelleyTxBody (..), @@ -67,7 +68,14 @@ import Cardano.Ledger.Crypto (Crypto, StandardCrypto) import Cardano.Ledger.Keys (HasKeyRole (coerceKeyRole), KeyHash, KeyRole (Witness)) import Cardano.Ledger.Keys.Bootstrap (bootstrapWitKeyHash) import Cardano.Ledger.Keys.WitVKey (witVKeyHash) -import Cardano.Ledger.MemoBytes (Mem, MemoBytes, memoBytes, mkMemoBytes, pattern Memo) +import Cardano.Ledger.MemoBytes ( + EqRaw (..), + Mem, + MemoBytes, + memoBytes, + mkMemoBytes, + pattern Memo, + ) import Cardano.Ledger.SafeHash (SafeToHash (..)) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Era (ShelleyEra) @@ -80,6 +88,7 @@ import Cardano.Ledger.Val ((<+>), (<×>)) import Control.DeepSeq (NFData) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS +import Data.Functor.Classes (Eq1 (liftEq)) import Data.Map.Strict (Map) import Data.Maybe (mapMaybe) import Data.Maybe.Strict ( @@ -206,6 +215,18 @@ instance Crypto c => EraTx (ShelleyEra c) where getMinFeeTx = shelleyMinFeeTx +instance (Tx era ~ ShelleyTx era, EraTx era) => EqRaw (ShelleyTx era) where + eqRaw = shelleyEqTxRaw + +shelleyEqTxRaw :: EraTx era => Tx era -> Tx era -> Bool +shelleyEqTxRaw tx1 tx2 = + eqRaw (tx1 ^. bodyTxL) (tx2 ^. bodyTxL) + && eqRaw (tx1 ^. witsTxL) (tx2 ^. witsTxL) + && liftEq -- TODO: Implement Eq1 instance for StrictMaybe + eqRaw + (strictMaybeToMaybe (tx1 ^. auxDataTxL)) + (strictMaybeToMaybe (tx2 ^. auxDataTxL)) + deriving newtype instance ( NFData (TxBody era) , NFData (TxWits era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxAuxData.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxAuxData.hs index 6d7231f2248..8938138f004 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxAuxData.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxAuxData.hs @@ -60,6 +60,7 @@ import qualified Cardano.Ledger.Binary.Plain as Plain (ToCBOR (toCBOR), encodePr import Cardano.Ledger.Core (Era (..), EraTxAuxData (..), eraProtVerLow) import Cardano.Ledger.Crypto (Crypto) import Cardano.Ledger.Hashes (EraIndependentTxAuxData) +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Cardano.Ledger.SafeHash ( HashAnnotated, SafeHash, @@ -128,6 +129,9 @@ instance Crypto c => EraTxAuxData (ShelleyEra c) where where index = Proxy @EraIndependentTxAuxData +instance EqRaw (ShelleyTxAuxData era) where + eqRaw txAuxData1 txAuxData2 = mdMap txAuxData1 == mdMap txAuxData2 + instance NFData (ShelleyTxAuxData era) where rnf m = mdMap m `deepseq` rnf (mdBytes m) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs index 0703dac9cc7..7038e5e0b5b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs @@ -92,6 +92,7 @@ import Cardano.Ledger.Crypto (Crypto, StandardCrypto) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Ledger.Keys.WitVKey import Cardano.Ledger.MemoBytes ( + EqRaw (..), Mem, MemoBytes, MemoHashIndex, @@ -267,6 +268,10 @@ newtype ShelleyTxBody era = TxBodyConstr (MemoBytes ShelleyTxBodyRaw era) instance Memoized ShelleyTxBody where type RawType ShelleyTxBody = ShelleyTxBodyRaw +instance + (Era era, Eq (TxOut era), Eq (TxCert era), Eq (PParamsUpdate era)) => + EqRaw (ShelleyTxBody era) + instance Crypto c => EraTxBody (ShelleyEra c) where {-# SPECIALIZE instance EraTxBody (ShelleyEra StandardCrypto) #-} diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs index adfa573a830..e8ea3dccc22 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs @@ -100,6 +100,7 @@ import Cardano.Ledger.Credential (Credential (..), StakeCredential, credKeyHashW import Cardano.Ledger.Crypto import Cardano.Ledger.Keys (Hash, KeyHash (..), KeyRole (..), VerKeyVRF, asWitness) import Cardano.Ledger.Shelley.Era (ShelleyEra) +import Cardano.Ledger.TreeDiff (ToExpr) import Control.DeepSeq (NFData (..), rwhnf) import Data.Map.Strict (Map) import Data.Maybe (isJust, isNothing) @@ -236,6 +237,8 @@ instance NoThunks (GenesisDelegCert c) instance NFData (GenesisDelegCert c) where rnf = rwhnf +instance ToExpr (GenesisDelegCert c) + genesisKeyHashWitness :: GenesisDelegCert c -> KeyHash 'Witness c genesisKeyHashWitness (GenesisDelegCert gk _ _) = asWitness gk @@ -258,6 +261,8 @@ instance DecCBOR MIRPot where 1 -> pure TreasuryMIR k -> invalidKey k +instance ToExpr MIRPot + -- | MIRTarget specifies if funds from either the reserves -- or the treasury are to be handed out to a collection of -- reward accounts or instead transfered to the opposite pot. @@ -280,6 +285,8 @@ instance Crypto c => EncCBOR (MIRTarget c) where encCBOR (StakeAddressesMIR m) = encCBOR m encCBOR (SendToOppositePotMIR c) = encCBOR c +instance ToExpr (MIRTarget c) + -- | Move instantaneous rewards certificate data MIRCert c = MIRCert { mirPot :: !MIRPot @@ -299,6 +306,8 @@ instance Crypto c => EncCBOR (MIRCert c) where <> encCBOR pot <> encCBOR targets +instance ToExpr (MIRCert c) + -- | A heavyweight certificate. data ShelleyTxCert era = ShelleyTxCertDelegCert !(ShelleyDelegCert (EraCrypto era)) @@ -309,6 +318,8 @@ data ShelleyTxCert era instance NoThunks (ShelleyTxCert era) +instance ToExpr (ShelleyTxCert era) + upgradeShelleyTxCert :: EraCrypto era1 ~ EraCrypto era2 => ShelleyTxCert era1 -> @@ -429,6 +440,8 @@ data ShelleyDelegCert c ShelleyDelegCert !(StakeCredential c) !(KeyHash 'StakePool c) deriving (Show, Generic, Eq) +instance ToExpr (ShelleyDelegCert c) + pattern RegKey :: StakeCredential c -> ShelleyDelegCert c pattern RegKey cred = ShelleyRegCert cred {-# DEPRECATED RegKey "In favor of `ShelleyRegCert`" #-} diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs index 353e26b4e1e..4f750d8c9c8 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs @@ -14,6 +14,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -34,6 +35,7 @@ module Cardano.Ledger.Shelley.TxWits ( bootAddrShelleyTxWitsL, addrWits', prettyWitnessSetParts, + shelleyEqTxWitsRaw, -- * Re-exports WitVKey (..), @@ -67,6 +69,7 @@ import Cardano.Ledger.HKD (HKD) import Cardano.Ledger.Keys (KeyRole (Witness)) import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness) import Cardano.Ledger.Keys.WitVKey (WitVKey (..), witVKeyHash) +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Cardano.Ledger.SafeHash (SafeToHash (..)) import Cardano.Ledger.Shelley.Era (ShelleyEra) import Cardano.Ledger.Shelley.Scripts () @@ -74,6 +77,7 @@ import Cardano.Ledger.Shelley.TxAuxData () import Control.DeepSeq (NFData) import qualified Data.ByteString.Lazy as BSL import Data.Foldable (fold) +import Data.Functor.Classes (Eq1 (liftEq)) import Data.Functor.Identity (Identity) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -83,7 +87,7 @@ import qualified Data.Set as Set import Data.Typeable (Typeable) import GHC.Generics (Generic) import GHC.Records () -import Lens.Micro (Lens', lens) +import Lens.Micro (Lens', lens, (^.)) import NoThunks.Class (AllowThunksIn (..), NoThunks (..)) data WitnessSetHKD f era = WitnessSet' @@ -186,6 +190,9 @@ instance Crypto c => EraTxWits (ShelleyEra c) where scriptTxWitsL = scriptShelleyTxWitsL {-# INLINE scriptTxWitsL #-} +instance (TxWits era ~ ShelleyTxWits era, EraTxWits era) => EqRaw (ShelleyTxWits era) where + eqRaw = shelleyEqTxWitsRaw + instance Era era => Plain.ToCBOR (ShelleyTxWits era) where toCBOR (ShelleyTxWitsConstr w) = Plain.encodePreEncoded $ BSL.toStrict $ txWitsBytes w @@ -232,6 +239,12 @@ pattern ShelleyTxWits {addrWits, scriptWits, bootWits} <- {-# COMPLETE ShelleyTxWits #-} +shelleyEqTxWitsRaw :: EraTxWits era => TxWits era -> TxWits era -> Bool +shelleyEqTxWitsRaw txWits1 txWits2 = + liftEq eqRaw (txWits1 ^. addrTxWitsL) (txWits2 ^. addrTxWitsL) + && liftEq eqRaw (txWits1 ^. scriptTxWitsL) (txWits2 ^. scriptTxWitsL) + && liftEq eqRaw (txWits1 ^. bootAddrTxWitsL) (txWits2 ^. bootAddrTxWitsL) + instance SafeToHash (ShelleyTxWits era) where originalBytes (ShelleyTxWitsConstr w) = BSL.toStrict $ txWitsBytes w diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index b6c78c2ec15..d8764c16974 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -2,7 +2,13 @@ ## 1.6.0.0 -* +* Add `eqBootstrapWitnessRaw` and `eqWitVKeyRaw` +* Add `eqRawType` +* Add `EqRaw` type class with `eqRaw`. +* Add `EqRaw` instance for `WitVKey` and `BootstrapWitness` +* Require `EqRaw` instance for `Script`, `TxWits`, `TxAuxData`, `TxBody` and `Tx` +* Add `ToExpr` instance for `PoolCert` +* Require `ToExpr` instance for `Script`, `TxAuxData` and `TxCert` ## 1.5.0.0 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs index e9ea74965b2..fef35416313 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs @@ -109,8 +109,10 @@ import Cardano.Ledger.Keys (KeyRole (Staking, Witness)) import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness) import Cardano.Ledger.Keys.WitVKey (WitVKey) import Cardano.Ledger.Language (Plutus) +import Cardano.Ledger.MemoBytes import Cardano.Ledger.Rewards (Reward (..), RewardType (..)) import Cardano.Ledger.SafeHash (HashAnnotated (..), SafeToHash (..)) +import Cardano.Ledger.TreeDiff (ToExpr) import Cardano.Ledger.TxIn (TxIn (..)) import Cardano.Ledger.Val (Val (..)) import Control.DeepSeq (NFData) @@ -142,6 +144,7 @@ class , ToCBOR (Tx era) , Show (Tx era) , Eq (Tx era) + , EqRaw (Tx era) ) => EraTx era where @@ -173,6 +176,7 @@ class , NFData (TxBody era) , Show (TxBody era) , Eq (TxBody era) + , EqRaw (TxBody era) ) => EraTxBody era where @@ -372,11 +376,13 @@ type family Value era :: Type class ( Era era , Eq (TxAuxData era) + , EqRaw (TxAuxData era) , Show (TxAuxData era) , NoThunks (TxAuxData era) , ToCBOR (TxAuxData era) , EncCBOR (TxAuxData era) , DecCBOR (Annotator (TxAuxData era)) + , ToExpr (TxAuxData era) , HashAnnotated (TxAuxData era) EraIndependentTxAuxData (EraCrypto era) ) => EraTxAuxData era @@ -410,6 +416,7 @@ validateAuxiliaryData = validateTxAuxData class ( EraScript era , Eq (TxWits era) + , EqRaw (TxWits era) , Show (TxWits era) , Monoid (TxWits era) , NoThunks (TxWits era) @@ -457,11 +464,13 @@ class ( Era era , Show (Script era) , Eq (Script era) + , EqRaw (Script era) , ToCBOR (Script era) , EncCBOR (Script era) , DecCBOR (Annotator (Script era)) , NoThunks (Script era) , SafeToHash (Script era) + , ToExpr (Script era) ) => EraScript era where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/TxCert.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/TxCert.hs index 8b3693cf864..127d935ec9a 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/TxCert.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/TxCert.hs @@ -62,6 +62,7 @@ class , NFData (TxCert era) , Show (TxCert era) , Eq (TxCert era) + , ToExpr (TxCert era) ) => EraTxCert era where @@ -136,6 +137,8 @@ instance NoThunks (PoolCert c) instance NFData (PoolCert c) where rnf = rwhnf +instance ToExpr (PoolCert c) + poolCertKeyHashWitness :: PoolCert c -> KeyHash 'Witness c poolCertKeyHashWitness = \case RegPool poolParams -> asWitness $ ppId poolParams diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs index df9caeeaeac..bc5278d4e75 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs @@ -27,6 +27,7 @@ module Cardano.Ledger.Keys.Bootstrap ( unpackByronVKey, makeBootstrapWitness, verifyBootstrapWit, + eqBootstrapWitnessRaw, ) where @@ -61,6 +62,7 @@ import Cardano.Ledger.Keys ( verifySignedDSIGN, ) import qualified Cardano.Ledger.Keys as Keys +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Control.DeepSeq (NFData) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS @@ -233,3 +235,13 @@ makeBootstrapWitness txBodyHash byronSigningKey addrAttributes = (mempty :: ByteString) (Byron.unSigningKey byronSigningKey) (Hash.hashToBytes txBodyHash) + +eqBootstrapWitnessRaw :: Crypto c => BootstrapWitness c -> BootstrapWitness c -> Bool +eqBootstrapWitnessRaw bw1 bw2 = + bwKey bw1 == bwKey bw2 + && bwSig bw1 == bwSig bw2 + && bwChainCode bw1 == bwChainCode bw2 + && bwAttributes bw1 == bwAttributes bw2 + +instance Crypto c => EqRaw (BootstrapWitness c) where + eqRaw = eqBootstrapWitnessRaw diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/WitVKey.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/WitVKey.hs index 9ed3a69a47a..fabf0b6678e 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/WitVKey.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/WitVKey.hs @@ -13,6 +13,7 @@ module Cardano.Ledger.Keys.WitVKey ( WitVKey (WitVKey), witVKeyBytes, witVKeyHash, + eqWitVKeyRaw, ) where @@ -41,6 +42,7 @@ import Cardano.Ledger.Keys ( hashKey, hashSignature, ) +import Cardano.Ledger.MemoBytes (EqRaw (..)) import Control.DeepSeq import qualified Data.ByteString.Lazy as BSL import Data.Ord (comparing) @@ -101,6 +103,9 @@ instance (Typeable kr, Crypto c) => DecCBOR (Annotator (WitVKey kr c)) where {-# INLINE mkWitVKey #-} {-# INLINE decCBOR #-} +instance (Crypto c, Typeable kr) => EqRaw (WitVKey kr c) where + eqRaw = eqWitVKeyRaw + pattern WitVKey :: (Typeable kr, Crypto c) => VKey kr c -> @@ -127,3 +132,6 @@ witVKeyHash = wvkKeyHash -- | Access CBOR encoded representation of the witness. Evaluated lazily witVKeyBytes :: WitVKey kr c -> BSL.ByteString witVKeyBytes = wvkBytes + +eqWitVKeyRaw :: (Crypto c, Typeable kr) => WitVKey kr c -> WitVKey kr c -> Bool +eqWitVKeyRaw (WitVKey k1 s1) (WitVKey k2 s2) = k1 == k2 && s1 == s2 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes.hs index fee9132fb44..1283a8d9921 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/MemoBytes.hs @@ -15,6 +15,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | MemoBytes is an abstraction for a data type that encodes its own serialization. @@ -43,9 +44,13 @@ module Cardano.Ledger.MemoBytes ( getMemoSafeHash, getMemoRawType, zipMemoRawType, + eqRawType, getMemoRawBytes, lensMemoRawType, getterMemoRawType, + + -- * Raw equality + EqRaw (..), ) where @@ -59,7 +64,7 @@ import Cardano.Ledger.Binary ( ) import Cardano.Ledger.Binary.Coders (Encode, encode, runE) import qualified Cardano.Ledger.Binary.Plain as Plain -import Cardano.Ledger.Core (Era (EraCrypto), eraProtVerLow) +import Cardano.Ledger.Core.Era (Era (EraCrypto), eraProtVerLow) import Cardano.Ledger.Crypto (HASH) import Cardano.Ledger.SafeHash (SafeHash, SafeToHash (..)) import Cardano.Ledger.TreeDiff (ToExpr) @@ -227,6 +232,14 @@ zipMemoRawType :: a zipMemoRawType f x y = f (getMemoRawType x) (getMemoRawType y) +eqRawType :: + forall t era. + (Memoized t, Eq (RawType t era)) => + t era -> + t era -> + Bool +eqRawType = zipMemoRawType @t (==) + -- | This is a helper Lens creator for any Memoized type. lensMemoRawType :: (Era era, EncCBOR (RawType t era), Memoized t) => @@ -245,3 +258,10 @@ getterMemoRawType :: getterMemoRawType getter = to (getter . getMemoRawType) {-# INLINEABLE getterMemoRawType #-} + +-- | Type class that implements equality on the Haskell type, ignoring any of the +-- potentially memoized binary representation of the type. +class EqRaw a where + eqRaw :: a -> a -> Bool + default eqRaw :: (a ~ t era, Memoized t, Eq (RawType t era)) => a -> a -> Bool + eqRaw = eqRawType diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs index 24b9e67d3cd..70379ec0c49 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs @@ -4,14 +4,13 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module Test.Cardano.Ledger.Core.Binary where import Cardano.Ledger.Core -import Cardano.Ledger.MemoBytes (Memoized (RawType), zipMemoRawType) +import Cardano.Ledger.MemoBytes (EqRaw (eqRaw)) import Test.Cardano.Ledger.Binary.RoundTrip -import Test.Cardano.Ledger.Binary.TreeDiff (ToExpr, expectExprEqual) +import Test.Cardano.Ledger.Binary.TreeDiff (diffExpr) import Test.Cardano.Ledger.Common specTxOutUpgrade :: @@ -60,13 +59,9 @@ specTxCertUpgrade = -- can be used with MemoBytes, which requires `t` to be of such kind, because it is later -- applied to `era`. specTxAuxDataUpgrade :: - forall era t. + forall era. ( EraTxAuxData (PreviousEra era) , EraTxAuxData era - , t era ~ TxAuxData era - , Memoized t - , Eq (RawType t era) - , ToExpr (RawType t era) , Arbitrary (TxAuxData (PreviousEra era)) , HasCallStack ) => @@ -78,10 +73,12 @@ specTxAuxDataUpgrade = expectationFailure $ "Expected to deserialize: =======================================================\n" ++ show err - Right (curTxAuxData :: t era) -> - -- We need to do all this MemoBytes trickery because underlying bytes and thus the - -- equality of the same type will no longer be the same, despite that the value will - zipMemoRawType @t @t expectExprEqual curTxAuxData (upgradeTxAuxData prevTxAuxData) + Right (curTxAuxData :: TxAuxData era) -> do + let upgradedTxAuxData = upgradeTxAuxData prevTxAuxData + unless (eqRaw curTxAuxData upgradedTxAuxData) $ + expectationFailure $ + "Expected raw representation of TxAuxData to be equal: \n" + <> diffExpr curTxAuxData upgradedTxAuxData specScriptUpgrade :: forall era. @@ -102,7 +99,7 @@ specScriptUpgrade = curScript `shouldBe` upgradeScript prevScript specUpgrade :: - forall era txAuxData. + forall era. ( EraTxOut (PreviousEra era) , EraTxOut era , Arbitrary (TxOut (PreviousEra era)) @@ -111,10 +108,6 @@ specUpgrade :: , Arbitrary (TxCert (PreviousEra era)) , EraTxAuxData (PreviousEra era) , EraTxAuxData era - , txAuxData era ~ TxAuxData era -- See specTxAuxDataUpgrade for `txAuxData` explanation. - , Memoized txAuxData - , Eq (RawType txAuxData era) - , ToExpr (RawType txAuxData era) , Arbitrary (TxAuxData (PreviousEra era)) , EraScript (PreviousEra era) , EraScript era @@ -127,6 +120,6 @@ specUpgrade isScriptUpgradeable = describe ("Upgrade from " ++ eraName @(PreviousEra era) ++ " to " ++ eraName @era) $ do specTxOutUpgrade @era specTxCertUpgrade @era - specTxAuxDataUpgrade @era @txAuxData + specTxAuxDataUpgrade @era when isScriptUpgradeable $ specScriptUpgrade @era