Update Conway predicate-failures to Mismatch.

Also, add `{To|From}Group` variant to Coders, in order to correctly serde
{Enc|Dec}CBORGroup instances with the correct count and with a valid
FlatTerm.

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)
@@ -89,6 +82,7 @@ import Control.State.Transition (
 import Data.Foldable (Foldable (foldMap'))
 import Data.Monoid (Sum (getSum))
 import qualified Data.Monoid as Monoid (Sum (..))
+import Data.Proxy (Proxy (..))
 import Data.Sequence (Seq)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
@@ -100,28 +94,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 +122,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 +135,13 @@ instance
   DecCBOR (ConwayBbodyPredFailure era)
   where
   decCBOR = decode . Summands "ConwayBbodyPred" $ \case
-    0 -> SumD WrongBlockBodySizeBBODY <! From <! From
-    1 -> SumD InvalidBodyHashBBODY <! From <! From
+    0 -> SumD WrongBlockBodySizeBBODY <! FromGroup (Proxy @(Mismatch 'RelEQ Int))
+    1 ->
+      SumD InvalidBodyHashBBODY
+        <! FromGroup (Proxy @(Mismatch 'RelEQ (Hash (EraCrypto era) EraIndependentBlockBody)))
     2 -> SumD LedgersFailure <! From
-    3 -> SumD TooManyExUnits <! From <! From
-    4 -> SumD BodyRefScriptsSizeTooBig <! From <! From
+    3 -> SumD TooManyExUnits <! FromGroup (Proxy @(Mismatch 'RelLTEQ ExUnits))
+    4 -> SumD BodyRefScriptsSizeTooBig <! FromGroup (Proxy @(Mismatch 'RelLTEQ Int))
     n -> Invalid n
 
 type instance EraRuleFailure "BBODY" (ConwayEra c) = ConwayBbodyPredFailure (ConwayEra c)
@@ -238,19 +218,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 +303,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)
@@ -127,6 +127,7 @@ import qualified Data.Foldable as F
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as Map
 import qualified Data.OSet.Strict as OSet
+import Data.Proxy (Proxy (..))
 import Data.Pulse (foldlM')
 import qualified Data.Sequence.Strict as SSeq
 import Data.Set (Set)
@@ -166,11 +167,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 +183,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 +219,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 (Proxy @(Mismatch 'RelEQ Coin))
     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 (Proxy @(Mismatch 'RelGT ProtVer))
     11 -> SumD InvalidPolicyHash <! From <! From
     12 -> SumD DisallowedProposalDuringBootstrap <! From
     13 -> SumD DisallowedVotesDuringBootstrap <! From
@@ -243,14 +238,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 +258,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 +454,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 +483,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