Skip to content

Commit 5c56d03

Browse files
Soupstrawlehins
Soupstraw
and
lehins
committed
Change Tx to an associated data type
Co-authored-by: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>
1 parent 4d330c5 commit 5c56d03

File tree

98 files changed

+930
-770
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

98 files changed

+930
-770
lines changed

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
module Cardano.Ledger.Allegra (
99
Allegra,
1010
AllegraEra,
11+
Tx (..),
1112
) where
1213

1314
import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -17,7 +18,7 @@ import Cardano.Ledger.Allegra.Scripts ()
1718
import Cardano.Ledger.Allegra.State ()
1819
import Cardano.Ledger.Allegra.Transition ()
1920
import Cardano.Ledger.Allegra.Translation ()
20-
import Cardano.Ledger.Allegra.Tx ()
21+
import Cardano.Ledger.Allegra.Tx (Tx (..))
2122
import Cardano.Ledger.Allegra.TxSeq ()
2223
import Cardano.Ledger.Allegra.UTxO ()
2324
import Cardano.Ledger.Shelley.API

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

Lines changed: 29 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,17 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE DerivingStrategies #-}
13
{-# LANGUAGE FlexibleContexts #-}
24
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
36
{-# LANGUAGE ScopedTypeVariables #-}
4-
{-# LANGUAGE TypeApplications #-}
57
{-# LANGUAGE TypeFamilies #-}
68
{-# LANGUAGE TypeOperators #-}
79
{-# LANGUAGE UndecidableInstances #-}
810
{-# OPTIONS_GHC -Wno-orphans #-}
911

1012
module Cardano.Ledger.Allegra.Tx (
1113
validateTimelock,
14+
Tx (..),
1215
) where
1316

1417
import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -17,48 +20,66 @@ import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..), Timelock, evalTime
1720
import Cardano.Ledger.Allegra.TxAuxData ()
1821
import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..))
1922
import Cardano.Ledger.Allegra.TxWits ()
23+
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR)
2024
import Cardano.Ledger.Core (
2125
EraTx (..),
2226
EraTxWits (..),
2327
NativeScript,
2428
)
2529
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
30+
import Cardano.Ledger.MemoBytes (EqRaw (..))
2631
import Cardano.Ledger.Shelley.Tx (
2732
ShelleyTx (..),
33+
Tx (..),
2834
auxDataShelleyTxL,
2935
bodyShelleyTxL,
3036
mkBasicShelleyTx,
3137
shelleyMinFeeTx,
38+
shelleyTxEqRaw,
3239
sizeShelleyTxF,
3340
witsShelleyTxL,
3441
)
42+
import Control.DeepSeq (NFData)
3543
import qualified Data.Set as Set (map)
36-
import Lens.Micro ((^.))
44+
import GHC.Generics (Generic)
45+
import Lens.Micro (Lens', lens, (^.))
46+
import NoThunks.Class (NoThunks)
3747

3848
-- ========================================
3949

4050
instance EraTx AllegraEra where
41-
type Tx AllegraEra = ShelleyTx AllegraEra
51+
newtype Tx AllegraEra = MkAllegraTx {unAllegraTx :: ShelleyTx AllegraEra}
52+
deriving newtype (Eq, NFData, NoThunks, Show, ToCBOR, EncCBOR)
53+
deriving (Generic)
4254

43-
mkBasicTx = mkBasicShelleyTx
55+
mkBasicTx = MkAllegraTx . mkBasicShelleyTx
4456

45-
bodyTxL = bodyShelleyTxL
57+
bodyTxL = allegraTxL . bodyShelleyTxL
4658
{-# INLINE bodyTxL #-}
4759

48-
witsTxL = witsShelleyTxL
60+
witsTxL = allegraTxL . witsShelleyTxL
4961
{-# INLINE witsTxL #-}
5062

51-
auxDataTxL = auxDataShelleyTxL
63+
auxDataTxL = allegraTxL . auxDataShelleyTxL
5264
{-# INLINE auxDataTxL #-}
5365

54-
sizeTxF = sizeShelleyTxF
66+
sizeTxF = allegraTxL . sizeShelleyTxF
5567
{-# INLINE sizeTxF #-}
5668

5769
validateNativeScript = validateTimelock
5870
{-# INLINE validateNativeScript #-}
5971

6072
getMinFeeTx pp tx _ = shelleyMinFeeTx pp tx
6173

74+
instance EqRaw (Tx AllegraEra) where
75+
eqRaw = shelleyTxEqRaw
76+
77+
instance DecCBOR (Annotator (Tx AllegraEra)) where
78+
decCBOR = fmap MkAllegraTx <$> decCBOR
79+
80+
allegraTxL :: Lens' (Tx AllegraEra) (ShelleyTx AllegraEra)
81+
allegraTxL = lens unAllegraTx (\x y -> x {unAllegraTx = y})
82+
6283
-- =======================================================
6384
-- Validating timelock scripts
6485
-- We extract ValidityInterval from TxBody with vldtTxBodyL getter

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ module Test.Cardano.Ledger.Allegra.Arbitrary (
1919
maxTimelockDepth,
2020
) where
2121

22-
import Cardano.Ledger.Allegra (AllegraEra)
22+
import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
2323
import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
2424
import Cardano.Ledger.Allegra.Scripts (
2525
AllegraEraScript (..),
@@ -130,3 +130,5 @@ instance Arbitrary ValidityInterval where
130130
shrink = genericShrink
131131

132132
deriving newtype instance Arbitrary (TransitionConfig AllegraEra)
133+
134+
deriving newtype instance Arbitrary (Tx AllegraEra)

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Allegra.Binary.Annotator (
1515
module Test.Cardano.Ledger.Shelley.Binary.Annotator,
1616
) where
1717

18-
import Cardano.Ledger.Allegra (AllegraEra)
18+
import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
1919
import Cardano.Ledger.Allegra.Scripts
2020
import Cardano.Ledger.Allegra.TxAuxData
2121
import Cardano.Ledger.Allegra.TxBody
@@ -67,3 +67,5 @@ instance Era era => DecCBOR (TimelockRaw era) where
6767

6868
instance Era era => DecCBOR (Timelock era) where
6969
decCBOR = MkTimelock <$> decodeMemoized decCBOR
70+
71+
deriving newtype instance DecCBOR (Tx AllegraEra)

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

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,18 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DerivingStrategies #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
46
{-# LANGUAGE MonoLocalBinds #-}
7+
{-# LANGUAGE StandaloneDeriving #-}
58
{-# LANGUAGE UndecidableInstances #-}
69
{-# OPTIONS_GHC -Wno-orphans #-}
710

811
module Test.Cardano.Ledger.Allegra.TreeDiff (
912
module Test.Cardano.Ledger.Shelley.TreeDiff,
1013
) where
1114

12-
import Cardano.Ledger.Allegra (AllegraEra)
15+
import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
1316
import Cardano.Ledger.Allegra.Rules
1417
import Cardano.Ledger.Allegra.Scripts
1518
import Cardano.Ledger.Allegra.TxAuxData
@@ -56,3 +59,5 @@ instance
5659
, ToExpr (Event (EraRule "PPUP" era))
5760
) =>
5861
ToExpr (AllegraUtxoEvent era)
62+
63+
deriving newtype instance ToExpr (Tx AllegraEra)

‎eras/alonzo/impl/CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
## 1.14.0.0
44

5+
* Rename `alonzoEqTxRaw` to `alonzoTxEqRaw`
56
* Add `Generic` instance to `TransactionScriptFailure`
67
* Add `Generic` instance for `AlonzoBbodyEvent`
78
* Fix `AlonzoPlutusPurpose` CBOR(Group) instances. #5135

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module Cardano.Ledger.Alonzo (
1515
pattern AlonzoTxBody,
1616
AlonzoScript,
1717
AlonzoTxAuxData,
18+
Tx (..),
1819
) where
1920

2021
import Cardano.Ledger.Alonzo.Era
@@ -25,7 +26,7 @@ import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
2526
import Cardano.Ledger.Alonzo.State ()
2627
import Cardano.Ledger.Alonzo.Transition ()
2728
import Cardano.Ledger.Alonzo.Translation ()
28-
import Cardano.Ledger.Alonzo.Tx ()
29+
import Cardano.Ledger.Alonzo.Tx (Tx (..))
2930
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
3031
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut, TxBody (AlonzoTxBody))
3132
import Cardano.Ledger.Alonzo.TxWits ()

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

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure)
2929
import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
3030
import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUtxowPredFailure)
3131
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits)
32-
import Cardano.Ledger.Alonzo.Tx (AlonzoTx, totExUnits)
32+
import Cardano.Ledger.Alonzo.Tx (totExUnits)
3333
import Cardano.Ledger.Alonzo.TxSeq (AlonzoTxSeq, txSeqTxns)
3434
import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
3535
import Cardano.Ledger.BHeaderView (BHeaderView (..), isOverlaySlot)
@@ -185,7 +185,6 @@ alonzoBbodyTransition ::
185185
, EraSegWits era
186186
, AlonzoEraTxWits era
187187
, TxSeq era ~ AlonzoTxSeq era
188-
, Tx era ~ AlonzoTx era
189188
, AlonzoEraPParams era
190189
) =>
191190
TransitionRule (EraRule "BBODY" era)
@@ -266,11 +265,9 @@ instance
266265
, Embed (EraRule "LEDGERS" era) (AlonzoBBODY era)
267266
, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
268267
, State (EraRule "LEDGERS" era) ~ LedgerState era
269-
, Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
268+
, Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
270269
, AlonzoEraTxWits era
271-
, Tx era ~ AlonzoTx era
272270
, TxSeq era ~ AlonzoTxSeq era
273-
, Tx era ~ AlonzoTx era
274271
, EraSegWits era
275272
, AlonzoEraPParams era
276273
) =>

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

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ import Cardano.Ledger.Alonzo.Rules.Delegs ()
2121
import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure)
2222
import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
2323
import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW, AlonzoUtxowEvent, AlonzoUtxowPredFailure)
24-
import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), IsValid (..))
24+
import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
2525
import Cardano.Ledger.BaseTypes (ShelleyBase)
2626
import Cardano.Ledger.Shelley.Core
2727
import Cardano.Ledger.Shelley.LedgerState (
@@ -157,12 +157,11 @@ ledgerTransition = do
157157
instance
158158
( AlonzoEraTx era
159159
, EraGov era
160-
, Tx era ~ AlonzoTx era
161160
, Embed (EraRule "DELEGS" era) (AlonzoLEDGER era)
162161
, Embed (EraRule "UTXOW" era) (AlonzoLEDGER era)
163162
, Environment (EraRule "UTXOW" era) ~ UtxoEnv era
164163
, State (EraRule "UTXOW" era) ~ UTxOState era
165-
, Signal (EraRule "UTXOW" era) ~ AlonzoTx era
164+
, Signal (EraRule "UTXOW" era) ~ Tx era
166165
, Environment (EraRule "DELEGS" era) ~ DelegsEnv era
167166
, State (EraRule "DELEGS" era) ~ CertState era
168167
, Signal (EraRule "DELEGS" era) ~ Seq (TxCert era)
@@ -172,7 +171,7 @@ instance
172171
STS (AlonzoLEDGER era)
173172
where
174173
type State (AlonzoLEDGER era) = LedgerState era
175-
type Signal (AlonzoLEDGER era) = AlonzoTx era
174+
type Signal (AlonzoLEDGER era) = Tx era
176175
type Environment (AlonzoLEDGER era) = LedgerEnv era
177176
type BaseM (AlonzoLEDGER era) = ShelleyBase
178177
type PredicateFailure (AlonzoLEDGER era) = ShelleyLedgerPredFailure era

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

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,11 @@
1313
module Cardano.Ledger.Alonzo.Translation where
1414

1515
import Cardano.Ledger.Alonzo.Core hiding (Tx)
16-
import qualified Cardano.Ledger.Alonzo.Core as Core
1716
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
1817
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
1918
import Cardano.Ledger.Alonzo.PParams ()
2019
import Cardano.Ledger.Alonzo.State
21-
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
20+
import Cardano.Ledger.Alonzo.Tx (IsValid (..), Tx (..))
2221
import Cardano.Ledger.Binary (DecoderError)
2322
import Cardano.Ledger.Shelley.LedgerState (
2423
EpochState (..),
@@ -30,7 +29,7 @@ import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
3029
import Data.Coerce (coerce)
3130
import Data.Default (def)
3231
import qualified Data.Map.Strict as Map
33-
import Lens.Micro ((^.))
32+
import Lens.Micro ((&), (.~), (^.))
3433

3534
--------------------------------------------------------------------------------
3635
-- Translation from Mary to Alonzo
@@ -71,11 +70,9 @@ instance TranslateEra AlonzoEra FuturePParams where
7170
DefinitePParamsUpdate pp -> DefinitePParamsUpdate <$> translateEra ctxt pp
7271
PotentialPParamsUpdate mpp -> PotentialPParamsUpdate <$> mapM (translateEra ctxt) mpp
7372

74-
newtype Tx era = Tx {unTx :: Core.Tx era}
75-
7673
instance TranslateEra AlonzoEra Tx where
7774
type TranslationError AlonzoEra Tx = DecoderError
78-
translateEra _ctxt (Tx tx) = do
75+
translateEra _ctxt tx = do
7976
-- Note that this does not preserve the hidden bytes field of the transaction.
8077
-- This is under the premise that this is irrelevant for TxInBlocks, which are
8178
-- not transmitted as contiguous chunks.
@@ -84,7 +81,11 @@ instance TranslateEra AlonzoEra Tx where
8481
txAuxData <- mapM (translateEraThroughCBOR "TxAuxData") (tx ^. auxDataTxL)
8582
-- transactions from Mary era always pass script ("phase 2") validation
8683
let validating = IsValid True
87-
pure $ Tx $ AlonzoTx txBody txWits validating txAuxData
84+
pure $
85+
mkBasicTx txBody
86+
& witsTxL .~ txWits
87+
& auxDataTxL .~ txAuxData
88+
& isValidTxL .~ validating
8889

8990
--------------------------------------------------------------------------------
9091
-- Auxiliary instances and functions

0 commit comments

Comments
 (0)