{-# 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,
  toSLanguage,
  withSLanguage,
  asSLanguage,
  withSamePlutusLanguage,

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

import qualified Cardano.Crypto.Hash.Class as Hash (castHash, hashWith)
import Cardano.Ledger.Binary (
  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.Hashes (SafeToHash (..), ScriptHash (..))
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.MemPack
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
[PlutusRunnable l] -> ShowS
PlutusRunnable l -> String
(Int -> PlutusRunnable l -> ShowS)
-> (PlutusRunnable l -> String)
-> ([PlutusRunnable l] -> ShowS)
-> Show (PlutusRunnable l)
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
$cshowsPrec :: forall (l :: Language). Int -> PlutusRunnable l -> ShowS
showsPrec :: Int -> PlutusRunnable l -> ShowS
$cshow :: forall (l :: Language). PlutusRunnable l -> String
show :: PlutusRunnable l -> String
$cshowList :: forall (l :: Language). [PlutusRunnable l] -> ShowS
showList :: [PlutusRunnable l] -> ShowS
Show, (forall x. PlutusRunnable l -> Rep (PlutusRunnable l) x)
-> (forall x. Rep (PlutusRunnable l) x -> PlutusRunnable l)
-> Generic (PlutusRunnable l)
forall x. Rep (PlutusRunnable l) x -> PlutusRunnable l
forall x. PlutusRunnable l -> Rep (PlutusRunnable l) x
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
$cfrom :: forall (l :: Language) x.
PlutusRunnable l -> Rep (PlutusRunnable l) x
from :: forall x. PlutusRunnable l -> Rep (PlutusRunnable l) x
$cto :: forall (l :: Language) x.
Rep (PlutusRunnable l) x -> PlutusRunnable l
to :: forall x. Rep (PlutusRunnable l) x -> PlutusRunnable l
Generic)
  deriving newtype (PlutusRunnable l -> PlutusRunnable l -> Bool
(PlutusRunnable l -> PlutusRunnable l -> Bool)
-> (PlutusRunnable l -> PlutusRunnable l -> Bool)
-> Eq (PlutusRunnable l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: Language).
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
/= :: PlutusRunnable l -> PlutusRunnable l -> Bool
Eq, PlutusRunnable l -> ()
(PlutusRunnable l -> ()) -> NFData (PlutusRunnable l)
forall a. (a -> ()) -> NFData a
forall (l :: Language). PlutusRunnable l -> ()
$crnf :: forall (l :: Language). PlutusRunnable l -> ()
rnf :: PlutusRunnable l -> ()
NFData, Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
Proxy (PlutusRunnable l) -> String
(Context -> PlutusRunnable l -> IO (Maybe ThunkInfo))
-> (Context -> PlutusRunnable l -> IO (Maybe ThunkInfo))
-> (Proxy (PlutusRunnable l) -> String)
-> NoThunks (PlutusRunnable l)
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
$cnoThunks :: forall (l :: Language).
Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (l :: Language).
Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PlutusRunnable l -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (l :: Language). Proxy (PlutusRunnable l) -> String
showTypeOf :: Proxy (PlutusRunnable l) -> String
NoThunks)

toMajorProtocolVersion :: Version -> P.MajorProtocolVersion
toMajorProtocolVersion :: Version -> MajorProtocolVersion
toMajorProtocolVersion = Int -> MajorProtocolVersion
P.MajorProtocolVersion (Int -> MajorProtocolVersion)
-> (Version -> Int) -> Version -> MajorProtocolVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Int
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 <- Decoder s (Plutus l)
forall s. Decoder s (Plutus l)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Version
pv <- Decoder s Version
forall s. Decoder s Version
getDecoderVersion
    (ScriptDecodeError -> Decoder s (PlutusRunnable l))
-> (PlutusRunnable l -> Decoder s (PlutusRunnable l))
-> Either ScriptDecodeError (PlutusRunnable l)
-> Decoder s (PlutusRunnable l)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Decoder s (PlutusRunnable l)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (PlutusRunnable l))
-> (ScriptDecodeError -> String)
-> ScriptDecodeError
-> Decoder s (PlutusRunnable l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDecodeError -> String
forall a. Show a => a -> String
show) PlutusRunnable l -> Decoder s (PlutusRunnable l)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ScriptDecodeError (PlutusRunnable l)
 -> Decoder s (PlutusRunnable l))
