{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module provides data structures and operations for talking about
--     Non-native Script languages. It is expected that new languages (or new
--     versions of old languages) will be added here.
module Cardano.Ledger.Plutus.Language (
  -- * Plutus Script
  Plutus (..),
  isValidPlutus,
  PlutusBinary (..),
  PlutusRunnable (..),
  plutusFromRunnable,
  decodeWithPlutus,
  hashPlutusScript,

  -- * Value level Plutus Language version
  Language (..),
  mkLanguageEnum,
  languageToText,
  languageFromText,
  nonNativeLanguages,
  guardPlutus,

  -- * Type level Plutus Language version
  SLanguage (..),
  PlutusLanguage (..),
  PlutusArgs (..),
  plutusLanguage,
  plutusSLanguage,
  fromSLanguage,
  toSLanguage,
  withSLanguage,
  asSLanguage,
  withSamePlutusLanguage,

  -- * Plutus Script Context
  LegacyPlutusArgs (..),
  PlutusScriptContext,
) where

import qualified Cardano.Crypto.Hash.Class as Hash (castHash, hashWith)
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  Version,
  decodeRecordNamed,
  decodeScriptContextFromData,
  encodeEnum,
  encodeListLen,
  getDecoderVersion,
  getVersion,
  natVersion,
  unlessDecoderVersionAtLeast,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Crypto
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad (when)
import Data.Aeson (
  FromJSON (parseJSON),
  FromJSONKey (fromJSONKey),
  FromJSONKeyFunction (FromJSONKeyTextParser),
  ToJSON (toJSON),
  ToJSONKey (toJSONKey),
  Value (String),
  withText,
 )
import Data.Aeson.Types (toJSONKeyText)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 (encode)
import Data.ByteString.Short (ShortByteString, fromShort)
import Data.Either (isRight)
import Data.Ix (Ix)
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Typeable (Typeable, gcast)
import Data.Word (Word8)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import PlutusCore (DefaultFun, DefaultUni)
import qualified PlutusLedgerApi.Common as P (
  Data,
  EvaluationContext,
  EvaluationError,
  ExBudget,
  LogOutput,
  MajorProtocolVersion (..),
  PlutusLedgerLanguage (PlutusV1, PlutusV2, PlutusV3),
  ScriptDecodeError,
  ScriptForEvaluation,
  VerboseMode,
  mkTermToEvaluate,
  serialisedScript,
 )
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
import Prettyprinter (Doc, Pretty (..), align, indent, line, vsep, (<+>))
import System.Random.Stateful (Random, Uniform (..), UniformRange (..), uniformEnumM, uniformEnumRM)
import qualified UntypedPlutusCore as UPLC

-- | This is a deserialized version of the `Plutus` type that can be used directly with
-- evaluation functions that rely on `evaluatePlutusRunnable`.
--
-- The only way to obtain this type is by the means of deserializing `Plutus` with
-- `decodePlutusRunnable`
newtype PlutusRunnable (l :: Language) = PlutusRunnable
  { forall (l :: Language). PlutusRunnable l -> ScriptForEvaluation
plutusRunnable :: P.ScriptForEvaluation
  }
  deriving stock (Int -> PlutusRunnable l -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: Language). Int -> PlutusRunnable l -> ShowS
forall (l :: Language). [PlutusRunnable l] -> ShowS
forall (l :: Language). PlutusRunnable l -> String
showList :: [PlutusRunnable l] -> ShowS
$cshowList :: forall (l :: Language). [PlutusRunnable l] -> ShowS
show :: PlutusRunnable l -> String
$cshow :: forall (l :: Language). PlutusRunnable l -> String
showsPrec :: Int -> PlutusRunnable l -> ShowS
$cshowsPrec :: forall (l :: Language). Int -> PlutusRunnable l -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (l :: Language) x.
Rep (PlutusRunnable l) x -> PlutusRunnable l
forall (l :: Language) x.
PlutusRunnable l -> Rep (PlutusRunnable l) x
$cto :: forall (l :: Language) x.
Rep (PlutusRunnable l) x -> PlutusRunnable l
$cfrom :: forall (l :: Language) x.
PlutusRunnable l -> Rep (PlutusRunnable l) x
Generic)
  deriving newtype (PlutusRunnable l -> PlutusRunnable l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: Language).
PlutusRunnable l -> PlutusRunnable l -> Bool
/= :: PlutusRunnable l -> PlutusRunnable l -> Bool
$c/= :: forall (l :: Language).
PlutusRunnable l -> PlutusRunnable l -> Bool
== :: PlutusRunnable l -> PlutusRunnable l -> Bool
$c== :: forall (l :: Language).
PlutusRunnable l -> PlutusRunnable l -> Bool
Eq, PlutusRunnable l -> ()
forall a. (a -> ()) -> NFData a
forall (l :: Language). PlutusRunnable l -> ()
rnf :: PlutusRunnable l -> ()
$crnf :: forall (l :: Language). PlutusRunnable l -> ()
NFData, Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
Proxy (PlutusRunnable l) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (l :: Language).
Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
forall (l :: Language). Proxy (PlutusRunnable l) -> String
showTypeOf :: Proxy (PlutusRunnable l) -> String
$cshowTypeOf :: forall (l :: Language). Proxy (PlutusRunnable l) -> String
wNoThunks :: Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (l :: Language).
Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (l :: Language).
Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
NoThunks)

toMajorProtocolVersion :: Version -> P.MajorProtocolVersion
toMajorProtocolVersion :: Version -> MajorProtocolVersion
toMajorProtocolVersion = Int -> MajorProtocolVersion
P.MajorProtocolVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Version -> i
getVersion

instance PlutusLanguage l => DecCBOR (PlutusRunnable l) where
  decCBOR :: forall s. Decoder s (PlutusRunnable l)
decCBOR = do
    Plutus l
plutus <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Version
pv <- forall s. Decoder s Version
getDecoderVersion
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
decodePlutusRunnable Version
pv Plutus l
plutus

instance PlutusLanguage l => EncCBOR (PlutusRunnable l) where
  encCBOR :: PlutusRunnable l -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusRunnable l -> Plutus l
