Create Conway BBODY rule instead of reusing the Alonzo one

and keep the same behavior, invoking the transition function from Alonzo

eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs

@@ -3,6 +3,7 @@
 
 module Cardano.Ledger.Conway.Era (
   ConwayEra,
+  ConwayBBODY,
   ConwayCERT,
   ConwayDELEG,
   ConwayGOVCERT,
@@ -19,7 +20,6 @@ module Cardano.Ledger.Conway.Era (
   ConwayRATIFY,
 ) where
 
-import Cardano.Ledger.Alonzo.Rules (AlonzoBBODY)
 import Cardano.Ledger.Babbage (BabbageEra)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
@@ -131,9 +131,9 @@ data ConwayUTXO era
 
 type instance EraRule "UTXO" (ConwayEra c) = ConwayUTXO (ConwayEra c)
 
--- Rules inherited from Alonzo
+data ConwayBBODY era
 
-type instance EraRule "BBODY" (ConwayEra c) = AlonzoBBODY (ConwayEra c)
+type instance EraRule "BBODY" (ConwayEra c) = ConwayBBODY (ConwayEra c)
 
 -- Rules inherited from Shelley
 

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

@@ -4,6 +4,7 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Conway.Rules (
+  module Cardano.Ledger.Conway.Rules.Bbody,
   module Cardano.Ledger.Conway.Rules.Cert,
   module Cardano.Ledger.Conway.Rules.Deleg,
   module Cardano.Ledger.Conway.Rules.GovCert,
@@ -23,7 +24,7 @@ where
 
 import Cardano.Ledger.Conway.Core (EraRuleEvent, InjectRuleEvent (..))
 import Cardano.Ledger.Conway.Era (ConwayEra)
-import Cardano.Ledger.Conway.Rules.Bbody ()
+import Cardano.Ledger.Conway.Rules.Bbody
 import Cardano.Ledger.Conway.Rules.Cert
 import Cardano.Ledger.Conway.Rules.Certs
 import Cardano.Ledger.Conway.Rules.Deleg

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

@@ -14,18 +14,32 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Cardano.Ledger.Conway.Rules.Bbody () where
+module Cardano.Ledger.Conway.Rules.Bbody (
+  ConwayBBODY,
+  ConwayBbodyPredFailure (..),
+) where
 
 import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
 import Cardano.Ledger.Alonzo.Rules (
-  AlonzoBbodyEvent,
-  AlonzoBbodyPredFailure (..),
+  AlonzoBbodyEvent (..),
+  AlonzoBbodyPredFailure (ShelleyInAlonzoBbodyPredFailure),
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
   AlonzoUtxowPredFailure,
+  alonzoBbodyTransition,
  )
+import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
-import Cardano.Ledger.Conway.Era (ConwayEra)
+
+import Cardano.Ledger.Alonzo.PParams (AlonzoEraPParams)
+import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (AlonzoBbodyPredFailure (..))
+import Cardano.Ledger.Alonzo.Tx (AlonzoTx)
+import Cardano.Ledger.Alonzo.TxSeq (AlonzoTxSeq)
+import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
+import Cardano.Ledger.BHeaderView (BHeaderView (..))
+import Cardano.Ledger.BaseTypes (ShelleyBase)
+import Cardano.Ledger.Block (Block (..))
+import Cardano.Ledger.Conway.Era (ConwayBBODY, ConwayEra)
 import Cardano.Ledger.Conway.Rules.Cert (ConwayCertPredFailure)
 import Cardano.Ledger.Conway.Rules.Certs (ConwayCertsPredFailure)
 import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure)
@@ -37,76 +51,207 @@ import Cardano.Ledger.Conway.Rules.Utxo (ConwayUtxoPredFailure)
 import Cardano.Ledger.Conway.Rules.Utxos (ConwayUtxosPredFailure)
 import Cardano.Ledger.Conway.Rules.Utxow (ConwayUtxowPredFailure)
 import Cardano.Ledger.Core
+import qualified Cardano.Ledger.Era as Era
+import Cardano.Ledger.Keys (DSignable, Hash)
+import Cardano.Ledger.Shelley.LedgerState (LedgerState)
 import Cardano.Ledger.Shelley.Rules (
-  ShelleyBbodyPredFailure (..),
-  ShelleyLedgersPredFailure (..),
+  BbodyEnv (..),
+  ShelleyBbodyEvent (..),
+  ShelleyBbodyPredFailure,
+  ShelleyBbodyState (..),
+  ShelleyLedgersEnv (..),
+  ShelleyLedgersPredFailure,
   ShelleyPoolPredFailure,
   ShelleyUtxoPredFailure,
   ShelleyUtxowPredFailure,
  )
+import qualified Cardano.Ledger.Shelley.Rules as Shelley (ShelleyBbodyPredFailure (..))
+import Control.State.Transition (
+  Embed (..),
+  STS (..),
+  TransitionRule,
+ )
+import Data.Sequence (Seq)
+import GHC.Generics (Generic)
+import NoThunks.Class (NoThunks (..))
+
+data ConwayBbodyPredFailure era
+  = TooManyExUnits
+      -- | Computed Sum of ExUnits for all plutus scripts
+      !ExUnits
+      -- | Maximum allowed by protocal parameters
+      !ExUnits
+  | WrongBlockBodySizeBBODY
+      !Int -- Actual Body Size
+      !Int -- Claimed Body Size in Header
+  | InvalidBodyHashBBODY
+      !(Hash (EraCrypto era) EraIndependentBlockBody) -- Actual Hash
+      !(Hash (EraCrypto era) EraIndependentBlockBody) -- Claimed Hash
+  | -- | LEDGERS rule subtransition Failures
+    LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
+  deriving (Generic)
+
+deriving instance
+  (Era era, Show (PredicateFailure (EraRule "LEDGERS" era))) =>
+  Show (ConwayBbodyPredFailure era)
+
+deriving instance
+  (Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) =>
+  Eq (ConwayBbodyPredFailure era)
 
-type instance EraRuleFailure "BBODY" (ConwayEra c) = AlonzoBbodyPredFailure (ConwayEra c)
+deriving anyclass instance
+  (Era era, NoThunks (PredicateFailure (EraRule "LEDGERS" era))) =>
+  NoThunks (ConwayBbodyPredFailure era)
+
+type instance EraRuleFailure "BBODY" (ConwayEra c) = ConwayBbodyPredFailure (ConwayEra c)
 
 type instance EraRuleEvent "BBODY" (ConwayEra c) = AlonzoBbodyEvent (ConwayEra c)
 
-instance InjectRuleFailure "BBODY" AlonzoBbodyPredFailure (ConwayEra c)
+instance InjectRuleFailure "BBODY" ConwayBbodyPredFailure (ConwayEra c)
+
+instance InjectRuleFailure "BBODY" AlonzoBbodyPredFailure (ConwayEra c) where
+  injectFailure = alonzoToConwayBbodyPredFailure
 
 instance InjectRuleFailure "BBODY" ShelleyBbodyPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure
+  injectFailure = shelleyToConwayBbodyPredFailure
 
 instance InjectRuleFailure "BBODY" ShelleyLedgersPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure
 
 instance InjectRuleFailure "BBODY" ConwayLedgerPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayUtxowPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" BabbageUtxowPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" AlonzoUtxowPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ShelleyUtxowPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayUtxoPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" BabbageUtxoPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" AlonzoUtxoPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" AlonzoUtxosPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayUtxosPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ShelleyUtxoPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" AllegraUtxoPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayCertsPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayCertPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayDelegPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ShelleyPoolPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayGovCertPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
 
 instance InjectRuleFailure "BBODY" ConwayGovPredFailure (ConwayEra c) where
-  injectFailure = ShelleyInAlonzoBbodyPredFailure . LedgersFailure . injectFailure
+  injectFailure = shelleyToConwayBbodyPredFailure . Shelley.LedgersFailure . injectFailure
+
+shelleyToConwayBbodyPredFailure ::
+  forall era.
+  ShelleyBbodyPredFailure era ->
+  ConwayBbodyPredFailure era
+shelleyToConwayBbodyPredFailure (Shelley.WrongBlockBodySizeBBODY x y) = WrongBlockBodySizeBBODY x y
+shelleyToConwayBbodyPredFailure (Shelley.InvalidBodyHashBBODY x y) = InvalidBodyHashBBODY x y
+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
+
+instance
+  ( DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
+  , Embed (EraRule "LEDGERS" era) (EraRule "BBODY" era)
+  , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
+  , State (EraRule "LEDGERS" era) ~ LedgerState era
+  , Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
+  , AlonzoEraTxWits era
+  , Tx era ~ AlonzoTx era
+  , Era.TxSeq era ~ AlonzoTxSeq era
+  , Tx era ~ AlonzoTx era
+  , EraSegWits era
+  , AlonzoEraPParams era
+  , InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era
+  , EraRule "BBODY" era ~ ConwayBBODY era
+  ) =>
+  STS (ConwayBBODY era)
+  where
+  type
+    State (ConwayBBODY era) =
+      ShelleyBbodyState era
+
+  type
+    Signal (ConwayBBODY era) =
+      (Block (BHeaderView (EraCrypto era)) era)
+
+  type Environment (ConwayBBODY era) = BbodyEnv era
+
+  type BaseM (ConwayBBODY era) = ShelleyBase
+
+  type PredicateFailure (ConwayBBODY era) = ConwayBbodyPredFailure era
+  type Event (ConwayBBODY era) = AlonzoBbodyEvent era
+
+  initialRules = []
+  transitionRules = [conwayBbodyTransition @era]
+
+conwayBbodyTransition ::
+  forall era.
+  ( STS (EraRule "BBODY" era)
+  , Signal (EraRule "BBODY" era) ~ Block (BHeaderView (EraCrypto era)) era
+  , State (EraRule "BBODY" era) ~ ShelleyBbodyState era
+  , Environment (EraRule "BBODY" era) ~ BbodyEnv era
+  , Embed (EraRule "LEDGERS" era) (EraRule "BBODY" era)
+  , BaseM (EraRule "BBODY" era) ~ ShelleyBase
+  , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
+  , State (EraRule "LEDGERS" era) ~ LedgerState era
+  , Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
+  , EraSegWits era
+  , AlonzoEraTxWits era
+  , Era.TxSeq era ~ AlonzoTxSeq era
+  , Tx era ~ AlonzoTx era
+  , AlonzoEraPParams era
+  , InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era
+  ) =>
+  TransitionRule (EraRule "BBODY" era)
+conwayBbodyTransition = alonzoBbodyTransition @era
+
+instance
+  ( Era era
+  , BaseM ledgers ~ ShelleyBase
+  , ledgers ~ EraRule "LEDGERS" era
+  , STS ledgers
+  , DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
+  , Era era
+  ) =>
+  Embed ledgers (ConwayBBODY era)
+  where
+  wrapFailed = LedgersFailure
+  wrapEvent = ShelleyInAlonzoEvent . LedgersEvent

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs

@@ -31,7 +31,10 @@ import Cardano.Ledger.BaseTypes (
 import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..), ConwayLedgerPredFailure (..))
