Change Tx to an associated data type

eras/allegra/impl/src/Cardano/Ledger/Allegra.hs

@@ -8,6 +8,7 @@
 module Cardano.Ledger.Allegra (
   Allegra,
   AllegraEra,
+  Tx (..),
 ) where
 
 import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -17,7 +18,7 @@ import Cardano.Ledger.Allegra.Scripts ()
 import Cardano.Ledger.Allegra.State ()
 import Cardano.Ledger.Allegra.Transition ()
 import Cardano.Ledger.Allegra.Translation ()
-import Cardano.Ledger.Allegra.Tx ()
+import Cardano.Ledger.Allegra.Tx (Tx (..))
 import Cardano.Ledger.Allegra.TxSeq ()
 import Cardano.Ledger.Allegra.UTxO ()
 import Cardano.Ledger.Shelley.API

eras/allegra/impl/src/Cardano/Ledger/Allegra/Tx.hs

@@ -1,14 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Allegra.Tx (
   validateTimelock,
+  Tx (..),
 ) where
 
 import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -17,48 +20,66 @@ import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..), Timelock, evalTime
 import Cardano.Ledger.Allegra.TxAuxData ()
 import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..))
 import Cardano.Ledger.Allegra.TxWits ()
+import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR)
 import Cardano.Ledger.Core (
   EraTx (..),
   EraTxWits (..),
   NativeScript,
  )
 import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
+import Cardano.Ledger.MemoBytes (EqRaw (..))
 import Cardano.Ledger.Shelley.Tx (
   ShelleyTx (..),
+  Tx (..),
   auxDataShelleyTxL,
   bodyShelleyTxL,
   mkBasicShelleyTx,
   shelleyMinFeeTx,
+  shelleyTxEqRaw,
   sizeShelleyTxF,
   witsShelleyTxL,
  )
+import Control.DeepSeq (NFData)
 import qualified Data.Set as Set (map)