plutusFromRunnable

-- | Serialized representation of a Plutus script that distinguishes the language version at the
-- type level. When encoded in CBOR language version is also encoded.
newtype Plutus (l :: Language) = Plutus
  { forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary :: PlutusBinary
  }
  deriving stock (Int -> Plutus l -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: Language). Int -> Plutus l -> ShowS
forall (l :: Language). [Plutus l] -> ShowS
forall (l :: Language). Plutus l -> String
showList :: [Plutus l] -> ShowS
$cshowList :: forall (l :: Language). [Plutus l] -> ShowS
show :: Plutus l -> String
$cshow :: forall (l :: Language). Plutus l -> String
showsPrec :: Int -> Plutus l -> ShowS
$cshowsPrec :: forall (l :: Language). Int -> Plutus l -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (l :: Language) x. Rep (Plutus l) x -> Plutus l
forall (l :: Language) x. Plutus l -> Rep (Plutus l) x
$cto :: forall (l :: Language) x. Rep (Plutus l) x -> Plutus l
$cfrom :: forall (l :: Language) x. Plutus l -> Rep (Plutus l) x
Generic)
  deriving newtype (Plutus l -> Plutus l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: Language). Plutus l -> Plutus l -> Bool
/= :: Plutus l -> Plutus l -> Bool
$c/= :: forall (l :: Language). Plutus l -> Plutus l -> Bool
== :: Plutus l -> Plutus l -> Bool
$c== :: forall (l :: Language). Plutus l -> Plutus l -> Bool
Eq, Plutus l -> Plutus l -> Bool
Plutus l -> Plutus l -> Ordering
Plutus l -> Plutus l -> Plutus l
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (l :: Language). Eq (Plutus l)
forall (l :: Language). Plutus l -> Plutus l -> Bool
forall (l :: Language). Plutus l -> Plutus l -> Ordering
forall (l :: Language). Plutus l -> Plutus l -> Plutus l
min :: Plutus l -> Plutus l -> Plutus l
$cmin :: forall (l :: Language). Plutus l -> Plutus l -> Plutus l
max :: Plutus l -> Plutus l -> Plutus l
$cmax :: forall (l :: Language). Plutus l -> Plutus l -> Plutus l
>= :: Plutus l -> Plutus l -> Bool
$c>= :: forall (l :: Language). Plutus l -> Plutus l -> Bool
> :: Plutus l -> Plutus l -> Bool
$c> :: forall (l :: Language). Plutus l -> Plutus l -> Bool
<= :: Plutus l -> Plutus l -> Bool
$c<= :: forall (l :: Language). Plutus l -> Plutus l -> Bool
< :: Plutus l -> Plutus l -> Bool
$c< :: forall (l :: Language). Plutus l -> Plutus l -> Bool
compare :: Plutus l -> Plutus l -> Ordering
$ccompare :: forall (l :: Language). Plutus l -> Plutus l -> Ordering
Ord, Plutus l -> Int
Plutus l -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Plutus l -> SafeHash c index
forall (l :: Language). Plutus l -> Int
forall (l :: Language). Plutus l -> ByteString
forall (l :: Language) c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Plutus l -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Plutus l -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall (l :: Language) c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Plutus l -> SafeHash c index
originalBytesSize :: Plutus l -> Int
$coriginalBytesSize :: forall (l :: Language). Plutus l -> Int
originalBytes :: Plutus l -> ByteString
$coriginalBytes :: forall (l :: Language). Plutus l -> ByteString
SafeToHash, Context -> Plutus l -> IO (Maybe ThunkInfo)
Proxy (Plutus l) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (l :: Language). Context -> Plutus l -> IO (Maybe ThunkInfo)
forall (l :: Language). Proxy (Plutus l) -> String
showTypeOf :: Proxy (Plutus l) -> String
$cshowTypeOf :: forall (l :: Language). Proxy (Plutus l) -> String
wNoThunks :: Context -> Plutus l -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (l :: Language). Context -> Plutus l -> IO (Maybe ThunkInfo)
noThunks :: Context -> Plutus l -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (l :: Language). Context -> Plutus l -> IO (Maybe ThunkInfo)
NoThunks, Plutus l -> ()
forall a. (a -> ()) -> NFData a
forall (l :: Language). Plutus l -> ()
rnf :: Plutus l -> ()
$crnf :: forall (l :: Language). Plutus l -> ()
NFData)

plutusSLanguage :: PlutusLanguage l => proxy l -> SLanguage l
plutusSLanguage :: forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> SLanguage l
plutusSLanguage proxy l
_ = forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage

-- | Compute a `ScriptHash` of a `Plutus` script. This function is equivalent to
-- `Cardano.Ledger.Core.hashScript`, except it is restricted to Plutus scripts
hashPlutusScript :: forall c l. (Crypto c, PlutusLanguage l) => Plutus l -> ScriptHash c
hashPlutusScript :: forall c (l :: Language).
(Crypto c, PlutusLanguage l) =>
Plutus l -> ScriptHash c
hashPlutusScript Plutus l
plutusScript =
  forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
ScriptHash forall a b. (a -> b) -> a -> b
$
    forall h a b. Hash h a -> Hash h b
Hash.castHash forall a b. (a -> b) -> a -> b
$
      forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith forall a. a -> a
id (Word8 -> ByteString
BS.singleton (forall (l :: Language). PlutusLanguage l => Plutus l -> Word8
plutusLanguageTag Plutus l
plutusScript) forall a. Semigroup a => a -> a -> a
<> forall t. SafeToHash t => t -> ByteString
originalBytes Plutus l
plutusScript)

decodePlutus :: Decoder s (Language, PlutusBinary)
decodePlutus :: forall s. Decoder s (Language, PlutusBinary)
decodePlutus = forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Plutus" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | Plutus script decoder that will enforce the type level language equals the one
-- included in the serialization
decodeWithPlutus :: (forall si l. PlutusLanguage l => Plutus l -> Decoder si a) -> Decoder so a
decodeWithPlutus :: forall a so.
(forall si (l :: Language).
 PlutusLanguage l =>
 Plutus l -> Decoder si a)