-> Either ScriptDecodeError (PlutusRunnable l)
-> Decoder s (PlutusRunnable l)
forall a b. (a -> b) -> a -> b
$ Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
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 = Plutus l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Plutus l -> Encoding)
-> (PlutusRunnable l -> Plutus l) -> PlutusRunnable l -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusRunnable l -> Plutus l
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
[Plutus l] -> ShowS
Plutus l -> String
(Int -> Plutus l -> ShowS)
-> (Plutus l -> String) -> ([Plutus l] -> ShowS) -> Show (Plutus l)
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
$cshowsPrec :: forall (l :: Language). Int -> Plutus l -> ShowS
showsPrec :: Int -> Plutus l -> ShowS
$cshow :: forall (l :: Language). Plutus l -> String
show :: Plutus l -> String
$cshowList :: forall (l :: Language). [Plutus l] -> ShowS
showList :: [Plutus l] -> ShowS
Show, (forall x. Plutus l -> Rep (Plutus l) x)
-> (forall x. Rep (Plutus l) x -> Plutus l) -> Generic (Plutus l)
forall x. Rep (Plutus l) x -> Plutus l
forall x. Plutus l -> Rep (Plutus l) x
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
$cfrom :: forall (l :: Language) x. Plutus l -> Rep (Plutus l) x
from :: forall x. Plutus l -> Rep (Plutus l) x
$cto :: forall (l :: Language) x. Rep (Plutus l) x -> Plutus l
to :: forall x. Rep (Plutus l) x -> Plutus l
Generic)
  deriving newtype (Plutus l -> Plutus l -> Bool
(Plutus l -> Plutus l -> Bool)
-> (Plutus l -> Plutus l -> Bool) -> Eq (Plutus l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: Language). 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
Eq, Eq (Plutus l)
Eq (Plutus l) =>
(Plutus l -> Plutus l -> Ordering)
-> (Plutus l -> Plutus l -> Bool)
-> (Plutus l -> Plutus l -> Bool)
-> (Plutus l -> Plutus l -> Bool)
-> (Plutus l -> Plutus l -> Bool)
-> (Plutus l -> Plutus l -> Plutus l)
-> (Plutus l -> Plutus l -> Plutus l)
-> Ord (Plutus l)
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
$ccompare :: forall (l :: Language). Plutus l -> Plutus l -> Ordering
compare :: Plutus l -> Plutus l -> Ordering
$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
>= :: Plutus l -> Plutus l -> Bool
$cmax :: forall (l :: Language). Plutus l -> Plutus l -> Plutus l
max :: Plutus l -> Plutus l -> Plutus l
$cmin :: forall (l :: Language). Plutus l -> Plutus l -> Plutus l
min :: Plutus l -> Plutus l -> Plutus l
Ord, Plutus l -> Int
Plutus l -> ByteString
(Plutus l -> ByteString)
-> (Plutus l -> Int)
-> (forall i. Proxy i -> Plutus l -> SafeHash i)
-> SafeToHash (Plutus l)
forall i. Proxy i -> Plutus l -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall (l :: Language). Plutus l -> Int
forall (l :: Language). Plutus l -> ByteString
forall (l :: Language) i. Proxy i -> Plutus l -> SafeHash i
$coriginalBytes :: forall (l :: Language). Plutus l -> ByteString
originalBytes :: Plutus l -> ByteString
$coriginalBytesSize :: forall (l :: Language). Plutus l -> Int
originalBytesSize :: Plutus l -> Int
$cmakeHashWithExplicitProxys :: forall (l :: Language) i. Proxy i -> Plutus l -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> Plutus l -> SafeHash i
SafeToHash, Context -> Plutus l -> IO (Maybe ThunkInfo)
Proxy (Plutus l) -> String
(Context -> Plutus l -> IO (Maybe ThunkInfo))
-> (Context -> Plutus l -> IO (Maybe ThunkInfo))
-> (Proxy (Plutus l) -> String)
-> NoThunks (Plutus l)
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
$cnoThunks :: forall (l :: Language). Context -> Plutus l -> IO (Maybe ThunkInfo)
noThunks :: Context -> Plutus l -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (l :: Language). Context -> Plutus l -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Plutus l -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (l :: Language). Proxy (Plutus l) -> String
showTypeOf :: Proxy (Plutus l) -> String
NoThunks, Plutus l -> ()
(Plutus l -> ()) -> NFData (Plutus l)
forall a. (a -> ()) -> NFData a
forall (l :: Language). Plutus l -> ()
$crnf :: forall (l :: Language). Plutus l -> ()
rnf :: Plutus l -> ()
NFData, String
String
-> (Plutus l -> Int)
-> (forall s. Plutus l -> Pack s ())
-> (forall b. Buffer b => Unpack b (Plutus l))
-> MemPack (Plutus l)
Plutus l -> Int
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b (Plutus l)
forall s. Plutus l -> Pack s ()
forall (l :: Language). String
forall (l :: Language). Plutus l -> Int
forall (l :: Language) b. Buffer b => Unpack b (Plutus l)
forall (l :: Language) s. Plutus l -> Pack s ()
$ctypeName :: forall (l :: Language). String
typeName :: String
$cpackedByteCount :: forall (l :: Language). Plutus l -> Int
packedByteCount :: Plutus l -> Int
$cpackM :: forall (l :: Language) s. Plutus l -> Pack s ()
packM :: forall s. Plutus l -> Pack s ()
$cunpackM :: forall (l :: Language) b. Buffer b => Unpack b (Plutus l)
unpackM :: forall b. Buffer b => Unpack b (Plutus l)
MemPack)

plutusSLanguage :: PlutusLanguage l => proxy l -> SLanguage l
plutusSLanguage :: forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> SLanguage l
plutusSLanguage proxy l
_ = SLanguage 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 l. PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript :: forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus l
plutusScript =
  Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript -> ScriptHash
forall a b. (a -> b) -> a -> b
$
    Hash ADDRHASH ByteString -> Hash ADDRHASH EraIndependentScript
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash ADDRHASH ByteString -> Hash ADDRHASH EraIndependentScript)
-> Hash ADDRHASH ByteString -> Hash ADDRHASH EraIndependentScript
forall a b. (a -> b) -> a -> b
$
      (ByteString -> ByteString)
