Skip to content

Commit

Permalink
Added Core.hs to each era that has a TxBody class
Browse files Browse the repository at this point in the history
Co-authored-by: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>
  • Loading branch information
Soupstraw and lehins committed Sep 20, 2022
1 parent 4d85002 commit 52e800e
Show file tree
Hide file tree
Showing 12 changed files with 141 additions and 60 deletions.
1 change: 1 addition & 0 deletions eras/alonzo/impl/cardano-ledger-alonzo.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
30 changes: 30 additions & 0 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Core.hs
Original file line number Diff line number Diff line change
@@ -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)
14 changes: 1 addition & 13 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand All @@ -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)
Expand All @@ -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))),
Expand Down Expand Up @@ -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) #-}

Expand Down
1 change: 1 addition & 0 deletions eras/babbage/impl/cardano-ledger-babbage.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
28 changes: 28 additions & 0 deletions eras/babbage/impl/src/Cardano/Ledger/Babbage/Core.hs
Original file line number Diff line number Diff line change
@@ -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)))
14 changes: 1 addition & 13 deletions eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) #-}

Expand Down
1 change: 1 addition & 0 deletions eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
26 changes: 26 additions & 0 deletions eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Core.hs
Original file line number Diff line number Diff line change
@@ -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)))
13 changes: 1 addition & 12 deletions eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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) #-}
Expand Down
1 change: 1 addition & 0 deletions eras/shelley/impl/cardano-ledger-shelley.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
49 changes: 49 additions & 0 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs
Original file line number Diff line number Diff line change
@@ -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
23 changes: 1 addition & 22 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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) #-}

Expand Down

0 comments on commit 52e800e

Please sign in to comment.