{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module PlutusLedgerApi.Common.SerialisedScript (
SerialisedScript,
serialiseCompiledCode,
serialiseUPLC,
uncheckedDeserialiseUPLC,
scriptCBORDecoder,
ScriptNamedDeBruijn (..),
ScriptForEvaluation,
ScriptDecodeError (..),
AsScriptDecodeError (..),
DeserialiseFailureInfo (..),
DeserialiseFailureReason (..),
deserialiseScript,
serialisedScript,
deserialisedScript,
) where
import PlutusCore
import PlutusLedgerApi.Common.Versions
import PlutusTx.Code
import UntypedPlutusCore qualified as UPLC
import PlutusCore.DeBruijn.Internal (FakeNamedDeBruijn (FakeNamedDeBruijn))
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Codec.Extras.SerialiseViaFlat as CBOR.Extras
import Codec.Serialise
import Control.Arrow ((>>>))
import Control.DeepSeq (NFData)
import Control.Exception
import Control.Lens
import Control.Monad (unless, when)
import Control.Monad.Error.Lens
import Control.Monad.Except (MonadError)
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Short
import Data.Coerce
import Data.Set as Set
import GHC.Generics
import NoThunks.Class
import Prettyprinter
data ScriptDecodeError
=
CBORDeserialiseError !CBOR.Extras.DeserialiseFailureInfo
|
RemainderError !BSL.ByteString
|
LedgerLanguageNotAvailableError
{ ScriptDecodeError -> PlutusLedgerLanguage
sdeAffectedLang :: !PlutusLedgerLanguage
, ScriptDecodeError -> MajorProtocolVersion
sdeIntroPv :: !MajorProtocolVersion
, ScriptDecodeError -> MajorProtocolVersion
sdeThisPv :: !MajorProtocolVersion
}
| PlutusCoreLanguageNotAvailableError
{ ScriptDecodeError -> Version
sdeAffectedVersion :: !UPLC.Version
, ScriptDecodeError -> PlutusLedgerLanguage
sdeThisLang :: !PlutusLedgerLanguage
, sdeThisPv :: !MajorProtocolVersion
}
deriving stock (ScriptDecodeError -> ScriptDecodeError -> Bool
(ScriptDecodeError -> ScriptDecodeError -> Bool)
-> (ScriptDecodeError -> ScriptDecodeError -> Bool)
-> Eq ScriptDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDecodeError -> ScriptDecodeError -> Bool
== :: ScriptDecodeError -> ScriptDecodeError -> Bool
$c/= :: ScriptDecodeError -> ScriptDecodeError -> Bool
/= :: ScriptDecodeError -> ScriptDecodeError -> Bool
Eq, Int -> ScriptDecodeError -> ShowS
[ScriptDecodeError] -> ShowS
ScriptDecodeError -> String
(Int -> ScriptDecodeError -> ShowS)
-> (ScriptDecodeError -> String)
-> ([ScriptDecodeError] -> ShowS)
-> Show ScriptDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDecodeError -> ShowS
showsPrec :: Int -> ScriptDecodeError -> ShowS
$cshow :: ScriptDecodeError -> String
show :: ScriptDecodeError -> String
$cshowList :: [ScriptDecodeError] -> ShowS
showList :: [ScriptDecodeError] -> ShowS
Show)
deriving anyclass (Show ScriptDecodeError
Typeable ScriptDecodeError
(Typeable ScriptDecodeError, Show ScriptDecodeError) =>
(ScriptDecodeError -> SomeException)
-> (SomeException -> Maybe ScriptDecodeError)
-> (ScriptDecodeError -> String)
-> Exception ScriptDecodeError
SomeException -> Maybe ScriptDecodeError
ScriptDecodeError -> String
ScriptDecodeError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ScriptDecodeError -> SomeException
toException :: ScriptDecodeError -> SomeException
$cfromException :: SomeException -> Maybe ScriptDecodeError
fromException :: SomeException -> Maybe ScriptDecodeError
$cdisplayException :: ScriptDecodeError -> String
displayException :: ScriptDecodeError -> String
Exception)
makeClassyPrisms ''ScriptDecodeError
instance Pretty ScriptDecodeError where
pretty :: forall ann. ScriptDecodeError -> Doc ann
pretty = \case
CBORDeserialiseError DeserialiseFailureInfo
e ->
Doc ann
"Failed to deserialise a script:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DeserialiseFailureInfo -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DeserialiseFailureInfo -> Doc ann
pretty DeserialiseFailureInfo
e
RemainderError ByteString
bs ->
Doc ann
"Script was successfully deserialised, but"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Int64
BSL.length ByteString
bs)
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"more bytes were encountered after the script's position."
LedgerLanguageNotAvailableError{MajorProtocolVersion
PlutusLedgerLanguage
sdeAffectedLang :: ScriptDecodeError -> PlutusLedgerLanguage
sdeIntroPv :: ScriptDecodeError -> MajorProtocolVersion
sdeThisPv :: ScriptDecodeError -> MajorProtocolVersion
sdeAffectedLang :: PlutusLedgerLanguage
sdeIntroPv :: MajorProtocolVersion
sdeThisPv :: MajorProtocolVersion
..} ->
Doc ann
"Your script has a Plutus Ledger Language version of"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PlutusLedgerLanguage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusLedgerLanguage -> Doc ann
pretty PlutusLedgerLanguage
sdeAffectedLang Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"This is not yet supported by the current major protocol version"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MajorProtocolVersion -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MajorProtocolVersion -> Doc ann
pretty MajorProtocolVersion
sdeThisPv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"The major protocol version that introduces \
\this Plutus Ledger Language is"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MajorProtocolVersion -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MajorProtocolVersion -> Doc ann
pretty MajorProtocolVersion
sdeIntroPv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
PlutusCoreLanguageNotAvailableError{Version
MajorProtocolVersion
PlutusLedgerLanguage
sdeThisPv :: ScriptDecodeError -> MajorProtocolVersion
sdeAffectedVersion :: ScriptDecodeError -> Version
sdeThisLang :: ScriptDecodeError -> PlutusLedgerLanguage
sdeAffectedVersion :: Version
sdeThisLang :: PlutusLedgerLanguage
sdeThisPv :: MajorProtocolVersion
..} ->
Doc ann
"Your script has a Plutus Core version of"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Version -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Version -> Doc ann
pretty Version
sdeAffectedVersion Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"This is not supported in"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PlutusLedgerLanguage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusLedgerLanguage -> Doc ann
pretty PlutusLedgerLanguage
sdeThisLang
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"and major protocol version"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MajorProtocolVersion -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MajorProtocolVersion -> Doc ann
pretty MajorProtocolVersion
sdeThisPv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
type SerialisedScript = ShortByteString
serialiseCompiledCode :: forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode :: forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode =
Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> (CompiledCode a -> Program DeBruijn DefaultUni DefaultFun ())
-> CompiledCode a
-> SerialisedScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
toNameless (Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ())
-> (CompiledCode a
-> Program NamedDeBruijn DefaultUni DefaultFun ())
-> CompiledCode a
-> Program DeBruijn DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledCode a -> Program NamedDeBruijn DefaultUni DefaultFun ()
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
getPlcNoAnn
where
toNameless ::
UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun () ->
UPLC.Program UPLC.DeBruijn DefaultUni DefaultFun ()
toNameless :: Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
toNameless = ASetter
(Program NamedDeBruijn DefaultUni DefaultFun ())
(Program DeBruijn DefaultUni DefaultFun ())
(Term NamedDeBruijn DefaultUni DefaultFun ())
(Term DeBruijn DefaultUni DefaultFun ())
-> (Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ())
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(Program NamedDeBruijn DefaultUni DefaultFun ())
(Program DeBruijn DefaultUni DefaultFun ())
(Term NamedDeBruijn DefaultUni DefaultFun ())
(Term DeBruijn DefaultUni DefaultFun ())
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
(f :: * -> *).
Functor f =>
(Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann))
-> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann)
UPLC.progTerm ((Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ())
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ())
-> (Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ())
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ (NamedDeBruijn -> DeBruijn)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: * -> *) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames NamedDeBruijn -> DeBruijn
UPLC.unNameDeBruijn
serialiseUPLC :: UPLC.Program UPLC.DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC :: Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC =
ByteString -> SerialisedScript
toShort (ByteString -> SerialisedScript)
-> (Program DeBruijn DefaultUni DefaultFun () -> ByteString)
-> Program DeBruijn DefaultUni DefaultFun ()
-> SerialisedScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Program DeBruijn DefaultUni DefaultFun () -> ByteString)
-> Program DeBruijn DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> ByteString
forall a. Serialise a => a -> ByteString
serialise (SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> ByteString)
-> (Program DeBruijn DefaultUni DefaultFun ()
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()))
-> Program DeBruijn DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
forall a. a -> SerialiseViaFlat a
SerialiseViaFlat (UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()))
-> (Program DeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> Program DeBruijn DefaultUni DefaultFun ()
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program DeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram
uncheckedDeserialiseUPLC :: SerialisedScript -> UPLC.Program UPLC.DeBruijn DefaultUni DefaultFun ()
uncheckedDeserialiseUPLC :: SerialisedScript -> Program DeBruijn DefaultUni DefaultFun ()
uncheckedDeserialiseUPLC =
UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
UnrestrictedProgram name uni fun ann -> Program name uni fun ann
UPLC.unUnrestrictedProgram (UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ())
-> (SerialisedScript
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> SerialisedScript
-> Program DeBruijn DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
forall a. SerialiseViaFlat a -> a
unSerialiseViaFlat (SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
-> (SerialisedScript
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()))
-> SerialisedScript
-> UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
forall a. Serialise a => ByteString -> a
deserialise (ByteString
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ()))
-> (SerialisedScript -> ByteString)
-> SerialisedScript
-> SerialiseViaFlat
(UnrestrictedProgram DeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (SerialisedScript -> ByteString)
-> SerialisedScript
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedScript -> ByteString
fromShort
newtype ScriptNamedDeBruijn
= ScriptNamedDeBruijn (UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ())
deriving stock (ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool
(ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool)
-> (ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool)
-> Eq ScriptNamedDeBruijn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool
== :: ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool
$c/= :: ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool
/= :: ScriptNamedDeBruijn -> ScriptNamedDeBruijn -> Bool
Eq, Int -> ScriptNamedDeBruijn -> ShowS
[ScriptNamedDeBruijn] -> ShowS
ScriptNamedDeBruijn -> String
(Int -> ScriptNamedDeBruijn -> ShowS)
-> (ScriptNamedDeBruijn -> String)
-> ([ScriptNamedDeBruijn] -> ShowS)
-> Show ScriptNamedDeBruijn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptNamedDeBruijn -> ShowS
showsPrec :: Int -> ScriptNamedDeBruijn -> ShowS
$cshow :: ScriptNamedDeBruijn -> String
show :: ScriptNamedDeBruijn -> String
$cshowList :: [ScriptNamedDeBruijn] -> ShowS
showList :: [ScriptNamedDeBruijn] -> ShowS
Show, (forall x. ScriptNamedDeBruijn -> Rep ScriptNamedDeBruijn x)
-> (forall x. Rep ScriptNamedDeBruijn x -> ScriptNamedDeBruijn)
-> Generic ScriptNamedDeBruijn
forall x. Rep ScriptNamedDeBruijn x -> ScriptNamedDeBruijn
forall x. ScriptNamedDeBruijn -> Rep ScriptNamedDeBruijn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptNamedDeBruijn -> Rep ScriptNamedDeBruijn x
from :: forall x. ScriptNamedDeBruijn -> Rep ScriptNamedDeBruijn x
$cto :: forall x. Rep ScriptNamedDeBruijn x -> ScriptNamedDeBruijn
to :: forall x. Rep ScriptNamedDeBruijn x -> ScriptNamedDeBruijn
Generic)
deriving anyclass (ScriptNamedDeBruijn -> ()
(ScriptNamedDeBruijn -> ()) -> NFData ScriptNamedDeBruijn
forall a. (a -> ()) -> NFData a
$crnf :: ScriptNamedDeBruijn -> ()
rnf :: ScriptNamedDeBruijn -> ()
NFData)
data ScriptForEvaluation = UnsafeScriptForEvaluation !SerialisedScript !ScriptNamedDeBruijn
deriving stock (ScriptForEvaluation -> ScriptForEvaluation -> Bool
(ScriptForEvaluation -> ScriptForEvaluation -> Bool)
-> (ScriptForEvaluation -> ScriptForEvaluation -> Bool)
-> Eq ScriptForEvaluation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptForEvaluation -> ScriptForEvaluation -> Bool
== :: ScriptForEvaluation -> ScriptForEvaluation -> Bool
$c/= :: ScriptForEvaluation -> ScriptForEvaluation -> Bool
/= :: ScriptForEvaluation -> ScriptForEvaluation -> Bool
Eq, Int -> ScriptForEvaluation -> ShowS
[ScriptForEvaluation] -> ShowS
ScriptForEvaluation -> String
(Int -> ScriptForEvaluation -> ShowS)
-> (ScriptForEvaluation -> String)
-> ([ScriptForEvaluation] -> ShowS)
-> Show ScriptForEvaluation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptForEvaluation -> ShowS
showsPrec :: Int -> ScriptForEvaluation -> ShowS
$cshow :: ScriptForEvaluation -> String
show :: ScriptForEvaluation -> String
$cshowList :: [ScriptForEvaluation] -> ShowS
showList :: [ScriptForEvaluation] -> ShowS
Show, (forall x. ScriptForEvaluation -> Rep ScriptForEvaluation x)
-> (forall x. Rep ScriptForEvaluation x -> ScriptForEvaluation)
-> Generic ScriptForEvaluation
forall x. Rep ScriptForEvaluation x -> ScriptForEvaluation
forall x. ScriptForEvaluation -> Rep ScriptForEvaluation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptForEvaluation -> Rep ScriptForEvaluation x
from :: forall x. ScriptForEvaluation -> Rep ScriptForEvaluation x
$cto :: forall x. Rep ScriptForEvaluation x -> ScriptForEvaluation
to :: forall x. Rep ScriptForEvaluation x -> ScriptForEvaluation
Generic)
deriving anyclass (ScriptForEvaluation -> ()
(ScriptForEvaluation -> ()) -> NFData ScriptForEvaluation
forall a. (a -> ()) -> NFData a
$crnf :: ScriptForEvaluation -> ()
rnf :: ScriptForEvaluation -> ()
NFData)
deriving via OnlyCheckWhnf ScriptForEvaluation instance NoThunks ScriptForEvaluation
serialisedScript :: ScriptForEvaluation -> SerialisedScript
serialisedScript :: ScriptForEvaluation -> SerialisedScript
serialisedScript (UnsafeScriptForEvaluation SerialisedScript
s ScriptNamedDeBruijn
_) = SerialisedScript
s
deserialisedScript :: ScriptForEvaluation -> ScriptNamedDeBruijn
deserialisedScript :: ScriptForEvaluation -> ScriptNamedDeBruijn
deserialisedScript (UnsafeScriptForEvaluation SerialisedScript
_ ScriptNamedDeBruijn
s) = ScriptNamedDeBruijn
s
scriptCBORDecoder ::
PlutusLedgerLanguage ->
MajorProtocolVersion ->
CBOR.Decoder s ScriptNamedDeBruijn
scriptCBORDecoder :: forall s.
PlutusLedgerLanguage
-> MajorProtocolVersion -> Decoder s ScriptNamedDeBruijn
scriptCBORDecoder PlutusLedgerLanguage
ll MajorProtocolVersion
pv =
let availableBuiltins :: Set DefaultFun
availableBuiltins = PlutusLedgerLanguage -> MajorProtocolVersion -> Set DefaultFun
builtinsAvailableIn PlutusLedgerLanguage
ll MajorProtocolVersion
pv
flatDecoder :: Get (Program FakeNamedDeBruijn DefaultUni DefaultFun ())
flatDecoder = (DefaultFun -> Maybe String)
-> Get (Program FakeNamedDeBruijn DefaultUni DefaultFun ())
forall name (uni :: * -> *) fun ann.
(Closed uni, Everywhere uni Flat, Flat fun, Flat ann, Flat name,
Flat (Binder name)) =>
(fun -> Maybe String) -> Get (Program name uni fun ann)
UPLC.decodeProgram DefaultFun -> Maybe String
checkBuiltin
checkBuiltin :: DefaultFun -> Maybe String
checkBuiltin DefaultFun
f | DefaultFun
f DefaultFun -> Set DefaultFun -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set DefaultFun
availableBuiltins = Maybe String
forall a. Maybe a
Nothing
checkBuiltin DefaultFun
f =
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
String
"Builtin function "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ DefaultFun -> String
forall a. Show a => a -> String
show DefaultFun
f
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not available in language "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (PlutusLedgerLanguage -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusLedgerLanguage -> Doc ann
pretty PlutusLedgerLanguage
ll)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at and protocol version "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (MajorProtocolVersion -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. MajorProtocolVersion -> Doc ann
pretty MajorProtocolVersion
pv)
in do
(Program FakeNamedDeBruijn DefaultUni DefaultFun ()
p :: UPLC.Program UPLC.FakeNamedDeBruijn DefaultUni DefaultFun ()) <-
Get (Program FakeNamedDeBruijn DefaultUni DefaultFun ())
-> Decoder s (Program FakeNamedDeBruijn DefaultUni DefaultFun ())
forall a s. Get a -> Decoder s a
decodeViaFlatWith Get (Program FakeNamedDeBruijn DefaultUni DefaultFun ())
flatDecoder
ScriptNamedDeBruijn -> Decoder s ScriptNamedDeBruijn
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptNamedDeBruijn -> Decoder s ScriptNamedDeBruijn)
-> ScriptNamedDeBruijn -> Decoder s ScriptNamedDeBruijn
forall a b. (a -> b) -> a -> b
$ Program FakeNamedDeBruijn DefaultUni DefaultFun ()
-> ScriptNamedDeBruijn
forall a b. Coercible a b => a -> b
coerce Program FakeNamedDeBruijn DefaultUni DefaultFun ()
p
deserialiseScript ::
forall m.
(MonadError ScriptDecodeError m) =>
PlutusLedgerLanguage ->
MajorProtocolVersion ->
SerialisedScript ->
m ScriptForEvaluation
deserialiseScript :: forall (m :: * -> *).
MonadError ScriptDecodeError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> m ScriptForEvaluation
deserialiseScript PlutusLedgerLanguage
ll MajorProtocolVersion
pv SerialisedScript
sScript = do
let llIntroPv :: MajorProtocolVersion
llIntroPv = PlutusLedgerLanguage -> MajorProtocolVersion
ledgerLanguageIntroducedIn PlutusLedgerLanguage
ll
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MajorProtocolVersion
llIntroPv MajorProtocolVersion -> MajorProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= MajorProtocolVersion
pv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
AReview ScriptDecodeError ScriptDecodeError
-> ScriptDecodeError -> m ()
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview ScriptDecodeError ScriptDecodeError
forall r. AsScriptDecodeError r => Prism' r ScriptDecodeError
Prism' ScriptDecodeError ScriptDecodeError
_ScriptDecodeError (ScriptDecodeError -> m ()) -> ScriptDecodeError -> m ()
forall a b. (a -> b) -> a -> b
$
PlutusLedgerLanguage
-> MajorProtocolVersion
-> MajorProtocolVersion
-> ScriptDecodeError
LedgerLanguageNotAvailableError PlutusLedgerLanguage
ll MajorProtocolVersion
llIntroPv MajorProtocolVersion
pv
(ByteString
remderBS, dScript :: ScriptNamedDeBruijn
dScript@(ScriptNamedDeBruijn (UPLC.Program{}))) <- SerialisedScript -> m (ByteString, ScriptNamedDeBruijn)
deserialiseSScript SerialisedScript
sScript
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PlutusLedgerLanguage
ll PlutusLedgerLanguage -> PlutusLedgerLanguage -> Bool
forall a. Eq a => a -> a -> Bool
/= PlutusLedgerLanguage
PlutusV1 Bool -> Bool -> Bool
&& PlutusLedgerLanguage
ll PlutusLedgerLanguage -> PlutusLedgerLanguage -> Bool
forall a. Eq a => a -> a -> Bool
/= PlutusLedgerLanguage
PlutusV2 Bool -> Bool -> Bool
&& ByteString
remderBS ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
forall a. Monoid a => a
mempty) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
AReview ScriptDecodeError ScriptDecodeError
-> ScriptDecodeError -> m ()
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview ScriptDecodeError ScriptDecodeError
forall r. AsScriptDecodeError r => Prism' r ScriptDecodeError
Prism' ScriptDecodeError ScriptDecodeError
_ScriptDecodeError (ScriptDecodeError -> m ()) -> ScriptDecodeError -> m ()
forall a b. (a -> b) -> a -> b
$
ByteString -> ScriptDecodeError
RemainderError ByteString
remderBS
ScriptForEvaluation -> m ScriptForEvaluation
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptForEvaluation -> m ScriptForEvaluation)
-> ScriptForEvaluation -> m ScriptForEvaluation
forall a b. (a -> b) -> a -> b
$ SerialisedScript -> ScriptNamedDeBruijn -> ScriptForEvaluation
UnsafeScriptForEvaluation SerialisedScript
sScript ScriptNamedDeBruijn
dScript
where
deserialiseSScript :: SerialisedScript -> m (BSL.ByteString, ScriptNamedDeBruijn)
deserialiseSScript :: SerialisedScript -> m (ByteString, ScriptNamedDeBruijn)
deserialiseSScript =
SerialisedScript -> ByteString
fromShort
(SerialisedScript -> ByteString)
-> (ByteString -> m (ByteString, ScriptNamedDeBruijn))
-> SerialisedScript
-> m (ByteString, ScriptNamedDeBruijn)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ByteString -> ByteString
BSL.fromStrict
(ByteString -> ByteString)
-> (ByteString -> m (ByteString, ScriptNamedDeBruijn))
-> ByteString
-> m (ByteString, ScriptNamedDeBruijn)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall s. Decoder s ScriptNamedDeBruijn)
-> ByteString
-> Either DeserialiseFailure (ByteString, ScriptNamedDeBruijn)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes (PlutusLedgerLanguage
-> MajorProtocolVersion -> Decoder s ScriptNamedDeBruijn
forall s.
PlutusLedgerLanguage
-> MajorProtocolVersion -> Decoder s ScriptNamedDeBruijn
scriptCBORDecoder PlutusLedgerLanguage
ll MajorProtocolVersion
pv)
(ByteString
-> Either DeserialiseFailure (ByteString, ScriptNamedDeBruijn))
-> (Either DeserialiseFailure (ByteString, ScriptNamedDeBruijn)
-> m (ByteString, ScriptNamedDeBruijn))
-> ByteString
-> m (ByteString, ScriptNamedDeBruijn)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (DeserialiseFailure -> m (ByteString, ScriptNamedDeBruijn))
-> ((ByteString, ScriptNamedDeBruijn)
-> m (ByteString, ScriptNamedDeBruijn))
-> Either DeserialiseFailure (ByteString, ScriptNamedDeBruijn)
-> m (ByteString, ScriptNamedDeBruijn)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AReview ScriptDecodeError ScriptDecodeError
-> ScriptDecodeError -> m (ByteString, ScriptNamedDeBruijn)
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview ScriptDecodeError ScriptDecodeError
forall r. AsScriptDecodeError r => Prism' r ScriptDecodeError
Prism' ScriptDecodeError ScriptDecodeError
_ScriptDecodeError (ScriptDecodeError -> m (ByteString, ScriptNamedDeBruijn))
-> (DeserialiseFailure -> ScriptDecodeError)
-> DeserialiseFailure
-> m (ByteString, ScriptNamedDeBruijn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeserialiseFailure -> ScriptDecodeError
toScripDecodeError) (ByteString, ScriptNamedDeBruijn)
-> m (ByteString, ScriptNamedDeBruijn)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
toScripDecodeError :: CBOR.DeserialiseFailure -> ScriptDecodeError
toScripDecodeError :: DeserialiseFailure -> ScriptDecodeError
toScripDecodeError = DeserialiseFailureInfo -> ScriptDecodeError
CBORDeserialiseError (DeserialiseFailureInfo -> ScriptDecodeError)
-> (DeserialiseFailure -> DeserialiseFailureInfo)
-> DeserialiseFailure
-> ScriptDecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeserialiseFailure -> DeserialiseFailureInfo
CBOR.Extras.readDeserialiseFailureInfo