Merge pull request #4666 from IntersectMBO/aniketd/mismatch-for-conway

Mismatch for Conway predicate failures

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -81,7 +81,7 @@ library
         cardano-data ^>=1.2.1,
         cardano-ledger-allegra ^>=1.6,
         cardano-crypto-class,
-        cardano-ledger-binary ^>=1.4,
+        cardano-ledger-binary ^>=1.5,
         cardano-ledger-core ^>=1.15,
         cardano-ledger-mary ^>=1.7,
         cardano-ledger-shelley ^>=1.15,

eras/conway/impl/cardano-ledger-conway.cabal

@@ -88,7 +88,7 @@ library
         data-default-class,
         cardano-crypto-class,
         cardano-data >=1.2.3,
-        cardano-ledger-binary ^>=1.4,
+        cardano-ledger-binary ^>=1.5,
         cardano-ledger-allegra ^>=1.6,
         cardano-ledger-alonzo ^>=1.12,
         cardano-ledger-babbage ^>=1.10,
@@ -187,7 +187,7 @@ executable huddle-cddl
     build-depends:
         base,
         testlib,
-        cardano-ledger-binary:testlib >=1.4
+        cardano-ledger-binary:testlib >=1.5
 
 executable gen-golden
     main-is:          GenerateGoldenFileMain.hs

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs

@@ -39,16 +39,9 @@ import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
 import Cardano.Ledger.BHeaderView (BHeaderView (..))
 import Cardano.Ledger.Babbage.Core (BabbageEraTxBody)
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
-import Cardano.Ledger.BaseTypes (Mismatch (..), ShelleyBase)
+import Cardano.Ledger.BaseTypes (Mismatch (..), Relation (..), ShelleyBase)
 import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
-import Cardano.Ledger.Binary.Coders (
-  Decode (..),
-  Encode (..),
-  decode,
-  encode,
-  (!>),
-  (<!),
- )
+import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
 import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Conway.Era (ConwayBBODY, ConwayEra)
 import Cardano.Ledger.Conway.Rules.Cert (ConwayCertPredFailure)
@@ -100,28 +93,12 @@ maxRefScriptSizePerBlock :: Int
 maxRefScriptSizePerBlock = 1024 * 1024 -- 1MiB
 
 data ConwayBbodyPredFailure era
