Skip to content

Commit 1f6262f

Browse files
SoupstrawSoupstraw
committed
Remove translateTimelock
1 parent c74e8cb commit 1f6262f

File tree

12 files changed

+40
-57
lines changed

12 files changed

+40
-57
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/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/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

‎eras/mary/impl/src/Cardano/Ledger/Mary/Scripts.hs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,6 @@ instance EraScript MaryEra where
2121
type Script MaryEra = Timelock MaryEra
2222
type NativeScript MaryEra = Timelock MaryEra
2323

24-
upgradeScript = translateTimelock
25-
2624
scriptPrefixTag _script = nativeMultiSigTag -- "\x00"
2725

2826
getNativeScript = Just

‎eras/mary/impl/src/Cardano/Ledger/Mary/Translation.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Cardano.Ledger.Binary (DecoderError)
1717
import Cardano.Ledger.Genesis (NoGenesis (..))
1818
import Cardano.Ledger.Mary.Core
1919
import Cardano.Ledger.Mary.Era (MaryEra)
20-
import Cardano.Ledger.Mary.Scripts (Timelock, translateTimelock)
20+
import Cardano.Ledger.Mary.Scripts (Timelock)
2121
import Cardano.Ledger.Mary.State
2222
import Cardano.Ledger.Mary.TxAuxData (AllegraTxAuxData (..))
2323
import Cardano.Ledger.Shelley.LedgerState (
@@ -163,7 +163,7 @@ instance TranslateEra MaryEra Update where
163163
translateEra _ (Update pp en) = pure $ Update (coerce pp) en
164164

165165
instance TranslateEra MaryEra Timelock where
166-
translateEra _ = pure . translateTimelock
166+
translateEra _ = pure . coerce
167167

168168
instance TranslateEra MaryEra AllegraTxAuxData where
169169
translateEra ctx (AllegraTxAuxData md as) =

0 commit comments

Comments
 (0)