Support PlutusV2

cabal.project

@@ -76,8 +76,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/plutus
-  tag: 8c83c4abe211b4bbcaca3cdf1b2c0e38d0eb683f
-  --sha256: 1643s1g3jlm9pgalpc3vpij1zqb1n8yv8irq6qc43gs9bvl0wc3l
+  tag: 2f08f29732e602c5f3afc174bd381a17eb49b041
+  --sha256: 1j4zinp6rfa78842cqfdwzr08jnnn05k6w0sqg5vf1vw80kl7w83
   subdir:
     plutus-ledger-api
     plutus-tx

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

@@ -23,6 +23,7 @@ where
 
 import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..))
 import Cardano.Ledger.Alonzo.Genesis
+import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.PParams
   ( PParams,
     PParams' (..),
@@ -125,11 +126,12 @@ instance (API.PraosCrypto c) => API.GetLedgerView (AlonzoEra c)
 instance (CC.Crypto c) => Shelley.ValidateScript (AlonzoEra c) where
   isNativeScript x = not (isPlutusScript x)
   scriptPrefixTag script =
-    if isPlutusScript script
-      then "\x01"
-      else nativeMultiSigTag -- "\x00"
+    case script of
+      (TimelockScript _) -> nativeMultiSigTag -- "\x00"
+      (PlutusScript PlutusV1 _) -> "\x01"
+      (PlutusScript PlutusV2 _) -> "\x02"
   validateScript (TimelockScript script) tx = validateTimelock @(AlonzoEra c) script tx
-  validateScript (PlutusScript _) _tx = True
+  validateScript (PlutusScript _ _) _tx = True
 
 -- To run a PlutusScript use Cardano.Ledger.Alonzo.TxInfo(runPLCScript)
 -- To run any Alonzo Script use Cardano.Ledger.Alonzo.PlutusScriptApi(evalScripts)

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

@@ -34,10 +34,8 @@ module Cardano.Ledger.Alonzo.Data
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), TokenType (..), peekTokenType, withSlice)
-import Cardano.Ledger.Alonzo.Scripts
-  ( Script (..),
-    isPlutusScript,
-  )
+import Cardano.Ledger.Alonzo.Language (Language (..))
+import Cardano.Ledger.Alonzo.Scripts (Script (..))
 import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.Core as Core
@@ -73,8 +71,7 @@ import qualified Codec.Serialise as Cborg (Serialise (..))
 import Data.ByteString.Lazy (toStrict)
 import Data.ByteString.Short (toShort)
 import Data.Coders
-import qualified Data.Foldable as Foldable
-import qualified Data.List as List
+import Data.Foldable (foldl')
 import Data.Map (Map)
 import Data.Maybe (mapMaybe)
 import Data.MemoBytes (Mem, MemoBytes (..), memoBytes)
@@ -180,19 +177,21 @@ encodeRaw ::
 encodeRaw metadata allScripts =
   Tag 259 $
     Keyed
-      (\m tss pss -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> pss))
+      (\m tss p1ss p2ss -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> p1ss <> p2ss))
       !> Omit null (Key 0 $ mapEncode metadata)
       !> Omit null (Key 1 $ E (encodeFoldable . mapMaybe getTimelock) timelocks)
-      !> Omit null (Key 2 $ E (encodeFoldable . mapMaybe getPlutus) plutusScripts)
+      !> Omit null (Key 2 $ E (encodeFoldable . mapMaybe getPlutus) plutusV1Scripts)
+      !> Omit null (Key 3 $ E (encodeFoldable . mapMaybe getPlutus) plutusV2Scripts)
   where
     getTimelock (TimelockScript x) = Just x
     getTimelock _ = Nothing
-    getPlutus (PlutusScript x) = Just x
+    getPlutus (PlutusScript _ x) = Just x
     getPlutus _ = Nothing