-  = WrongBlockBodySizeBBODY
-      -- | Actual Body Size
-      !Int
-      -- | Claimed Body Size in Header
-      !Int
-  | InvalidBodyHashBBODY
-      -- | Actual Hash
-      !(Hash (EraCrypto era) EraIndependentBlockBody)
-      -- | Claimed Hash
-      !(Hash (EraCrypto era) EraIndependentBlockBody)
+  = WrongBlockBodySizeBBODY !(Mismatch 'RelEQ Int)
+  | InvalidBodyHashBBODY !(Mismatch 'RelEQ (Hash (EraCrypto era) EraIndependentBlockBody))
   | -- | LEDGERS rule subtransition Failures
     LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
-  | TooManyExUnits
-      -- | Computed Sum of ExUnits for all plutus scripts
-      !ExUnits
-      -- | Maximum allowed by protocal parameters
-      !ExUnits
-  | BodyRefScriptsSizeTooBig
-      -- | Computed sum of reference script size
-      Int
-      -- | Maximum allowed total reference script size
-      Int
+  | TooManyExUnits !(Mismatch 'RelLTEQ ExUnits)
+  | BodyRefScriptsSizeTooBig !(Mismatch 'RelLTEQ Int)
   deriving (Generic)
 
 deriving instance
@@ -144,11 +121,11 @@ instance
   where
   encCBOR =
     encode . \case
-      WrongBlockBodySizeBBODY x y -> Sum WrongBlockBodySizeBBODY 0 !> To x !> To y
-      InvalidBodyHashBBODY x y -> Sum (InvalidBodyHashBBODY @era) 1 !> To x !> To y
+      WrongBlockBodySizeBBODY mm -> Sum WrongBlockBodySizeBBODY 0 !> ToGroup mm
+      InvalidBodyHashBBODY mm -> Sum (InvalidBodyHashBBODY @era) 1 !> ToGroup mm
       LedgersFailure x -> Sum (LedgersFailure @era) 2 !> To x
-      TooManyExUnits x y -> Sum TooManyExUnits 3 !> To x !> To y
-      BodyRefScriptsSizeTooBig x y -> Sum BodyRefScriptsSizeTooBig 4 !> To x !> To y
+      TooManyExUnits mm -> Sum TooManyExUnits 3 !> ToGroup mm
+      BodyRefScriptsSizeTooBig mm -> Sum BodyRefScriptsSizeTooBig 4 !> ToGroup mm
 
 instance
   ( Era era
@@ -157,11 +134,11 @@ instance
   DecCBOR (ConwayBbodyPredFailure era)
   where
   decCBOR = decode . Summands "ConwayBbodyPred" $ \case
-    0 -> SumD WrongBlockBodySizeBBODY <! From <! From
-    1 -> SumD InvalidBodyHashBBODY <! From <! From
+    0 -> SumD WrongBlockBodySizeBBODY <! FromGroup
+    1 -> SumD InvalidBodyHashBBODY <! FromGroup
     2 -> SumD LedgersFailure <! From
-    3 -> SumD TooManyExUnits <! From <! From
-    4 -> SumD BodyRefScriptsSizeTooBig <! From <! From
+    3 -> SumD TooManyExUnits <! FromGroup
+    4 -> SumD BodyRefScriptsSizeTooBig <! FromGroup
     n -> Invalid n
 
 type instance EraRuleFailure "BBODY" (ConwayEra c) = ConwayBbodyPredFailure (ConwayEra c)
@@ -238,19 +215,24 @@ shelleyToConwayBbodyPredFailure ::
   ShelleyBbodyPredFailure era ->
   ConwayBbodyPredFailure era
 shelleyToConwayBbodyPredFailure
-  (Shelley.WrongBlockBodySizeBBODY (Mismatch supplied expected)) =
-    WrongBlockBodySizeBBODY supplied expected
+  (Shelley.WrongBlockBodySizeBBODY m) =
+    WrongBlockBodySizeBBODY m
 shelleyToConwayBbodyPredFailure
-  (Shelley.InvalidBodyHashBBODY (Mismatch supplied expected)) =
-    InvalidBodyHashBBODY supplied expected
+  (Shelley.InvalidBodyHashBBODY m) =
+    InvalidBodyHashBBODY m
 shelleyToConwayBbodyPredFailure (Shelley.LedgersFailure x) = LedgersFailure x
 
 alonzoToConwayBbodyPredFailure ::
   forall era.
   AlonzoBbodyPredFailure era ->
   ConwayBbodyPredFailure era
 alonzoToConwayBbodyPredFailure (ShelleyInAlonzoBbodyPredFailure x) = shelleyToConwayBbodyPredFailure x
-alonzoToConwayBbodyPredFailure (Alonzo.TooManyExUnits x y) = TooManyExUnits x y
+alonzoToConwayBbodyPredFailure (Alonzo.TooManyExUnits x y) =
+  TooManyExUnits $
+    Mismatch
+      { mismatchSupplied = x
+      , mismatchExpected = y
+      }
 
 instance
   ( DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
@@ -318,7 +300,12 @@ conwayBbodyTransition = do
         totalRefScriptSize
           <= maxRefScriptSizePerBlock
             ?! injectFailure
-              (BodyRefScriptsSizeTooBig totalRefScriptSize maxRefScriptSizePerBlock)
+              ( BodyRefScriptsSizeTooBig $
+                  Mismatch
+                    { mismatchSupplied = totalRefScriptSize
+                    , mismatchExpected = maxRefScriptSizePerBlock
+                    }
+              )
         pure state
 
 instance

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -32,8 +32,10 @@ import Cardano.Ledger.Address (RewardAccount, raCredential, raNetwork)
 import Cardano.Ledger.BaseTypes (
   EpochInterval (..),
   EpochNo (..),
+  Mismatch (..),
   Network,
   ProtVer,
+  Relation (..),
   ShelleyBase,
   StrictMaybe (SJust),
   addEpochInterval,
@@ -94,9 +96,7 @@ import Cardano.Ledger.Conway.Governance (
   toPrevGovActionIds,
  )
 import Cardano.Ledger.Conway.Governance.Proposals (mapProposals)
-import Cardano.Ledger.Conway.PParams (
-  ConwayEraPParams (..),
- )
+import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..))
 import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
@@ -166,11 +166,7 @@ data ConwayGovPredFailure era
   | MalformedProposal (GovAction era)
   | ProposalProcedureNetworkIdMismatch (RewardAccount (EraCrypto era)) Network
   | TreasuryWithdrawalsNetworkIdMismatch (Set.Set (RewardAccount (EraCrypto era))) Network
-  | ProposalDepositIncorrect
-      -- | Submitted deposit
-      Coin
-      -- | Expected deposit taken from `PParams`
-      Coin
+  | ProposalDepositIncorrect !(Mismatch 'RelEQ Coin)
   | -- | Some governance actions are not allowed to be voted on by certain types of
     -- Voters. This failure lists all governance action ids with their respective voters
     -- that are not allowed to vote on those governance actions.
@@ -186,10 +182,8 @@ data ConwayGovPredFailure era
   | ProposalCantFollow
       -- | The PrevGovActionId of the HardForkInitiation that fails
       (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-      -- | Its protocol version
-      ProtVer
-      -- | The ProtVer of the Previous GovAction pointed to by the one proposed
-      ProtVer
+      -- | Its protocol version and the protocal version of the previous gov-action pointed to by the proposal
+      !(Mismatch 'RelGT ProtVer)
   | InvalidPolicyHash
       -- | The policy script hash in the proposal
       (StrictMaybe (ScriptHash (EraCrypto era)))
@@ -224,13 +218,13 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where
     1 -> SumD MalformedProposal <! From
     2 -> SumD ProposalProcedureNetworkIdMismatch <! From <! From
     3 -> SumD TreasuryWithdrawalsNetworkIdMismatch <! From <! From
-    4 -> SumD ProposalDepositIncorrect <! From <! From
+    4 -> SumD ProposalDepositIncorrect <! FromGroup
     5 -> SumD DisallowedVoters <! From
     6 -> SumD ConflictingCommitteeUpdate <! From
     7 -> SumD ExpirationEpochTooSmall <! From
     8 -> SumD InvalidPrevGovActionId <! From
     9 -> SumD VotingOnExpiredGovAction <! From
-    10 -> SumD ProposalCantFollow <! From <! From <! From
+    10 -> SumD ProposalCantFollow <! From <! FromGroup
     11 -> SumD InvalidPolicyHash <! From <! From
     12 -> SumD DisallowedProposalDuringBootstrap <! From
     13 -> SumD DisallowedVotesDuringBootstrap <! From
@@ -243,14 +237,16 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where
 instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
   encCBOR =
     encode . \case
-      GovActionsDoNotExist gid -> Sum GovActionsDoNotExist 0 !> To gid
-      MalformedProposal ga -> Sum MalformedProposal 1 !> To ga
+      GovActionsDoNotExist gid ->
+        Sum GovActionsDoNotExist 0 !> To gid
+      MalformedProposal ga ->
+        Sum MalformedProposal 1 !> To ga
       ProposalProcedureNetworkIdMismatch acnt nid ->
         Sum ProposalProcedureNetworkIdMismatch 2 !> To acnt !> To nid
       TreasuryWithdrawalsNetworkIdMismatch acnts nid ->
         Sum TreasuryWithdrawalsNetworkIdMismatch 3 !> To acnts !> To nid
-      ProposalDepositIncorrect submitted expected ->
-        Sum ProposalDepositIncorrect 4 !> To submitted !> To expected
+      ProposalDepositIncorrect mm ->
+        Sum ProposalDepositIncorrect 4 !> ToGroup mm
       DisallowedVoters votes ->
         Sum DisallowedVoters 5 !> To votes
       ConflictingCommitteeUpdate members ->
@@ -261,15 +257,10 @@ instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
         Sum InvalidPrevGovActionId 8 !> To proposal
       VotingOnExpiredGovAction ga ->
         Sum VotingOnExpiredGovAction 9 !> To ga
-      ProposalCantFollow prevgaid pv1 pv2 ->
-        Sum ProposalCantFollow 10
-          !> To prevgaid
-          !> To pv1
-          !> To pv2
+      ProposalCantFollow prevgaid mm ->
+        Sum ProposalCantFollow 10 !> To prevgaid !> ToGroup mm
       InvalidPolicyHash got expected ->
-        Sum InvalidPolicyHash 11
-          !> To got
-          !> To expected
+        Sum InvalidPolicyHash 11 !> To got !> To expected
       DisallowedProposalDuringBootstrap proposal ->
         Sum DisallowedProposalDuringBootstrap 12 !> To proposal
       DisallowedVotesDuringBootstrap votes ->
@@ -462,7 +453,13 @@ govTransition = do
                 preceedingHardFork @era pProcGovAction pp prevGovActionIds st
               if pvCanFollow prevProtVer newProtVer
                 then Nothing
-                else Just $ ProposalCantFollow @era prevGaid newProtVer prevProtVer
+                else
+                  Just $
+                    ProposalCantFollow @era prevGaid $
+                      Mismatch
+                        { mismatchSupplied = newProtVer
+                        , mismatchExpected = prevProtVer
+                        }
         failOnJust badHardFork id
 
         -- PParamsUpdate well-formedness check
@@ -485,7 +482,11 @@ govTransition = do
         let expectedDep = pp ^. ppGovActionDepositL
          in pProcDeposit
               == expectedDep
-                ?! ProposalDepositIncorrect pProcDeposit expectedDep
+                ?! ProposalDepositIncorrect
+                  Mismatch
+                    { mismatchSupplied = pProcDeposit
+                    , mismatchExpected = expectedDep
+                    }
 
         -- Return address network id check
         raNetwork pProcReturnAddr