-import qualified Cardano.Ledger.Conway.Rules as Conway (ConwayCertPredFailure (..))
+import qualified Cardano.Ledger.Conway.Rules as Conway (
+  ConwayBbodyPredFailure (..),
+  ConwayCertPredFailure (..),
+ )
 import Cardano.Ledger.Credential (
   Credential (..),
   StakeCredential,
@@ -683,7 +686,7 @@ testBBodyState pf =
 
 -- ============================== Helper functions ===============================
 
-makeTooBig :: Proof era -> AlonzoBbodyPredFailure era
+makeTooBig :: Proof era -> PredicateFailure (EraRule "BBODY" era)
 makeTooBig proof@Alonzo =
   ShelleyInAlonzoBbodyPredFailure
     . LedgersFailure
@@ -701,8 +704,7 @@ makeTooBig proof@Babbage =
     . PoolFailure
     $ PoolMedataHashTooBig (coerceKeyRole . hashKey . vKey $ someKeys proof) (hashsize @Mock + 1)
 makeTooBig proof@Conway =
-  ShelleyInAlonzoBbodyPredFailure
-    . LedgersFailure
+  Conway.LedgersFailure
     . LedgerFailure
     . ConwayCertsFailure
     . CertFailure

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/STSTestUtils.hs

@@ -36,7 +36,6 @@ where
 import qualified Cardano.Crypto.Hash as CH
 import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Alonzo.Rules (
-  AlonzoBBODY,
   AlonzoUtxoPredFailure (..),
   AlonzoUtxosPredFailure (..),
   AlonzoUtxowPredFailure (..),
@@ -103,7 +102,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
  )
 import Test.Tasty.HUnit (Assertion, assertFailure, (@?=))
 
--- import Test.Cardano.Ledger.Generic.PrettyCore(pcTx)
 import Test.Cardano.Ledger.Constrained.Preds.Tx (pcTxWithUTxO)
 
 -- =================================================================
@@ -252,7 +250,7 @@ testBBODY ::
   WitRule "BBODY" era ->
   ShelleyBbodyState era ->
   Block (BHeaderView (EraCrypto era)) era ->
-  Either (NonEmpty (PredicateFailure (AlonzoBBODY era))) (ShelleyBbodyState era) ->
+  Either (NonEmpty (PredicateFailure (EraRule "BBODY" era))) (ShelleyBbodyState era) ->
   PParams era ->
   Assertion
 testBBODY wit@(BBODY proof) initialSt block expected pparams =