-> ByteString -> Hash ADDRHASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id (Word8 -> ByteString
BS.singleton (Plutus l -> Word8
forall (l :: Language). PlutusLanguage l => Plutus l -> Word8
plutusLanguageTag Plutus l
plutusScript) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Plutus l -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes Plutus l
plutusScript)

decodePlutus :: Decoder s (Language, PlutusBinary)
decodePlutus :: forall s. Decoder s (Language, PlutusBinary)
decodePlutus = Text
-> ((Language, PlutusBinary) -> Int)
-> Decoder s (Language, PlutusBinary)
-> Decoder s (Language, PlutusBinary)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Plutus" (Int -> (Language, PlutusBinary) -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (Language, PlutusBinary)
 -> Decoder s (Language, PlutusBinary))
-> Decoder s (Language, PlutusBinary)
-> Decoder s (Language, PlutusBinary)
forall a b. (a -> b) -> a -> b
$ (,) (Language -> PlutusBinary -> (Language, PlutusBinary))
-> Decoder s Language
-> Decoder s (PlutusBinary -> (Language, PlutusBinary))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Language
forall s. Decoder s Language
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (PlutusBinary -> (Language, PlutusBinary))
-> Decoder s PlutusBinary -> Decoder s (Language, PlutusBinary)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s PlutusBinary
forall s. Decoder s PlutusBinary
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) <- Decoder so (Language, PlutusBinary)
forall s. Decoder s (Language, PlutusBinary)
decodePlutus
  Language
-> (forall {l :: Language}.
    PlutusLanguage l =>
    SLanguage l -> Decoder so a)
-> Decoder so a
forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang ((forall {l :: Language}.
  PlutusLanguage l =>
  SLanguage l -> Decoder so a)
 -> Decoder so a)
-> (forall {l :: Language}.
    PlutusLanguage l =>
    SLanguage l -> Decoder so a)
-> Decoder so a
forall a b. (a -> b) -> a -> b
$ \SLanguage l
slang ->
    Plutus l -> Decoder so a
forall si (l :: Language).
PlutusLanguage l =>
Plutus l -> Decoder si a
decoderAction (Plutus l -> Decoder so a) -> Plutus l -> Decoder so a
forall a b. (a -> b) -> a -> b
$ SLanguage l -> Plutus l -> Plutus l
forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage SLanguage l
slang (Plutus l -> Plutus l) -> Plutus l -> Plutus l
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus l
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) <- Decoder s (Language, PlutusBinary)
forall s. Decoder s (Language, PlutusBinary)
decodePlutus
    let plutus :: Plutus l
plutus = PlutusBinary -> Plutus l
forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
binary
        langExpected :: Language
langExpected = Plutus l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
plutus
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Language
langDecoded Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
/= Language
langExpected) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ do
      String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Language -> String
forall a. Show a => a -> String
show Language
langExpected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Language -> String
forall a. Show a => a -> String
show Language
langDecoded
    Plutus l -> Decoder s (Plutus l)
forall a. a -> Decoder s a
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Language -> Encoding
forall a. Enum a => a -> Encoding
encodeEnum Language
lang Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PlutusBinary -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PlutusBinary
binaryScript
    where
      lang :: Language
