Skip to content

Commit 6c4526a

Browse files
SoupstrawSoupstraw
committed
WIP
1 parent 66eca84 commit 6c4526a

File tree

99 files changed

+905
-804
lines changed

Some content is hidden

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

99 files changed

+905
-804
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: 25 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,6 +20,8 @@ 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)
24+
import Cardano.Ledger.Binary.Coders (Decode (..), decode, (<*!))
2025
import Cardano.Ledger.Core (
2126
EraTx (..),
2227
EraTxWits (..),
@@ -25,40 +30,52 @@ import Cardano.Ledger.Core (
2530
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
2631
import Cardano.Ledger.Shelley.Tx (
2732
ShelleyTx (..),
33+
Tx (..),
2834
auxDataShelleyTxL,
2935
bodyShelleyTxL,
3036
mkBasicShelleyTx,
3137
shelleyMinFeeTx,
3238
sizeShelleyTxF,
3339
witsShelleyTxL,
3440
)
41+
import Control.DeepSeq (NFData)
3542
import qualified Data.Set as Set (map)
36-
import Lens.Micro ((^.))
43+
import GHC.Generics (Generic)
44+
import Lens.Micro (Lens', lens, (^.))
45+
import NoThunks.Class (NoThunks)
3746

3847
-- ========================================
3948

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

43-
mkBasicTx = mkBasicShelleyTx
54+
mkBasicTx = MkAllegraTx . mkBasicShelleyTx
4455

45-
bodyTxL = bodyShelleyTxL
56+
bodyTxL = allegraTxL . bodyShelleyTxL
4657
{-# INLINE bodyTxL #-}
4758

48-
witsTxL = witsShelleyTxL
59+
witsTxL = allegraTxL . witsShelleyTxL
4960
{-# INLINE witsTxL #-}
5061

51-
auxDataTxL = auxDataShelleyTxL
62+
auxDataTxL = allegraTxL . auxDataShelleyTxL
5263
{-# INLINE auxDataTxL #-}
5364

54-
sizeTxF = sizeShelleyTxF
65+
sizeTxF = allegraTxL . sizeShelleyTxF
5566
{-# INLINE sizeTxF #-}
5667

5768
validateNativeScript = validateTimelock
5869
{-# INLINE validateNativeScript #-}
5970

6071
getMinFeeTx pp tx _ = shelleyMinFeeTx pp tx
6172

73+
instance DecCBOR (Annotator (Tx AllegraEra)) where
74+
decCBOR = decode $ Ann (RecD MkAllegraTx) <*! From
75+
76+
allegraTxL :: Lens' (Tx AllegraEra) (ShelleyTx AllegraEra)
77+
allegraTxL = lens unAllegraTx (\x y -> x {unAllegraTx = y})
78+
6279
-- =======================================================
6380
-- Validating timelock scripts
6481
-- 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
@@ -4,12 +4,15 @@
44
{-# LANGUAGE MonoLocalBinds #-}
55
{-# LANGUAGE UndecidableInstances #-}
66
{-# OPTIONS_GHC -Wno-orphans #-}
7+
{-# LANGUAGE StandaloneDeriving #-}
8+
{-# LANGUAGE DerivingStrategies #-}
9+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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/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)
@@ -184,7 +184,6 @@ alonzoBbodyTransition ::
184184
, EraSegWits era
185185
, AlonzoEraTxWits era
186186
, TxSeq era ~ AlonzoTxSeq era
187-
, Tx era ~ AlonzoTx era
188187
, AlonzoEraPParams era
189188
) =>
190189
TransitionRule (EraRule "BBODY" era)
@@ -265,11 +264,9 @@ instance
265264
, Embed (EraRule "LEDGERS" era) (AlonzoBBODY era)
266265
, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
267266
, State (EraRule "LEDGERS" era) ~ LedgerState era
268-
, Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
267+
, Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
269268
, AlonzoEraTxWits era
270-
, Tx era ~ AlonzoTx era
271269
, TxSeq era ~ AlonzoTxSeq era
272-
, Tx era ~ AlonzoTx era
273270
, EraSegWits era
274271
, AlonzoEraPParams era
275272
) =>

‎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: 9 additions & 8 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,8 +81,12 @@ 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
88-
84+
pure $
85+
mkBasicTx txBody
86+
& witsTxL .~ txWits
87+
& auxDataTxL .~ txAuxData
88+
& isValidTxL .~ validating
89+
8990
--------------------------------------------------------------------------------
9091
-- Auxiliary instances and functions
9192
--------------------------------------------------------------------------------

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

Lines changed: 16 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,6 @@
99
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1010
{-# LANGUAGE MultiParamTypeClasses #-}
1111
{-# LANGUAGE NamedFieldPuns #-}
12-
{-# LANGUAGE OverloadedStrings #-}
13-
{-# LANGUAGE PatternSynonyms #-}
1412
{-# LANGUAGE ScopedTypeVariables #-}
1513
{-# LANGUAGE StandaloneDeriving #-}
1614
{-# LANGUAGE TypeApplications #-}
@@ -42,6 +40,7 @@ module Cardano.Ledger.Alonzo.Tx (
4240
ScriptIntegrityHash,
4341
-- Figure 3
4442
AlonzoTx (AlonzoTx, atBody, atWits, atIsValid, atAuxData),
43+
Tx (..),
4544
AlonzoEraTx (..),
4645
mkBasicAlonzoTx,
4746
bodyAlonzoTxL,
@@ -61,7 +60,6 @@ module Cardano.Ledger.Alonzo.Tx (
6160
-- Other
6261
toCBORForSizeComputation,
6362
toCBORForMempoolSubmission,
64-
alonzoEqTxRaw,
6563
) where
6664

6765
import Cardano.Ledger.Allegra.Tx (validateTimelock)
@@ -108,10 +106,9 @@ import Cardano.Ledger.Binary (
108106
import Cardano.Ledger.Binary.Coders
109107
import Cardano.Ledger.Coin (Coin (..))
110108
import Cardano.Ledger.Core
111-
import Cardano.Ledger.MemoBytes (EqRaw (..))
109+
import Cardano.Ledger.Mary (Tx (..))
112110
import Cardano.Ledger.Plutus.Data (Data, hashData)
113111
import Cardano.Ledger.Plutus.Language (nonNativeLanguages)
114-
import Cardano.Ledger.Shelley.Tx (shelleyEqTxRaw)
115112
import qualified Cardano.Ledger.State as Shelley
116113
import Cardano.Ledger.Val (Val ((<+>), (<×>)))
117114
import Control.DeepSeq (NFData (..))
@@ -145,20 +142,22 @@ data AlonzoTx era = AlonzoTx
145142
deriving (Generic)
146143

147144
instance EraTx AlonzoEra where
148-
type Tx AlonzoEra = AlonzoTx AlonzoEra
145+
newtype Tx AlonzoEra = MkAlonzoTx (AlonzoTx AlonzoEra)
146+
deriving newtype (Eq, NFData, EncCBOR, ToCBOR, NoThunks, Show)
147+
deriving (Generic)
149148

150-
mkBasicTx = mkBasicAlonzoTx
149+
mkBasicTx = MkAlonzoTx . mkBasicAlonzoTx
151150

152-
bodyTxL = bodyAlonzoTxL
151+
bodyTxL = alonzoTxL . bodyAlonzoTxL
153152
{-# INLINE bodyTxL #-}
154153

155-
witsTxL = witsAlonzoTxL
154+
witsTxL = alonzoTxL . witsAlonzoTxL
156155
{-# INLINE witsTxL #-}
157156

158-
auxDataTxL = auxDataAlonzoTxL
157+
auxDataTxL = alonzoTxL . auxDataAlonzoTxL
159158
{-# INLINE auxDataTxL #-}
160159

161-
sizeTxF = sizeAlonzoTxF
160+
sizeTxF = alonzoTxL . sizeAlonzoTxF
162161
{-# INLINE sizeTxF #-}
163162

164163
validateNativeScript = validateTimelock
@@ -167,17 +166,20 @@ instance EraTx AlonzoEra where
167166
getMinFeeTx pp tx _ = alonzoMinFeeTx pp tx
168167
{-# INLINE getMinFeeTx #-}
169168

170-
instance (Tx era ~ AlonzoTx era, AlonzoEraTx era) => EqRaw (AlonzoTx era) where
171-
eqRaw = alonzoEqTxRaw
169+
alonzoTxL :: Lens' (Tx AlonzoEra) (AlonzoTx AlonzoEra)
170+
alonzoTxL = lens undefined undefined
172171

173172
class
174173
(EraTx era, AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraScript era) =>
175174
AlonzoEraTx era
176175
where
177176
isValidTxL :: Lens' (Tx era) IsValid
178177

178+
instance DecCBOR (Annotator (Tx AlonzoEra)) where
179+
decCBOR = decode $ Ann (RecD MkAlonzoTx) <*! From
180+
179181
instance AlonzoEraTx AlonzoEra where
180-
isValidTxL = isValidAlonzoTxL
182+
isValidTxL = alonzoTxL . isValidAlonzoTxL
181183
{-# INLINE isValidTxL #-}
182184

183185
mkBasicAlonzoTx :: Monoid (TxWits era) => TxBody era -> AlonzoTx era
@@ -395,7 +397,3 @@ instance
395397
<$> decodeNullMaybe decCBOR
396398
)
397399
{-# INLINE decCBOR #-}
398-
399-
alonzoEqTxRaw :: AlonzoEraTx era => Tx era -> Tx era -> Bool
400-
alonzoEqTxRaw tx1 tx2 =
401-
shelleyEqTxRaw tx1 tx2 && (tx1 ^. isValidTxL == tx2 ^. isValidTxL)

‎eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/GoldenTranslation.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ module Test.Cardano.Ledger.Alonzo.GoldenTranslation (
2424
import Cardano.Ledger.Alonzo (AlonzoEra)
2525
import Paths_cardano_ledger_alonzo (getDataFileName)
2626
import Test.Cardano.Ledger.Alonzo.Translation.Golden (assertTranslationResultsMatchGolden)
27+
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
2728
import Test.Cardano.Ledger.Common
2829
import Test.HUnit (Assertion)
2930

0 commit comments

Comments
 (0)