Merge pull request #4711 from IntersectMBO/aniketd/mismatch-for-other…

…-eras Use Mismatch for Shelley, Mary, Allegra, Alonzo, Babbage
IntersectMBO · Oct 25, 2024 · d62d17d · d62d17d
2 parents d44f581 + a32a058
commit d62d17d
Show file tree

Hide file tree

Showing 34 changed files with 313 additions and 502 deletions.
diff --git a/eras/allegra/impl/CHANGELOG.md b/eras/allegra/impl/CHANGELOG.md
@@ -1,8 +1,8 @@
 # Version history for `cardano-ledger-allegra`
 
-## 1.6.0.2
+## 1.6.1.0
 
-*
+* Use `Mismatch` to clarify predicate failures. #4711
 
 ## 1.6.0.1
 

diff --git 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.6.0.1
+version:            1.6.1.0
 license:            Apache-2.0
 maintainer:         operations@iohk.io
 author:             IOHK

diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs
@@ -32,18 +32,13 @@ import Cardano.Ledger.BaseTypes (
   Mismatch (..),
   Network,
   ProtVer (pvMajor),
+  Relation (..),
   ShelleyBase,
   StrictMaybe (..),
   networkId,
  )
-import Cardano.Ledger.Binary (
-  DecCBOR (..),
-  EncCBOR (..),
-  decodeRecordSum,
-  encodeListLen,
-  invalidKey,
-  serialize,
- )
+import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), serialize)
+import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.CertState (certDState, dsGenDelegs)
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Crypto (Crypto)
@@ -58,11 +53,7 @@ import Cardano.Ledger.Shelley.Rules (
  )
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
 import Cardano.Ledger.TxIn (TxIn)
-import Cardano.Ledger.UTxO (
-  EraUTxO (..),
-  UTxO (..),
-  txouts,
- )
+import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), txouts)
 import qualified Cardano.Ledger.Val as Val
 import Cardano.Slotting.Slot (SlotNo)
 import Control.DeepSeq (NFData)
@@ -73,7 +64,6 @@ import Data.Foldable (toList)
 import Data.Int (Int64)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
-import Data.Word (Word8)
 import GHC.Generics (Generic)
 import Lens.Micro
 import NoThunks.Class (NoThunks)
@@ -87,16 +77,10 @@ data AllegraUtxoPredFailure era
   | OutsideValidityIntervalUTxO
       !ValidityInterval -- transaction's validity interval
       !SlotNo -- current slot
