Add NFData and ToExpr instances for block-related types

neilmayhew · neilmayhew · commit c24d507ac132 · 2025-12-05T17:26:15.000-07:00
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs
@@ -47,6 +47,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.BlockBody (auxDataSeqDecoder)
+import Control.DeepSeq (NFData)
 import Control.Monad (unless)
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
@@ -88,6 +89,8 @@ data AlonzoBlockBody era = AlonzoBlockBodyInternal
   }
   deriving (Generic)
 
+instance NFData (Tx TopTx era) => NFData (AlonzoBlockBody era)
+
 instance EraBlockBody AlonzoEra where
   type BlockBody AlonzoEra = AlonzoBlockBody AlonzoEra
   mkBasicBlockBody = mkBasicBlockBodyAlonzo
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs
@@ -55,6 +55,7 @@ import Cardano.Ledger.Shelley.Rules (
   ShelleyUtxowPredFailure,
  )
 import Cardano.Ledger.Slot (epochInfoEpoch, epochInfoFirst)
+import Control.DeepSeq (NFData)
 import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition (
   Embed (..),
@@ -80,6 +81,8 @@ data AlonzoBbodyPredFailure era
   | TooManyExUnits (Mismatch RelLTEQ ExUnits)
   deriving (Generic)
 
+instance NFData (PredicateFailure (EraRule "LEDGERS" era)) => NFData (AlonzoBbodyPredFailure era)
+
 newtype AlonzoBbodyEvent era
   = ShelleyInAlonzoEvent (ShelleyBbodyEvent era)
   deriving (Generic)
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/TreeDiff.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/TreeDiff.hs
@@ -14,6 +14,7 @@ module Test.Cardano.Ledger.Alonzo.TreeDiff (
 ) where
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
+import Cardano.Ledger.Alonzo.BlockBody
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.PParams
 import Cardano.Ledger.Alonzo.Plutus.Context
@@ -122,6 +123,8 @@ instance ToExpr (AlonzoTxBodyRaw TopTx AlonzoEra) where
 
 instance ToExpr (TxBody TopTx AlonzoEra)
 
+instance ToExpr (Tx TopTx era) => ToExpr (AlonzoBlockBody era)
+
 -- Tx
 instance ToExpr IsValid
 
diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs
@@ -82,6 +82,7 @@ import Cardano.Ledger.Shelley.Rules (
  )
 import qualified Cardano.Ledger.Shelley.Rules as Shelley (ShelleyBbodyPredFailure (..))
 import Cardano.Ledger.Shelley.UTxO (UTxO (..), txouts, unUTxO)
+import Control.DeepSeq (NFData)
 import Control.State.Transition (
   Embed (..),
   STS (..),
@@ -119,6 +120,10 @@ deriving instance
   (Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) =>
   Eq (ConwayBbodyPredFailure era)
 
+deriving anyclass instance
+  (Era era, NFData (PredicateFailure (EraRule "LEDGERS" era))) =>
+  NFData (ConwayBbodyPredFailure era)
+
 deriving anyclass instance
   (Era era, NoThunks (PredicateFailure (EraRule "LEDGERS" era))) =>
   NoThunks (ConwayBbodyPredFailure era)
diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs
@@ -51,6 +51,7 @@ import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra.Era
 import Cardano.Ledger.Dijkstra.Tx ()
 import Cardano.Ledger.Shelley.BlockBody (auxDataSeqDecoder)
+import Control.DeepSeq (NFData)
 import Control.Monad (unless)
 import Data.Bifunctor (Bifunctor (..))
 import Data.ByteString (ByteString)
@@ -102,6 +103,8 @@ data DijkstraBlockBody era = DijkstraBlockBodyInternal
   }
   deriving (Generic)
 
+instance (NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBody era)
+
 instance EraBlockBody DijkstraEra where
   type BlockBody DijkstraEra = DijkstraBlockBody DijkstraEra
   mkBasicBlockBody = mkBasicBlockBodyDijkstra
diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs
@@ -79,6 +79,7 @@ import Cardano.Ledger.Shelley.Rules (
   ShelleyUtxowPredFailure,
  )
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
+import Control.DeepSeq (NFData)
 import Control.State.Transition (
   Embed (..),
   STS (..),
@@ -96,6 +97,8 @@ data DijkstraBbodyPredFailure era
   | BodyRefScriptsSizeTooBig (Mismatch RelLTEQ Int)
   deriving (Generic)
 
+instance NFData (PredicateFailure (EraRule "LEDGERS" era)) => NFData (DijkstraBbodyPredFailure era)
+
 deriving instance
   (Era era, Show (PredicateFailure (EraRule "LEDGERS" era))) =>
   Show (DijkstraBbodyPredFailure era)
diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs
@@ -16,12 +16,13 @@ module Test.Cardano.Ledger.Dijkstra.TreeDiff (
   module Test.Cardano.Ledger.Conway.TreeDiff,
 ) where
 
-import Cardano.Ledger.BaseTypes (StrictMaybe)
+import Cardano.Ledger.BaseTypes (PerasCert, StrictMaybe)
 import Cardano.Ledger.Dijkstra (DijkstraEra)
 import Cardano.Ledger.Dijkstra.Core (
   AlonzoEraScript (..),
   AsItem,
   AsIx,
+  DijkstraBlockBody,
   Era,
   EraPParams (..),
   EraRule,
@@ -30,10 +31,12 @@ import Cardano.Ledger.Dijkstra.Core (
   EraTxCert (..),
   EraTxOut (..),
   PlutusScript,
+  TopTx,
   Value,
  )
 import Cardano.Ledger.Dijkstra.PParams (DijkstraPParams)
 import Cardano.Ledger.Dijkstra.Rules (
+  DijkstraBbodyPredFailure,
   DijkstraGovCertPredFailure,
   DijkstraGovPredFailure,
   DijkstraLedgerPredFailure,
@@ -122,6 +125,10 @@ instance ToExpr (DijkstraTxBodyRaw l DijkstraEra) where
 
 instance ToExpr (TxBody l DijkstraEra)
 
+instance ToExpr PerasCert
+
+instance (ToExpr (Tx TopTx era), ToExpr PerasCert) => ToExpr (DijkstraBlockBody era)
+
 instance ToExpr (DijkstraTx l DijkstraEra) where
   toExpr = \case
     txBody@(DijkstraTx _ _ _ _) ->
@@ -186,3 +193,7 @@ instance
   ToExpr (DijkstraGovPredFailure era)
 
 instance ToExpr (DijkstraGovCertPredFailure era)
+
+instance
+  ToExpr (PredicateFailure (EraRule "LEDGERS" era)) =>
+  ToExpr (DijkstraBbodyPredFailure era)
diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md
@@ -49,6 +49,15 @@
 
 ### `testlib`
 
+* Add `NFData` and `ToExpr` constraints and instances for:
+  - `AlonzoBlockBody`
+  - `AlonzoBbodyPredFailure`
+  - `ConwayBbodyPredFailure`
+  - `ShelleyBlockBody`
+  - `ShelleyBbodyPredFailure`
+  - `BHeaderView`
+  - `Block`
+* Add a `Generic` instance for `BHeaderView`
 * Add `impEventsFrom`
 * Change type of `ImpTestState.impEvents` field from `[]` to `Seq`
 * Renamed `impLastTick` to `impCurSlotNo` and `impLastTickG` to `impCurSlotNoG`
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs
@@ -63,6 +63,7 @@ import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
 import Cardano.Ledger.Shelley.Tx ()
 import Cardano.Ledger.Slot (SlotNo (..))
+import Control.DeepSeq (NFData)
 import Control.Monad (unless)
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
@@ -95,6 +96,8 @@ data ShelleyBlockBody era = ShelleyBlockBodyInternal
   }
   deriving (Generic)
 
+instance NFData (Tx TopTx era) => NFData (ShelleyBlockBody era)
+
 instance EraBlockBody ShelleyEra where
   type BlockBody ShelleyEra = ShelleyBlockBody ShelleyEra
   mkBasicBlockBody = mkBasicBlockBodyShelley
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs
@@ -58,6 +58,7 @@ import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyPpupPredFailure)
 import Cardano.Ledger.Shelley.Rules.Utxo (ShelleyUtxoPredFailure)
 import Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUtxowPredFailure)
 import Cardano.Ledger.Slot (epochInfoEpoch, epochInfoFirst)
+import Control.DeepSeq (NFData)
 import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition (
   Embed (..),
@@ -98,6 +99,8 @@ data ShelleyBbodyPredFailure era
   | LedgersFailure (PredicateFailure (EraRule "LEDGERS" era)) -- Subtransition Failures
   deriving (Generic)
 
+instance NFData (PredicateFailure (EraRule "LEDGERS" era)) => NFData (ShelleyBbodyPredFailure era)
+
 type instance EraRuleFailure "BBODY" ShelleyEra = ShelleyBbodyPredFailure ShelleyEra
 
 instance InjectRuleFailure "BBODY" ShelleyBbodyPredFailure ShelleyEra
diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
@@ -424,6 +424,10 @@ class
   , State (EraRule "BBODY" era) ~ ShelleyBbodyState era
   , Signal (EraRule "BBODY" era) ~ Block BHeaderView era
   , ToExpr (Event (EraRule "BBODY" era))
+  , NFData (BlockBody era)
+  , ToExpr (BlockBody era)
+  , NFData (PredicateFailure (EraRule "BBODY" era))
+  , ToExpr (PredicateFailure (EraRule "BBODY" era))
   , State (EraRule "LEDGERS" era) ~ LedgerState era
   , -- For the LEDGER rule
     STS (EraRule "LEDGER" era)
diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/TreeDiff.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/TreeDiff.hs
@@ -14,6 +14,7 @@ import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Ledger.Shelley.AdaPots (AdaPots)
+import Cardano.Ledger.Shelley.BlockBody
 import Cardano.Ledger.Shelley.Governance
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.PParams
@@ -106,6 +107,9 @@ instance ToExpr (ShelleyTxBodyRaw TopTx ShelleyEra) where
 
 instance ToExpr (TxBody TopTx ShelleyEra)
 
+-- BlockBody
+instance ToExpr (Tx TopTx era) => ToExpr (ShelleyBlockBody era)
+
 -- PoolRank
 instance ToExpr Likelihood
 
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BHeaderView.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BHeaderView.hs
@@ -1,12 +1,15 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Cardano.Ledger.BHeaderView where
 
 import Cardano.Ledger.BaseTypes (BoundedRational (..), UnitInterval)
 import Cardano.Ledger.Hashes (EraIndependentBlockBody, HASH, Hash, KeyHash, KeyRole (..))
 import Cardano.Ledger.Slot (SlotNo (..), (-*))
+import Control.DeepSeq (NFData)
 import Data.Word (Word32)
+import GHC.Generics (Generic)
 
 -- | 'BHeaderView' provides an interface between block headers
 -- from different Cardano protocols and packages that should be
@@ -30,6 +33,9 @@ data BHeaderView = BHeaderView
   , bhviewSlot :: SlotNo
   -- ^ The slot for which this block was submitted to the chain.
   }
+  deriving (Generic)
+
+instance NFData BHeaderView
 
 -- | Determine if the given slot is reserved for the overlay schedule.
 isOverlaySlot ::
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs
@@ -1002,6 +1002,8 @@ instance ToKeyValuePairs a => ToJSON (KeyValuePairs a) where
 data PerasCert = PerasCert
   deriving (Eq, Show, Generic, NoThunks)
 
+instance NFData PerasCert
+
 instance EncCBOR PerasCert where
   encCBOR PerasCert =
     encCBOR ()
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs
@@ -32,6 +32,7 @@ import Cardano.Ledger.Binary (
 import qualified Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Core
 import Cardano.Ledger.TxIn (TxIn (..))
+import Control.DeepSeq (NFData)
 import Data.Foldable (toList)
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -61,6 +62,8 @@ deriving anyclass instance
   ) =>
   NoThunks (Block h era)
 
+instance (NFData h, NFData (BlockBody era)) => NFData (Block h era)
+
 instance
   forall era h.
   ( Era era
diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/TreeDiff.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/TreeDiff.hs
@@ -16,7 +16,9 @@ module Test.Cardano.Ledger.TreeDiff (
 ) where
 
 import Cardano.Ledger.Address
+import Cardano.Ledger.BHeaderView
 import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Block
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Compactible (fromCompact)
 import Cardano.Ledger.Core
@@ -251,3 +253,7 @@ instance ToExpr a => ToExpr (NonZero a) where
 
 instance ToExpr PositiveInterval where
   toExpr = toExpr . unboundRational
+
+instance ToExpr BHeaderView
+
+instance (ToExpr h, ToExpr (BlockBody era)) => ToExpr (Block h era)