-    (plutusScripts, timelocks) =
-      List.partition
-        isPlutusScript
-        (Foldable.toList allScripts)
+    sortScripts (ts, v1, v2) s@(TimelockScript _) = (s : ts, v1, v2)
+    sortScripts (ts, v1, v2) s@(PlutusScript PlutusV1 _) = (ts, s : v1, v2)
+    sortScripts (ts, v1, v2) s@(PlutusScript PlutusV2 _) = (ts, v1, s : v2)
+    (timelocks, plutusV1Scripts, plutusV2Scripts) =
+      foldl' sortScripts (mempty, mempty, mempty) allScripts
 
 instance
   ( Era era,
@@ -243,7 +242,11 @@ instance
           (D (sequence <$> decodeStrictSeq fromCBOR))
       auxDataField 2 =
         fieldA
-          (\x ad -> ad {scripts' = scripts' ad <> (PlutusScript <$> x)})
+          (\x ad -> ad {scripts' = scripts' ad <> (PlutusScript PlutusV1 <$> x)})
+          (D (decodeStrictSeq fromCBOR))
+      auxDataField 3 =
+        fieldA
+          (\x ad -> ad {scripts' = scripts' ad <> (PlutusScript PlutusV2 <$> x)})
           (D (decodeStrictSeq fromCBOR))
       auxDataField n = field (\_ t -> t) (Invalid n)
 

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

@@ -24,7 +24,9 @@ import NoThunks.Class (NoThunks)
 -- For now, the only Non-Native Scriting language is Plutus
 -- We might add new languages in the futures.
 
-data Language = PlutusV1 --    | ADD-NEW-LANGUAGES-HERE
+data Language
+  = PlutusV1
+  | PlutusV2
   deriving (Eq, Generic, Show, Ord, Enum, Bounded, Ix)
 
 instance NoThunks Language
@@ -33,20 +35,23 @@ instance NFData Language
 
 instance ToCBOR Language where
   toCBOR PlutusV1 = toCBOR (0 :: Int)
+  toCBOR PlutusV2 = toCBOR (1 :: Int)
 
 instance FromCBOR Language where
   fromCBOR = do
     n <- decodeWord64
     case n of
       0 -> pure PlutusV1
+      1 -> pure PlutusV2
       m -> invalidKey (fromIntegral m)
 
 nonNativeLanguages :: Set.Set Language
-nonNativeLanguages = Set.singleton PlutusV1
+nonNativeLanguages = Set.fromList [minBound .. maxBound]
 
 -- ==================================
 
 ppLanguage :: Language -> PDoc
 ppLanguage PlutusV1 = ppString "PlutusV1"
+ppLanguage PlutusV2 = ppString "PlutusV2"
 
 instance PrettyA Language where prettyA = ppLanguage

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

@@ -41,7 +41,7 @@ import Cardano.Binary
     serialize',
     serializeEncoding',
   )
