From 3a72c41e697f6fb76bff3081ac28adb714289419 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Thu, 15 Sep 2022 12:30:11 +0300 Subject: [PATCH] Added Core.hs to each era that has a TxBody class Co-authored-by: Alexey Kuleshevich --- eras/alonzo/impl/cardano-ledger-alonzo.cabal | 1 + .../impl/src/Cardano/Ledger/Alonzo/Core.hs | 30 +++++++++++ .../impl/src/Cardano/Ledger/Alonzo/TxBody.hs | 14 +----- .../babbage/impl/cardano-ledger-babbage.cabal | 1 + .../impl/src/Cardano/Ledger/Babbage/Core.hs | 28 +++++++++++ .../impl/src/Cardano/Ledger/Babbage/TxBody.hs | 14 +----- .../impl/cardano-ledger-shelley-ma.cabal | 1 + .../impl/src/Cardano/Ledger/ShelleyMA/Core.hs | 26 ++++++++++ .../src/Cardano/Ledger/ShelleyMA/TxBody.hs | 13 +---- .../shelley/impl/cardano-ledger-shelley.cabal | 1 + .../impl/src/Cardano/Ledger/Shelley/Core.hs | 50 +++++++++++++++++++ .../impl/src/Cardano/Ledger/Shelley/TxBody.hs | 23 +-------- 12 files changed, 142 insertions(+), 60 deletions(-) create mode 100644 eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Core.hs create mode 100644 eras/babbage/impl/src/Cardano/Ledger/Babbage/Core.hs create mode 100644 eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Core.hs create mode 100644 eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index aa9d4ba1ba0..0e2baa9f2c0 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/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 diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Core.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Core.hs new file mode 100644 index 00000000000..39960effc2a --- /dev/null +++ b/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) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 33b3283b6bc..27da20b3196 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/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) #-} diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal index d76d66dc620..8aa21fdc4f3 100644 --- a/eras/babbage/impl/cardano-ledger-babbage.cabal +++ b/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 diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Core.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Core.hs new file mode 100644 index 00000000000..5ceeb7d2a20 --- /dev/null +++ b/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))) diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs index c7b92187317..8601170561b 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs +++ b/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) #-} diff --git a/eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal b/eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal index 2cdecbbf57c..c4e41c5d387 100644 --- a/eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal +++ b/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 diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Core.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Core.hs new file mode 100644 index 00000000000..a25b835b865 --- /dev/null +++ b/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))) diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs index 1f08d46d77a..4515395662d 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs +++ b/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) #-} diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index 891491a4504..ef1535c98b7 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/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 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs new file mode 100644 index 00000000000..a093c466855 --- /dev/null +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Core.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE ConstrainedClassMethods #-} +{-# 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 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs index 723ab1e2033..af911b70542 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs +++ b/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) #-}