lang = Plutus l -> Language
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 = Either ScriptDecodeError (PlutusRunnable l) -> Bool
forall a b. Either a b -> Bool
isRight (Either ScriptDecodeError (PlutusRunnable l) -> Bool)
-> (Plutus l -> Either ScriptDecodeError (PlutusRunnable l))
-> Plutus l
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
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 = PlutusBinary -> Plutus l
forall (l :: Language). PlutusBinary -> Plutus l
Plutus (PlutusBinary -> Plutus l)
-> (PlutusRunnable l -> PlutusBinary)
-> PlutusRunnable l
-> Plutus l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusBinary
PlutusBinary (ShortByteString -> PlutusBinary)
-> (PlutusRunnable l -> ShortByteString)
-> PlutusRunnable l
-> PlutusBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptForEvaluation -> ShortByteString
P.serialisedScript (ScriptForEvaluation -> ShortByteString)
-> (PlutusRunnable l -> ScriptForEvaluation)
-> PlutusRunnable l
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusRunnable l -> ScriptForEvaluation
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
(PlutusBinary -> PlutusBinary -> Bool)
-> (PlutusBinary -> PlutusBinary -> Bool) -> Eq PlutusBinary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlutusBinary -> PlutusBinary -> Bool
== :: PlutusBinary -> PlutusBinary -> Bool
$c/= :: PlutusBinary -> PlutusBinary -> Bool
/= :: PlutusBinary -> PlutusBinary -> Bool
Eq, Eq PlutusBinary
Eq PlutusBinary =>
(PlutusBinary -> PlutusBinary -> Ordering)
-> (PlutusBinary -> PlutusBinary -> Bool)
-> (PlutusBinary -> PlutusBinary -> Bool)
-> (PlutusBinary -> PlutusBinary -> Bool)
-> (PlutusBinary -> PlutusBinary -> Bool)
-> (PlutusBinary -> PlutusBinary -> PlutusBinary)
-> (PlutusBinary -> PlutusBinary -> PlutusBinary)
-> Ord 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
$ccompare :: PlutusBinary -> PlutusBinary -> Ordering
compare :: PlutusBinary -> PlutusBinary -> Ordering
$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
>= :: PlutusBinary -> PlutusBinary -> Bool
$cmax :: PlutusBinary -> PlutusBinary -> PlutusBinary
max :: PlutusBinary -> PlutusBinary -> PlutusBinary
$cmin :: PlutusBinary -> PlutusBinary -> PlutusBinary
min :: PlutusBinary -> PlutusBinary -> PlutusBinary
Ord, (forall x. PlutusBinary -> Rep PlutusBinary x)
-> (forall x. Rep PlutusBinary x -> PlutusBinary)
-> Generic PlutusBinary
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
$cfrom :: forall x. PlutusBinary -> Rep PlutusBinary x
from :: forall x. PlutusBinary -> Rep PlutusBinary x
$cto :: forall x. Rep PlutusBinary x -> PlutusBinary
to :: forall x. Rep PlutusBinary x -> PlutusBinary
Generic)
  deriving newtype (Typeable PlutusBinary
Typeable PlutusBinary =>
(PlutusBinary -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PlutusBinary -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PlutusBinary] -> Size)
-> ToCBOR 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
$ctoCBOR :: PlutusBinary -> Encoding
toCBOR :: PlutusBinary -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
ToCBOR, Typeable PlutusBinary
Typeable PlutusBinary =>
(forall s. Decoder s PlutusBinary)
-> (Proxy PlutusBinary -> Text) -> FromCBOR PlutusBinary
Proxy PlutusBinary -> Text
forall s. Decoder s PlutusBinary
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PlutusBinary
fromCBOR :: forall s. Decoder s PlutusBinary
$clabel :: Proxy PlutusBinary -> Text
label :: Proxy PlutusBinary -> Text
FromCBOR, Typeable PlutusBinary
Typeable PlutusBinary =>
(PlutusBinary -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy PlutusBinary -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [PlutusBinary] -> Size)
-> EncCBOR 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
$cencCBOR :: PlutusBinary -> Encoding
encCBOR :: PlutusBinary -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PlutusBinary -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusBinary] -> Size
EncCBOR, Typeable PlutusBinary
Typeable PlutusBinary =>
(forall s. Decoder s PlutusBinary)
-> (forall s. Proxy PlutusBinary -> Decoder s ())
-> (Proxy PlutusBinary -> Text)
-> DecCBOR 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 ()
$cdecCBOR :: forall s. Decoder s PlutusBinary
decCBOR :: forall s. Decoder s PlutusBinary
$cdropCBOR :: forall s. Proxy PlutusBinary -> Decoder s ()
dropCBOR :: forall s. Proxy PlutusBinary -> Decoder s ()
$clabel :: Proxy PlutusBinary -> Text
label :: Proxy PlutusBinary -> Text
DecCBOR, PlutusBinary -> ()
(PlutusBinary -> ()) -> NFData PlutusBinary
forall a. (a -> ()) -> NFData a
$crnf :: PlutusBinary -> ()
rnf :: PlutusBinary -> ()
NFData, Context -> PlutusBinary -> IO (Maybe ThunkInfo)
Proxy PlutusBinary -> String
(Context -> PlutusBinary -> IO (Maybe ThunkInfo))
-> (Context -> PlutusBinary -> IO (Maybe ThunkInfo))
-> (Proxy PlutusBinary -> String)
-> NoThunks PlutusBinary
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PlutusBinary -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PlutusBinary -> String
showTypeOf :: Proxy PlutusBinary -> String
NoThunks, String
String
-> (PlutusBinary -> Int)
-> (forall s. PlutusBinary -> Pack s ())
-> (forall b. Buffer b => Unpack b PlutusBinary)
-> MemPack PlutusBinary
PlutusBinary -> Int
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b PlutusBinary
forall s. PlutusBinary -> Pack s ()
$ctypeName :: String
typeName :: String
$cpackedByteCount :: PlutusBinary -> Int
packedByteCount :: PlutusBinary -> Int
$cpackM :: forall s. PlutusBinary -> Pack s ()
packM :: forall s. PlutusBinary -> Pack s ()
$cunpackM :: forall b. Buffer b => Unpack b PlutusBinary
unpackM :: forall b. Buffer b => Unpack b PlutusBinary
MemPack)

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

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
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
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
$cfrom :: forall x. Language -> Rep Language x
from :: forall x. Language -> Rep Language x
$cto :: forall x. Rep Language x -> Language
to :: forall x. Rep Language x -> Language
Generic, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord 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
$ccompare :: Language -> Language -> Ordering
compare :: Language -> Language -> Ordering
$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
>= :: Language -> Language -> Bool
$cmax :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
min :: Language -> Language -> Language
Ord, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum 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
$csucc :: Language -> Language
succ :: Language -> Language
$cpred :: Language -> Language
pred :: Language -> Language
$ctoEnum :: Int -> Language
toEnum :: Int -> Language
$cfromEnum :: Language -> Int
fromEnum :: Language -> Int
$cenumFrom :: Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromThenTo :: Language -> Language -> Language -> [Language]
Enum, Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
$cminBound :: Language
minBound :: Language
$cmaxBound :: Language
maxBound :: Language
Bounded, Ord Language
Ord Language =>
((Language, Language) -> [Language])
-> ((Language, Language) -> Language -> Int)
-> ((Language, Language) -> Language -> Int)
-> ((Language, Language) -> Language -> Bool)
-> ((Language, Language) -> Int)
-> ((Language, Language) -> Int)
-> Ix 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
$crange :: (Language, Language) -> [Language]
range :: (Language, Language) -> [Language]
$cindex :: (Language, Language) -> Language -> Int
index :: (Language, Language) -> Language -> Int
$cunsafeIndex :: (Language, Language) -> Language -> Int
unsafeIndex :: (Language, Language) -> Language -> Int
$cinRange :: (Language, Language) -> Language -> Bool
inRange :: (Language, Language) -> Language -> Bool
$crangeSize :: (Language, Language) -> Int
rangeSize :: (Language, Language) -> Int
$cunsafeRangeSize :: (Language, Language) -> Int
unsafeRangeSize :: (Language, Language) -> Int
Ix, ReadPrec [Language]
ReadPrec Language
Int -> ReadS Language
ReadS [Language]
(Int -> ReadS Language)
-> ReadS [Language]
-> ReadPrec Language
-> ReadPrec [Language]
-> Read Language
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Language
readsPrec :: Int -> ReadS Language
$creadList :: ReadS [Language]
readList :: ReadS [Language]
$creadPrec :: ReadPrec Language
readPrec :: ReadPrec Language
$creadListPrec :: ReadPrec [Language]
readListPrec :: ReadPrec [Language]
Read)