-> Decoder so a
decodeWithPlutus forall si (l :: Language).
PlutusLanguage l =>
Plutus l -> Decoder si a
decoderAction = do
  (Language
lang, PlutusBinary
binary) <- forall s. Decoder s (Language, PlutusBinary)
decodePlutus
  forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang forall a b. (a -> b) -> a -> b
$ \SLanguage l
slang ->
    forall si (l :: Language).
PlutusLanguage l =>
Plutus l -> Decoder si a
decoderAction forall a b. (a -> b) -> a -> b
$ forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage SLanguage l
slang forall a b. (a -> b) -> a -> b
$ forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
binary

instance PlutusLanguage l => DecCBOR (Plutus l) where
  decCBOR :: forall s. Decoder s (Plutus l)
decCBOR = do
    (Language
langDecoded, PlutusBinary
binary) <- forall s. Decoder s (Language, PlutusBinary)
decodePlutus
    let plutus :: Plutus l
plutus = forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
binary
        langExpected :: Language
langExpected = forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
plutus
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Language
langDecoded forall a. Eq a => a -> a -> Bool
/= Language
langExpected) forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Language
langExpected forall a. Semigroup a => a -> a -> a
<> String
", but got: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Language
langDecoded
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Plutus l
plutus

instance PlutusLanguage l => EncCBOR (Plutus l) where
  encCBOR :: Plutus l -> Encoding
encCBOR plutus :: Plutus l
plutus@(Plutus PlutusBinary
binaryScript) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. Enum a => a -> Encoding
encodeEnum Language
lang forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR PlutusBinary
binaryScript
    where
      lang :: Language
lang = forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
plutus

-- | Verify that the binary version of the Plutus script is deserializable.
isValidPlutus :: PlutusLanguage l => Version -> Plutus l -> Bool
isValidPlutus :: forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Bool
isValidPlutus Version
v = forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
decodePlutusRunnable Version
v

-- | Serialize the runnable version of the plutus script
--
-- prop> decodePlutusRunnable majVer (plutusFromRunnable pr) == Right pr
plutusFromRunnable :: PlutusRunnable l -> Plutus l
plutusFromRunnable :: forall (l :: Language). PlutusRunnable l -> Plutus l
plutusFromRunnable = forall (l :: Language). PlutusBinary -> Plutus l
Plutus forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusBinary
PlutusBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptForEvaluation -> ShortByteString
P.serialisedScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusRunnable l -> ScriptForEvaluation
plutusRunnable

-- | Binary representation of a Plutus script.
newtype PlutusBinary = PlutusBinary {PlutusBinary -> ShortByteString
unPlutusBinary :: ShortByteString}
  deriving stock (PlutusBinary -> PlutusBinary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusBinary -> PlutusBinary -> Bool
$c/= :: PlutusBinary -> PlutusBinary -> Bool
== :: PlutusBinary -> PlutusBinary -> Bool
$c== :: PlutusBinary -> PlutusBinary -> Bool
Eq, Eq PlutusBinary
PlutusBinary -> PlutusBinary -> Bool
PlutusBinary -> PlutusBinary -> Ordering
PlutusBinary -> PlutusBinary -> PlutusBinary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlutusBinary -> PlutusBinary -> PlutusBinary
$cmin :: PlutusBinary -> PlutusBinary -> PlutusBinary
max :: PlutusBinary -> PlutusBinary -> PlutusBinary
$cmax :: PlutusBinary -> PlutusBinary -> PlutusBinary
>= :: PlutusBinary -> PlutusBinary -> Bool
$c>= :: PlutusBinary -> PlutusBinary -> Bool
> :: PlutusBinary -> PlutusBinary -> Bool
$c> :: PlutusBinary -> PlutusBinary -> Bool
<= :: PlutusBinary -> PlutusBinary -> Bool
$c<= :: PlutusBinary -> PlutusBinary -> Bool
< :: PlutusBinary -> PlutusBinary -> Bool
$c< :: PlutusBinary -> PlutusBinary -> Bool
compare :: PlutusBinary -> PlutusBinary -> Ordering
$ccompare :: PlutusBinary -> PlutusBinary -> Ordering
Ord, forall x. Rep PlutusBinary x -> PlutusBinary
forall x. PlutusBinary -> Rep PlutusBinary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlutusBinary x -> PlutusBinary
$cfrom :: forall x. PlutusBinary -> Rep PlutusBinary x
Generic)
  deriving newtype (Typeable PlutusBinary
PlutusBinary -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
toCBOR :: PlutusBinary -> Encoding
$ctoCBOR :: PlutusBinary -> Encoding
ToCBOR, Typeable PlutusBinary
Proxy PlutusBinary -> Text
forall s. Decoder s PlutusBinary
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy PlutusBinary -> Text
$clabel :: Proxy PlutusBinary -> Text
fromCBOR :: forall s. Decoder s PlutusBinary
$cfromCBOR :: forall s. Decoder s PlutusBinary
FromCBOR, Typeable PlutusBinary
PlutusBinary -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
encCBOR :: PlutusBinary -> Encoding
$cencCBOR :: PlutusBinary -> Encoding
EncCBOR, Typeable PlutusBinary
Proxy PlutusBinary -> Text
forall s. Decoder s PlutusBinary
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy PlutusBinary -> Decoder s ()
label :: Proxy PlutusBinary -> Text
$clabel :: Proxy PlutusBinary -> Text
dropCBOR :: forall s. Proxy PlutusBinary -> Decoder s ()
$cdropCBOR :: forall s. Proxy PlutusBinary -> Decoder s ()
decCBOR :: forall s. Decoder s PlutusBinary
$cdecCBOR :: forall s. Decoder s PlutusBinary
DecCBOR, PlutusBinary -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusBinary -> ()
$crnf :: PlutusBinary -> ()
NFData, Context -> PlutusBinary -> IO (Maybe ThunkInfo)
Proxy PlutusBinary -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PlutusBinary -> String
$cshowTypeOf :: Proxy PlutusBinary -> String
wNoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
NoThunks)

