{-# LANGUAGE ViewPatterns #-}
module Plutarch.Extra.ScriptContext (
paddressFromScriptHash,
paddressFromPubKeyHash,
pownTxOutRef,
pownTxInfo,
ptryOwnValue,
pownMintValue,
ptryOwnInput,
pisTokenSpent,
pisUTXOSpent,
pvalueSpent,
ptxSignedBy,
pfindTxInByTxOutRef,
pscriptHashFromAddress,
pisScriptAddress,
pisPubKey,
pfindOutputsToAddress,
pfindOwnInput,
pfromPDatum,
presolveOutputDatum,
ptryResolveOutputDatum,
pfromOutputDatum,
ptryFromOutputDatum,
ptryFromDatumHash,
ptryFromInlineDatum,
scriptHashToTokenName,
pscriptHashToTokenName,
ptryFromRedeemer,
) where
import Data.Coerce (coerce)
import Plutarch.Api.V1 (
AmountGuarantees (NoGuarantees, NonZero, Positive),
PCredential (PPubKeyCredential, PScriptCredential),
PMap,
PTokenName,
PValue,
)
import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V1.AssocMap qualified as AssocMap
import Plutarch.Api.V1.Scripts (PRedeemer)
import Plutarch.Api.V2 (
KeyGuarantees (Sorted, Unsorted),
PAddress (PAddress),
PDatum,
PDatumHash,
PMaybeData,
POutputDatum (PNoOutputDatum, POutputDatum, POutputDatumHash),
PPubKeyHash,
PScriptContext,
PScriptHash,
PScriptPurpose (PSpending),
PStakingCredential,
PTxInInfo (PTxInInfo),
PTxInfo,
PTxOut (PTxOut),
PTxOutRef,
)
import Plutarch.Extra.AssetClass (PAssetClass)
import Plutarch.Extra.Function ((#.*))
import Plutarch.Extra.Functor (PFunctor (pfmap))
import Plutarch.Extra.List (pfindJust)
import Plutarch.Extra.Maybe (pfromJust, pisJust, pjust, pnothing, ptraceIfNothing)
import Plutarch.Extra.TermCont (pletC, pmatchC)
import Plutarch.Extra.Value (passetClassValueOf)
import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V1 (TokenName (TokenName))
import PlutusLedgerApi.V2 (ScriptHash (ScriptHash))
pownTxOutRef ::
forall (s :: S).
Term s (PScriptContext :--> PTxOutRef)
pownTxOutRef :: forall (s :: S). Term s (PScriptContext :--> PTxOutRef)
pownTxOutRef = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptContext
sc -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
PSpending Term s (PDataRecord '[ "_0" ':= PTxOutRef])
t <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC (forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"purpose" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"_0" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PDataRecord '[ "_0" ':= PTxOutRef])
t
pownTxInfo ::
forall (s :: S).
Term s (PScriptContext :--> PTxInfo)
pownTxInfo :: forall (s :: S). Term s (PScriptContext :--> PTxInfo)
pownTxInfo = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptContext
sc -> forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"txInfo" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc
ptryOwnValue ::
forall (s :: S).
Term s (PScriptContext :--> PValue 'Sorted 'Positive)
ptryOwnValue :: forall (s :: S).
Term s (PScriptContext :--> PValue 'Sorted 'Positive)
ptryOwnValue = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptContext
sc -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
Term s PTxInInfo
input <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC (forall (s :: S). Term s (PScriptContext :--> PTxInInfo)
ptryOwnInput forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"value" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"resolved" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInInfo
input)
pownMintValue ::
forall (s :: S).
Term s (PScriptContext :--> PValue 'Sorted 'NoGuarantees)
pownMintValue :: forall (s :: S).
Term s (PScriptContext :--> PValue 'Sorted 'NoGuarantees)
pownMintValue = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptContext
sc -> forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"mint" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (forall (s :: S). Term s (PScriptContext :--> PTxInfo)
pownTxInfo forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc)
ptryOwnInput ::
forall (s :: S).
Term s (PScriptContext :--> PTxInInfo)
ptryOwnInput :: forall (s :: S). Term s (PScriptContext :--> PTxInInfo)
ptryOwnInput = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptContext
sc -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
Term s PTxInfo
txInfo <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC (forall (s :: S). Term s (PScriptContext :--> PTxInfo)
pownTxInfo forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc)
Term s PTxOutRef
txOutRef <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC (forall (s :: S). Term s (PScriptContext :--> PTxOutRef)
pownTxOutRef forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
sc)
Term s (PBuiltinList PTxInInfo)
txInInfos <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC (forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"inputs" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInfo
txInfo)
PMaybe PTxInInfo s
res <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC (forall (l :: PType -> PType) (a :: PType) (s :: S).
PIsListLike l a =>
Term s ((a :--> PBool) :--> (l a :--> PMaybe a))
pfind forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (forall (s' :: S). Term s' (PTxOutRef :--> (PTxInInfo :--> PBool))
go forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxOutRef
txOutRef) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PTxInInfo)
txInInfos)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case PMaybe PTxInInfo s
res of
PMaybe PTxInInfo s
PNothing -> forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryOwnInput: Could not find my own input"
PJust Term s PTxInInfo
res' -> Term s PTxInInfo
res'
where
go ::
forall (s' :: S).
Term s' (PTxOutRef :--> PTxInInfo :--> PBool)
go :: forall (s' :: S). Term s' (PTxOutRef :--> (PTxInInfo :--> PBool))
go = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PTxOutRef
tgt Term s PTxInInfo
t -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
Term s PTxOutRef
x <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC (forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"outRef" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInInfo
t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Term s PTxOutRef
tgt forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PTxOutRef
x
pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList PTxInInfo :--> PBool)
pisUTXOSpent :: forall (s :: S).
Term s (PTxOutRef :--> (PBuiltinList PTxInInfo :--> PBool))
pisUTXOSpent = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$
\Term s PTxOutRef
oref Term s (PBuiltinList PTxInInfo)
inputs -> forall (a :: PType) (s :: S). Term s (PMaybe a :--> PBool)
pisJust forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S).
Term
s (PTxOutRef :--> (PBuiltinList PTxInInfo :--> PMaybe PTxInInfo))
pfindTxInByTxOutRef forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxOutRef
oref forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PTxInInfo)
inputs
pvalueSpent ::
forall (s :: S).
Term s (PBuiltinList PTxInInfo :--> PValue 'Sorted 'Positive)
pvalueSpent :: forall (s :: S).
Term s (PBuiltinList PTxInInfo :--> PValue 'Sorted 'Positive)
pvalueSpent = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinList PTxInInfo)
inputs ->
forall (list :: PType -> PType) (a :: PType) (s :: S) (b :: PType).
PIsListLike list a =>
Term s ((a :--> (b :--> b)) :--> (b :--> (list a :--> b)))
pfoldr
# plam
( \txInInfo' v ->
pmatch
txInInfo'
$ \(PTxInInfo txInInfo) ->
pmatch
(pfield @"resolved" # txInInfo)
(\(PTxOut o) -> pfield @"value" # o)
<> v
)
# punsafeCoerce (pconstant mempty :: forall (s' :: S). Term s' (PValue 'Unsorted 'NonZero))
# inputs
pisTokenSpent ::
forall (s :: S).
Term
s
( PAssetClass
:--> PBuiltinList PTxInInfo
:--> PBool
)
pisTokenSpent :: forall (s :: S).
Term s (PAssetClass :--> (PBuiltinList PTxInInfo :--> PBool))
pisTokenSpent =
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PAssetClass
tokenClass Term s (PBuiltinList PTxInInfo)
inputs ->
Term s PInteger
0
#< pfoldr @PBuiltinList
# plam
( \txInInfo' acc -> unTermCont $ do
PTxInInfo txInInfo <- pmatchC txInInfo'
PTxOut txOut' <- pmatchC $ pfromData $ pfield @"resolved" # txInInfo
let value = pfromData $ pfield @"value" # txOut'
pure $ acc + passetClassValueOf # tokenClass # value
)
# 0
# inputs
pfindTxInByTxOutRef :: forall (s :: S). Term s (PTxOutRef :--> PBuiltinList PTxInInfo :--> PMaybe PTxInInfo)
pfindTxInByTxOutRef :: forall (s :: S).
Term
s (PTxOutRef :--> (PBuiltinList PTxInInfo :--> PMaybe PTxInInfo))
pfindTxInByTxOutRef = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PTxOutRef
txOutRef Term s (PBuiltinList PTxInInfo)
inputs ->
forall (b :: PType) (ell :: PType -> PType) (a :: PType) (s :: S).
(PElemConstraint ell a, PListLike ell) =>
Term s ((a :--> PMaybe b) :--> (ell a :--> PMaybe b))
pfindJust
# plam
( \r ->
pmatch r $ \(PTxInInfo txInInfo) ->
pif
(pdata txOutRef #== pfield @"outRef" # txInInfo)
(pcon (PJust r))
(pcon PNothing)
)
#$ inputs
ptxSignedBy :: forall (s :: S). Term s (PBuiltinList (PAsData PPubKeyHash) :--> PAsData PPubKeyHash :--> PBool)
ptxSignedBy :: forall (s :: S).
Term
s
(PBuiltinList (PAsData PPubKeyHash)
:--> (PAsData PPubKeyHash :--> PBool))
ptxSignedBy = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$
\Term s (PBuiltinList (PAsData PPubKeyHash))
sigs Term s (PAsData PPubKeyHash)
sig -> forall (list :: PType -> PType) (a :: PType) (s :: S).
(PIsListLike list a, PEq a) =>
Term s (a :--> (list a :--> PBool))
pelem forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PAsData PPubKeyHash)
sig forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList (PAsData PPubKeyHash))
sigs
pfromPDatum ::
forall (a :: S -> Type) (s :: S).
PTryFrom PData a =>
Term s (PDatum :--> a)
pfromPDatum :: forall (a :: PType) (s :: S).
PTryFrom PData a =>
Term s (PDatum :--> a)
pfromPDatum = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto
presolveOutputDatum ::
forall (keys :: KeyGuarantees) (s :: S).
Term
s
( POutputDatum
:--> PMap keys PDatumHash PDatum
:--> PMaybe PDatum
)
presolveOutputDatum :: forall (keys :: KeyGuarantees) (s :: S).
Term
s
(POutputDatum
:--> (PMap keys PDatumHash PDatum :--> PMaybe PDatum))
presolveOutputDatum = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s POutputDatum
od Term s (PMap keys PDatumHash PDatum)
m -> forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s POutputDatum
od forall a b. (a -> b) -> a -> b
$ \case
PNoOutputDatum Term s (PDataRecord '[])
_ ->
forall (s :: S) (a :: PType).
Term s PString -> Term s a -> Term s a
ptrace Term s PString
"no datum" forall (a :: PType) (s :: S). Term s (PMaybe a)
pnothing
POutputDatum ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"outputDatum" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#) -> Term s PDatum
datum) ->
forall (s :: S) (a :: PType).
Term s PString -> Term s a -> Term s a
ptrace Term s PString
"inline datum" forall (a :: PType) (s :: S). Term s (a :--> PMaybe a)
pjust forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PDatum
datum
POutputDatumHash ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"datumHash" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#) -> Term s PDatumHash
hash) ->
forall (s :: S) (a :: PType).
Term s PString -> Term s a -> Term s a
ptrace Term s PString
"datum hash" forall a b. (a -> b) -> a -> b
$ forall (k :: PType) (v :: PType) (s :: S) (any :: KeyGuarantees).
(PIsData k, PIsData v) =>
Term s (k :--> (PMap any k v :--> PMaybe v))
AssocMap.plookup forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PDatumHash
hash forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMap keys PDatumHash PDatum)
m
ptryResolveOutputDatum ::
forall (keys :: KeyGuarantees) (s :: S).
Term s (POutputDatum :--> PMap keys PDatumHash PDatum :--> PDatum)
ptryResolveOutputDatum :: forall (keys :: KeyGuarantees) (s :: S).
Term
s (POutputDatum :--> (PMap keys PDatumHash PDatum :--> PDatum))
ptryResolveOutputDatum = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s POutputDatum
od Term s (PMap keys PDatumHash PDatum)
m ->
forall (a :: PType) (s :: S).
Term s PString -> Term s (PMaybe a) -> Term s a
ptraceIfNothing Term s PString
"ptryResolveOutputDatum: no PDatum" forall a b. (a -> b) -> a -> b
$ forall (keys :: KeyGuarantees) (s :: S).
Term
s
(POutputDatum
:--> (PMap keys PDatumHash PDatum :--> PMaybe PDatum))
presolveOutputDatum forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s POutputDatum
od forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMap keys PDatumHash PDatum)
m
pfromOutputDatum ::
forall (a :: S -> Type) (s :: S).
PTryFrom PData a =>
Term
s
( POutputDatum
:--> PMap 'Unsorted PDatumHash PDatum
:--> PMaybe a
)
pfromOutputDatum :: forall (a :: PType) (s :: S).
PTryFrom PData a =>
Term
s
(POutputDatum
:--> (PMap 'Unsorted PDatumHash PDatum :--> PMaybe a))
pfromOutputDatum =
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
(forall (f :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
(PFunctor f, PSubcategory f a, PSubcategory f b) =>
Term s ((a :--> b) :--> (f a :--> f b))
pfmap forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (a :: PType) (s :: S).
PTryFrom PData a =>
Term s (PDatum :--> a)
pfromPDatum)
#.* presolveOutputDatum
ptryFromOutputDatum ::
forall (a :: S -> Type) (s :: S).
PTryFrom PData a =>
Term
s
( POutputDatum
:--> PMap 'Unsorted PDatumHash PDatum
:--> a
)
ptryFromOutputDatum :: forall (a :: PType) (s :: S).
PTryFrom PData a =>
Term
s (POutputDatum :--> (PMap 'Unsorted PDatumHash PDatum :--> a))
ptryFromOutputDatum =
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). Term s (PMaybe a :--> a)
pfromJust forall (d :: PType) (c :: PType) (b :: PType) (a :: PType)
(s :: S).
Term s (c :--> d)
-> Term s (a :--> (b :--> c)) -> Term s (a :--> (b :--> d))
#.* forall (a :: PType) (s :: S).
PTryFrom PData a =>
Term
s
(POutputDatum
:--> (PMap 'Unsorted PDatumHash PDatum :--> PMaybe a))
pfromOutputDatum
ptryFromDatumHash :: forall (s :: S). Term s (POutputDatum :--> PDatumHash)
ptryFromDatumHash :: forall (s :: S). Term s (POutputDatum :--> PDatumHash)
ptryFromDatumHash = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch forall a b. (a -> b) -> a -> b
$ \case
POutputDatumHash ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"datumHash" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#) -> Term s PDatumHash
hash) -> Term s PDatumHash
hash
POutputDatum s
_ -> forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"not a datum hash"
ptryFromInlineDatum :: forall (s :: S). Term s (POutputDatum :--> PDatum)
ptryFromInlineDatum :: forall (s :: S). Term s (POutputDatum :--> PDatum)
ptryFromInlineDatum = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch forall a b. (a -> b) -> a -> b
$ \case
POutputDatum ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"outputDatum" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#) -> Term s PDatum
datum) -> Term s PDatum
datum
POutputDatum s
_ -> forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"not an inline datum"
paddressFromScriptHash ::
forall (s :: S).
Term s (PScriptHash :--> PMaybeData PStakingCredential :--> PAddress)
paddressFromScriptHash :: forall (s :: S).
Term
s (PScriptHash :--> (PMaybeData PStakingCredential :--> PAddress))
paddressFromScriptHash = forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptHash
valHash Term s (PMaybeData PStakingCredential)
stakingCred ->
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S).
Term
s
(PDataRecord
'[ "credential" ':= PCredential,
"stakingCredential" ':= PMaybeData PStakingCredential])
-> PAddress s
PAddress forall a b. (a -> b) -> a -> b
$
forall (label :: Symbol) (a :: PType) (l :: [PLabeledType])
(s :: S).
Term
s
(PAsData a
:--> (PDataRecord l :--> PDataRecord ((label ':= a) : l)))
pdcons
# pdata (pcon $ PScriptCredential (pdcons # pdata valHash # pdnil))
#$ pdcons
# pdata stakingCred
#$ pdnil
paddressFromPubKeyHash ::
forall (s :: S).
Term s (PPubKeyHash :--> PMaybeData PStakingCredential :--> PAddress)
paddressFromPubKeyHash :: forall (s :: S).
Term
s (PPubKeyHash :--> (PMaybeData PStakingCredential :--> PAddress))
paddressFromPubKeyHash = forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PPubKeyHash
pkh Term s (PMaybeData PStakingCredential)
stakingCred ->
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S).
Term
s
(PDataRecord
'[ "credential" ':= PCredential,
"stakingCredential" ':= PMaybeData PStakingCredential])
-> PAddress s
PAddress forall a b. (a -> b) -> a -> b
$
forall (label :: Symbol) (a :: PType) (l :: [PLabeledType])
(s :: S).
Term
s
(PAsData a
:--> (PDataRecord l :--> PDataRecord ((label ':= a) : l)))
pdcons
# pdata (pcon $ PPubKeyCredential (pdcons # pdata pkh # pdnil))
#$ pdcons
# pdata stakingCred
#$ pdnil
pscriptHashFromAddress :: forall (s :: S). Term s (PAddress :--> PMaybe PScriptHash)
pscriptHashFromAddress :: forall (s :: S). Term s (PAddress :--> PMaybe PScriptHash)
pscriptHashFromAddress = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PAddress
addr ->
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch (forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"credential" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PAddress
addr) forall a b. (a -> b) -> a -> b
$ \case
PScriptCredential ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"_0" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#) -> Term s PScriptHash
h) -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). Term s a -> PMaybe a s
PJust Term s PScriptHash
h
PCredential s
_ -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall (a :: PType) (s :: S). PMaybe a s
PNothing
pisScriptAddress :: forall (s :: S). Term s (PAddress :--> PBool)
pisScriptAddress :: forall (s :: S). Term s (PAddress :--> PBool)
pisScriptAddress = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$
\Term s PAddress
addr -> forall (s :: S). Term s (PBool :--> PBool)
pnot forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S). Term s (PCredential :--> PBool)
pisPubKey forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"credential" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PAddress
addr
pisPubKey :: forall (s :: S). Term s (PCredential :--> PBool)
pisPubKey :: forall (s :: S). Term s (PCredential :--> PBool)
pisPubKey = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PCredential
cred ->
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PCredential
cred forall a b. (a -> b) -> a -> b
$ \case
PScriptCredential Term s (PDataRecord '[ "_0" ':= PScriptHash])
_ -> forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
False
PCredential s
_ -> forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
True
pfindOutputsToAddress ::
forall (s :: S).
Term
s
( PBuiltinList PTxOut
:--> PAddress
:--> PBuiltinList PTxOut
)
pfindOutputsToAddress :: forall (s :: S).
Term
s (PBuiltinList PTxOut :--> (PAddress :--> PBuiltinList PTxOut))
pfindOutputsToAddress = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinList PTxOut)
outputs Term s PAddress
address' -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
Term s (PAsData PAddress)
address <- forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont s (Term s a)
pletC forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata Term s PAddress
address'
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (list :: PType -> PType) (a :: PType) (s :: S).
PIsListLike list a =>
Term s ((a :--> PBool) :--> (list a :--> list a))
pfilter
# plam (\txOut -> pfield @"address" # txOut #== address)
# outputs
pfindOwnInput ::
Term
s
( PBuiltinList PTxInInfo
:--> PTxOutRef
:--> PMaybe PTxInInfo
)
pfindOwnInput :: forall (s :: S).
Term
s (PBuiltinList PTxInInfo :--> (PTxOutRef :--> PMaybe PTxInInfo))
pfindOwnInput = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinList PTxInInfo)
inputs Term s PTxOutRef
outRef ->
forall (l :: PType -> PType) (a :: PType) (s :: S).
PIsListLike l a =>
Term s ((a :--> PBool) :--> (l a :--> PMaybe a))
pfind forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (forall (s' :: S). Term s' (PTxOutRef :--> (PTxInInfo :--> PBool))
matches forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxOutRef
outRef) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PTxInInfo)
inputs
where
matches :: Term s (PTxOutRef :--> PTxInInfo :--> PBool)
matches :: forall (s' :: S). Term s' (PTxOutRef :--> (PTxInInfo :--> PBool))
matches = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PTxOutRef
outref Term s PTxInInfo
txininfo ->
Term s PTxOutRef
outref forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p, as ~ PFields p, n ~ PLabelIndex name as,
KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) =>
Term s (p :--> b)
pfield @"outRef" forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInInfo
txininfo
scriptHashToTokenName :: ScriptHash -> TokenName
scriptHashToTokenName :: ScriptHash -> TokenName
scriptHashToTokenName = coerce :: forall a b. Coercible a b => a -> b
coerce
pscriptHashToTokenName ::
forall (s :: S).
Term s PScriptHash ->
Term s PTokenName
pscriptHashToTokenName :: forall (s :: S). Term s PScriptHash -> Term s PTokenName
pscriptHashToTokenName = forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce
ptryFromRedeemer ::
forall (r :: PType) (s :: S).
(PTryFrom PData r) =>
Term
s
( PScriptPurpose
:--> PMap 'Unsorted PScriptPurpose PRedeemer
:--> PMaybe r
)
ptryFromRedeemer :: forall (r :: PType) (s :: S).
PTryFrom PData r =>
Term
s
(PScriptPurpose
:--> (PMap 'Unsorted PScriptPurpose PRedeemer :--> PMaybe r))
ptryFromRedeemer = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PScriptPurpose
p Term s (PMap 'Unsorted PScriptPurpose PRedeemer)
m ->
forall (f :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
(PFunctor f, PSubcategory f a, PSubcategory f b) =>
Term s ((a :--> b) :--> (f a :--> f b))
pfmap
# plam (flip ptryFrom fst . pto)
# (plookup # p # m)