Skip to content

Commit da32661

Browse files
SoupstrawSoupstraw
committed
Replace Timelock with NativeScript in AllegraTxWitsRaw
1 parent 25bfd99 commit da32661

File tree

16 files changed

+91
-60
lines changed

16 files changed

+91
-60
lines changed

‎eras/allegra/impl/CHANGELOG.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,9 @@
22

33
## 1.8.0.0
44

5+
* Replace `timelockScriptsTxAuxDataL` with `nativeScriptsTxAuxDataL`
6+
* Replace `timelockScriptsAllegraTxAuxDataL` with `nativeScriptsAllegraTxAuxDataL`
7+
* Add `upgradeNativeScript` method to `AllegraEraScript`
58
* Remove `TriesToForgeADA`
69
* Change the type of `actualSize` and `PParameterMaxValue` fields in `OutputTooBigUTxO` to `Int`
710
* Added `COMPLETE` pragma for `TxCert AllegraEra`

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -462,6 +462,8 @@ showTimelock (RequireMOf m xs) = "(MOf " ++ show m ++ " " ++ F.foldl' accum ")"
462462
showTimelock (RequireSignature hash) = "(Signature " ++ show hash ++ ")"
463463
showTimelock _ = error "Impossible: All NativeScripts should have been accounted for"
464464

465+
-- | Check the equality of two underlying types, while ignoring their binary
466+
-- representation, which `Eq` instance normally does. This is used for testing.
465467
eqTimelockRaw :: Timelock era -> Timelock era -> Bool
466468
eqTimelockRaw t1 t2 = go (getMemoRawType t1) (getMemoRawType t2)
467469
where

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

Lines changed: 40 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -23,11 +23,11 @@ module Cardano.Ledger.Allegra.TxAuxData (
2323
AllegraTxAuxDataRaw (..),
2424
metadataAllegraTxAuxDataL,
2525
AllegraEraTxAuxData (..),
26-
timelockScriptsAllegraTxAuxDataL,
26+
nativeScriptsAllegraTxAuxDataL,
2727
) where
2828

