Support for Plutus V2 (ledger API)

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 p1 p2 -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> p1 <> p2))
       !> 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

@@ -8,45 +8,43 @@ module Cardano.Ledger.Alonzo.Language where
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeWord64)
 import Cardano.Ledger.Pretty (PDoc, PrettyA (..), ppString)
 import Control.DeepSeq (NFData (..))
-import Data.Coders
 import Data.Ix (Ix)
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
 
--- ==================================================================
--- Non-Native Script language. This is an Enumerated type.
+-- | Non-Native Script language. This is an Enumerated type.
 -- This is expected to be an open type. We will add new Constuctors
 -- to this type as additional Non-Native scripting language as are added.
 -- We use an enumerated type for two reasons.
 -- 1) We can write total functions by case analysis over the constructors
 -- 2) We will use DataKinds to make some datatypes  indexed by Language
 -- 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
+--
+-- Note that the the serialization of 'Language' depends on the ordering.
+data Language
+  = PlutusV1
+  | PlutusV2
   deriving (Eq, Generic, Show, Ord, Enum, Bounded, Ix)
 
 instance NoThunks Language
 
 instance NFData Language
 
 instance ToCBOR Language where
-  toCBOR PlutusV1 = toCBOR (0 :: Int)
+  toCBOR = toCBOR . fromEnum
 
 instance FromCBOR Language where
-  fromCBOR = do
-    n <- decodeWord64
-    case n of
-      0 -> pure PlutusV1
-      m -> invalidKey (fromIntegral m)
+  fromCBOR = toEnum . fromIntegral <$> decodeWord64
 
 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.