From 0f3555bac717b75e24bf871010abdf4d53dc99ec Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 21 Feb 2025 15:31:13 -0700 Subject: [PATCH 1/4] Disbale conditional decdoing for `Coin` --- libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs index 1755887a470..84a2579edcd 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs @@ -47,10 +47,7 @@ import Cardano.Ledger.Binary ( EncCBOR (..), FromCBOR (..), ToCBOR, - decodeInteger, decodeWord64, - ifDecoderVersionAtLeast, - natVersion, ) import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Compactible @@ -89,12 +86,7 @@ newtype Coin = Coin {unCoin :: Integer} instance FromCBOR Coin where fromCBOR = Coin . toInteger <$> Plain.decodeWord64 -instance DecCBOR Coin where - decCBOR = - ifDecoderVersionAtLeast - (natVersion @9) - (Coin . fromIntegral <$> decodeWord64) - (Coin <$> decodeInteger) +instance DecCBOR Coin newtype DeltaCoin = DeltaCoin Integer deriving (Eq, Ord, Generic, Enum, NoThunks, HeapWords) From 70784297813b1c09e0bb797dc9b4becbb2d503ed Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 22 Feb 2025 16:01:16 -0700 Subject: [PATCH 2/4] Remove `IgnoreSigOrd` as no longer necessary --- .../impl/src/Cardano/Ledger/Shelley/TxWits.hs | 32 +++---------------- 1 file changed, 5 insertions(+), 27 deletions(-) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs index 633d7e3a6f6..f6cec22cbeb 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs @@ -56,7 +56,7 @@ import Cardano.Ledger.Core ( hashScript, ) import Cardano.Ledger.Hashes (SafeToHash (..)) -import Cardano.Ledger.Keys (BootstrapWitness, KeyRole (Witness), WitVKey (..), witVKeyHash) +import Cardano.Ledger.Keys (BootstrapWitness, KeyRole (Witness), WitVKey (..)) import Cardano.Ledger.MemoBytes ( EqRaw (..), Mem, @@ -77,7 +77,6 @@ import qualified Data.Map.Strict as Map import qualified Data.MapExtras as Map (fromElems) import Data.Set (Set) import qualified Data.Set as Set -import Data.Typeable (Typeable) import GHC.Generics (Generic) import GHC.Records () import Lens.Micro (Lens', (^.)) @@ -228,7 +227,7 @@ deriving via instance EraScript era => DecCBOR (Annotator (ShelleyTxWits era)) -instance forall era. (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWitsRaw era) where +instance (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWitsRaw era) where decCBOR = decode $ SparseKeyed @@ -238,31 +237,14 @@ instance forall era. (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTx [] where witField :: Word -> Field (ShelleyTxWitsRaw era) - witField 0 = - field - (\x wits -> wits {addrWits' = x}) - (D $ withIgnoreSigOrd <$> decodeList decCBOR) + witField 0 = field (\x wits -> wits {addrWits' = x}) From witField 1 = field (\x wits -> wits {scriptWits' = x}) (D $ Map.fromElems (hashScript @era) <$> decodeList decCBOR) - witField 2 = - field - (\x wits -> wits {bootWits' = x}) - (D $ Set.fromList <$> decodeList decCBOR) + witField 2 = field (\x wits -> wits {bootWits' = x}) From witField n = field (\_ wits -> wits) (Invalid n) --- | This type is only used to preserve the old buggy behavior where signature --- was ignored in the `Ord` instance for `WitVKey`s. -newtype IgnoreSigOrd kr = IgnoreSigOrd {unIgnoreSigOrd :: WitVKey kr} - deriving (Eq) - -withIgnoreSigOrd :: Typeable kr => [WitVKey kr] -> Set (WitVKey kr) -withIgnoreSigOrd = Set.map unIgnoreSigOrd . Set.fromList . fmap IgnoreSigOrd - -instance Typeable kr => Ord (IgnoreSigOrd kr) where - compare (IgnoreSigOrd w1) (IgnoreSigOrd w2) = compare (witVKeyHash w1) (witVKeyHash w2) - decodeWits :: forall era s. EraScript era => @@ -280,11 +262,7 @@ decodeWits = witField 0 = fieldAA (\x wits -> wits {addrWits' = x}) - ( D $ - mapTraverseableDecoderA - (decodeList decCBOR) - withIgnoreSigOrd - ) + (D $ mapTraverseableDecoderA (decodeList decCBOR) Set.fromList) witField 1 = fieldAA (\x wits -> wits {scriptWits' = x}) From 19a55ef514453c9d34c373f1f93ab01f85a8f54f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 24 Feb 2025 20:01:39 -0700 Subject: [PATCH 3/4] Add a comment about inability to remove buggy translation --- eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs index 77185d5af94..64bbc6b01a5 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs @@ -506,10 +506,12 @@ transTxBodyWithdrawals :: EraTxBody era => TxBody era -> PV3.Map PV3.Credential transTxBodyWithdrawals txBody = transMap transRewardAccount transCoinToLovelace (unWithdrawals $ txBody ^. withdrawalsTxBodyL) --- | In version 9, a bug in `RegTxCert` and `UnRegTxCert` pattern definitions --- was causing the deposit in `RegDepositTxCert` and `UnRegDepositTxCert` to be omitted. --- We need to keep this behavior for version 9, so, now that the bug in the patterns has been fixed, --- we are explicitly omitting the deposit in these cases. +-- | In protocol version 9, a bug in `RegTxCert` and `UnRegTxCert` pattern definitions was causing +-- the deposit in `RegDepositTxCert` and `UnRegDepositTxCert` to be omitted. We need to keep this +-- behavior for version 9, so, now that the bug in the patterns has been fixed, we are explicitly +-- omitting the deposit in these cases. It has been confirmed that this buggy behavior for protocol +-- version 9 has been exercised on Mainnet, therefore this conditional translation can never be +-- removed for Conway era (#4863) transTxCert :: ConwayEraTxCert era => ProtVer -> TxCert era -> PV3.TxCert transTxCert pv = \case RegPoolTxCert PoolParams {ppId, ppVrf} -> From 6d53ad29086d30b98d2fefc8bee7c524952a85f1 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 25 Feb 2025 13:52:29 -0700 Subject: [PATCH 4/4] Remove the no longer valid test --- eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs index aa515862e93..da46b9f2ecb 100644 --- a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs +++ b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs @@ -24,7 +24,6 @@ import Test.Cardano.Data import Test.Cardano.Ledger.Binary.RoundTrip ( roundTripCborExpectation, roundTripCborFailureExpectation, - roundTripCborRangeExpectation, roundTripCborRangeFailureExpectation, ) import Test.Cardano.Ledger.Common @@ -47,10 +46,8 @@ spec = do context "Coin" $ do prop "Non-negative Coin succeeds for all eras" $ \(NonNegative i) -> roundTripCborExpectation (Coin i) - prop "Negative Coin succeeds for pre-Conway" $ - \(Negative i) -> roundTripCborRangeExpectation minBound (natVersion @8) (Coin i) - prop "Negative Coin fails to deserialise for Conway" $ - \(Negative i) -> roundTripCborRangeFailureExpectation (natVersion @9) (natVersion @9) (Coin i) + prop "Negative Coin fails to deserialise for all eras" $ + \(Negative i) -> roundTripCborRangeFailureExpectation (natVersion @0) maxBound (Coin i) context "MultiAsset" $ do prop "Non-zero-valued MultiAsset succeeds for all eras" $ roundTripCborExpectation @MultiAsset