2929
import Cardano.Ledger.Allegra.Era (AllegraEra)
30-
import Cardano.Ledger.Allegra.Scripts (Timelock)
30+
import Cardano.Ledger.Allegra.Scripts (AllegraEraScript)
3131
import Cardano.Ledger.Binary (
3232
Annotator,
3333
DecCBOR (..),
@@ -63,6 +63,7 @@ import Control.DeepSeq (NFData, deepseq)
6363
import Data.Map.Strict (Map)
6464
import Data.Sequence.Strict (StrictSeq)
6565
import qualified Data.Sequence.Strict as StrictSeq
66+
import Data.Typeable (Typeable)
6667
import Data.Word (Word64)
6768
import GHC.Generics (Generic)
6869
import Lens.Micro (Lens')
@@ -74,16 +75,18 @@ import NoThunks.Class (NoThunks)
7475
data AllegraTxAuxDataRaw era = AllegraTxAuxDataRaw
7576
{ atadrMetadata :: !(Map Word64 Metadatum)
7677
-- ^ Structured transaction metadata
77-
, atadrNativeScripts :: !(StrictSeq (Timelock era))
78+
, atadrNative :: !(StrictSeq (NativeScript era))
7879
-- ^ Pre-images of script hashes found within the TxBody, but which are not
7980
-- required as witnesses. Examples include:
8081
-- - Token policy IDs appearing in transaction outputs
8182
-- - Pool reward account registrations
8283
}
83-
deriving (Generic, Eq)
84+
deriving (Generic)
85+
86+
deriving instance Eq (NativeScript era) => Eq (AllegraTxAuxDataRaw era)
8487

8588
class EraTxAuxData era => AllegraEraTxAuxData era where
86-
timelockScriptsTxAuxDataL :: Lens' (TxAuxData era) (StrictSeq (Timelock era))
89+
nativeScriptsTxAuxDataL :: Lens' (TxAuxData era) (StrictSeq (NativeScript era))
8790

8891
instance EraTxAuxData AllegraEra where
8992
type TxAuxData AllegraEra = AllegraTxAuxData AllegraEra
@@ -95,58 +98,66 @@ instance EraTxAuxData AllegraEra where
9598
validateTxAuxData _ (AllegraTxAuxData md as) = as `deepseq` all validMetadatum md
9699

97100
metadataAllegraTxAuxDataL ::
98-
forall era. Era era => Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
101+
forall era.
102+
( Era era
103+
, EncCBOR (NativeScript era)
104+
) =>
105+
Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
99106
metadataAllegraTxAuxDataL =
100107
lensMemoRawType @era atadrMetadata $
101108
\txAuxDataRaw md -> txAuxDataRaw {atadrMetadata = md}
102109

103110
instance AllegraEraTxAuxData AllegraEra where
104-
timelockScriptsTxAuxDataL = timelockScriptsAllegraTxAuxDataL
111+
nativeScriptsTxAuxDataL = nativeScriptsAllegraTxAuxDataL
105112

106-
timelockScriptsAllegraTxAuxDataL ::
113+
nativeScriptsAllegraTxAuxDataL ::
107114
forall era.
108-
Era era =>
109-
Lens' (AllegraTxAuxData era) (StrictSeq (Timelock era))
110-
timelockScriptsAllegraTxAuxDataL =
111-
lensMemoRawType @era atadrNativeScripts $
112-
\txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
115+
(Era era, EncCBOR (NativeScript era)) =>
116+
Lens' (AllegraTxAuxData era) (StrictSeq (NativeScript era))
117+
nativeScriptsAllegraTxAuxDataL =
118+
lensMemoRawType @era atadrNative $
119+
\txAuxDataRaw ts -> txAuxDataRaw {atadrNative = ts}
113120

114-
deriving instance Show (AllegraTxAuxDataRaw era)
121+
deriving instance Show (NativeScript era) => Show (AllegraTxAuxDataRaw era)
115122

116-
deriving instance Era era => NoThunks (AllegraTxAuxDataRaw era)
123+
deriving instance (Era era, NoThunks (NativeScript era)) => NoThunks (AllegraTxAuxDataRaw era)
117124

118-
instance NFData (AllegraTxAuxDataRaw era)
125+
instance NFData (NativeScript era) => NFData (AllegraTxAuxDataRaw era)
119126

120127
newtype AllegraTxAuxData era = MkAlegraTxAuxData (MemoBytes (AllegraTxAuxDataRaw era))
121128
deriving (Generic)
122-
deriving newtype (Eq, ToCBOR, SafeToHash)
129+
deriving newtype (ToCBOR, SafeToHash)
130+
131+
deriving instance Eq (NativeScript era) => Eq (AllegraTxAuxData era)
123132

124133
instance Memoized (AllegraTxAuxData era) where
125134
type RawType (AllegraTxAuxData era) = AllegraTxAuxDataRaw era
126135

127136
deriving via
128137
(Mem (AllegraTxAuxDataRaw era))
129138
instance
130-
Era era => DecCBOR (Annotator (AllegraTxAuxData era))
139+
AllegraEraScript era => DecCBOR (Annotator (AllegraTxAuxData era))
131140

132141
type instance MemoHashIndex (AllegraTxAuxDataRaw era) = EraIndependentTxAuxData
133142

134143
instance HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData where
135144
hashAnnotated = getMemoSafeHash
136145

137-
deriving newtype instance Show (AllegraTxAuxData era)
146+
deriving newtype instance Show (NativeScript era) => Show (AllegraTxAuxData era)
138147

139-
deriving newtype instance Era era => NoThunks (AllegraTxAuxData era)
148+
deriving newtype instance (Era era, NoThunks (NativeScript era)) => NoThunks (AllegraTxAuxData era)
140149

141-
deriving newtype instance NFData (AllegraTxAuxData era)
150+
deriving newtype instance NFData (NativeScript era) => NFData (AllegraTxAuxData era)
142151

143-
instance EqRaw (AllegraTxAuxData era)
152+
instance Eq (NativeScript era) => EqRaw (AllegraTxAuxData era)
144153

145154
pattern AllegraTxAuxData ::
146155
forall era.
147-
Era era =>
156+
( Era era
157+
, EncCBOR (NativeScript era)
158+
) =>
148159
Map Word64 Metadatum ->
149-
StrictSeq (Timelock era) ->
160+
StrictSeq (NativeScript era) ->
150161
AllegraTxAuxData era
151162
pattern AllegraTxAuxData blob sp <- (getMemoRawType -> AllegraTxAuxDataRaw blob sp)
152163
where
@@ -158,14 +169,17 @@ pattern AllegraTxAuxData blob sp <- (getMemoRawType -> AllegraTxAuxDataRaw blob
158169
-- Serialisation
159170
--------------------------------------------------------------------------------
160171

161-
instance Era era => EncCBOR (AllegraTxAuxDataRaw era) where
172+
instance (Era era, EncCBOR (NativeScript era)) => EncCBOR (AllegraTxAuxDataRaw era) where
162173
encCBOR (AllegraTxAuxDataRaw blob sp) =
163174
encode (Rec AllegraTxAuxDataRaw !> To blob !> To sp)
164175

165176
-- | Encodes memoized bytes created upon construction.
166177
instance Era era => EncCBOR (AllegraTxAuxData era)
167178

168-
instance Era era => DecCBOR (Annotator (AllegraTxAuxDataRaw era)) where
179+
instance
180+
(Era era, Typeable (NativeScript era), DecCBOR (Annotator (NativeScript era))) =>
181+
DecCBOR (Annotator (AllegraTxAuxDataRaw era))
182+
where
169183
decCBOR =
170184
peekTokenType >>= \case
171185
TypeMapLen -> decodeFromMap

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

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,13 @@ import Test.Cardano.Ledger.Shelley.Binary.Annotator
2929

3030
deriving newtype instance DecCBOR (TxBody AllegraEra)
3131

32-
instance Era era => DecCBOR (AllegraTxAuxDataRaw era) where
32+
instance
33+
( Era era
34+
, AllegraEraScript era
35+
, DecCBOR (NativeScript era)
36+
) =>
37+
DecCBOR (AllegraTxAuxDataRaw era)
38+
where
3339
decCBOR =
3440
peekTokenType >>= \case
3541
TypeMapLen -> decodeFromMap
@@ -53,7 +59,8 @@ instance Era era => DecCBOR (AllegraTxAuxDataRaw era) where
5359
<! From
5460
)
5561

56-
deriving newtype instance Era era => DecCBOR (AllegraTxAuxData era)
62+
deriving newtype instance
63+
(AllegraEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AllegraTxAuxData era)
5764

5865
instance Era era => DecCBOR (TimelockRaw era) where
5966
decCBOR = decode $ Summands "TimelockRaw" $ \case

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,9 @@ instance ToExpr (TimelockRaw era)
3030
instance ToExpr (Timelock era)
3131

3232
-- TxAuxData
33-
instance ToExpr (AllegraTxAuxDataRaw era)
33+
instance ToExpr (NativeScript era) => ToExpr (AllegraTxAuxDataRaw era)
3434

35-
instance ToExpr (AllegraTxAuxData era)
35+
instance ToExpr (NativeScript era) => ToExpr (AllegraTxAuxData era)
3636

3737
-- TxBody
3838
instance

‎eras/alonzo/impl/CHANGELOG.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
## 1.14.0.0
44

5+
* Replace `atadTimelock` with `atadNativeScript`
6+
* Replace `TimelockScript` constructor of `AlonzoScript` with a new constructor `NativeScript`
57
* Make `transValidityInterval` based on eras instead of protocol versions.
68
* Remove `hardforkConwayTranslateUpperBoundForPlutusScripts` from `Cardano.Ledger.Alonzo.Era`.
79
* Remove protocol version from arguments to `transValidityInterval`.

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

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ module Cardano.Ledger.Alonzo.TxAuxData (
3939
validateAlonzoTxAuxData,
4040
getAlonzoTxAuxDataScripts,
4141
metadataAlonzoTxAuxDataL,
42-
timelockScriptsAlonzoTxAuxDataL,
42+
nativeScriptsAlonzoTxAuxDataL,
4343
plutusScriptsAllegraTxAuxDataL,
4444
addPlutusScripts,
4545
decodeTxAuxDataByTokenType,
@@ -102,7 +102,7 @@ class AllegraEraTxAuxData era => AlonzoEraTxAuxData era where
102102

103103
data AlonzoTxAuxDataRaw era = AlonzoTxAuxDataRaw
104104
{ atadrMetadata :: !(Map Word64 Metadatum)
105-
, atadrNativeScripts :: !(StrictSeq (NativeScript era))
105+
, atadrNative :: !(StrictSeq (NativeScript era))
106106
, atadrPlutus :: !(Map Language (NE.NonEmpty PlutusBinary))
107107
}
108108
deriving (Generic)
@@ -122,7 +122,7 @@ deriving via
122122
instance Era era => EncCBOR (AlonzoTxAuxData era)
123123

124124
instance (Era era, EncCBOR (NativeScript era)) => EncCBOR (AlonzoTxAuxDataRaw era) where
125-
encCBOR AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus} =
125+
encCBOR AlonzoTxAuxDataRaw {atadrMetadata, atadrNative, atadrPlutus} =
126126
encode $
127127
Tag 259 $
128128
Keyed
@@ -139,7 +139,7 @@ instance (Era era, EncCBOR (NativeScript era)) => EncCBOR (AlonzoTxAuxDataRaw er
139139
]
140140
)
141141
!> Omit null (Key 0 $ To atadrMetadata)
142-
!> Omit null (Key 1 $ To atadrNativeScripts)
142+
!> Omit null (Key 1 $ To atadrNative)
143143
!> Omit isNothing (Key 2 $ E (maybe mempty encCBOR) (Map.lookup PlutusV1 atadrPlutus))
144144
!> Omit isNothing (Key 3 $ E (maybe mempty encCBOR) (Map.lookup PlutusV2 atadrPlutus))
145145
!> Omit isNothing (Key 4 $ E (maybe mempty encCBOR) (Map.lookup PlutusV3 atadrPlutus))
@@ -156,7 +156,7 @@ mkAlonzoTxAuxData ::
156156
AlonzoTxAuxData era
157157
mkAlonzoTxAuxData atadrMetadata allScripts =
158158
mkMemoizedEra @era $
159-
AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
159+
AlonzoTxAuxDataRaw {atadrMetadata, atadrNative, atadrPlutus}
160160
where
161161
partitionScripts (tss, pss) =
162162
\case
@@ -165,7 +165,7 @@ mkAlonzoTxAuxData atadrMetadata allScripts =
165165
let lang = plutusScriptLanguage ps
166166
bs = plutusScriptBinary ps
167167
in (tss, Map.alter (Just . maybe (pure bs) (NE.cons bs)) lang pss)
168-
(atadrNativeScripts, atadrPlutus) =
168+
(atadrNative, atadrPlutus) =
169169
foldr (flip partitionScripts) (mempty, Map.empty) allScripts
170170

171171
getAlonzoTxAuxDataScripts ::
@@ -223,7 +223,7 @@ instance
223223
auxDataField 0 = fieldA (\x ad -> ad {atadrMetadata = x}) From
224224
auxDataField 1 =
225225
fieldAA
226-
(\x ad -> ad {atadrNativeScripts = atadrNativeScripts ad <> x})
226+
(\x ad -> ad {atadrNative = atadrNative ad <> x})
227227
(D (sequence <$> decodeStrictSeq decCBOR))
228228
auxDataField 2 = fieldA (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
229229
auxDataField 3 = fieldA (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
@@ -306,14 +306,14 @@ validateAlonzoTxAuxData pv auxData@AlonzoTxAuxData {atadMetadata = metadata} =
306306
&& all (validScript pv) (getAlonzoTxAuxDataScripts auxData)
307307

308308
instance AllegraEraTxAuxData AlonzoEra where
309-
timelockScriptsTxAuxDataL = timelockScriptsAlonzoTxAuxDataL
309+
nativeScriptsTxAuxDataL = nativeScriptsAlonzoTxAuxDataL
310310

311-
timelockScriptsAlonzoTxAuxDataL ::
311+
nativeScriptsAlonzoTxAuxDataL ::
312312
forall era.
313313
(Era era, EncCBOR (NativeScript era)) => Lens' (AlonzoTxAuxData era) (StrictSeq (NativeScript era))
314-
timelockScriptsAlonzoTxAuxDataL =
315-
lensMemoRawType @era atadrNativeScripts $
316-
\txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
314+
nativeScriptsAlonzoTxAuxDataL =
315+
lensMemoRawType @era atadrNative $
316+
\txAuxDataRaw ts -> txAuxDataRaw {atadrNative = ts}
317317

318318
instance AlonzoEraTxAuxData AlonzoEra where
319319
plutusScriptsTxAuxDataL = plutusScriptsAllegraTxAuxDataL
@@ -355,15 +355,15 @@ pattern AlonzoTxAuxData ::
355355
pattern AlonzoTxAuxData {atadMetadata, atadNative, atadPlutus} <-
356356
(getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata atadNative atadPlutus)
357357
where
358-
AlonzoTxAuxData atadrMetadata atadrNativeScripts atadrPlutus =
358+
AlonzoTxAuxData atadrMetadata atadrNative atadrPlutus =
359359
let unsupportedScripts =
360360
Map.filterWithKey (\lang _ -> lang > eraMaxLanguage @era) atadrPlutus
361361
prefix =
362362
intercalate "," (show <$> Map.keys unsupportedScripts)
363363
++ if Map.size unsupportedScripts > 1 then " languages are" else " language is"
364364
in if Map.null unsupportedScripts
365365
then
366-
mkMemoizedEra @era $ AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
366+
mkMemoizedEra @era $ AlonzoTxAuxDataRaw {atadrMetadata, atadrNative, atadrPlutus}
367367
else error $ prefix ++ " not supported in " ++ eraName @era
368368

369369
{-# COMPLETE AlonzoTxAuxData #-}

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -135,7 +135,7 @@ instance
135135

136136
auxDataField :: Word -> Field (AlonzoTxAuxDataRaw era)
137137
auxDataField 0 = field (\x ad -> ad {atadrMetadata = x}) From
138-
auxDataField 1 = field (\x ad -> ad {atadrNativeScripts = atadrNativeScripts ad <> x}) From
138+
auxDataField 1 = field (\x ad -> ad {atadrNative = atadrNative ad <> x}) From
139139
auxDataField 2 = field (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
140140
auxDataField 3 = field (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
141141
auxDataField 4 = field (addPlutusScripts PlutusV3) (D (guardPlutus PlutusV3 >> decCBOR))

‎eras/babbage/impl/src/Cardano/Ledger/Babbage/TxAuxData.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,8 @@ import Cardano.Ledger.Alonzo.Core
77
import Cardano.Ledger.Alonzo.TxAuxData (
88
AlonzoTxAuxData (..),
99
metadataAlonzoTxAuxDataL,
10+
nativeScriptsAlonzoTxAuxDataL,
1011
plutusScriptsAllegraTxAuxDataL,
11-
timelockScriptsAlonzoTxAuxDataL,
1212
validateAlonzoTxAuxData,
1313
)
1414
import Cardano.Ledger.Babbage.Era
@@ -23,7 +23,7 @@ instance EraTxAuxData BabbageEra where
2323
validateTxAuxData = validateAlonzoTxAuxData
2424

2525
instance AllegraEraTxAuxData BabbageEra where
26-
timelockScriptsTxAuxDataL = timelockScriptsAlonzoTxAuxDataL
26+
nativeScriptsTxAuxDataL = nativeScriptsAlonzoTxAuxDataL
2727

2828
instance AlonzoEraTxAuxData BabbageEra where
2929
plutusScriptsTxAuxDataL = plutusScriptsAllegraTxAuxDataL

‎eras/conway/impl/src/Cardano/Ledger/Conway/TxAuxData.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,8 @@ import Cardano.Ledger.Alonzo.Core
77
import Cardano.Ledger.Alonzo.TxAuxData (
88
AlonzoTxAuxData (..),
99
metadataAlonzoTxAuxDataL,
10+
nativeScriptsAlonzoTxAuxDataL,
1011
plutusScriptsAllegraTxAuxDataL,
11-
timelockScriptsAlonzoTxAuxDataL,
1212
validateAlonzoTxAuxData,
1313
)
1414
import Cardano.Ledger.Conway.Era
@@ -24,7 +24,7 @@ instance EraTxAuxData ConwayEra where
2424
validateTxAuxData = validateAlonzoTxAuxData
2525

2626
instance AllegraEraTxAuxData ConwayEra where
27-
timelockScriptsTxAuxDataL = timelockScriptsAlonzoTxAuxDataL
27+
nativeScriptsTxAuxDataL = nativeScriptsAlonzoTxAuxDataL
2828

2929
instance AlonzoEraTxAuxData ConwayEra where
3030
plutusScriptsTxAuxDataL = plutusScriptsAllegraTxAuxDataL

0 commit comments

Comments
 (0)