-import Cardano.Ledger.Alonzo.Language (Language (PlutusV1), ppLanguage)
+import Cardano.Ledger.Alonzo.Language (Language (..), ppLanguage)
 import Cardano.Ledger.Alonzo.Scripts
   ( CostModel,
     ExUnits (..),
@@ -517,6 +517,10 @@ getLanguageView pp lang@PlutusV1 =
   LangDepView
     (serialize' lang)
     (serializeEncoding' $ maybe encodeNull toCBOR $ Map.lookup lang (_costmdls pp))
+getLanguageView pp lang@PlutusV2 =
+  LangDepView
+    (serialize' lang)
+    (serializeEncoding' $ maybe encodeNull toCBOR $ Map.lookup lang (_costmdls pp))
 
 encodeLangViews :: Set LangDepView -> Encoding
 encodeLangViews views =

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

@@ -26,7 +26,7 @@ import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.Alonzo.Data (getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.PParams (ProtVer)
-import Cardano.Ledger.Alonzo.Scripts (CostModel, ExUnits (..))
+import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..))
 import qualified Cardano.Ledger.Alonzo.Scripts as AlonzoScript (Script (..))
 import Cardano.Ledger.Alonzo.Tx
   ( Data,
@@ -168,18 +168,22 @@ collectTwoPhaseScriptInputs ::
   UTxO era ->
   Either [CollectError (Crypto era)] [(AlonzoScript.Script era, [Data era], ExUnits, CostModel)]
 collectTwoPhaseScriptInputs ei sysS pp tx utxo =
-  case Map.lookup PlutusV1 (getField @"_costmdls" pp) of
-    Nothing -> Left [NoCostModel PlutusV1]
-    Just cost -> merge (apply cost) (map redeemer needed) (map getscript needed) (Right [])
+  let scriptsUsed = Map.elems . txscripts' $ getField @"wits" tx
+      usedLanguages = [lang | (AlonzoScript.PlutusScript lang _) <- scriptsUsed]
+      costModels = getField @"_costmdls" pp
+      missingCMs = [lang | lang <- usedLanguages, lang `Map.notMember` costModels]
+   in case missingCMs of
+        l : _ -> Left [NoCostModel l]
+        _ -> merge (apply costModels) (map redeemer needed) (map getscript needed) (Right [])
   where
-    txinfo = runIdentity $ txInfo pp ei sysS utxo tx
+    txinfo lang = runIdentity $ txInfo pp lang ei sysS utxo tx
     needed = filter knownToNotBe1Phase $ scriptsNeeded utxo tx
     -- The formal spec achieves the same filtering as knownToNotBe1Phase
     -- by use of the (partial) language function, which is not defined
     -- on 1-phase scripts.
     knownToNotBe1Phase (_, sh) =
       case sh `Map.lookup` txscripts' (getField @"wits" tx) of
-        Just (AlonzoScript.PlutusScript _) -> True
+        Just (AlonzoScript.PlutusScript _ _) -> True
         Just (AlonzoScript.TimelockScript _) -> False
         Nothing -> True
     redeemer (sp, _) =
@@ -190,8 +194,9 @@ collectTwoPhaseScriptInputs ei sysS pp tx utxo =
       case hash `Map.lookup` txscripts' (getField @"wits" tx) of
         Just script -> Right script
         Nothing -> Left (NoWitness hash)
-    apply cost (sp, d, eu) script =
-      (script, getData tx utxo sp ++ (d : [valContext txinfo sp]), eu, cost)
+    apply costs (sp, d, eu) script@(AlonzoScript.PlutusScript lang _) =
+      (script, getData tx utxo sp ++ (d : [valContext (txinfo lang) sp]), eu, costs Map.! lang)
+    apply _ (_, _, eu) script = (script, [], eu, CostModel mempty)
 
 -- | Merge two lists (either of which may have failures, i.e. (Left _)), collect all the failures
 --   but if there are none, use 'f' to construct a success.
@@ -212,7 +217,7 @@ merge f (x : xs) (y : ys) zs = merge f xs ys (gg x y zs)
     gg (Left a) (Left b) (Left cs) = Left (a : b : cs)
 
 language :: AlonzoScript.Script era -> Maybe Language
-language (AlonzoScript.PlutusScript _) = Just PlutusV1
+language (AlonzoScript.PlutusScript lang _) = Just lang
 language (AlonzoScript.TimelockScript _) = Nothing
 
 -- | evaluate a list of scripts, All scripts in the list must be True.
@@ -237,8 +242,8 @@ evalScripts tx ((AlonzoScript.TimelockScript timelock, _, _, _) : rest) =
     vhks = Set.map witKeyHash (txwitsVKey' (getField @"wits" tx))
     lift True = Passes
     lift False = Fails [OnePhaseFailure . pack . show $ timelock]
-evalScripts tx ((AlonzoScript.PlutusScript pscript, ds, units, cost) : rest) =
-  runPLCScript (Proxy @era) cost pscript units (map getPlutusData ds)
+evalScripts tx ((AlonzoScript.PlutusScript lang pscript, ds, units, cost) : rest) =
+  runPLCScript (Proxy @era) lang cost pscript units (map getPlutusData ds)
     `andResult` evalScripts tx rest
 
 -- Collect information (purpose and hash) about all the scripts in a Tx.

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

@@ -85,11 +85,12 @@ import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
 import NoThunks.Class (InspectHeapNamed (..), NoThunks)
 import Numeric.Natural (Natural)
-import Plutus.V1.Ledger.Api (defaultCostModelParams, validateCostModelParams)
+import Plutus.V1.Ledger.Api as PV1 hiding (Map, Script)
 import qualified Plutus.V1.Ledger.Examples as Plutus
   ( alwaysFailingNAryFunction,
     alwaysSucceedingNAryFunction,
   )
+import Plutus.V2.Ledger.Api as PV2 hiding (Map, Script)
 import qualified Prettyprinter as PP
 
 -- | Marker indicating the part of a transaction for which this script is acting
@@ -112,12 +113,12 @@ instance NoThunks Tag
 -- | Scripts in the Alonzo Era, Either a Timelock script or a Plutus script.
 data Script era
   = TimelockScript (Timelock (Crypto era))
-  | PlutusScript ShortByteString -- A Plutus.V1.Ledger.Scripts(Script) that has been 'CBOR' encoded
+  | PlutusScript Language ShortByteString
   deriving (Eq, Generic, Ord)
 
 instance (ValidateScript era, Core.Script era ~ Script era) => Show (Script era) where
   show (TimelockScript x) = "TimelockScript " ++ show x
-  show s@(PlutusScript _) = "PlutusScript " ++ show (hashScript @era s)
+  show s@(PlutusScript v _) = "PlutusScript " ++ show v ++ " " ++ show (hashScript @era s)
 
 deriving via
   InspectHeapNamed "Script" (Script era)
@@ -129,14 +130,14 @@ instance NFData (Script era)
 -- | Both constructors know their original bytes
 instance SafeToHash (Script era) where
   originalBytes (TimelockScript t) = originalBytes t
-  originalBytes (PlutusScript bs) = fromShort bs
+  originalBytes (PlutusScript _ bs) = fromShort bs
 
-alwaysSucceeds, alwaysFails :: Natural -> Script era
-alwaysSucceeds n = PlutusScript (Plutus.alwaysSucceedingNAryFunction n)
-alwaysFails n = PlutusScript (Plutus.alwaysFailingNAryFunction n)
+alwaysSucceeds, alwaysFails :: Language -> Natural -> Script era
+alwaysSucceeds lang n = PlutusScript lang (Plutus.alwaysSucceedingNAryFunction n)
+alwaysFails lang n = PlutusScript lang (Plutus.alwaysFailingNAryFunction n)
 
 isPlutusScript :: Script era -> Bool
-isPlutusScript (PlutusScript _) = True
+isPlutusScript (PlutusScript _ _) = True
 isPlutusScript (TimelockScript _) = False
 
 -- ===========================================
@@ -186,28 +187,36 @@ instance NoThunks CostModel
 
 instance NFData CostModel
 
-checkCostModel :: Map Text Integer -> Either String CostModel
-checkCostModel cm =
-  if validateCostModelParams cm
+checkCostModel :: Language -> Map Text Integer -> Either String CostModel
+checkCostModel PlutusV1 cm =
+  if PV1.validateCostModelParams cm
     then Right (CostModel cm)
-    else Left ("Invalid cost model: " ++ show cm)
+    else Left ("Invalid PlutusV1 cost model: " ++ show cm)
+checkCostModel PlutusV2 cm =
+  if PV2.validateCostModelParams cm
+    then Right (CostModel cm)
+    else Left ("Invalid PlutusV2 cost model: " ++ show cm)
 
-{-# DEPRECATED defaultCostModel "Use 'import Test.Cardano.Ledger.Alonzo.PlutusScripts' instead." #-}
-defaultCostModel :: Maybe CostModel
-defaultCostModel = CostModel <$> defaultCostModelParams
+defaultCostModel :: Language -> Maybe CostModel
+defaultCostModel PlutusV1 = CostModel <$> PV1.defaultCostModelParams
+defaultCostModel PlutusV2 = CostModel <$> PV2.defaultCostModelParams
 
 decodeCostModelMap :: Decoder s (Map Language CostModel)
 decodeCostModelMap = decodeMapByKey fromCBOR decodeCostModel
 
 decodeCostModel :: Language -> Decoder s CostModel
-decodeCostModel PlutusV1 =
-  case defaultCostModelParams of
+decodeCostModel lang =
+  case dcmps of
     Nothing -> fail "Default Plutus Cost Model is corrupt."
     Just dcm -> do
-      checked <- checkCostModel <$> decodeArrayAsMap (Map.keysSet dcm) fromCBOR
+      checked <- checkCostModel lang <$> decodeArrayAsMap (Map.keysSet dcm) fromCBOR
       case checked of
         Left e -> fail e
         Right cm -> pure cm
+  where
+    dcmps = case lang of
+      PlutusV1 -> PV1.defaultCostModelParams
+      PlutusV2 -> PV2.defaultCostModelParams
 
 decodeArrayAsMap :: Ord a => Set a -> Decoder s b -> Decoder s (Map a b)
 decodeArrayAsMap keys decodeValue = do
@@ -294,7 +303,8 @@ instance forall era. (Typeable (Crypto era), Typeable era) => ToCBOR (Script era
 
 encodeScript :: (Typeable (Crypto era)) => Script era -> Encode 'Open (Script era)
 encodeScript (TimelockScript i) = Sum TimelockScript 0 !> To i
-encodeScript (PlutusScript s) = Sum PlutusScript 1 !> To s -- Use the ToCBOR instance of ShortByteString
+encodeScript (PlutusScript PlutusV1 s) = Sum (PlutusScript PlutusV1) 1 !> To s -- Use the ToCBOR instance of ShortByteString
+encodeScript (PlutusScript PlutusV2 s) = Sum (PlutusScript PlutusV1) 2 !> To s
 
 instance
   (CC.Crypto (Crypto era), Typeable (Crypto era), Typeable era) =>
@@ -304,7 +314,8 @@ instance
     where
       decodeScript :: Word -> Decode 'Open (Annotator (Script era))
       decodeScript 0 = Ann (SumD TimelockScript) <*! From
-      decodeScript 1 = Ann (SumD PlutusScript) <*! Ann From
+      decodeScript 1 = Ann (SumD $ PlutusScript PlutusV1) <*! Ann From
+      decodeScript 2 = Ann (SumD $ PlutusScript PlutusV2) <*! Ann From
       decodeScript n = Invalid n
 
 -- ============================================================
@@ -316,7 +327,7 @@ ppTag x = ppString (show x)
 instance PrettyA Tag where prettyA = ppTag
 
 ppScript :: forall era. (ValidateScript era, Core.Script era ~ Script era) => Script era -> PDoc
-ppScript s@(PlutusScript _) = ppString "PlutusScript " PP.<+> ppScriptHash (hashScript @era s)
+ppScript s@(PlutusScript v _) = ppString ("PlutusScript " <> show v <> " ") PP.<+> ppScriptHash (hashScript @era s)
 ppScript (TimelockScript x) = ppTimelock x
 
 instance (ValidateScript era, Core.Script era ~ Script era) => PrettyA (Script era) where prettyA = ppScript