-  | MaxTxSizeUTxO
-      !Integer -- the actual transaction size
-      !Integer -- the max transaction size
+  | MaxTxSizeUTxO !(Mismatch 'RelLTEQ Integer)
   | InputSetEmptyUTxO
-  | FeeTooSmallUTxO
-      !Coin -- the minimum fee for this transaction
-      !Coin -- the fee supplied in this transaction
-  | ValueNotConservedUTxO
-      !(Value era) -- the Coin consumed by this transaction
-      !(Value era) -- the Coin produced by this transaction
+  | FeeTooSmallUTxO !(Mismatch 'RelGTEQ Coin)
+  | ValueNotConservedUTxO !(Mismatch 'RelEQ (Value era)) -- Consumed, then produced
   | WrongNetwork
       !Network -- the expected network id
       !(Set (Addr (EraCrypto era))) -- the set of addresses with incorrect network IDs
@@ -160,7 +144,7 @@ data AllegraUtxoEvent era
     TxUTxODiff
       -- | UTxO consumed
       (UTxO era)
-      -- | UTxO created
+      -- | UTxO created (produced)
       (UTxO era)
   deriving (Generic)
 
@@ -363,119 +347,54 @@ instance
   ) =>
   EncCBOR (AllegraUtxoPredFailure era)
   where
-  encCBOR = \case
-    BadInputsUTxO ins ->
-      encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR ins
-    (OutsideValidityIntervalUTxO a b) ->
-      encodeListLen 3
-        <> encCBOR (1 :: Word8)
-        <> encCBOR a
-        <> encCBOR b
-    (MaxTxSizeUTxO a b) ->
-      encodeListLen 3
-        <> encCBOR (2 :: Word8)
-        <> encCBOR a
-        <> encCBOR b
-    InputSetEmptyUTxO -> encodeListLen 1 <> encCBOR (3 :: Word8)
-    (FeeTooSmallUTxO a b) ->
-      encodeListLen 3
-        <> encCBOR (4 :: Word8)
-        <> encCBOR a
-        <> encCBOR b
-    (ValueNotConservedUTxO a b) ->
-      encodeListLen 3
-        <> encCBOR (5 :: Word8)
-        <> encCBOR a
-        <> encCBOR b
-    OutputTooSmallUTxO outs ->
-      encodeListLen 2
-        <> encCBOR (6 :: Word8)
-        <> encCBOR outs
-    (UpdateFailure a) ->
-      encodeListLen 2
-        <> encCBOR (7 :: Word8)
-        <> encCBOR a
-    (WrongNetwork right wrongs) ->
-      encodeListLen 3
-        <> encCBOR (8 :: Word8)
-        <> encCBOR right
-        <> encCBOR wrongs
-    (WrongNetworkWithdrawal right wrongs) ->
-      encodeListLen 3
-        <> encCBOR (9 :: Word8)
-        <> encCBOR right
-        <> encCBOR wrongs
-    OutputBootAddrAttrsTooBig outs ->
-      encodeListLen 2
-        <> encCBOR (10 :: Word8)
-        <> encCBOR outs
-    TriesToForgeADA -> encodeListLen 1 <> encCBOR (11 :: Word8)
-    OutputTooBigUTxO outs ->
-      encodeListLen 2
-        <> encCBOR (12 :: Word8)
-        <> encCBOR outs
+  encCBOR =
+    encode . \case
+      BadInputsUTxO ins -> Sum BadInputsUTxO 0 !> To ins
+      OutsideValidityIntervalUTxO validityInterval slot ->
+        Sum OutsideValidityIntervalUTxO 1 !> To validityInterval !> To slot
+      MaxTxSizeUTxO m -> Sum MaxTxSizeUTxO 2 !> To m
+      InputSetEmptyUTxO -> Sum InputSetEmptyUTxO 3
+      FeeTooSmallUTxO m -> Sum FeeTooSmallUTxO 4 !> To m
+      ValueNotConservedUTxO m -> Sum ValueNotConservedUTxO 5 !> To m
+      OutputTooSmallUTxO outs -> Sum OutputTooSmallUTxO 6 !> To outs
+      UpdateFailure fails -> Sum UpdateFailure 7 !> To fails
+      WrongNetwork right wrongs -> Sum WrongNetwork 8 !> To right !> To wrongs
+      WrongNetworkWithdrawal right wrongs -> Sum WrongNetworkWithdrawal 9 !> To right !> To wrongs
+      OutputBootAddrAttrsTooBig outs -> Sum OutputBootAddrAttrsTooBig 10 !> To outs
+      TriesToForgeADA -> Sum TriesToForgeADA 11
+      OutputTooBigUTxO outs -> Sum OutputTooBigUTxO 12 !> To outs
 
 instance
   ( EraTxOut era
   , DecCBOR (EraRuleFailure "PPUP" era)
   ) =>
   DecCBOR (AllegraUtxoPredFailure era)
   where
-  decCBOR =
-    decodeRecordSum "PredicateFailureUTXO" $
-      \case
-        0 -> do
-          ins <- decCBOR
-          pure (2, BadInputsUTxO ins) -- The (2,..) indicates the number of things decoded, INCLUDING the tags, which are decoded by decodeRecordSumNamed
-        1 -> do
-          a <- decCBOR
-          b <- decCBOR
-          pure (3, OutsideValidityIntervalUTxO a b)
-        2 -> do
-          a <- decCBOR
-          b <- decCBOR
-          pure (3, MaxTxSizeUTxO a b)
-        3 -> pure (1, InputSetEmptyUTxO)
-        4 -> do
-          a <- decCBOR
-          b <- decCBOR
-          pure (3, FeeTooSmallUTxO a b)
-        5 -> do
-          a <- decCBOR
-          b <- decCBOR
-          pure (3, ValueNotConservedUTxO a b)
-        6 -> do
-          outs <- decCBOR
-          pure (2, OutputTooSmallUTxO outs)
-        7 -> do
-          a <- decCBOR
-          pure (2, UpdateFailure a)
-        8 -> do
-          right <- decCBOR
-          wrongs <- decCBOR
-          pure (3, WrongNetwork right wrongs)
-        9 -> do
-          right <- decCBOR
-          wrongs <- decCBOR
-          pure (3, WrongNetworkWithdrawal right wrongs)
-        10 -> do
-          outs <- decCBOR
-          pure (2, OutputBootAddrAttrsTooBig outs)
-        11 -> pure (1, TriesToForgeADA)
-        12 -> do
-          outs <- decCBOR
-          pure (2, OutputTooBigUTxO outs)
-        k -> invalidKey k
+  decCBOR = decode . Summands "AllegraUtxoPredFailure" $ \case
+    0 -> SumD BadInputsUTxO <! From
+    1 -> SumD OutsideValidityIntervalUTxO <! From <! From
+    2 -> SumD MaxTxSizeUTxO <! From
+    3 -> SumD InputSetEmptyUTxO
+    4 -> SumD FeeTooSmallUTxO <! From
+    5 -> SumD ValueNotConservedUTxO <! From
+    6 -> SumD OutputTooSmallUTxO <! From
+    7 -> SumD UpdateFailure <! From
+    8 -> SumD WrongNetwork <! From <! From
+    9 -> SumD WrongNetworkWithdrawal <! From <! From
+    10 -> SumD OutputBootAddrAttrsTooBig <! From
+    11 -> SumD TriesToForgeADA
+    12 -> SumD OutputTooBigUTxO <! From
+    k -> Invalid k
 
 shelleyToAllegraUtxoPredFailure :: Shelley.ShelleyUtxoPredFailure era -> AllegraUtxoPredFailure era
 shelleyToAllegraUtxoPredFailure = \case
   Shelley.BadInputsUTxO ins -> BadInputsUTxO ins
-  Shelley.ExpiredUTxO ttl current ->
+  Shelley.ExpiredUTxO Mismatch {mismatchSupplied = ttl, mismatchExpected = current} ->
     OutsideValidityIntervalUTxO (ValidityInterval SNothing (SJust ttl)) current
-  Shelley.MaxTxSizeUTxO (Mismatch a m) -> MaxTxSizeUTxO a m
+  Shelley.MaxTxSizeUTxO m -> MaxTxSizeUTxO m
   Shelley.InputSetEmptyUTxO -> InputSetEmptyUTxO
-  Shelley.FeeTooSmallUTxO (Mismatch sf ef) -> FeeTooSmallUTxO ef sf
-  Shelley.ValueNotConservedUTxO vc vp -> ValueNotConservedUTxO vc vp
+  Shelley.FeeTooSmallUTxO m -> FeeTooSmallUTxO m
+  Shelley.ValueNotConservedUTxO m -> ValueNotConservedUTxO m
   Shelley.WrongNetwork n as -> WrongNetwork n as
   Shelley.WrongNetworkWithdrawal n as -> WrongNetworkWithdrawal n as
   Shelley.OutputTooSmallUTxO x -> OutputTooSmallUTxO x

diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md
@@ -2,7 +2,7 @@
 
 ## 1.12.0.0
 
-*
+* Use `Mismatch` to clarify predicate failures. #4711
 
 ### `testlib`
 

diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal
@@ -79,7 +79,7 @@ library
         base64-bytestring,
         bytestring,
         cardano-data ^>=1.2.1,
-        cardano-ledger-allegra ^>=1.6,
+        cardano-ledger-allegra ^>=1.6.1,
         cardano-crypto-class,
         cardano-ledger-binary ^>=1.5,
         cardano-ledger-core ^>=1.15,

diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs
@@ -33,7 +33,7 @@ import Cardano.Ledger.Alonzo.Tx (AlonzoTx, totExUnits)
 import Cardano.Ledger.Alonzo.TxSeq (AlonzoTxSeq, txSeqTxns)
 import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
 import Cardano.Ledger.BHeaderView (BHeaderView (..), isOverlaySlot)
-import Cardano.Ledger.BaseTypes (Mismatch (..), ShelleyBase, epochInfoPure)
+import Cardano.Ledger.BaseTypes (Mismatch (..), Relation (..), ShelleyBase, epochInfoPure)
 import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Block (Block (..))
@@ -82,11 +82,7 @@ import NoThunks.Class (NoThunks (..))
 
 data AlonzoBbodyPredFailure era
   = ShelleyInAlonzoBbodyPredFailure (ShelleyBbodyPredFailure era)
-  | TooManyExUnits
-      -- | Computed Sum of ExUnits for all plutus scripts
-      !ExUnits
-      -- | Maximum allowed by protocal parameters
-      !ExUnits
+  | TooManyExUnits !(Mismatch 'RelLTEQ ExUnits)
   deriving (Generic)
 
 newtype AlonzoBbodyEvent era
@@ -157,7 +153,7 @@ instance
   EncCBOR (AlonzoBbodyPredFailure era)
   where
   encCBOR (ShelleyInAlonzoBbodyPredFailure x) = encode (Sum ShelleyInAlonzoBbodyPredFailure 0 !> To x)
-  encCBOR (TooManyExUnits x y) = encode (Sum TooManyExUnits 1 !> To x !> To y)
+  encCBOR (TooManyExUnits m) = encode (Sum TooManyExUnits 1 !> To m)
 
 instance
   ( Typeable era
@@ -168,7 +164,7 @@ instance
   decCBOR = decode (Summands "AlonzoBbodyPredFail" dec)
     where
       dec 0 = SumD ShelleyInAlonzoBbodyPredFailure <! From
-      dec 1 = SumD TooManyExUnits <! From <! From
+      dec 1 = SumD TooManyExUnits <! From
       dec n = Invalid n
 
 -- ========================================
@@ -253,7 +249,7 @@ alonzoBbodyTransition =
             txTotal = foldMap totExUnits txs
             ppMax = pp ^. ppMaxBlockExUnitsL
         pointWiseExUnits (<=) txTotal ppMax
-          ?! injectFailure (TooManyExUnits txTotal ppMax)
+          ?! injectFailure (TooManyExUnits Mismatch {mismatchSupplied = txTotal, mismatchExpected = ppMax})
 
         pure $
           BbodyState @era
-Original file line number
+Diff line change
@@ Expand Up / @@ -2,7 +2,7 @@ @@
     ## 1.12.0.0
-    *
+    * Use `Mismatch` to clarify predicate failures. #4711
     ### `testlib`
@@ Expand Down @@