instance NoThunks Language

instance NFData Language

instance Random Language

instance Uniform Language where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Language
uniformM = g -> m Language
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 = (Language, Language) -> g -> m Language
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
iLang Bool -> Bool -> Bool
&& Int
iLang Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLang = Language -> Maybe Language
forall a. a -> Maybe a
Just (Language -> Maybe Language) -> Language -> Maybe Language
forall a b. (a -> b) -> a -> b
$ Int -> Language
forall a. Enum a => Int -> a
toEnum Int
iLang
  | Bool
otherwise = Maybe Language
forall a. Maybe a
Nothing
  where
    minLang :: Int
minLang = Language -> Int
forall a. Enum a => a -> Int
fromEnum (Language
forall a. Bounded a => a
minBound :: Language)
    maxLang :: Int
maxLang = Language -> Int
forall a. Enum a => a -> Int
fromEnum (Language
forall a. Bounded a => a
maxBound :: Language)

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

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

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

instance FromJSONKey Language where
  fromJSONKey :: FromJSONKeyFunction Language
fromJSONKey = (Text -> Parser Language) -> FromJSONKeyFunction Language
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser Language
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" = Language -> m Language
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV1
languageFromText Text
"PlutusV2" = Language -> m Language
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV2
languageFromText Text
"PlutusV3" = Language -> m Language
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV3
languageFromText Text
lang = String -> m Language
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Language) -> String -> m Language
forall a b. (a -> b) -> a -> b
$ String
"Error decoding Language: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
lang

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

instance FromCBOR Language where
  fromCBOR :: forall s. Decoder s Language
fromCBOR = Decoder s Language
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 = [Language
forall a. Bounded a => a
minBound .. Language
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 = Language -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Language -> Encoding)
-> (SLanguage l -> Language) -> SLanguage l -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage

instance PlutusLanguage l => FromCBOR (SLanguage l) where
  fromCBOR :: forall s. Decoder s (SLanguage l)
fromCBOR = Language -> Decoder s (SLanguage l)
forall (l :: Language) (m :: * -> *).
(PlutusLanguage l, MonadFail m) =>
Language -> m (SLanguage l)
toSLanguage (Language -> Decoder s (SLanguage l))
-> Decoder s Language -> Decoder s (SLanguage l)
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)

-- | 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 Data -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` PlutusScriptContext l -> ()
forall a. NFData a => a -> ()
rnf PlutusScriptContext l
scriptContext
    LegacyPlutusArgs3 Data
datum Data
redeemer PlutusScriptContext l
scriptContext -> Data
datum Data -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Data
redeemer Data -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` PlutusScriptContext l -> ()
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 = Data -> ()
forall a. NFData a => a -> ()
rnf (Data -> ()) -> (ScriptContext -> Data) -> ScriptContext -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> Data
forall a. ToData a => a -> Data
PV3.toData

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

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

instance (PlutusLanguage l, PV3.ToData (PlutusScriptContext l)) => EncCBOR (LegacyPlutusArgs l) where
  encCBOR :: LegacyPlutusArgs l -> Encoding
encCBOR = [Data] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([Data] -> Encoding)
-> (LegacyPlutusArgs l -> [Data]) -> LegacyPlutusArgs l -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs l -> [Data]
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 =
    Decoder s [Data]
forall s. Decoder s [Data]
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s [Data]
-> ([Data] -> Decoder s (LegacyPlutusArgs l))
-> Decoder s (LegacyPlutusArgs l)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Data
redeemer, Data
scriptContextData] ->
        Data -> PlutusScriptContext l -> LegacyPlutusArgs l
forall (l :: Language).
Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs2 Data
redeemer (PlutusScriptContext l -> LegacyPlutusArgs l)
-> Decoder s (PlutusScriptContext l)
-> Decoder s (LegacyPlutusArgs l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Decoder s (PlutusScriptContext l)
forall a (m :: * -> *). (FromData a, MonadFail m) => Data -> m a
decodeScriptContextFromData Data
scriptContextData
      [Data
datum, Data
redeemer, Data
scriptContextData] ->
        Data -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
forall (l :: Language).
Data -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs3 Data
datum Data
redeemer (PlutusScriptContext l -> LegacyPlutusArgs l)
-> Decoder s (PlutusScriptContext l)
-> Decoder s (LegacyPlutusArgs l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Decoder s (PlutusScriptContext l)
forall a (m :: * -> *). (FromData a, MonadFail m) => Data -> m a
decodeScriptContextFromData Data
scriptContextData
      [Data]
args ->
        String -> Decoder s (LegacyPlutusArgs l)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (LegacyPlutusArgs l))
-> String -> Decoder s (LegacyPlutusArgs l)
forall a b. (a -> b) -> a -> b
$ String
"Invalid number of aruments " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Data] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Data]
args) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is encoded for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Language -> String
forall a. Show a => a -> String
show Language
lang
    where
      lang :: Language