instance Show PlutusBinary where
  show :: PlutusBinary -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> ShortByteString
unPlutusBinary

instance DecCBOR (Annotator PlutusBinary) where
  decCBOR :: forall s. Decoder s (Annotator PlutusBinary)
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance SafeToHash PlutusBinary where
  originalBytes :: PlutusBinary -> ByteString
originalBytes (PlutusBinary ShortByteString
binaryBlutus) = ShortByteString -> ByteString
fromShort ShortByteString
binaryBlutus

-- | Non-Native Plutus Script language. This is expected to be an open type. We will add
-- new Constuctors to this type as additional Plutus language versions 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 use DataKinds to make some datatypes indexed by Language.
--
-- Note that the the serialization of 'Language' depends on the ordering.
data Language
  = PlutusV1
  | PlutusV2
  | PlutusV3
  deriving (Language -> Language -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, Eq Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
Ord, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Language -> Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFrom :: Language -> [Language]
fromEnum :: Language -> Int
$cfromEnum :: Language -> Int
toEnum :: Int -> Language
$ctoEnum :: Int -> Language
pred :: Language -> Language
$cpred :: Language -> Language
succ :: Language -> Language
$csucc :: Language -> Language
Enum, Language
forall a. a -> a -> Bounded a
maxBound :: Language
$cmaxBound :: Language
minBound :: Language
$cminBound :: Language
Bounded, Ord Language
(Language, Language) -> Int
(Language, Language) -> [Language]
(Language, Language) -> Language -> Bool
(Language, Language) -> Language -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Language, Language) -> Int
$cunsafeRangeSize :: (Language, Language) -> Int
rangeSize :: (Language, Language) -> Int
$crangeSize :: (Language, Language) -> Int
inRange :: (Language, Language) -> Language -> Bool
$cinRange :: (Language, Language) -> Language -> Bool
unsafeIndex :: (Language, Language) -> Language -> Int
$cunsafeIndex :: (Language, Language) -> Language -> Int
index :: (Language, Language) -> Language -> Int
$cindex :: (Language, Language) -> Language -> Int
range :: (Language, Language) -> [Language]
$crange :: (Language, Language) -> [Language]
Ix)

instance NoThunks Language

instance NFData Language

instance Random Language

instance Uniform Language where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Language
uniformM = forall a g (m :: * -> *).
(Enum a, Bounded a, StatefulGen g m) =>
g -> m a
uniformEnumM

instance UniformRange Language where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Language, Language) -> g -> m Language
uniformRM = forall a g (m :: * -> *).
(Enum a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformEnumRM

-- | Make a language from its `Enum` index.
mkLanguageEnum :: Int -> Maybe Language
mkLanguageEnum :: Int -> Maybe Language
mkLanguageEnum Int
iLang
  | Int
minLang forall a. Ord a => a -> a -> Bool
<= Int
iLang Bool -> Bool -> Bool
&& Int
iLang forall a. Ord a => a -> a -> Bool
<= Int
maxLang = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
iLang
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    minLang :: Int
minLang = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: Language)
    maxLang :: Int
maxLang = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Language)

instance FromJSON Language where
  parseJSON :: Value -> Parser Language
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Language" forall (m :: * -> *). MonadFail m => Text -> m Language
languageFromText

instance ToJSON Language where
  toJSON :: Language -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Text
languageToText

instance ToJSONKey Language where
  toJSONKey :: ToJSONKeyFunction Language
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Language -> Text
languageToText

instance FromJSONKey Language where
  fromJSONKey :: FromJSONKeyFunction Language
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall (m :: * -> *). MonadFail m => Text -> m Language
languageFromText

languageToText :: Language -> Text
languageToText :: Language -> Text
languageToText Language
PlutusV1 = Text
"PlutusV1"
languageToText Language
PlutusV2 = Text
"PlutusV2"
languageToText Language
PlutusV3 = Text
"PlutusV3"

languageFromText :: MonadFail m => Text -> m Language
languageFromText :: forall (m :: * -> *). MonadFail m => Text -> m Language
languageFromText Text
"PlutusV1" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV1
languageFromText Text
"PlutusV2" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV2
languageFromText Text
"PlutusV3" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV3
languageFromText Text
lang = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Error decoding Language: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
lang

instance ToCBOR Language where
  toCBOR :: Language -> Encoding
toCBOR = forall a. Enum a => a -> Encoding
Plain.encodeEnum

instance FromCBOR Language where
  fromCBOR :: forall s. Decoder s Language
fromCBOR = forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
Plain.decodeEnumBounded

instance EncCBOR Language

instance DecCBOR Language

nonNativeLanguages :: [Language]
nonNativeLanguages :: [Language]
nonNativeLanguages = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Singleton for '@Language@'
data SLanguage (l :: Language) where
  SPlutusV1 :: SLanguage 'PlutusV1
  SPlutusV2 :: SLanguage 'PlutusV2
  SPlutusV3 :: SLanguage 'PlutusV3

deriving instance Eq (SLanguage l)

deriving instance Show (SLanguage l)

instance PlutusLanguage l => ToCBOR (SLanguage l) where
  toCBOR :: SLanguage l -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusLanguage l => SLanguage l -> Language
fromSLanguage

instance PlutusLanguage l => FromCBOR (SLanguage l) where
  fromCBOR :: forall s. Decoder s (SLanguage l)
fromCBOR = forall (l :: Language) (m :: * -> *).
(PlutusLanguage l, MonadFail m) =>
Language -> m (SLanguage l)
toSLanguage forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. FromCBOR a => Decoder s a
fromCBOR @Language

instance PlutusLanguage l => EncCBOR (SLanguage l)

instance PlutusLanguage l => DecCBOR (SLanguage l)

