Merge pull request #5179 from IntersectMBO/aniketd/better-blockbody-accessors

aniketd · web-flow · commit 19923f2c6dee · 2025-07-21T18:28:23.000+05:30
Add mkBasicBlockBody{Shelley,Alonzo} and txSeqBlockBody{Shelley,Alonzo}L
diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/BlockBody.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/BlockBody.hs
@@ -13,15 +13,15 @@ import Cardano.Ledger.Allegra.Era (AllegraEra)
 import Cardano.Ledger.Allegra.Tx ()
 import Cardano.Ledger.Core (EraBlockBody (..))
 import Cardano.Ledger.Shelley.BlockBody (
-  ShelleyBlockBody (ShelleyBlockBody),
+  ShelleyBlockBody,
+  mkBasicBlockBodyShelley,
   shelleyBlockBodyHash,
-  shelleyBlockBodyTxs,
+  txSeqBlockBodyShelleyL,
  )
-import Lens.Micro
 
 instance EraBlockBody AllegraEra where
   type BlockBody AllegraEra = ShelleyBlockBody AllegraEra
-  mkBasicBlockBody = ShelleyBlockBody mempty
-  txSeqBlockBodyL = lens shelleyBlockBodyTxs (\_ s -> ShelleyBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyShelley
+  txSeqBlockBodyL = txSeqBlockBodyShelleyL
   hashBlockBody = shelleyBlockBodyHash
   numSegComponents = 3
diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## 1.14.0.0
 
+* Add `mkBasicBlockBodyAlonzo` and `txSeqBlockBodyAlonzoL` to use in Babbage, Conway and Dijkstra.
 * Added `eraUnsupportedLanguage`
 * Changed return type of `mkPlutusScript` and `mkBinaryPlutusScript` from `Maybe` to `MonadFail`
 * Deprecate `Alonzo.TxSeq` in favour of `Alonzo.BlockBody`. #5156
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody.hs
@@ -1,5 +1,7 @@
 module Cardano.Ledger.Alonzo.BlockBody (
   AlonzoBlockBody (AlonzoBlockBody),
+  mkBasicBlockBodyAlonzo,
+  txSeqBlockBodyAlonzoL,
   alonzoBlockBodyHash,
   alonzoBlockBodyTxs,
 ) where
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -26,6 +27,8 @@ module Cardano.Ledger.Alonzo.BlockBody.Internal (
   AlonzoBlockBody (AlonzoBlockBody, ..),
   hashAlonzoSegWits,
   alignedValidFlags,
+  mkBasicBlockBodyAlonzo,
+  txSeqBlockBodyAlonzoL,
 ) where
 
 import qualified Cardano.Crypto.Hash as Hash
@@ -89,11 +92,29 @@ data AlonzoBlockBody era = AlonzoBlockBodyInternal
 
 instance EraBlockBody AlonzoEra where
   type BlockBody AlonzoEra = AlonzoBlockBody AlonzoEra
-  mkBasicBlockBody = AlonzoBlockBody mempty
-  txSeqBlockBodyL = lens abbTxs (\_ s -> AlonzoBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyAlonzo
+  txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = abbHash
   numSegComponents = 4
 
+mkBasicBlockBodyAlonzo ::
+  ( SafeToHash (TxWits era)
+  , BlockBody era ~ AlonzoBlockBody era
+  , AlonzoEraTx era
+  ) =>
+  BlockBody era
+mkBasicBlockBodyAlonzo = AlonzoBlockBody mempty
+{-# INLINEABLE mkBasicBlockBodyAlonzo #-}
+
+txSeqBlockBodyAlonzoL ::
+  ( SafeToHash (TxWits era)
+  , BlockBody era ~ AlonzoBlockBody era
+  , AlonzoEraTx era
+  ) =>
+  Lens' (BlockBody era) (StrictSeq (Tx era))
+txSeqBlockBodyAlonzoL = lens abbTxs (\_ s -> AlonzoBlockBody s)
+{-# INLINEABLE txSeqBlockBodyAlonzoL #-}
+
 pattern AlonzoBlockBody ::
   forall era.
   ( AlonzoEraTx era
diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/BlockBody.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/BlockBody.hs
@@ -7,11 +7,10 @@ import Cardano.Ledger.Alonzo.BlockBody
 import Cardano.Ledger.Babbage.Era
 import Cardano.Ledger.Babbage.Tx ()
 import Cardano.Ledger.Core
-import Lens.Micro (lens)
 
 instance EraBlockBody BabbageEra where
   type BlockBody BabbageEra = AlonzoBlockBody BabbageEra
-  mkBasicBlockBody = AlonzoBlockBody mempty
-  txSeqBlockBodyL = lens alonzoBlockBodyTxs (\_ s -> AlonzoBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyAlonzo
+  txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = alonzoBlockBodyHash
   numSegComponents = 4
diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/BlockBody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/BlockBody.hs
@@ -7,11 +7,10 @@ import Cardano.Ledger.Alonzo.BlockBody
 import Cardano.Ledger.Conway.Era
 import Cardano.Ledger.Conway.Tx ()
 import Cardano.Ledger.Core
-import Lens.Micro (lens)
 
 instance EraBlockBody ConwayEra where
   type BlockBody ConwayEra = AlonzoBlockBody ConwayEra
-  mkBasicBlockBody = AlonzoBlockBody mempty
-  txSeqBlockBodyL = lens alonzoBlockBodyTxs (\_ s -> AlonzoBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyAlonzo
+  txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = alonzoBlockBodyHash
   numSegComponents = 4
diff --git a/eras/dijkstra/src/Cardano/Ledger/Dijkstra/BlockBody.hs b/eras/dijkstra/src/Cardano/Ledger/Dijkstra/BlockBody.hs
@@ -7,11 +7,10 @@ import Cardano.Ledger.Alonzo.BlockBody
 import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra.Era
 import Cardano.Ledger.Dijkstra.Tx ()
-import Lens.Micro (lens)
 
 instance EraBlockBody DijkstraEra where
   type BlockBody DijkstraEra = AlonzoBlockBody DijkstraEra
-  mkBasicBlockBody = AlonzoBlockBody mempty
-  txSeqBlockBodyL = lens alonzoBlockBodyTxs (\_ s -> AlonzoBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyAlonzo
+  txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = alonzoBlockBodyHash
   numSegComponents = 4
diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/BlockBody.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/BlockBody.hs
@@ -13,15 +13,15 @@ import Cardano.Ledger.Core (EraBlockBody (..))
 import Cardano.Ledger.Mary.Era (MaryEra)
 import Cardano.Ledger.Mary.Tx ()
 import Cardano.Ledger.Shelley.BlockBody (
-  ShelleyBlockBody (ShelleyBlockBody),
+  ShelleyBlockBody,
+  mkBasicBlockBodyShelley,
   shelleyBlockBodyHash,
-  shelleyBlockBodyTxs,
+  txSeqBlockBodyShelleyL,
  )
-import Lens.Micro
 
 instance EraBlockBody MaryEra where
   type BlockBody MaryEra = ShelleyBlockBody MaryEra
-  mkBasicBlockBody = ShelleyBlockBody mempty
-  txSeqBlockBodyL = lens shelleyBlockBodyTxs (\_ s -> ShelleyBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyShelley
+  txSeqBlockBodyL = txSeqBlockBodyShelleyL
   hashBlockBody = shelleyBlockBodyHash
   numSegComponents = 3
diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## 1.17.0.0
 
+* Add `mkBasicBlockBodyShelley` and `txSeqBlockBodyShelleyL` to use in Allegra and Mary.
 * Add `Default` instance for `NewEpochState`
 * Remove `epochStateUMapL`, `unifiedL`, `rewards`, `delegations`, `ptrsMap` and `dsUnifiedL`
 * Add `ShelleyEraAccounts` with `mkShelleyAccountState`, `accountsPtrsMapG`, `ptrAccountStateG`
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody.hs
@@ -1,5 +1,7 @@
 module Cardano.Ledger.Shelley.BlockBody (
   ShelleyBlockBody (ShelleyBlockBody),
+  txSeqBlockBodyShelleyL,
+  mkBasicBlockBodyShelley,
   shelleyBlockBodyHash,
   shelleyBlockBodyTxs,
   auxDataSeqDecoder,
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_HADDOCK not-home #-}
@@ -26,6 +27,8 @@
 -- and __without any warning__ between minor versions of this package.
 module Cardano.Ledger.Shelley.BlockBody.Internal (
   ShelleyBlockBody (ShelleyBlockBody, ..),
+  mkBasicBlockBodyShelley,
+  txSeqBlockBodyShelleyL,
   auxDataSeqDecoder,
   hashShelleySegWits,
   bBodySize,
@@ -75,7 +78,7 @@ import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
 import Data.Typeable
 import GHC.Generics (Generic)
-import Lens.Micro (lens, (&), (.~), (^.))
+import Lens.Micro hiding (ix)
 import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
 
 data ShelleyBlockBody era = ShelleyBlockBodyInternal
@@ -94,11 +97,29 @@ data ShelleyBlockBody era = ShelleyBlockBodyInternal
 
 instance EraBlockBody ShelleyEra where
   type BlockBody ShelleyEra = ShelleyBlockBody ShelleyEra
-  mkBasicBlockBody = ShelleyBlockBody mempty
-  txSeqBlockBodyL = lens sbbTxs (\_ s -> ShelleyBlockBody s)
+  mkBasicBlockBody = mkBasicBlockBodyShelley
+  txSeqBlockBodyL = txSeqBlockBodyShelleyL
   hashBlockBody = sbbHash
   numSegComponents = 3
 
+mkBasicBlockBodyShelley ::
+  ( EraBlockBody era
+  , SafeToHash (TxWits era)
+  , BlockBody era ~ ShelleyBlockBody era
+  ) =>
+  BlockBody era
+mkBasicBlockBodyShelley = ShelleyBlockBody mempty
+{-# INLINEABLE mkBasicBlockBodyShelley #-}
+
+txSeqBlockBodyShelleyL ::
+  ( EraBlockBody era
+  , SafeToHash (TxWits era)
+  , BlockBody era ~ ShelleyBlockBody era
+  ) =>
+  Lens' (BlockBody era) (StrictSeq (Tx era))
+txSeqBlockBodyShelleyL = lens sbbTxs (\_ s -> ShelleyBlockBody s)
+{-# INLINEABLE txSeqBlockBodyShelleyL #-}
+
 deriving via
   AllowThunksIn
     '[ "sbbHash"
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs
@@ -2,10 +2,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