lang = Proxy l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage (forall {k} (t :: k). Proxy t
forall (t :: Language). 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:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i (Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty Data
redeemer)
            , Doc ann
"ScriptContext:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i (PlutusScriptContext l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusScriptContext l -> Doc ann
pretty PlutusScriptContext l
scriptContext)
            ]
       in Int -> [Doc ann] -> Doc ann
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:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i (Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty Data
datum)
            , Doc ann
"Redeemer:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i (Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty Data
redeemer)
            , Doc ann
"ScriptContext:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
i (PlutusScriptContext l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusScriptContext l -> Doc ann
pretty PlutusScriptContext l
scriptContext)
            ]
       in Int -> [Doc ann] -> Doc ann
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" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"  " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
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, PlutusScriptContext l -> Data
forall a. ToData a => a -> Data
PV3.toData PlutusScriptContext l
scriptContext]
  LegacyPlutusArgs3 Data
datum Data
redeemer PlutusScriptContext l
scriptContext -> [Data
datum, Data
redeemer, PlutusScriptContext l -> Data
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
(PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool)
-> (PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool)
-> Eq (PlutusArgs 'PlutusV1)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
== :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
$c/= :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
/= :: PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1 -> Bool
Eq, Int -> PlutusArgs 'PlutusV1 -> ShowS
[PlutusArgs 'PlutusV1] -> ShowS
PlutusArgs 'PlutusV1 -> String
(Int -> PlutusArgs 'PlutusV1 -> ShowS)
-> (PlutusArgs 'PlutusV1 -> String)
-> ([PlutusArgs 'PlutusV1] -> ShowS)
-> Show (PlutusArgs 'PlutusV1)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusArgs 'PlutusV1 -> ShowS
showsPrec :: Int -> PlutusArgs 'PlutusV1 -> ShowS
$cshow :: PlutusArgs 'PlutusV1 -> String
show :: PlutusArgs 'PlutusV1 -> String
$cshowList :: [PlutusArgs 'PlutusV1] -> ShowS
showList :: [PlutusArgs 'PlutusV1] -> ShowS
Show, (forall ann. PlutusArgs 'PlutusV1 -> Doc ann)
-> (forall ann. [PlutusArgs 'PlutusV1] -> Doc ann)
-> Pretty (PlutusArgs 'PlutusV1)
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
$cpretty :: forall ann. PlutusArgs 'PlutusV1 -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV1 -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV1] -> Doc ann
prettyList :: forall ann. [PlutusArgs 'PlutusV1] -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV1)
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)
-> EncCBOR (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
$cencCBOR :: PlutusArgs 'PlutusV1 -> Encoding
encCBOR :: PlutusArgs 'PlutusV1 -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV1) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV1) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV1] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV1] -> Size
EncCBOR, Typeable (PlutusArgs 'PlutusV1)
Typeable (PlutusArgs 'PlutusV1) =>
(forall s. Decoder s (PlutusArgs 'PlutusV1))
-> (forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ())
-> (Proxy (PlutusArgs 'PlutusV1) -> Text)
-> DecCBOR (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 ()
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV1)
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV1)
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ()
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV1) -> Decoder s ()
$clabel :: Proxy (PlutusArgs 'PlutusV1) -> Text
label :: Proxy (PlutusArgs 'PlutusV1) -> Text
DecCBOR, PlutusArgs 'PlutusV1 -> ()
(PlutusArgs 'PlutusV1 -> ()) -> NFData (PlutusArgs 'PlutusV1)
forall a. (a -> ()) -> NFData a
$crnf :: PlutusArgs 'PlutusV1 -> ()
rnf :: 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)) =
    ScriptForEvaluation -> PlutusRunnable 'PlutusV1
forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable (ScriptForEvaluation -> PlutusRunnable 'PlutusV1)
-> Either ScriptDecodeError ScriptForEvaluation
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MajorProtocolVersion
-> ShortByteString -> Either ScriptDecodeError ScriptForEvaluation
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
      ([Data] -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV1 -> [Data])
-> PlutusArgs 'PlutusV1
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV1 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV1 -> [Data])
-> (PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1)
-> PlutusArgs 'PlutusV1
-> [Data]
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
      ([Data] -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV1 -> [Data])
-> PlutusArgs 'PlutusV1
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV1 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV1 -> [Data])
-> (PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1)
-> PlutusArgs 'PlutusV1
-> [Data]
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) =
    PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
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
      ([Data]
 -> Either
      EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> (PlutusArgs 'PlutusV1 -> [Data])
-> PlutusArgs 'PlutusV1
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV1 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV1 -> [Data])
-> (PlutusArgs 'PlutusV1 -> LegacyPlutusArgs 'PlutusV1)
-> PlutusArgs 'PlutusV1
-> [Data]
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
(PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool)
-> (PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool)
-> Eq (PlutusArgs 'PlutusV2)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
== :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
$c/= :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
/= :: PlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2 -> Bool
Eq, Int -> PlutusArgs 'PlutusV2 -> ShowS
[PlutusArgs 'PlutusV2] -> ShowS
PlutusArgs 'PlutusV2 -> String
(Int -> PlutusArgs 'PlutusV2 -> ShowS)
-> (PlutusArgs 'PlutusV2 -> String)
-> ([PlutusArgs 'PlutusV2] -> ShowS)
-> Show (PlutusArgs 'PlutusV2)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusArgs 'PlutusV2 -> ShowS
showsPrec :: Int -> PlutusArgs 'PlutusV2 -> ShowS
$cshow :: PlutusArgs 'PlutusV2 -> String
show :: PlutusArgs 'PlutusV2 -> String
$cshowList :: [PlutusArgs 'PlutusV2] -> ShowS
showList :: [PlutusArgs 'PlutusV2] -> ShowS
Show, (forall ann. PlutusArgs 'PlutusV2 -> Doc ann)
-> (forall ann. [PlutusArgs 'PlutusV2] -> Doc ann)
-> Pretty (PlutusArgs 'PlutusV2)
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
$cpretty :: forall ann. PlutusArgs 'PlutusV2 -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV2 -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV2] -> Doc ann
prettyList :: forall ann. [PlutusArgs 'PlutusV2] -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV2)
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)
-> EncCBOR (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
$cencCBOR :: PlutusArgs 'PlutusV2 -> Encoding
encCBOR :: PlutusArgs 'PlutusV2 -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV2) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV2) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV2] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV2] -> Size
EncCBOR, Typeable (PlutusArgs 'PlutusV2)
Typeable (PlutusArgs 'PlutusV2) =>
(forall s. Decoder s (PlutusArgs 'PlutusV2))
-> (forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ())
-> (Proxy (PlutusArgs 'PlutusV2) -> Text)
-> DecCBOR (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 ()
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV2)
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV2)
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ()
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV2) -> Decoder s ()
$clabel :: Proxy (PlutusArgs 'PlutusV2) -> Text
label :: Proxy (PlutusArgs 'PlutusV2) -> Text
DecCBOR, PlutusArgs 'PlutusV2 -> ()
(PlutusArgs 'PlutusV2 -> ()) -> NFData (PlutusArgs 'PlutusV2)
forall a. (a -> ()) -> NFData a
$crnf :: PlutusArgs 'PlutusV2 -> ()
rnf :: 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)) =
    ScriptForEvaluation -> PlutusRunnable 'PlutusV2
forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable (ScriptForEvaluation -> PlutusRunnable 'PlutusV2)
-> Either ScriptDecodeError ScriptForEvaluation
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MajorProtocolVersion
-> ShortByteString -> Either ScriptDecodeError ScriptForEvaluation
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
      ([Data] -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV2 -> [Data])
-> PlutusArgs 'PlutusV2
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV2 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV2 -> [Data])
-> (PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2)
-> PlutusArgs 'PlutusV2
-> [Data]
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
      ([Data] -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV2 -> [Data])
-> PlutusArgs 'PlutusV2
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV2 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV2 -> [Data])
-> (PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2)
-> PlutusArgs 'PlutusV2
-> [Data]
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) =
    PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
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
      ([Data]
 -> Either
      EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> (PlutusArgs 'PlutusV2 -> [Data])
-> PlutusArgs 'PlutusV2
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegacyPlutusArgs 'PlutusV2 -> [Data]
forall (l :: Language).
ToData (PlutusScriptContext l) =>
LegacyPlutusArgs l -> [Data]
legacyPlutusArgsToData
      (LegacyPlutusArgs 'PlutusV2 -> [Data])
-> (PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2)
-> PlutusArgs 'PlutusV2
-> [Data]
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
(PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool)
-> (PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool)
-> Eq (PlutusArgs 'PlutusV3)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
== :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
$c/= :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
/= :: PlutusArgs 'PlutusV3 -> PlutusArgs 'PlutusV3 -> Bool
Eq, Int -> PlutusArgs 'PlutusV3 -> ShowS
[PlutusArgs 'PlutusV3] -> ShowS
PlutusArgs 'PlutusV3 -> String
(Int -> PlutusArgs 'PlutusV3 -> ShowS)
-> (PlutusArgs 'PlutusV3 -> String)
-> ([PlutusArgs 'PlutusV3] -> ShowS)
-> Show (PlutusArgs 'PlutusV3)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusArgs 'PlutusV3 -> ShowS
showsPrec :: Int -> PlutusArgs 'PlutusV3 -> ShowS
$cshow :: PlutusArgs 'PlutusV3 -> String
show :: PlutusArgs 'PlutusV3 -> String
$cshowList :: [PlutusArgs 'PlutusV3] -> ShowS
showList :: [PlutusArgs 'PlutusV3] -> ShowS
Show, (forall ann. PlutusArgs 'PlutusV3 -> Doc ann)
-> (forall ann. [PlutusArgs 'PlutusV3] -> Doc ann)
-> Pretty (PlutusArgs 'PlutusV3)
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
$cpretty :: forall ann. PlutusArgs 'PlutusV3 -> Doc ann
pretty :: forall ann. PlutusArgs 'PlutusV3 -> Doc ann
$cprettyList :: forall ann. [PlutusArgs 'PlutusV3] -> Doc ann
prettyList :: forall ann. [PlutusArgs 'PlutusV3] -> Doc ann
Pretty, Typeable (PlutusArgs 'PlutusV3)
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)
-> EncCBOR (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
$cencCBOR :: PlutusArgs 'PlutusV3 -> Encoding
encCBOR :: PlutusArgs 'PlutusV3 -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV3) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PlutusArgs 'PlutusV3) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV3] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PlutusArgs 'PlutusV3] -> Size
EncCBOR, Typeable (PlutusArgs 'PlutusV3)
Typeable (PlutusArgs 'PlutusV3) =>
(forall s. Decoder s (PlutusArgs 'PlutusV3))
-> (forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ())
-> (Proxy (PlutusArgs 'PlutusV3) -> Text)
-> DecCBOR (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 ()
$cdecCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV3)
decCBOR :: forall s. Decoder s (PlutusArgs 'PlutusV3)
$cdropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ()
dropCBOR :: forall s. Proxy (PlutusArgs 'PlutusV3) -> Decoder s ()
$clabel :: Proxy (PlutusArgs 'PlutusV3) -> Text
label :: Proxy (PlutusArgs 'PlutusV3) -> Text
DecCBOR, PlutusArgs 'PlutusV3 -> ()
(PlutusArgs 'PlutusV3 -> ()) -> NFData (PlutusArgs 'PlutusV3)
forall a. (a -> ()) -> NFData a
$crnf :: PlutusArgs 'PlutusV3 -> ()
rnf :: 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)) =
    ScriptForEvaluation -> PlutusRunnable 'PlutusV3
forall (l :: Language). ScriptForEvaluation -> PlutusRunnable l
PlutusRunnable (ScriptForEvaluation -> PlutusRunnable 'PlutusV3)
-> Either ScriptDecodeError ScriptForEvaluation
-> Either ScriptDecodeError (PlutusRunnable 'PlutusV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MajorProtocolVersion
-> ShortByteString -> Either ScriptDecodeError ScriptForEvaluation
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
      (Data -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV3 -> Data)
-> PlutusArgs 'PlutusV3
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> Data
forall a. ToData a => a -> Data
PV3.toData
      (ScriptContext -> Data)
-> (PlutusArgs 'PlutusV3 -> ScriptContext)
-> PlutusArgs 'PlutusV3
-> Data
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
      (Data -> (LogOutput, Either EvaluationError ExBudget))
-> (PlutusArgs 'PlutusV3 -> Data)
-> PlutusArgs 'PlutusV3
-> (LogOutput, Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> Data
forall a. ToData a => a -> Data
PV3.toData
      (ScriptContext -> Data)
-> (PlutusArgs 'PlutusV3 -> ScriptContext)
-> PlutusArgs 'PlutusV3
-> Data
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) =
    PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
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
      ([Data]
 -> Either
      EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> (PlutusArgs 'PlutusV3 -> [Data])
-> PlutusArgs 'PlutusV3
-> Either
     EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> [Data]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Data -> [Data])
-> (PlutusArgs 'PlutusV3 -> Data) -> PlutusArgs 'PlutusV3 -> [Data]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> Data
forall a. ToData a => a -> Data
PV3.toData
      (ScriptContext -> Data)
-> (PlutusArgs 'PlutusV3 -> ScriptContext)
-> PlutusArgs 'PlutusV3
-> Data
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
  | SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
thisLanguage Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Language
lang = SLanguage l -> m (SLanguage l)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SLanguage l
thisLanguage
  | Bool
otherwise =
      String -> m (SLanguage l)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SLanguage l)) -> String -> m (SLanguage l)
forall a b. (a -> b) -> a -> b
$
        String
"Plutus language mismatch. Expected "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ SLanguage l -> String
forall a. Show a => a -> String
show SLanguage l
thisLanguage
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Language -> String
forall a. Show a => a -> String
show Language
lang
  where
    thisLanguage :: SLanguage l
    thisLanguage :: SLanguage l
thisLanguage = SLanguage l
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 = (proxy l -> SLanguage l -> proxy l)
-> SLanguage l -> proxy l -> proxy l
forall a b c. (a -> b -> c) -> b -> a -> c
flip proxy l -> SLanguage l -> proxy l
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 -> SLanguage 'PlutusV1 -> a
forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f SLanguage 'PlutusV1
SPlutusV1
    Language
PlutusV2 -> SLanguage 'PlutusV2 -> a
forall (l :: Language). PlutusLanguage l => SLanguage l -> a
f SLanguage 'PlutusV2
SPlutusV2
    Language
PlutusV3 -> SLanguage 'PlutusV3 -> a
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 Version -> Decoder s Any -> Decoder s ()
forall s a. Version -> Decoder s a -> Decoder s ()
unlessDecoderVersionAtLeast Version
v (Decoder s Any -> Decoder s ()) -> Decoder s Any -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s Any
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Language -> String
forall a. Show a => a -> String
show Language
lang String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not supported until " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
forall a. Show a => a -> String
show Version
v String -> ShowS
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 = f1 l1 -> f2 l1 -> a
forall (l :: Language). PlutusLanguage l => f1 l -> f2 l -> a
f f1 l1
x1 (f2 l1 -> a) -> Maybe (f2 l1) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f2 l2 -> Maybe (f2 l1)
forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast f2 l2
x2