-import Lens.Micro ((^.))
+import GHC.Generics (Generic)
+import Lens.Micro (Lens', lens, (^.))
+import NoThunks.Class (NoThunks)
 
 -- ========================================
 
 instance EraTx AllegraEra where
-  type Tx AllegraEra = ShelleyTx AllegraEra
+  newtype Tx AllegraEra = MkAllegraTx {unAllegraTx :: ShelleyTx AllegraEra}
+    deriving newtype (Eq, NFData, NoThunks, Show, ToCBOR, EncCBOR)
+    deriving (Generic)
 
-  mkBasicTx = mkBasicShelleyTx
+  mkBasicTx = MkAllegraTx . mkBasicShelleyTx
 
-  bodyTxL = bodyShelleyTxL
+  bodyTxL = allegraTxL . bodyShelleyTxL
   {-# INLINE bodyTxL #-}
 
-  witsTxL = witsShelleyTxL
+  witsTxL = allegraTxL . witsShelleyTxL
   {-# INLINE witsTxL #-}
 
-  auxDataTxL = auxDataShelleyTxL
+  auxDataTxL = allegraTxL . auxDataShelleyTxL
   {-# INLINE auxDataTxL #-}
 
-  sizeTxF = sizeShelleyTxF
+  sizeTxF = allegraTxL . sizeShelleyTxF
   {-# INLINE sizeTxF #-}
 
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 
   getMinFeeTx pp tx _ = shelleyMinFeeTx pp tx
 
+instance EqRaw (Tx AllegraEra) where
+  eqRaw = shelleyTxEqRaw
+
+instance DecCBOR (Annotator (Tx AllegraEra)) where
+  decCBOR = fmap MkAllegraTx <$> decCBOR
+
+allegraTxL :: Lens' (Tx AllegraEra) (ShelleyTx AllegraEra)
+allegraTxL = lens unAllegraTx (\x y -> x {unAllegraTx = y})
+
 -- =======================================================
 -- Validating timelock scripts
 -- We extract ValidityInterval from TxBody with vldtTxBodyL getter

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Arbitrary.hs

@@ -19,7 +19,7 @@ module Test.Cardano.Ledger.Allegra.Arbitrary (
   maxTimelockDepth,
 ) where
 
-import Cardano.Ledger.Allegra (AllegraEra)
+import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
 import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
 import Cardano.Ledger.Allegra.Scripts (
   AllegraEraScript (..),
@@ -130,3 +130,5 @@ instance Arbitrary ValidityInterval where
   shrink = genericShrink
 
 deriving newtype instance Arbitrary (TransitionConfig AllegraEra)
+
+deriving newtype instance Arbitrary (Tx AllegraEra)

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Annotator.hs

@@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Allegra.Binary.Annotator (
   module Test.Cardano.Ledger.Shelley.Binary.Annotator,
 ) where
 
-import Cardano.Ledger.Allegra (AllegraEra)
+import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
 import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Allegra.TxAuxData
 import Cardano.Ledger.Allegra.TxBody
@@ -67,3 +67,5 @@ instance Era era => DecCBOR (TimelockRaw era) where
 
 instance Era era => DecCBOR (Timelock era) where
   decCBOR = MkTimelock <$> decodeMemoized decCBOR
+
+deriving newtype instance DecCBOR (Tx AllegraEra)

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/TreeDiff.hs

@@ -1,15 +1,18 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.Allegra.TreeDiff (
   module Test.Cardano.Ledger.Shelley.TreeDiff,
 ) where
 
-import Cardano.Ledger.Allegra (AllegraEra)
+import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
 import Cardano.Ledger.Allegra.Rules
 import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Allegra.TxAuxData
@@ -56,3 +59,5 @@ instance
   , ToExpr (Event (EraRule "PPUP" era))
   ) =>
   ToExpr (AllegraUtxoEvent era)
+
+deriving newtype instance ToExpr (Tx AllegraEra)

eras/alonzo/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.14.0.0
 
+* Rename `alonzoEqTxRaw` to `alonzoTxEqRaw`
 * Add `Generic` instance to `TransactionScriptFailure`
 * Add `Generic` instance for `AlonzoBbodyEvent`
 * Fix `AlonzoPlutusPurpose` CBOR(Group) instances. #5135

eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -15,6 +15,7 @@ module Cardano.Ledger.Alonzo (
   pattern AlonzoTxBody,
   AlonzoScript,
   AlonzoTxAuxData,
+  Tx (..),
 ) where
 
 import Cardano.Ledger.Alonzo.Era
@@ -25,7 +26,7 @@ import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
 import Cardano.Ledger.Alonzo.State ()
 import Cardano.Ledger.Alonzo.Transition ()
 import Cardano.Ledger.Alonzo.Translation ()
-import Cardano.Ledger.Alonzo.Tx ()
+import Cardano.Ledger.Alonzo.Tx (Tx (..))
 import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
 import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut, TxBody (AlonzoTxBody))
 import Cardano.Ledger.Alonzo.TxWits ()

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -29,7 +29,7 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUtxowPredFailure)
 import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits)
-import Cardano.Ledger.Alonzo.Tx (AlonzoTx, totExUnits)
+import Cardano.Ledger.Alonzo.Tx (totExUnits)
 import Cardano.Ledger.Alonzo.TxSeq (AlonzoTxSeq, txSeqTxns)
 import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
 import Cardano.Ledger.BHeaderView (BHeaderView (..), isOverlaySlot)
@@ -185,7 +185,6 @@ alonzoBbodyTransition ::
   , EraSegWits era
   , AlonzoEraTxWits era
   , TxSeq era ~ AlonzoTxSeq era
-  , Tx era ~ AlonzoTx era
   , AlonzoEraPParams era
   ) =>
   TransitionRule (EraRule "BBODY" era)
@@ -266,11 +265,9 @@ instance
   , Embed (EraRule "LEDGERS" era) (AlonzoBBODY era)
   , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
   , State (EraRule "LEDGERS" era) ~ LedgerState era
-  , Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
+  , Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
   , AlonzoEraTxWits era
-  , Tx era ~ AlonzoTx era
   , TxSeq era ~ AlonzoTxSeq era
-  , Tx era ~ AlonzoTx era
   , EraSegWits era
   , AlonzoEraPParams era
   ) =>

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs

@@ -21,7 +21,7 @@ import Cardano.Ledger.Alonzo.Rules.Delegs ()
 import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW, AlonzoUtxowEvent, AlonzoUtxowPredFailure)
-import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), IsValid (..))
+import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
 import Cardano.Ledger.BaseTypes (ShelleyBase)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.LedgerState (
@@ -157,12 +157,11 @@ ledgerTransition = do
 instance
   ( AlonzoEraTx era
   , EraGov era
-  , Tx era ~ AlonzoTx era
   , Embed (EraRule "DELEGS" era) (AlonzoLEDGER era)
   , Embed (EraRule "UTXOW" era) (AlonzoLEDGER era)
   , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
   , State (EraRule "UTXOW" era) ~ UTxOState era
-  , Signal (EraRule "UTXOW" era) ~ AlonzoTx era
+  , Signal (EraRule "UTXOW" era) ~ Tx era
   , Environment (EraRule "DELEGS" era) ~ DelegsEnv era
   , State (EraRule "DELEGS" era) ~ CertState era
   , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era)
@@ -172,7 +171,7 @@ instance
   STS (AlonzoLEDGER era)
   where
   type State (AlonzoLEDGER era) = LedgerState era
-  type Signal (AlonzoLEDGER era) = AlonzoTx era
+  type Signal (AlonzoLEDGER era) = Tx era
   type Environment (AlonzoLEDGER era) = LedgerEnv era
   type BaseM (AlonzoLEDGER era) = ShelleyBase
   type PredicateFailure (AlonzoLEDGER era) = ShelleyLedgerPredFailure era

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs

@@ -13,12 +13,11 @@
 module Cardano.Ledger.Alonzo.Translation where
 
 import Cardano.Ledger.Alonzo.Core hiding (Tx)
-import qualified Cardano.Ledger.Alonzo.Core as Core
 import Cardano.Ledger.Alonzo.Era (AlonzoEra)
 import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.PParams ()
 import Cardano.Ledger.Alonzo.State
-import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
+import Cardano.Ledger.Alonzo.Tx (IsValid (..), Tx (..))
 import Cardano.Ledger.Binary (DecoderError)
 import Cardano.Ledger.Shelley.LedgerState (
   EpochState (..),
@@ -30,7 +29,7 @@ import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
 import Data.Coerce (coerce)
 import Data.Default (def)
 import qualified Data.Map.Strict as Map
-import Lens.Micro ((^.))
+import Lens.Micro ((&), (.~), (^.))
 
 --------------------------------------------------------------------------------
 -- Translation from Mary to Alonzo
@@ -71,11 +70,9 @@ instance TranslateEra AlonzoEra FuturePParams where
     DefinitePParamsUpdate pp -> DefinitePParamsUpdate <$> translateEra ctxt pp
     PotentialPParamsUpdate mpp -> PotentialPParamsUpdate <$> mapM (translateEra ctxt) mpp
 
-newtype Tx era = Tx {unTx :: Core.Tx era}
-
 instance TranslateEra AlonzoEra Tx where
   type TranslationError AlonzoEra Tx = DecoderError
-  translateEra _ctxt (Tx tx) = do
+  translateEra _ctxt tx = do
     -- Note that this does not preserve the hidden bytes field of the transaction.
     -- This is under the premise that this is irrelevant for TxInBlocks, which are
     -- not transmitted as contiguous chunks.
@@ -84,7 +81,11 @@ instance TranslateEra AlonzoEra Tx where
     txAuxData <- mapM (translateEraThroughCBOR "TxAuxData") (tx ^. auxDataTxL)
     -- transactions from Mary era always pass script ("phase 2") validation
     let validating = IsValid True
-    pure $ Tx $ AlonzoTx txBody txWits validating txAuxData
+    pure $
+      mkBasicTx txBody
+        & witsTxL .~ txWits
+        & auxDataTxL .~ txAuxData
+        & isValidTxL .~ validating
 
 --------------------------------------------------------------------------------
 -- Auxiliary instances and functions