-- | Reflection for '@SLanguage@'
fromSLanguage :: PlutusLanguage l => SLanguage l -> Language
fromSLanguage :: forall (l :: Language). PlutusLanguage l => SLanguage l -> Language
fromSLanguage = forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage
{-# DEPRECATED fromSLanguage "In favor of `plutusLanguage`" #-}

-- | Construct value level laguage version from the type level
plutusLanguage :: forall l proxy. PlutusLanguage l => proxy l -> Language
plutusLanguage :: forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage proxy l
_ = case forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage @l of
  SLanguage l
SPlutusV1 -> Language
PlutusV1
  SLanguage l
SPlutusV2 -> Language
PlutusV2
  SLanguage l
SPlutusV3 -> Language
PlutusV3

type family PlutusScriptContext (l :: Language) = r | r -> l where
  PlutusScriptContext 'PlutusV1 = PV1.ScriptContext
  PlutusScriptContext 'PlutusV2 = PV2.ScriptContext
  PlutusScriptContext 'PlutusV3 = PV3.ScriptContext

data LegacyPlutusArgs l
  = -- | Scripts that require 2 arguments.
    LegacyPlutusArgs2
      -- | Redeemer
      !P.Data
      -- | PlutusScriptContext
      !(PlutusScriptContext l)
  | -- | Scripts that require 3 arguments. Which is only PlutusV1/V2 spending scripts
    LegacyPlutusArgs3
      -- | Mandatory Spending Datum
      !P.Data
      -- | Redeemer
      !P.Data
      -- | PlutusScriptContext
      !(PlutusScriptContext l)

deriving instance Eq (PlutusScriptContext l) => Eq (LegacyPlutusArgs l)
deriving instance Show (PlutusScriptContext l) => Show (LegacyPlutusArgs l)

instance NFData (PlutusScriptContext l) => NFData (LegacyPlutusArgs l) where
  rnf :: LegacyPlutusArgs l -> ()
rnf = \case
    LegacyPlutusArgs2 Data
redeemer PlutusScriptContext l
scriptContext -> Data
redeemer forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf PlutusScriptContext l
scriptContext
    LegacyPlutusArgs3 Data
datum Data
redeemer PlutusScriptContext l
scriptContext -> Data
datum forall a b. NFData a => a -> b -> b
`deepseq` Data
redeemer forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf PlutusScriptContext l
scriptContext

-- TODO: Change NFData instances to not go through Data and move to Plutus repo
instance NFData PV1.ScriptContext where
  rnf :: ScriptContext -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData

instance NFData PV2.ScriptContext where
  rnf :: ScriptContext -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData

instance NFData PV3.ScriptContext where
  rnf :: ScriptContext -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData

instance (PlutusLanguage l, PV3.ToData (PlutusScriptContext l)) => EncCBOR (LegacyPlutusArgs l) where
  encCBOR :: LegacyPlutusArgs l -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData

instance (PlutusLanguage l, PV3.FromData (PlutusScriptContext l)) => DecCBOR (LegacyPlutusArgs l) where
  decCBOR :: forall s. Decoder s (LegacyPlutusArgs l)
decCBOR =
    forall a s. DecCBOR a => Decoder s a
decCBOR forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Data
redeemer, Data
scriptContextData] ->
        forall (l :: Language).
Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs2 Data
redeemer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (FromData a, MonadFail m) => Data -> m a
decodeScriptContextFromData Data
scriptContextData
      [Data
datum, Data
redeemer, Data
scriptContextData] ->
        forall (l :: Language).
Data -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs3 Data
datum Data
redeemer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (FromData a, MonadFail m) => Data -> m a
decodeScriptContextFromData Data
scriptContextData
      [Data]
args ->
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid number of aruments " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Data]
args) forall a. Semigroup a => a -> a -> a
<> String
" is encoded for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Language
lang
    where
      lang :: Language
lang = forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage (forall {k} (t :: k). Proxy t
Proxy @l)

instance Pretty (PlutusScriptContext l) => Pretty (LegacyPlutusArgs l) where
  pretty :: forall ann. LegacyPlutusArgs l -> Doc ann
pretty = \case
    LegacyPlutusArgs2 Data
redeemer PlutusScriptContext l
scriptContext ->
      let argsList :: [Doc ann]
argsList =
            [ Doc ann
"Redeemer:"
            , forall ann. Int -> Doc ann -> Doc ann
indent Int
i (forall a ann. Pretty a => a -> Doc ann
pretty Data
redeemer)
            , Doc ann
"ScriptContext:"
            , forall ann. Int -> Doc ann -> Doc ann
indent Int
i (forall a ann. Pretty a => a -> Doc ann
pretty PlutusScriptContext l
scriptContext)
            ]
       in forall ann. Int -> [Doc ann] -> Doc ann
argsHeader Int
2 [Doc ann]
argsList
    LegacyPlutusArgs3 Data
datum Data
redeemer PlutusScriptContext l
scriptContext ->
      let argsList :: [Doc ann]
argsList =
            [ Doc ann
"Datum:"
            , forall ann. Int -> Doc ann -> Doc ann
indent Int
i (forall a ann. Pretty a => a -> Doc ann
pretty Data
datum)
            , Doc ann
"Redeemer:"
            , forall ann. Int -> Doc ann -> Doc ann
indent Int
i (forall a ann. Pretty a => a -> Doc ann
pretty Data
redeemer)
            , Doc ann
"ScriptContext:"
            , forall ann. Int -> Doc ann -> Doc ann
indent Int
i (forall a ann. Pretty a => a -> Doc ann
pretty PlutusScriptContext l
scriptContext)
            ]
       in forall ann. Int -> [Doc ann] -> Doc ann
argsHeader Int
3 [Doc ann]
argsList
    where
      argsHeader :: Int -> [Doc ann] -> Doc ann
      argsHeader :: forall ann. Int -> [Doc ann] -> Doc ann
argsHeader Int
n [Doc ann]
argsList =
        Doc ann
"LegacyPlutusArgs" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
line forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"  " forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
argsList)
      i :: Int
i = Int
5

legacyPlutusArgsToData :: PV3.ToData (PlutusScriptContext l) => LegacyPlutusArgs l -> [P.Data]
legacyPlutusArgsToData :: forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData = \case
  LegacyPlutusArgs2 Data
