WIP

Author: Soupstraw

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

@@ -264,6 +264,8 @@ instance EraScript AllegraEra where
 
   fromNativeScript = id
 
+  eqNativeRaw = undefined
+
 instance ShelleyEraScript AllegraEra where
   mkRequireSignature = mkRequireSignatureTimelock
   getRequireSignature = getRequireSignatureTimelock
@@ -448,8 +450,6 @@ showTimelock (RequireMOf m xs) = "(MOf " ++ show m ++ " " ++ F.foldl' accum ")"
 showTimelock (RequireSignature hash) = "(Signature " ++ show hash ++ ")"
 showTimelock _ = error "Impossible: All NativeScripts should have been accounted for"
 
--- | Check the equality of two underlying types, while ignoring their binary
--- representation, which `Eq` instance normally does. This is used for testing.
 eqTimelockRaw :: Timelock era -> Timelock era -> Bool
 eqTimelockRaw t1 t2 = go (getMemoRawType t1) (getMemoRawType t2)
   where

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

@@ -74,7 +74,7 @@ import NoThunks.Class (NoThunks)
 data AllegraTxAuxDataRaw era = AllegraTxAuxDataRaw
   { atadrMetadata :: !(Map Word64 Metadatum)
   -- ^ Structured transaction metadata
-  , atadrTimelock :: !(StrictSeq (Timelock era))
+  , atadrNativeScripts :: !(StrictSeq (Timelock era))
   -- ^ Pre-images of script hashes found within the TxBody, but which are not
   -- required as witnesses. Examples include:
   -- - Token policy IDs appearing in transaction outputs
@@ -108,8 +108,8 @@ timelockScriptsAllegraTxAuxDataL ::
   Era era =>
   Lens' (AllegraTxAuxData era) (StrictSeq (Timelock era))
 timelockScriptsAllegraTxAuxDataL =
-  lensMemoRawType @era atadrTimelock $
-    \txAuxDataRaw ts -> txAuxDataRaw {atadrTimelock = ts}
+  lensMemoRawType @era atadrNativeScripts $
+    \txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
 
 deriving instance Show (AllegraTxAuxDataRaw era)
 

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

@@ -24,7 +24,7 @@
 
 module Cardano.Ledger.Alonzo.Scripts (
   PlutusBinary (..),
-  AlonzoScript (TimelockScript, PlutusScript),
+  AlonzoScript (NativeScript, PlutusScript),
   Script,
   isPlutusScript,
   validScript,
@@ -426,44 +426,52 @@ pattern RewardingPurpose c <- (toRewardingPurpose -> Just c)
 
 -- Alonzo Script ===============================================================
 
--- | Scripts in the Alonzo Era, Either a Timelock script or a Plutus script.
+-- | Scripts in the Alonzo Era, Either a nativve script or a Plutus script.
 data AlonzoScript era
-  = TimelockScript !(Timelock era)
+  = NativeScript !(NativeScript era)
   | PlutusScript !(PlutusScript era)
   deriving (Generic)
 
-instance (Era era, MemPack (PlutusScript era)) => MemPack (AlonzoScript era) where
+instance
+  ( Era era
+  , MemPack (PlutusScript era)
+  , MemPack (NativeScript era)
+  ) =>
+  MemPack (AlonzoScript era)
+  where
   packedByteCount = \case
-    TimelockScript script -> packedTagByteCount + packedByteCount script
+    NativeScript script -> packedTagByteCount + packedByteCount script
     PlutusScript script -> packedTagByteCount + packedByteCount script
   packM = \case
-    TimelockScript script -> packTagM 0 >> packM script
+    NativeScript script -> packTagM 0 >> packM script
     PlutusScript script -> packTagM 1 >> packM script
   {-# INLINE packM #-}
   unpackM =
     unpackTagM >>= \case
-      0 -> TimelockScript <$> unpackM
+      0 -> NativeScript <$> unpackM
       1 -> PlutusScript <$> unpackM
       n -> unknownTagM @(AlonzoScript era) n
   {-# INLINE unpackM #-}
 
-deriving instance Eq (PlutusScript era) => Eq (AlonzoScript era)
+deriving instance (Eq (PlutusScript era), Eq (NativeScript era)) => Eq (AlonzoScript era)
 
-instance (Era era, NoThunks (PlutusScript era)) => NoThunks (AlonzoScript era)
+instance
+  (Era era, NoThunks (PlutusScript era), NoThunks (NativeScript era)) =>
+  NoThunks (AlonzoScript era)
 
-instance NFData (PlutusScript era) => NFData (AlonzoScript era) where
+instance (NFData (PlutusScript era), NFData (NativeScript era)) => NFData (AlonzoScript era) where
   rnf = \case
-    TimelockScript ts -> rnf ts
+    NativeScript ts -> rnf ts
     PlutusScript ps -> rnf ps
 
 instance (AlonzoEraScript era, Script era ~ AlonzoScript era) => Show (AlonzoScript era) where
-  show (TimelockScript x) = "TimelockScript " ++ show x
+  show (NativeScript x) = "NativeScript " ++ show x
   show s@(PlutusScript plutus) =
     "PlutusScript " ++ show (plutusScriptLanguage plutus) ++ " " ++ show (hashScript @era s)
 
 -- | Both constructors know their original bytes
-instance SafeToHash (PlutusScript era) => SafeToHash (AlonzoScript era) where
-  originalBytes (TimelockScript t) = originalBytes t
+instance (SafeToHash (PlutusScript era), SafeToHash (NativeScript era)) => SafeToHash (AlonzoScript era) where
+  originalBytes (NativeScript t) = originalBytes t
   originalBytes (PlutusScript plutus) = originalBytes plutus
 
 isPlutusScript :: AlonzoEraScript era => Script era -> Bool
@@ -473,22 +481,22 @@ instance EraScript AlonzoEra where
   type Script AlonzoEra = AlonzoScript AlonzoEra
   type NativeScript AlonzoEra = Timelock AlonzoEra
 
-  upgradeScript = TimelockScript . translateTimelock
+  upgradeScript = NativeScript . translateTimelock
 
   scriptPrefixTag = alonzoScriptPrefixTag
 
   getNativeScript = \case
-    TimelockScript ts -> Just ts
+    NativeScript ts -> Just ts
     _ -> Nothing
 
-  fromNativeScript = TimelockScript
+  fromNativeScript = NativeScript
 
 alonzoScriptPrefixTag ::
   (AlonzoEraScript era, AlonzoScript era ~ Script era) =>
   Script era ->
   BS.ByteString
 alonzoScriptPrefixTag = \case
-  TimelockScript _ -> nativeMultiSigTag -- "\x00"
+  NativeScript _ -> nativeMultiSigTag -- "\x00"
   PlutusScript plutusScript -> BS.singleton (withPlutusScript plutusScript plutusLanguageTag)
 
 instance ShelleyEraScript AlonzoEra where
@@ -598,7 +606,7 @@ instance AlonzoEraScript era => ToCBOR (AlonzoScript era) where
 
 encodeScript :: AlonzoEraScript era => AlonzoScript era -> Encode 'Open (AlonzoScript era)
 encodeScript = \case
-  TimelockScript i -> Sum TimelockScript 0 !> To i
+  NativeScript i -> Sum NativeScript 0 !> To i
   PlutusScript plutusScript -> withPlutusScript plutusScript $ \plutus@(Plutus pb) ->
     case plutusSLanguage plutus of
       SPlutusV1 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV1) 1 !> To pb
@@ -614,7 +622,7 @@ instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
       {-# INLINE decodeAnnPlutus #-}
       decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
       decodeScript = \case
-        0 -> Ann (SumD TimelockScript) <*! From
+        0 -> Ann (SumD NativeScript) <*! From
         1 -> decodeAnnPlutus SPlutusV1
         2 -> decodeAnnPlutus SPlutusV2
         3 -> decodeAnnPlutus SPlutusV3
@@ -637,7 +645,7 @@ validScript pv script =
 -- | Check the equality of two underlying types, while ignoring their binary
 -- representation, which `Eq` instance normally does. This is used for testing.
 eqAlonzoScriptRaw :: Eq (PlutusScript era) => AlonzoScript era -> AlonzoScript era -> Bool
-eqAlonzoScriptRaw (TimelockScript t1) (TimelockScript t2) = eqTimelockRaw t1 t2
+eqAlonzoScriptRaw (NativeScript t1) (NativeScript t2) = eqTimelockRaw t1 t2
 eqAlonzoScriptRaw (PlutusScript ps1) (PlutusScript ps2) = ps1 == ps2
 eqAlonzoScriptRaw _ _ = False
 

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

@@ -102,16 +102,16 @@ class AllegraEraTxAuxData era => AlonzoEraTxAuxData era where
 
 data AlonzoTxAuxDataRaw era = AlonzoTxAuxDataRaw
   { atadrMetadata :: !(Map Word64 Metadatum)
-  , atadrTimelock :: !(StrictSeq (Timelock era))
+  , atadrNativeScripts :: !(StrictSeq (NativeScript era))
   , atadrPlutus :: !(Map Language (NE.NonEmpty PlutusBinary))
   }
   deriving (Generic)
 
-deriving instance Eq (Timelock era) => Eq (AlonzoTxAuxDataRaw era)
+deriving instance Eq (NativeScript era) => Eq (AlonzoTxAuxDataRaw era)
 
-deriving instance Show (Timelock era) => Show (AlonzoTxAuxDataRaw era)
+deriving instance Show (NativeScript era) => Show (AlonzoTxAuxDataRaw era)
 
-instance NFData (Timelock era) => NFData (AlonzoTxAuxDataRaw era)
+instance NFData (NativeScript era) => NFData (AlonzoTxAuxDataRaw era)
 
 deriving via
   InspectHeapNamed "AlonzoTxAuxDataRaw" (AlonzoTxAuxDataRaw era)
@@ -121,8 +121,8 @@ deriving via
 -- | Encodes memoized bytes created upon construction.
 instance Era era => EncCBOR (AlonzoTxAuxData era)
 
-instance Era era => EncCBOR (AlonzoTxAuxDataRaw era) where
-  encCBOR AlonzoTxAuxDataRaw {atadrMetadata, atadrTimelock, atadrPlutus} =
+instance (Era era, EncCBOR (NativeScript era)) => EncCBOR (AlonzoTxAuxDataRaw era) where
+  encCBOR AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus} =
     encode $
       Tag 259 $
         Keyed
@@ -139,7 +139,7 @@ instance Era era => EncCBOR (AlonzoTxAuxDataRaw era) where
                   ]
           )
           !> Omit null (Key 0 $ To atadrMetadata)
-          !> Omit null (Key 1 $ To atadrTimelock)
+          !> Omit null (Key 1 $ To atadrNativeScripts)
           !> Omit isNothing (Key 2 $ E (maybe mempty encCBOR) (Map.lookup PlutusV1 atadrPlutus))
           !> Omit isNothing (Key 3 $ E (maybe mempty encCBOR) (Map.lookup PlutusV2 atadrPlutus))
           !> Omit isNothing (Key 4 $ E (maybe mempty encCBOR) (Map.lookup PlutusV3 atadrPlutus))
@@ -156,7 +156,7 @@ mkAlonzoTxAuxData ::
   AlonzoTxAuxData era
 mkAlonzoTxAuxData atadrMetadata allScripts =
   mkMemoizedEra @era $
-    AlonzoTxAuxDataRaw {atadrMetadata, atadrTimelock, atadrPlutus}
+    AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
   where
     partitionScripts (tss, pss) =
       \case
@@ -165,7 +165,7 @@ mkAlonzoTxAuxData atadrMetadata allScripts =
           let lang = plutusScriptLanguage ps
               bs = plutusScriptBinary ps
            in (tss, Map.alter (Just . maybe (pure bs) (NE.cons bs)) lang pss)
-    (atadrTimelock, atadrPlutus) =
+    (atadrNativeScripts, atadrPlutus) =
       foldr (flip partitionScripts) (mempty, Map.empty) allScripts
 
 getAlonzoTxAuxDataScripts ::
@@ -217,7 +217,7 @@ instance Era era => DecCBOR (Annotator (AlonzoTxAuxDataRaw era)) where
       auxDataField 0 = fieldA (\x ad -> ad {atadrMetadata = x}) From
       auxDataField 1 =
         fieldAA
-          (\x ad -> ad {atadrTimelock = atadrTimelock ad <> x})
+          (\x ad -> ad {atadrNativeScripts = atadrNativeScripts ad <> x})
           (D (sequence <$> decodeStrictSeq decCBOR))
       auxDataField 2 = fieldA (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
       auxDataField 3 = fieldA (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
@@ -303,8 +303,8 @@ instance AllegraEraTxAuxData AlonzoEra where
 timelockScriptsAlonzoTxAuxDataL ::
   forall era. Era era => Lens' (AlonzoTxAuxData era) (StrictSeq (Timelock era))
 timelockScriptsAlonzoTxAuxDataL =
-  lensMemoRawType @era atadrTimelock $
-    \txAuxDataRaw ts -> txAuxDataRaw {atadrTimelock = ts}
+  lensMemoRawType @era atadrNativeScripts $
+    \txAuxDataRaw ts -> txAuxDataRaw {atadrNativeScripts = ts}
 
 instance AlonzoEraTxAuxData AlonzoEra where
   plutusScriptsTxAuxDataL = plutusScriptsAllegraTxAuxDataL
@@ -344,15 +344,15 @@ pattern AlonzoTxAuxData ::
 pattern AlonzoTxAuxData {atadMetadata, atadTimelock, atadPlutus} <-
   (getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata atadTimelock atadPlutus)
   where
-    AlonzoTxAuxData atadrMetadata atadrTimelock atadrPlutus =
+    AlonzoTxAuxData atadrMetadata atadrNativeScripts atadrPlutus =
       let unsupportedScripts =
             Map.filterWithKey (\lang _ -> lang > eraMaxLanguage @era) atadrPlutus
           prefix =
             intercalate "," (show <$> Map.keys unsupportedScripts)
               ++ if Map.size unsupportedScripts > 1 then " languages are" else " language is"
        in if Map.null unsupportedScripts
             then
-              mkMemoizedEra @era $ AlonzoTxAuxDataRaw {atadrMetadata, atadrTimelock, atadrPlutus}
+              mkMemoizedEra @era $ AlonzoTxAuxDataRaw {atadrMetadata, atadrNativeScripts, atadrPlutus}
             else error $ prefix ++ " not supported in " ++ eraName @era
 
 {-# COMPLETE AlonzoTxAuxData #-}

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

@@ -132,7 +132,7 @@ instance Era era => DecCBOR (AlonzoTxAuxDataRaw era) where
 
       auxDataField :: Word -> Field (AlonzoTxAuxDataRaw era)
       auxDataField 0 = field (\x ad -> ad {atadrMetadata = x}) From
-      auxDataField 1 = field (\x ad -> ad {atadrTimelock = atadrTimelock ad <> x}) From
+      auxDataField 1 = field (\x ad -> ad {atadrNativeScripts = atadrNativeScripts ad <> x}) From
       auxDataField 2 = field (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
       auxDataField 3 = field (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
       auxDataField 4 = field (addPlutusScripts PlutusV3) (D (guardPlutus PlutusV3 >> decCBOR))

libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs

@@ -369,7 +369,7 @@ instance EraApi AlonzoEra where
     mkMemoizedEra @AlonzoEra $
       AlonzoTxAuxDataRaw
         { atadrMetadata = md
-        , atadrTimelock = translateTimelock <$> scripts
+        , atadrNativeScripts = translateTimelock <$> scripts
         , atadrPlutus = mempty
         }
 

libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs

@@ -541,6 +541,10 @@ class
 
   fromNativeScript :: NativeScript era -> Script era
 
+  -- | Check the equality of two underlying types, while ignoring their binary
+  -- representation, which `Eq` instance normally does. This is used for testing.
+  eqNativeRaw :: NativeScript era -> NativeScript era -> Bool
+
 isNativeScript :: EraScript era => Script era -> Bool
 isNativeScript = isJust . getNativeScript