Skip to content

Commit 6dc1b84

Browse files
SoupstrawSoupstraw
committed
Remove translateTimelock
1 parent c74e8cb commit 6dc1b84

File tree

14 files changed

+47
-64
lines changed

14 files changed

+47
-64
lines changed

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

Lines changed: 0 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -51,8 +51,6 @@ module Cardano.Ledger.Allegra.Scripts (
5151
ValidityInterval (..),
5252
encodeVI,
5353
decodeVI,
54-
-- translate,
55-
translateTimelock,
5654
) where
5755

5856
import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -86,7 +84,6 @@ import Cardano.Ledger.MemoBytes (
8684
packMemoBytesM,
8785
unpackMemoBytesM,
8886
)
89-
import Cardano.Ledger.MemoBytes.Internal (mkMemoBytes)
9087
import Cardano.Ledger.Shelley.Scripts (
9188
ShelleyEraScript (..),
9289
nativeMultiSigTag,
@@ -99,8 +96,6 @@ import Cardano.Slotting.Slot (SlotNo (..))
9996
import Control.DeepSeq (NFData (..))
10097
import Data.Aeson (ToJSON (..), (.=))
10198
import qualified Data.Aeson as Aeson
102-
import Data.ByteString.Lazy (fromStrict)
103-
import Data.ByteString.Short (fromShort)
10499
import Data.Coerce (Coercible, coerce)
105100
import Data.Foldable as F (foldl')
106101
import Data.MemPack
@@ -169,26 +164,6 @@ deriving instance Era era => NoThunks (TimelockRaw era)
169164

170165
deriving instance Show (TimelockRaw era)
171166

172-
-- | This function deconstructs and then reconstructs the timelock script
173-
-- to prove the compiler that we can arbirarily switch out the eras as long
174-
-- as the cryptos for both eras are the same.
175-
translateTimelock ::
176-
forall era1 era2.
177-
( Era era1
178-
, Era era2
179-
) =>
180-
Timelock era1 ->
181-
Timelock era2
182-
translateTimelock (MkTimelock (Memo tl bs)) =
183-
let rewrap rtl = MkTimelock $ mkMemoBytes rtl (fromStrict $ fromShort bs)
184-
in case tl of
185-
TimelockSignature s -> rewrap $ TimelockSignature s
186-
TimelockAllOf l -> rewrap . TimelockAllOf $ translateTimelock <$> l
187-
TimelockAnyOf l -> rewrap . TimelockAnyOf $ translateTimelock <$> l
188-
TimelockMOf n l -> rewrap $ TimelockMOf n (translateTimelock <$> l)
189-
TimelockTimeStart x -> rewrap $ TimelockTimeStart x
190-
TimelockTimeExpire x -> rewrap $ TimelockTimeExpire x
191-
192167
-- These coding choices are chosen so that a MultiSig script
193168
-- can be deserialised as a Timelock script
194169

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

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DefaultSignatures #-}
23
{-# LANGUAGE DeriveAnyClass #-}
34
{-# LANGUAGE DeriveGeneric #-}
45
{-# LANGUAGE DerivingVia #-}
@@ -13,6 +14,7 @@
1314
{-# LANGUAGE StandaloneDeriving #-}
1415
{-# LANGUAGE TypeApplications #-}
1516
{-# LANGUAGE TypeFamilies #-}
17+
{-# LANGUAGE TypeOperators #-}
1618
{-# LANGUAGE UndecidableInstances #-}
1719
{-# LANGUAGE UndecidableSuperClasses #-}
1820
{-# LANGUAGE ViewPatterns #-}
@@ -27,7 +29,7 @@ module Cardano.Ledger.Allegra.TxAuxData (
2729
) where
2830

2931
import Cardano.Ledger.Allegra.Era (AllegraEra)
30-
import Cardano.Ledger.Allegra.Scripts (AllegraEraScript)
32+
import Cardano.Ledger.Allegra.Scripts (AllegraEraScript, Timelock)
3133
import Cardano.Ledger.Binary (
3234
Annotator,
3335
DecCBOR (..),
@@ -87,9 +89,10 @@ deriving instance Eq (NativeScript era) => Eq (AllegraTxAuxDataRaw era)
8789

8890
class EraTxAuxData era => AllegraEraTxAuxData era where
8991
nativeScriptsTxAuxDataL :: Lens' (TxAuxData era) (StrictSeq (NativeScript era))
90-
92+
9193
timelockScriptsTxAuxDataL :: Lens' (TxAuxData era) (StrictSeq (Timelock era))
92-
default timelockScriptsTxAuxDataL :: NativeScript era ~ Timelock era => Lens' (TxAuxData era) (StrictSeq (Timelock era))
94+
default timelockScriptsTxAuxDataL ::
95+
NativeScript era ~ Timelock era => Lens' (TxAuxData era) (StrictSeq (Timelock era))
9396
timelockScriptsTxAuxDataL = nativeScriptsTxAuxDataL
9497

9598
{-# DEPRECATED timelockScriptsTxAuxDataL "In favor of `nativeScriptsTxAuxDataL`" #-}
@@ -121,8 +124,8 @@ nativeScriptsAllegraTxAuxDataL ::
121124
(Era era, EncCBOR (NativeScript era)) =>
122125
Lens' (AllegraTxAuxData era) (StrictSeq (NativeScript era))
123126
nativeScriptsAllegraTxAuxDataL =
124-
lensMemoRawType @era atadrNative $
125-
\txAuxDataRaw ts -> txAuxDataRaw {atadrNative = ts}
127+
lensMemoRawType @era atadrNativeScripts $
128+
\txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
126129

127130
deriving instance Show (NativeScript era) => Show (AllegraTxAuxDataRaw era)
128131

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,7 @@ import Data.Word (Word16, Word32, Word8)
120120
import GHC.Generics (Generic)
121121
import GHC.Stack
122122
import NoThunks.Class (NoThunks (..))
123+
import Data.Coerce (coerce)
123124

124125
class
125126
( EraScript era
@@ -481,7 +482,7 @@ instance EraScript AlonzoEra where
481482
type Script AlonzoEra = AlonzoScript AlonzoEra
482483
type NativeScript AlonzoEra = Timelock AlonzoEra
483484

484-
upgradeScript = NativeScript . translateTimelock
485+
upgradeScript = NativeScript . coerce
485486

486487
scriptPrefixTag = alonzoScriptPrefixTag
487488

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

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ module Cardano.Ledger.Alonzo.TxAuxData (
2626
AlonzoTxAuxData,
2727
AlonzoTxAuxData',
2828
atadMetadata,
29-
atadNative,
29+
atadNativeScripts,
3030
atadPlutus,
3131
atadMetadata',
3232
atadNative',
@@ -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, atadrNative, atadrPlutus} =
125+
encCBOR AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, 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 atadrNative)
142+
!> Omit null (Key 1 $ To atadrNativeScripts)
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, atadrNative, atadrPlutus}
159+
AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
160160
where
161161
partitionScripts (tss, pss) =
162162
\case
@@ -165,15 +165,15 @@ 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-
(atadrNative, atadrPlutus) =
168+
(atadrNativeScripts, atadrPlutus) =
169169
foldr (flip partitionScripts) (mempty, Map.empty) allScripts
170170

171171
getAlonzoTxAuxDataScripts ::
172172
forall era.
173173
AlonzoEraScript era =>
174174
AlonzoTxAuxData era ->
175175
StrictSeq (AlonzoScript era)
176-
getAlonzoTxAuxDataScripts AlonzoTxAuxData {atadNative = timelocks, atadPlutus = plutus} =
176+
getAlonzoTxAuxDataScripts AlonzoTxAuxData {atadNativeScripts = timelocks, atadPlutus = plutus} =
177177
mconcat $
178178
(NativeScript <$> timelocks)
179179
: [ StrictSeq.fromList $
@@ -223,7 +223,7 @@ instance
223223
auxDataField 0 = fieldA (\x ad -> ad {atadrMetadata = x}) From
224224
auxDataField 1 =
225225
fieldAA
226-
(\x ad -> ad {atadrNative = atadrNative ad <> x})
226+
(\x ad -> ad {atadrNativeScripts = atadrNativeScripts 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))
@@ -312,8 +312,8 @@ nativeScriptsAlonzoTxAuxDataL ::
312312
forall era.
313313
(Era era, EncCBOR (NativeScript era)) => Lens' (AlonzoTxAuxData era) (StrictSeq (NativeScript era))
314314
nativeScriptsAlonzoTxAuxDataL =
315-
lensMemoRawType @era atadrNative $
316-
\txAuxDataRaw ts -> txAuxDataRaw {atadrNative = ts}
315+
lensMemoRawType @era atadrNativeScripts $
316+
\txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
317317

318318
instance AlonzoEraTxAuxData AlonzoEra where
319319
plutusScriptsTxAuxDataL = plutusScriptsAllegraTxAuxDataL
@@ -352,18 +352,18 @@ pattern AlonzoTxAuxData ::
352352
StrictSeq (NativeScript era) ->
353353
Map Language (NE.NonEmpty PlutusBinary) ->
354354
AlonzoTxAuxData era
355-
pattern AlonzoTxAuxData {atadMetadata, atadNative, atadPlutus} <-
356-
(getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata atadNative atadPlutus)
355+
pattern AlonzoTxAuxData {atadMetadata, atadNativeScripts, atadPlutus} <-
356+
(getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata atadNativeScripts atadPlutus)
357357
where
358-
AlonzoTxAuxData atadrMetadata atadrNative atadrPlutus =
358+
AlonzoTxAuxData atadrMetadata atadrNativeScripts 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, atadrNative, atadrPlutus}
366+
mkMemoizedEra @era $ AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
367367
else error $ prefix ++ " not supported in " ++ eraName @era
368368

369369
{-# COMPLETE AlonzoTxAuxData #-}

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -114,8 +114,8 @@ import Test.Cardano.Ledger.Plutus (alwaysFailsPlutus, alwaysSucceedsPlutus)
114114

115115
instance
116116
( Arbitrary (AlonzoScript era)
117+
, Arbitrary (NativeScript era)
117118
, AlonzoEraScript era
118-
, NativeScript era ~ Timelock era
119119
) =>
120120
Arbitrary (AlonzoTxAuxData era)
121121
where

‎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 {atadrNative = atadrNative ad <> x}) From
138+
auxDataField 1 = field (\x ad -> ad {atadrNativeScripts = atadrNativeScripts 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/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ import Cardano.Ledger.Address (Addr (..))
1717
import Cardano.Ledger.Allegra.Scripts (
1818
AllegraEraScript,
1919
Timelock (..),
20-
translateTimelock,
2120
pattern RequireTimeExpire,
2221
pattern RequireTimeStart,
2322
)
@@ -83,6 +82,7 @@ import Cardano.Ledger.State (
8382
import Cardano.Ledger.TxIn (TxIn)
8483
import Cardano.Ledger.Val (Val (isAdaOnly, (<+>), (<×>)))
8584
import Control.Monad (replicateM)
85+
import Data.Coerce (coerce)
8686
import Data.Foldable as F
8787
import qualified Data.List as List
8888
import Data.Map.Strict (Map)
@@ -265,20 +265,20 @@ genAux constants = do
265265
maybeAux <- genEraAuxiliaryData @MaryEra constants
266266
pure $
267267
fmap
268-
(\(AllegraTxAuxData x y) -> mkAlonzoTxAuxData x (NativeScript . translateTimelock <$> y))
268+
(\(AllegraTxAuxData x y) -> mkAlonzoTxAuxData x (NativeScript . coerce <$> y))
269269
maybeAux
270270

271271
instance ScriptClass AlonzoEra where
272272
basescript = someLeaf
273-
isKey _ (NativeScript x) = isKey (Proxy @MaryEra) $ translateTimelock x
273+
isKey _ (NativeScript x) = isKey (Proxy @MaryEra) $ coerce x
274274
isKey _ (PlutusScript _) = Nothing
275275
isOnePhase _ (NativeScript _) = True
276276
isOnePhase _ (PlutusScript _) = False
277-
quantify _ (NativeScript x) = fmap (NativeScript . translateTimelock) (quantify (Proxy @MaryEra) (translateTimelock x))
277+
quantify _ (NativeScript x) = fmap (NativeScript . coerce) (quantify (Proxy @MaryEra) (coerce x))
278278
quantify _ x = Leaf x
279279
unQuantify _ quant =
280-
NativeScript . translateTimelock $
281-
unQuantify (Proxy @MaryEra) (fmap (translateTimelock . unTime) quant)
280+
NativeScript . coerce $
281+
unQuantify (Proxy @MaryEra) (fmap (coerce . unTime) quant)
282282

283283
unTime :: AlonzoScript era -> NativeScript era
284284
unTime (NativeScript x) = x

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ import Cardano.Ledger.Babbage.TxCert ()
3333
import Cardano.Ledger.Plutus.Language
3434
import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
3535
import Control.DeepSeq (NFData (..), rwhnf)
36+
import Data.Coerce (coerce)
3637
import Data.MemPack
3738
import GHC.Generics
3839
import NoThunks.Class (NoThunks (..))
@@ -42,7 +43,7 @@ instance EraScript BabbageEra where
4243
type NativeScript BabbageEra = Timelock BabbageEra
4344

4445
upgradeScript = \case
45-
NativeScript ts -> NativeScript $ translateTimelock ts
46+
NativeScript ts -> NativeScript $ coerce ts
4647
PlutusScript (AlonzoPlutusV1 ps) -> PlutusScript $ BabbagePlutusV1 ps
4748

4849
scriptPrefixTag = alonzoScriptPrefixTag

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,7 @@ import Data.Typeable
6060
import Data.Word (Word16, Word32, Word8)
6161
import GHC.Generics
6262
import NoThunks.Class (NoThunks (..))
63+
import Data.Coerce (coerce)
6364

6465
class AlonzoEraScript era => ConwayEraScript era where
6566
mkVotingPurpose :: f Word32 Voter -> PlutusPurpose f era
@@ -75,7 +76,7 @@ instance EraScript ConwayEra where
7576
type NativeScript ConwayEra = Timelock ConwayEra
7677

7778
upgradeScript = \case
78-
NativeScript ts -> NativeScript $ translateTimelock ts
79+
NativeScript ts -> NativeScript $ coerce ts
7980
PlutusScript (BabbagePlutusV1 ps) -> PlutusScript $ ConwayPlutusV1 ps
8081
PlutusScript (BabbagePlutusV2 ps) -> PlutusScript $ ConwayPlutusV2 ps
8182

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/Scripts.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,6 @@ import Cardano.Ledger.Allegra.Scripts (
3838
mkRequireSignatureTimelock,
3939
mkTimeExpireTimelock,
4040
mkTimeStartTimelock,
41-
translateTimelock,
4241
)
4342
import Cardano.Ledger.Alonzo (AlonzoScript)
4443
import Cardano.Ledger.Alonzo.Scripts (
@@ -81,6 +80,7 @@ import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
8180
import Cardano.Ledger.TxIn (TxIn)
8281
import Control.DeepSeq (NFData (..), rwhnf)
8382
import Data.Aeson (KeyValue (..), ToJSON (..))
83+
import Data.Coerce (coerce)
8484
import Data.MemPack (MemPack (..), packTagM, packedTagByteCount, unknownTagM, unpackTagM)
8585
import Data.Typeable (Proxy (..), Typeable)
8686
import Data.Word (Word16, Word32, Word8)
@@ -220,7 +220,7 @@ instance EraScript DijkstraEra where
220220
type NativeScript DijkstraEra = Timelock DijkstraEra
221221

222222
upgradeScript = \case
223-
NativeScript ts -> NativeScript $ translateTimelock ts
223+
NativeScript ts -> NativeScript $ coerce ts
224224
PlutusScript (ConwayPlutusV1 s) -> PlutusScript $ DijkstraPlutusV1 s
225225
PlutusScript (ConwayPlutusV2 s) -> PlutusScript $ DijkstraPlutusV2 s
226226
PlutusScript (ConwayPlutusV3 s) -> PlutusScript $ DijkstraPlutusV3 s

0 commit comments

Comments
 (0)