redeemer PlutusScriptContext l
scriptContext -> [Data
redeemer, forall a. ToData a => a -> Data
PV3.toData PlutusScriptContext l
scriptContext]
  LegacyPlutusArgs3 Data
datum Data
redeemer PlutusScriptContext l
scriptContext -> [Data
datum, Data
redeemer, forall a. ToData a => a -> Data
PV3.toData PlutusScriptContext l
scriptContext]

-- | For implicit reflection on '@SLanguage@'
-- See "Cardano.Ledger.Alonzo.Plutus.TxInfo" for example usage
class
  ( Typeable l
  , NFData (PlutusArgs l)
  , EncCBOR (PlutusArgs l)
  , DecCBOR (PlutusArgs l)
  , Pretty (PlutusArgs l)
  , Show (PlutusArgs l)
  , Eq (PlutusArgs l)
  ) =>
  PlutusLanguage (l :: Language)
  where
  data PlutusArgs l :: Type

  isLanguage :: SLanguage l

  -- | Tag that will be used as a prefix to compute the `ScriptHash`
  plutusLanguageTag :: Plutus l -> Word8

  decodePlutusRunnable ::
    -- | Which major protocol version to use for deserialization and further execution
    Version ->
    -- | Binary version of the script that will be deserialized
    Plutus l ->
    Either P.ScriptDecodeError (PlutusRunnable l)

  evaluatePlutusRunnable ::
    -- | Which major protocol version to use for script execution
    Version ->
    -- | Whether to produce log output
    P.VerboseMode ->
    -- | Includes the cost model to use for tallying up the execution costs
    P.EvaluationContext ->
    -- | The resource budget which must not be exceeded during evaluation
    P.ExBudget ->
    -- | The script to evaluate
    PlutusRunnable l ->
    -- | The arguments to the script
    PlutusArgs l ->
    (P.LogOutput, Either P.EvaluationError P.ExBudget)

  -- | Similar to `evaluatePlutusRunnable`, except does not require `P.ExBudget` to be
  -- provided as input and instead computes it as output. This function is meant to be
  -- used for testing.
  evaluatePlutusRunnableBudget ::
    -- | Which major protocol version to use for script execution
    Version ->
    -- | Whether to produce log output
    P.VerboseMode ->
    -- | Includes the cost model to use for tallying up the execution costs
    P.EvaluationContext ->
    -- | The script to evaluate
    PlutusRunnable l ->
    -- | The arguments to the script
    PlutusArgs l ->
    (P.LogOutput, Either P.EvaluationError P.ExBudget)

  mkTermToEvaluate ::
    -- | Which major protocol version to use for script execution
    Version ->
    -- | The script to evaluate
    PlutusRunnable l ->
    -- | The arguments to the script
    PlutusArgs l ->
    Either P.EvaluationError (UPLC.Term UPLC.NamedDeBruijn DefaultUni DefaultFun ())

instance PlutusLanguage 'PlutusV1 where
  newtype PlutusArgs 'PlutusV1 = PlutusV1Args {PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1
