Added Core.hs to each era that has a TxBody class

Co-authored-by: Alexey Kuleshevich <[email protected]>

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -36,6 +36,7 @@ library
   import:             base, project-config
   exposed-modules:
     Cardano.Ledger.Alonzo
+    Cardano.Ledger.Alonzo.Core
     Cardano.Ledger.Alonzo.Data
     Cardano.Ledger.Alonzo.Genesis
     Cardano.Ledger.Alonzo.Language

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

@@ -0,0 +1,30 @@
+{-# LANGUAGE DataKinds #-}
+
+module Cardano.Ledger.Alonzo.Core
+  ( AlonzoEraTxBody (..),
+    ScriptIntegrityHash,
+    module Cardano.Ledger.ShelleyMA.Core,
+  )
+where
+
+import Cardano.Ledger.Alonzo.TxOut (AlonzoEraTxOut)
+import Cardano.Ledger.BaseTypes (Network)
+import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
+import Cardano.Ledger.SafeHash (SafeHash)
+import Cardano.Ledger.ShelleyMA.Core
+import Cardano.Ledger.TxIn (TxIn (..))
+import Data.Maybe.Strict (StrictMaybe)
+import Data.Set (Set)
+import Lens.Micro (Lens')
+
+type ScriptIntegrityHash c = SafeHash c EraIndependentScriptIntegrity
+
+class (ShelleyMAEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where
+  collateralInputsTxBodyL :: Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
+
+  reqSignerHashesTxBodyL :: Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
+
+  scriptIntegrityHashTxBodyL ::
+    Lens' (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
+
+  networkIdTxBodyL :: Lens' (TxBody era) (StrictMaybe Network)

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

@@ -79,6 +79,7 @@ import Cardano.Binary
   ( FromCBOR (..),
     ToCBOR (..),
   )
+import Cardano.Ledger.Alonzo.Core (AlonzoEraTxBody (..), ScriptIntegrityHash)
 import Cardano.Ledger.Alonzo.Data (AuxiliaryDataHash (..))
 import Cardano.Ledger.Alonzo.Era
 import Cardano.Ledger.Alonzo.Scripts ()
@@ -97,7 +98,6 @@ import Cardano.Ledger.Mary.Value (MaryValue (MaryValue), MultiAsset (..), polici
 import Cardano.Ledger.MemoBytes (Mem, MemoBytes (..), MemoHashIndex, contentsEq, memoBytes)
 import Cardano.Ledger.SafeHash
   ( HashAnnotated (..),
-    SafeHash,
     SafeToHash,
   )
 import Cardano.Ledger.Shelley.Delegation.Certificates (DCert)
@@ -122,8 +122,6 @@ import Prelude hiding (lookup)
 
 -- ======================================
 
-type ScriptIntegrityHash c = SafeHash c EraIndependentScriptIntegrity
-
 data TxBodyRaw era = TxBodyRaw
   { _inputs :: !(Set (TxIn (EraCrypto era))),
     _collateral :: !(Set (TxIn (EraCrypto era))),
@@ -238,16 +236,6 @@ instance CC.Crypto c => ShelleyMAEraTxBody (AlonzoEra c) where
     to (\(TxBodyConstr (Memo txBodyRaw _)) -> Set.map policyID (policies (_mint txBodyRaw)))
   {-# INLINEABLE mintedTxBodyF #-}
 
-class (ShelleyMAEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where
-  collateralInputsTxBodyL :: Lens' (Core.TxBody era) (Set (TxIn (EraCrypto era)))
-
-  reqSignerHashesTxBodyL :: Lens' (Core.TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
-
-  scriptIntegrityHashTxBodyL ::
-    Lens' (Core.TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
-
-  networkIdTxBodyL :: Lens' (Core.TxBody era) (StrictMaybe Network)
-
 instance CC.Crypto c => AlonzoEraTxBody (AlonzoEra c) where
   {-# SPECIALIZE instance AlonzoEraTxBody (AlonzoEra CC.StandardCrypto) #-}
 

eras/babbage/impl/cardano-ledger-babbage.cabal

@@ -44,6 +44,7 @@ library
     Cardano.Ledger.Babbage.Scripts
     Cardano.Ledger.Babbage.Collateral
     Cardano.Ledger.Babbage.Rules
+    Cardano.Ledger.Babbage.Core
     Cardano.Ledger.Babbage
   other-modules:
     Cardano.Ledger.Babbage.Era

eras/babbage/impl/src/Cardano/Ledger/Babbage/Core.hs

@@ -0,0 +1,28 @@
+module Cardano.Ledger.Babbage.Core
+  ( BabbageEraTxBody (..),
+    module Cardano.Ledger.Alonzo.Core,
+  )
+where
+
+import Cardano.Ledger.Alonzo.Core
+import Cardano.Ledger.Babbage.TxOut (BabbageEraTxOut)
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Serialization (Sized (..))
+import Cardano.Ledger.TxIn (TxIn (..))
+import Data.Maybe.Strict (StrictMaybe)
+import Data.Sequence.Strict (StrictSeq)
+import Data.Set (Set)
+import Lens.Micro (Lens', SimpleGetter)
+
+class (AlonzoEraTxBody era, BabbageEraTxOut era) => BabbageEraTxBody era where
+  sizedOutputsTxBodyL :: Lens' (TxBody era) (StrictSeq (Sized (TxOut era)))
+
+  referenceInputsTxBodyL :: Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
+
+  totalCollateralTxBodyL :: Lens' (TxBody era) (StrictMaybe Coin)
+
+  collateralReturnTxBodyL :: Lens' (TxBody era) (StrictMaybe (TxOut era))
+
+  sizedCollateralReturnTxBodyL :: Lens' (TxBody era) (StrictMaybe (Sized (TxOut era)))
+
+  allSizedOutputsTxBodyF :: SimpleGetter (TxBody era) (StrictSeq (Sized (TxOut era)))

eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs

@@ -125,6 +125,7 @@ import Cardano.Ledger.Alonzo.TxBody as AlonzoTxBodyReExports
     ShelleyEraTxBody (..),
     ShelleyMAEraTxBody (..),
   )
+import Cardano.Ledger.Babbage.Core (BabbageEraTxBody (..))
 import Cardano.Ledger.Babbage.Era (BabbageEra)
 import Cardano.Ledger.Babbage.Scripts ()
 import Cardano.Ledger.Babbage.TxOut
@@ -457,19 +458,6 @@ instance CC.Crypto c => AlonzoEraTxBody (BabbageEra c) where
   networkIdTxBodyL = networkIdBabbageTxBodyL
   {-# INLINE networkIdTxBodyL #-}
 
-class (AlonzoEraTxBody era, BabbageEraTxOut era) => BabbageEraTxBody era where
-  sizedOutputsTxBodyL :: Lens' (Core.TxBody era) (StrictSeq (Sized (Core.TxOut era)))
-
-  referenceInputsTxBodyL :: Lens' (Core.TxBody era) (Set (TxIn (EraCrypto era)))
-
-  totalCollateralTxBodyL :: Lens' (Core.TxBody era) (StrictMaybe Coin)
-
-  collateralReturnTxBodyL :: Lens' (Core.TxBody era) (StrictMaybe (Core.TxOut era))
-
-  sizedCollateralReturnTxBodyL :: Lens' (Core.TxBody era) (StrictMaybe (Sized (Core.TxOut era)))
-
-  allSizedOutputsTxBodyF :: SimpleGetter (TxBody era) (StrictSeq (Sized (Core.TxOut era)))
-
 instance CC.Crypto c => BabbageEraTxBody (BabbageEra c) where
   {-# SPECIALIZE instance BabbageEraTxBody (BabbageEra CC.StandardCrypto) #-}
 

eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal

@@ -43,6 +43,7 @@ library
     Cardano.Ledger.Mary.Translation
     Cardano.Ledger.Mary.Value
     Cardano.Ledger.ShelleyMA
+    Cardano.Ledger.ShelleyMA.Core
     Cardano.Ledger.ShelleyMA.Era
     Cardano.Ledger.ShelleyMA.AuxiliaryData
     Cardano.Ledger.ShelleyMA.Rules

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Core.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Cardano.Ledger.ShelleyMA.Core
+  ( ShelleyMAEraTxBody (..),
+    module Cardano.Ledger.Shelley.Core,
+  )
+where
+
+import Cardano.Ledger.Mary.Value (MultiAsset (..))
+import Cardano.Ledger.Shelley.Core
+import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
+import Cardano.Ledger.Val (DecodeMint, EncodeMint)
+import Data.Set (Set)
+import Lens.Micro (Lens', SimpleGetter)
+
+class
+  (ShelleyEraTxBody era, EncodeMint (Value era), DecodeMint (Value era)) =>
+  ShelleyMAEraTxBody era
+  where
+  vldtTxBodyL :: Lens' (TxBody era) ValidityInterval
+
+  mintTxBodyL :: Lens' (TxBody era) (MultiAsset (EraCrypto era))
+
+  mintValueTxBodyF :: SimpleGetter (TxBody era) (Value era)
+
+  mintedTxBodyF :: SimpleGetter (TxBody era) (Set (ScriptHash (EraCrypto era)))

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs

@@ -64,6 +64,7 @@ import Cardano.Ledger.Shelley.TxBody
     ShelleyTxOut (..),
     Wdrl (..),
   )
+import Cardano.Ledger.ShelleyMA.Core (ShelleyMAEraTxBody (..))
 import Cardano.Ledger.ShelleyMA.Era
   ( MAClass (getScriptHash, promoteMultiAsset),
     MaryOrAllegra (..),
@@ -362,18 +363,6 @@ instance MAClass ma c => ShelleyEraTxBody (ShelleyMAEra ma c) where
     lensTxBodyRaw certs (\txBodyRaw certs_ -> txBodyRaw {certs = certs_})
   {-# INLINEABLE certsTxBodyL #-}
 
-class
-  (ShelleyEraTxBody era, EncodeMint (Value era), DecodeMint (Value era)) =>
-  ShelleyMAEraTxBody era
-  where
-  vldtTxBodyL :: Lens' (Core.TxBody era) ValidityInterval
-
-  mintTxBodyL :: Lens' (Core.TxBody era) (MultiAsset (EraCrypto era))
-
-  mintValueTxBodyF :: SimpleGetter (Core.TxBody era) (Core.Value era)
-
-  mintedTxBodyF :: SimpleGetter (Core.TxBody era) (Set (ScriptHash (EraCrypto era)))
-
 instance MAClass ma c => ShelleyMAEraTxBody (ShelleyMAEra ma c) where
   {-# SPECIALIZE instance ShelleyMAEraTxBody (ShelleyMAEra 'Mary StandardCrypto) #-}
   {-# SPECIALIZE instance ShelleyMAEraTxBody (ShelleyMAEra 'Allegra StandardCrypto) #-}

eras/shelley/impl/cardano-ledger-shelley.cabal

@@ -42,6 +42,7 @@ library
     Cardano.Ledger.Shelley.API.Types
     Cardano.Ledger.Shelley.AdaPots
     Cardano.Ledger.Shelley.BlockChain
+    Cardano.Ledger.Shelley.Core
     Cardano.Ledger.Shelley.CompactAddr
     Cardano.Ledger.Shelley.Delegation.Certificates
     Cardano.Ledger.Shelley.Delegation.PoolParams

eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Cardano.Ledger.Shelley.Core
+  ( ShelleyEraTxBody (..),
+    Wdrl (..),
+    module Cardano.Ledger.Core,
+  )
+where
+
+import Cardano.Binary (FromCBOR (..), ToCBOR (..))
+import Cardano.Ledger.Address (RewardAcnt (..))
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Core
+import Cardano.Ledger.Crypto (Crypto)
+import Cardano.Ledger.Serialization (mapFromCBOR, mapToCBOR)
+import Cardano.Ledger.Shelley.Delegation.Certificates (DCert)
+import Cardano.Ledger.Shelley.Era (ShelleyEra)
+import Cardano.Ledger.Shelley.PParams (Update)
+import Cardano.Ledger.Slot (SlotNo (..))
+import Control.DeepSeq (NFData)
+import Data.Map.Strict (Map)
+import Data.Maybe.Strict (StrictMaybe)
+import Data.Sequence.Strict (StrictSeq)
+import GHC.Generics (Generic)
+import Lens.Micro (Lens')
+import NoThunks.Class (NoThunks)
+
+class EraTxBody era => ShelleyEraTxBody era where
+  wdrlsTxBodyL :: Lens' (TxBody era) (Wdrl (EraCrypto era))
+
+  ttlTxBodyL :: ExactEra ShelleyEra era => Lens' (TxBody era) SlotNo
+
+  updateTxBodyL :: Lens' (TxBody era) (StrictMaybe (Update era))
+
+  certsTxBodyL :: Lens' (TxBody era) (StrictSeq (DCert (EraCrypto era)))
+
+newtype Wdrl c = Wdrl {unWdrl :: Map (RewardAcnt c) Coin}
+  deriving (Show, Eq, Generic)
+  deriving newtype (NoThunks, NFData)
+
+instance Crypto c => ToCBOR (Wdrl c) where
+  toCBOR = mapToCBOR . unWdrl
+
+instance Crypto c => FromCBOR (Wdrl c) where
+  fromCBOR = Wdrl <$> mapFromCBOR

eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs

@@ -84,9 +84,8 @@ import Cardano.Ledger.Serialization
   ( decodeSet,
     decodeStrictSeq,
     encodeFoldable,
-    mapFromCBOR,
-    mapToCBOR,
   )
+import Cardano.Ledger.Shelley.Core (ShelleyEraTxBody (..), Wdrl (..))
 import Cardano.Ledger.Shelley.Delegation.Certificates
   ( DCert (..),
     DelegCert (..),
@@ -120,7 +119,6 @@ import Data.Coders
     ofield,
     (!>),
   )
-import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
@@ -133,16 +131,6 @@ import NoThunks.Class (NoThunks (..))
 
 -- ========================================================================
 
-newtype Wdrl c = Wdrl {unWdrl :: Map (RewardAcnt c) Coin}
-  deriving (Show, Eq, Generic)
-  deriving newtype (NoThunks, NFData)
-
-instance CC.Crypto c => ToCBOR (Wdrl c) where
-  toCBOR = mapToCBOR . unWdrl
-
-instance CC.Crypto c => FromCBOR (Wdrl c) where
-  fromCBOR = Wdrl <$> mapFromCBOR
-
 -- ---------------------------
 -- WellFormed instances
 
@@ -313,15 +301,6 @@ instance CC.Crypto c => EraTxBody (ShelleyEra c) where
       (\txBody auxDataHash -> txBody {_mdHash = auxDataHash})
   {-# INLINEABLE auxDataHashTxBodyL #-}
 
-class EraTxBody era => ShelleyEraTxBody era where
-  wdrlsTxBodyL :: Lens' (Core.TxBody era) (Wdrl (EraCrypto era))
-
-  ttlTxBodyL :: ExactEra ShelleyEra era => Lens' (Core.TxBody era) SlotNo
-
-  updateTxBodyL :: Lens' (Core.TxBody era) (StrictMaybe (Update era))
-
-  certsTxBodyL :: Lens' (Core.TxBody era) (StrictSeq (DCert (EraCrypto era)))
-
 instance CC.Crypto c => ShelleyEraTxBody (ShelleyEra c) where
   {-# SPECIALIZE instance ShelleyEraTxBody (ShelleyEra CC.StandardCrypto) #-}