unPlutusV1Args :: LegacyPlutusArgs 'PlutusV1}
    deriving newtype (PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
$c/= :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
== :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
$c== :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
Eq, Int -> PlutusArgs 'PlutusV1 -> ShowS
[PlutusArgs 'PlutusV1] -> ShowS
PlutusArgs 'PlutusV1 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusArgs 'PlutusV1] -> ShowS
$cshowList :: [PlutusArgs 'PlutusV1] -> ShowS
show :: PlutusArgs 'PlutusV1 -> String
$cshow :: PlutusArgs 'PlutusV1 -> String
showsPrec :: Int -> PlutusArgs 'PlutusV1 -> ShowS
$cshowsPrec :: Int -> PlutusArgs 'PlutusV1 -> ShowS
Show, forall ann. [PlutusArgs 'PlutusV1] -> Doc ann
forall ann. PlutusArgs 'PlutusV1 -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [PlutusArgs 'PlutusV1] -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV1] -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV1 -> Doc ann
$cpretty :: forall ann. PlutusArgs 'PlutusV1 -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV1)
PlutusArgs 'PlutusV1 -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV1] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV1) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV1] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV1] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV1) -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV1) -> Size
encCBOR :: PlutusArgs 'PlutusV1 -> Encoding
$cencCBOR :: PlutusArgs 'PlutusV1 -> Encoding
EncCBOR, Typeable (PlutusArgs 'PlutusV1)
Proxy (PlutusArgs 'PlutusV1) -> Text
forall s. Decoder s (PlutusArgs 'PlutusV1)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ()
label :: Proxy (PlutusArgs 'PlutusV1) -> Text
$clabel :: Proxy (PlutusArgs 'PlutusV1) -> Text
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ()
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ()
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV1)
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV1)
DecCBOR, PlutusArgs 'PlutusV1 -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusArgs 'PlutusV1 -> ()
$crnf :: PlutusArgs 'PlutusV1 -> ()
NFData)
  isLanguage :: SLanguage 'PlutusV1
isLanguage = SLanguage 'PlutusV1
SPlutusV1
  plutusLanguageTag :: Plutus 'PlutusV1 -> Word8
plutusLanguageTag Plutus 'PlutusV1
_ = Word8
0x01
  decodePlutusRunnable :: Version
-> Plutus 'PlutusV1
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV1)
decodePlutusRunnable Version
pv (Plutus (PlutusBinary ShortByteString
bs)) =
    forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError ScriptDecodeError m =>
MajorProtocolVersion -> ShortByteString -> m ScriptForEvaluation
PV1.deserialiseScript (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ShortByteString
bs
  evaluatePlutusRunnable :: Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable 'PlutusV1
-> PlutusArgs 'PlutusV1
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnable Version
pv VerboseMode
vm EvaluationContext
ec ExBudget
exBudget (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV1.evaluateScriptRestricting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ExBudget
exBudget ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1
unPlutusV1Args
  evaluatePlutusRunnableBudget :: Version
-> VerboseMode
-> EvaluationContext
-> PlutusRunnable 'PlutusV1
-> PlutusArgs 'PlutusV1
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnableBudget Version
pv VerboseMode
vm EvaluationContext
ec (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV1.evaluateScriptCounting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1
unPlutusV1Args
  mkTermToEvaluate :: Version
-> PlutusRunnable 'PlutusV1
-> PlutusArgs 'PlutusV1
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate Version
pv (PlutusRunnable ScriptForEvaluation
rs) =
    forall (m :: * -> *).
MonadError EvaluationError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> m (Term NamedDeBruijn DefaultUni DefaultFun ())
P.mkTermToEvaluate PlutusLedgerLanguage
P.PlutusV1 (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1
unPlutusV1Args

instance PlutusLanguage 'PlutusV2 where
  newtype PlutusArgs 'PlutusV2 = PlutusV2Args {PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2
unPlutusV2Args :: LegacyPlutusArgs 'PlutusV2}
    deriving newtype (PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
$c/= :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
== :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
$c== :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
Eq, Int -> PlutusArgs 'PlutusV2 -> ShowS
[PlutusArgs 'PlutusV2] -> ShowS
PlutusArgs 'PlutusV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusArgs 'PlutusV2] -> ShowS
$cshowList :: [PlutusArgs 'PlutusV2] -> ShowS
show :: PlutusArgs 'PlutusV2 -> String
$cshow :: PlutusArgs 'PlutusV2 -> String
showsPrec :: Int -> PlutusArgs 'PlutusV2 -> ShowS
$cshowsPrec :: Int -> PlutusArgs 'PlutusV2 -> ShowS
Show, forall ann. [PlutusArgs 'PlutusV2] -> Doc ann
forall ann. PlutusArgs 'PlutusV2 -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [PlutusArgs 'PlutusV2] -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV2] -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV2 -> Doc ann
$cpretty :: forall ann. PlutusArgs 'PlutusV2 -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV2)
PlutusArgs 'PlutusV2 -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV2] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV2) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV2] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV2] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV2) -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV2) -> Size
encCBOR :: PlutusArgs 'PlutusV2 -> Encoding
$cencCBOR :: PlutusArgs 'PlutusV2 -> Encoding
EncCBOR, Typeable (PlutusArgs 'PlutusV2)
Proxy (PlutusArgs 'PlutusV2) -> Text
forall s. Decoder s (PlutusArgs 'PlutusV2)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ()
label :: Proxy (PlutusArgs 'PlutusV2) -> Text
$clabel :: Proxy (PlutusArgs 'PlutusV2) -> Text
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ()
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ()
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV2)
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV2)
DecCBOR, PlutusArgs 'PlutusV2 -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusArgs 'PlutusV2 -> ()
$crnf :: PlutusArgs 'PlutusV2 -> ()
NFData)
  isLanguage :: SLanguage 'PlutusV2
isLanguage = SLanguage 'PlutusV2
SPlutusV2
  plutusLanguageTag :: Plutus 'PlutusV2 -> Word8
plutusLanguageTag Plutus 'PlutusV2
_ = Word8
0x02
  decodePlutusRunnable :: Version
-> Plutus 'PlutusV2
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV2)
decodePlutusRunnable Version
pv (Plutus (PlutusBinary ShortByteString
bs)) =
    forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError ScriptDecodeError m =>
MajorProtocolVersion -> ShortByteString -> m ScriptForEvaluation
PV2.deserialiseScript (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ShortByteString
bs
  evaluatePlutusRunnable :: Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable 'PlutusV2
-> PlutusArgs 'PlutusV2
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnable Version
pv VerboseMode
vm EvaluationContext
ec ExBudget
exBudget (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV2.evaluateScriptRestricting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ExBudget
exBudget ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2
unPlutusV2Args
  evaluatePlutusRunnableBudget :: Version
-> VerboseMode
-> EvaluationContext
-> PlutusRunnable 'PlutusV2
-> PlutusArgs 'PlutusV2
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnableBudget Version
pv VerboseMode
vm EvaluationContext
ec (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV2.evaluateScriptCounting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2
unPlutusV2Args
  mkTermToEvaluate :: Version
-> PlutusRunnable 'PlutusV2
-> PlutusArgs 'PlutusV2
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate Version
pv (PlutusRunnable ScriptForEvaluation
rs) =
    forall (m :: * -> *).
MonadError EvaluationError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> m (Term NamedDeBruijn DefaultUni DefaultFun ())
P.mkTermToEvaluate PlutusLedgerLanguage
P.PlutusV2 (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2
unPlutusV2Args

instance PlutusLanguage 'PlutusV3 where
  newtype PlutusArgs 'PlutusV3 = PlutusV3Args {PlutusArgs 'PlutusV3 -> ScriptContext
unPlutusV3Args :: PV3.ScriptContext}
    deriving newtype (PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
$c/= :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
== :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
$c== :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
Eq, Int -> PlutusArgs 'PlutusV3 -> ShowS
[PlutusArgs 'PlutusV3] -> ShowS
PlutusArgs 'PlutusV3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusArgs 'PlutusV3] -> ShowS
$cshowList :: [PlutusArgs 'PlutusV3] -> ShowS
show :: PlutusArgs 'PlutusV3 -> String
$cshow :: PlutusArgs 'PlutusV3 -> String
showsPrec :: Int -> PlutusArgs 'PlutusV3 -> ShowS
$cshowsPrec :: Int -> PlutusArgs 'PlutusV3 -> ShowS
Show, forall ann. [PlutusArgs 'PlutusV3] -> Doc ann
forall ann. PlutusArgs 'PlutusV3 -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [PlutusArgs 'PlutusV3] -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV3] -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV3 -> Doc ann
$cpretty :: forall ann. PlutusArgs 'PlutusV3 -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV3)
PlutusArgs 'PlutusV3 -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV3] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV3) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV3] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV3] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV3) -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV3) -> Size
encCBOR :: PlutusArgs 'PlutusV3 -> Encoding
$cencCBOR :: PlutusArgs 'PlutusV3 -> Encoding
EncCBOR, Typeable (PlutusArgs 'PlutusV3)
Proxy (PlutusArgs 'PlutusV3) -> Text
forall s. Decoder s (PlutusArgs 'PlutusV3)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ()
label :: Proxy (PlutusArgs 'PlutusV3) -> Text
$clabel :: Proxy (PlutusArgs 'PlutusV3) -> Text
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ()
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ()
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV3)
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV3)
DecCBOR, PlutusArgs 'PlutusV3 -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusArgs 'PlutusV3 -> ()
$crnf :: PlutusArgs 'PlutusV3 -> ()
NFData)
  isLanguage :: SLanguage 'PlutusV3
isLanguage = SLanguage 'PlutusV3
SPlutusV3
  plutusLanguageTag :: Plutus 'PlutusV3 -> Word8
plutusLanguageTag Plutus 'PlutusV3
_ = Word8
0x03
  decodePlutusRunnable :: Version
-> Plutus 'PlutusV3
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV3)
decodePlutusRunnable Version
pv (Plutus (PlutusBinary ShortByteString
bs)) =
    forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError ScriptDecodeError m =>
MajorProtocolVersion -> ShortByteString -> m ScriptForEvaluation
PV3.deserialiseScript (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ShortByteString
bs
  evaluatePlutusRunnable :: Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable 'PlutusV3
-> PlutusArgs 'PlutusV3
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnable Version
pv VerboseMode
vm EvaluationContext
ec ExBudget
exBudget (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> Data
-> (LogOutput, Either EvaluationError ExBudget)
PV3.evaluateScriptRestricting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ExBudget
exBudget ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV3 -> ScriptContext
unPlutusV3Args
  evaluatePlutusRunnableBudget :: Version
-> VerboseMode
-> EvaluationContext
-> PlutusRunnable 'PlutusV3
-> PlutusArgs 'PlutusV3
-> (LogOutput, Either EvaluationError ExBudget)
evaluatePlutusRunnableBudget Version
pv VerboseMode
vm EvaluationContext
ec (PlutusRunnable ScriptForEvaluation
rs) =
    MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ScriptForEvaluation
-> Data
-> (LogOutput, Either EvaluationError ExBudget)
PV3.evaluateScriptCounting (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) VerboseMode
vm EvaluationContext
ec ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV3 -> ScriptContext
unPlutusV3Args
  mkTermToEvaluate :: Version
-> PlutusRunnable 'PlutusV3
-> PlutusArgs 'PlutusV3
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate Version
pv (PlutusRunnable ScriptForEvaluation
rs) =
    forall (m :: * -> *).
MonadError EvaluationError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> m (Term NamedDeBruijn DefaultUni DefaultFun ())
P.mkTermToEvaluate PlutusLedgerLanguage
P.PlutusV3 (Version -> MajorProtocolVersion
toMajorProtocolVersion Version
pv) ScriptForEvaluation
rs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV3.toData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusArgs 'PlutusV3 -> ScriptContext
unPlutusV3Args

toSLanguage :: forall l m. (PlutusLanguage l, MonadFail m) => Language -> m (SLanguage l)
toSLanguage :: forall (l :: Language) (m :: * -> *).
(PlutusLanguage l, MonadFail m) =>
Language -> m (SLanguage l)
toSLanguage Language
lang
  | forall (l :: Language). PlutusLanguage l => SLanguage l -> Language
fromSLanguage SLanguage l
thisLanguage forall a. Eq a => a -> a -> Bool
== Language
lang = forall (f :: * -> *) a. Applicative f => a -> f a
pure SLanguage l
thisLanguage
  | Bool
otherwise =
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Plutus language mismatch. Expected "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SLanguage l
thisLanguage
          forall a. [a] -> [a] -> [a]
++ String
", but got: "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Language
lang
  where
    thisLanguage :: SLanguage l
    thisLanguage :: SLanguage l
thisLanguage = forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage

asSLanguage :: SLanguage l -> proxy l -> proxy l
asSLanguage :: forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const

withSLanguage :: Language -> (forall l. PlutusLanguage l => SLanguage l -> a) -> a
withSLanguage :: forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
l forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f =
  case Language
l of
    Language
PlutusV1 -> forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f SLanguage 'PlutusV1
SPlutusV1
    Language
PlutusV2 -> forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f SLanguage 'PlutusV2
SPlutusV2
    Language
PlutusV3 -> forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f SLanguage 'PlutusV3
SPlutusV3

-- | Prevent decoding a version of Plutus until
-- the appropriate protocol version.
guardPlutus :: Language -> Decoder s ()
guardPlutus :: forall s. Language -> Decoder s ()
guardPlutus Language
lang =
  let v :: Version
v = case Language
lang of
        Language
PlutusV1 -> forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5
        Language
PlutusV2 -> forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @7
        Language
PlutusV3 -> forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9
   in forall s a. Version -> Decoder s a -> Decoder s ()
unlessDecoderVersionAtLeast Version
v forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show Language
lang forall a. Semigroup a => a -> a -> a
<> String
" is not supported until " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Version
v forall a. Semigroup a => a -> a -> a
<> String
" major protocol version")

withSamePlutusLanguage ::
  forall f1 f2 l1 l2 a.
  (PlutusLanguage l1, PlutusLanguage l2) =>
  f1 l1 ->
  f2 l2 ->
  (forall l. PlutusLanguage l => f1 l -> f2 l -> a) ->
  Maybe a
withSamePlutusLanguage :: forall (f1 :: Language -> *) (f2 :: Language -> *) (l1 :: Language)
       (l2 :: Language) a.
(PlutusLanguage l1, PlutusLanguage l2) =>
f1 l1
-> f2 l2
-> (forall (l :: Language). PlutusLanguage l => f1 l -> f2 l -> a)
-> Maybe a
withSamePlutusLanguage f1 l1
x1 f2 l2
x2 forall (l :: Language). PlutusLanguage l => f1 l -> f2 l -> a
f = forall (l :: Language). PlutusLanguage l => f1 l -> f2 l -> a
f f1 l1
x1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast f2 l2
x2