{-# LANGUAGE RankNTypes #-}
module Cardano.YTxP.Control.Yielding.Helper (yieldingHelper) where
import Cardano.YTxP.Control.Yielding (PAuthorisedScriptPurpose (PMinting, PRewarding, PSpending), getAuthorisedScriptHash)
import Plutarch.LedgerApi.V2 (
PCredential (PPubKeyCredential, PScriptCredential),
PCurrencySymbol,
PScriptContext,
PStakingCredential (PStakingHash, PStakingPtr),
)
import Utils (pcheck, pscriptHashToCurrencySymbol)
yieldingHelper ::
forall (s :: S).
Term s (PCurrencySymbol :--> PData :--> PScriptContext :--> POpaque)
yieldingHelper :: forall (s :: S).
Term
s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
yieldingHelper = (Term s PCurrencySymbol
-> Term s PData -> Term s PScriptContext -> Term s POpaque)
-> Term
s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c
-> Term s PData -> Term s PScriptContext -> Term s POpaque)
-> Term s (c :--> (PData :--> (PScriptContext :--> POpaque)))
plam ((Term s PCurrencySymbol
-> Term s PData -> Term s PScriptContext -> Term s POpaque)
-> Term
s
(PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque))))
-> (Term s PCurrencySymbol
-> Term s PData -> Term s PScriptContext -> Term s POpaque)
-> Term
s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
forall a b. (a -> b) -> a -> b
$ \Term s PCurrencySymbol
pylstcs Term s PData
redeemer Term s PScriptContext
ctx -> TermCont @POpaque s (Term s POpaque) -> Term s POpaque
forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @POpaque s (Term s POpaque) -> Term s POpaque)
-> TermCont @POpaque s (Term s POpaque) -> Term s POpaque
forall a b. (a -> b) -> a -> b
$ do
Term s PTxInfo
txInfo <- Term s PTxInfo -> TermCont @POpaque s (Term s PTxInfo)
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term s PTxInfo -> TermCont @POpaque s (Term s PTxInfo))
-> Term s PTxInfo -> TermCont @POpaque s (Term s PTxInfo)
forall a b. (a -> b) -> a -> b
$ Term s (PAsData PTxInfo) -> Term s PTxInfo
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PTxInfo) -> Term s PTxInfo)
-> Term s (PAsData PTxInfo) -> Term s PTxInfo
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"txInfo" Term s (PScriptContext :--> PAsData PTxInfo)
-> Term s PScriptContext -> Term s (PAsData PTxInfo)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
ctx
let txInfoRefInputs :: Term s (PBuiltinList (PAsData PTxInInfo))
txInfoRefInputs = Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo))
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo))
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"referenceInputs" Term s (PTxInfo :--> PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s PTxInfo
-> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInfo
txInfo
Term s PYieldingRedeemer
yieldingRedeemer <- Term s (PAsData PYieldingRedeemer) -> Term s PYieldingRedeemer
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PYieldingRedeemer) -> Term s PYieldingRedeemer)
-> ((Term s (PAsData PYieldingRedeemer),
GReduce
(PTryFromExcess PData (PAsData PYieldingRedeemer) s)
(Rep (PTryFromExcess PData (PAsData PYieldingRedeemer) s)))
-> Term s (PAsData PYieldingRedeemer))
-> (Term s (PAsData PYieldingRedeemer),
GReduce
(PTryFromExcess PData (PAsData PYieldingRedeemer) s)
(Rep (PTryFromExcess PData (PAsData PYieldingRedeemer) s)))
-> Term s PYieldingRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term s (PAsData PYieldingRedeemer),
GReduce
(PTryFromExcess PData (PAsData PYieldingRedeemer) s)
(Rep (PTryFromExcess PData (PAsData PYieldingRedeemer) s)))
-> Term s (PAsData PYieldingRedeemer)
forall a b. (a, b) -> a
fst ((Term s (PAsData PYieldingRedeemer),
GReduce
(PTryFromExcess PData (PAsData PYieldingRedeemer) s)
(Rep (PTryFromExcess PData (PAsData PYieldingRedeemer) s)))
-> Term s PYieldingRedeemer)
-> TermCont
@POpaque
s
(Term s (PAsData PYieldingRedeemer),
GReduce
(PTryFromExcess PData (PAsData PYieldingRedeemer) s)
(Rep (PTryFromExcess PData (PAsData PYieldingRedeemer) s)))
-> TermCont @POpaque s (Term s PYieldingRedeemer)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Term s PData
-> TermCont
@POpaque
s
(Term s (PAsData PYieldingRedeemer),
Reduce (PTryFromExcess PData (PAsData PYieldingRedeemer) s))
forall (b :: PType) (r :: PType) (a :: PType) (s :: S).
PTryFrom a b =>
Term s a -> TermCont @r s (Term s b, Reduce (PTryFromExcess a b s))
ptryFromC Term s PData
redeemer
let authorisedScriptHash :: Term s PScriptHash
authorisedScriptHash = Term
s
(PCurrencySymbol
:--> (PBuiltinList (PAsData PTxInInfo)
:--> (PYieldingRedeemer :--> PScriptHash)))
forall (s :: S).
Term
s
(PCurrencySymbol
:--> (PBuiltinList (PAsData PTxInInfo)
:--> (PYieldingRedeemer :--> PScriptHash)))
getAuthorisedScriptHash Term
s
(PCurrencySymbol
:--> (PBuiltinList (PAsData PTxInInfo)
:--> (PYieldingRedeemer :--> PScriptHash)))
-> Term s PCurrencySymbol
-> Term
s
(PBuiltinList (PAsData PTxInInfo)
:--> (PYieldingRedeemer :--> PScriptHash))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PCurrencySymbol
pylstcs Term
s
(PBuiltinList (PAsData PTxInInfo)
:--> (PYieldingRedeemer :--> PScriptHash))
-> Term s (PBuiltinList (PAsData PTxInInfo))
-> Term s (PYieldingRedeemer :--> PScriptHash)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList (PAsData PTxInInfo))
txInfoRefInputs Term s (PYieldingRedeemer :--> PScriptHash)
-> Term s PYieldingRedeemer -> Term s PScriptHash
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PYieldingRedeemer
yieldingRedeemer
authorisedScriptProofIndex :: Term s (PInner PAuthorisedScriptProofIndex)
authorisedScriptProofIndex = Term s PAuthorisedScriptProofIndex
-> Term s (PInner PAuthorisedScriptProofIndex)
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto (Term s PAuthorisedScriptProofIndex
-> Term s (PInner PAuthorisedScriptProofIndex))
-> Term s PAuthorisedScriptProofIndex
-> Term s (PInner PAuthorisedScriptProofIndex)
forall a b. (a -> b) -> a -> b
$ Term s (PAsData PAuthorisedScriptProofIndex)
-> Term s PAuthorisedScriptProofIndex
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PAuthorisedScriptProofIndex)
-> Term s PAuthorisedScriptProofIndex)
-> Term s (PAsData PAuthorisedScriptProofIndex)
-> Term s PAuthorisedScriptProofIndex
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"authorisedScriptProofIndex" Term s (PYieldingRedeemer :--> PAsData PAuthorisedScriptProofIndex)
-> Term s PYieldingRedeemer
-> Term s (PAsData PAuthorisedScriptProofIndex)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PYieldingRedeemer
yieldingRedeemer
authorisedScriptPurpose :: Term s PAuthorisedScriptPurpose
authorisedScriptPurpose = Term s (PAsData PAuthorisedScriptPurpose)
-> Term s PAuthorisedScriptPurpose
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PAuthorisedScriptPurpose)
-> Term s PAuthorisedScriptPurpose)
-> Term s (PAsData PAuthorisedScriptPurpose)
-> Term s PAuthorisedScriptPurpose
forall a b. (a -> b) -> a -> b
$ Term
s
(PBuiltinPair (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)
:--> PAsData PAuthorisedScriptPurpose)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term
s
(PBuiltinPair (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)
:--> PAsData PAuthorisedScriptPurpose)
-> Term
s
(PBuiltinPair
(PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
-> Term s (PAsData PAuthorisedScriptPurpose)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term
s
(PBuiltinPair
(PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
Term s (PInner PAuthorisedScriptProofIndex)
authorisedScriptProofIndex
authorisedScriptIndex :: Term s PInteger
authorisedScriptIndex = Term s (PAsData PInteger) -> Term s PInteger
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PInteger) -> Term s PInteger)
-> Term s (PAsData PInteger) -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Term
s
(PBuiltinPair (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)
:--> PAsData PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin Term
s
(PBuiltinPair (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)
:--> PAsData PInteger)
-> Term
s
(PBuiltinPair
(PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
-> Term s (PAsData PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term
s
(PBuiltinPair
(PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
Term s (PInner PAuthorisedScriptProofIndex)
authorisedScriptProofIndex
Term s POpaque -> TermCont @POpaque s (Term s POpaque)
forall a. a -> TermCont @POpaque s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s POpaque -> TermCont @POpaque s (Term s POpaque))
-> Term s POpaque -> TermCont @POpaque s (Term s POpaque)
forall a b. (a -> b) -> a -> b
$
Term s PBool -> Term s POpaque
forall (s :: S). Term s PBool -> Term s POpaque
pcheck (Term s PBool -> Term s POpaque) -> Term s PBool -> Term s POpaque
forall a b. (a -> b) -> a -> b
$
Term s PAuthorisedScriptPurpose
-> (PAuthorisedScriptPurpose s -> Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PAuthorisedScriptPurpose
authorisedScriptPurpose ((PAuthorisedScriptPurpose s -> Term s PBool) -> Term s PBool)
-> (PAuthorisedScriptPurpose s -> Term s PBool) -> Term s PBool
forall a b. (a -> b) -> a -> b
$ \case
PAuthorisedScriptPurpose s
PMinting ->
let txInfoMints :: Term s (PValue 'Sorted 'NoGuarantees)
txInfoMints = Term s (PAsData (PValue 'Sorted 'NoGuarantees))
-> Term s (PValue 'Sorted 'NoGuarantees)
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PValue 'Sorted 'NoGuarantees))
-> Term s (PValue 'Sorted 'NoGuarantees))
-> Term s (PAsData (PValue 'Sorted 'NoGuarantees))
-> Term s (PValue 'Sorted 'NoGuarantees)
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"mint" Term s (PTxInfo :--> PAsData (PValue 'Sorted 'NoGuarantees))
-> Term s PTxInfo
-> Term s (PAsData (PValue 'Sorted 'NoGuarantees))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInfo
txInfo
authorisedScriptMint :: Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger)))
authorisedScriptMint = Term s (PInner (PValue 'Sorted 'NoGuarantees))
-> Term s (PInner (PInner (PValue 'Sorted 'NoGuarantees)))
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto (Term s (PValue 'Sorted 'NoGuarantees)
-> Term s (PInner (PValue 'Sorted 'NoGuarantees))
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s (PValue 'Sorted 'NoGuarantees)
txInfoMints) Term
s
(PBuiltinList
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger))))
-> Term s PInteger
-> Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger)))
forall (l :: PType -> PType) (a :: PType) (s :: S).
PIsListLike l a =>
Term s (l a) -> Term s PInteger -> Term s a
#!! Term s PInteger
authorisedScriptIndex
currencySymbol :: Term s PCurrencySymbol
currencySymbol = Term s PScriptHash -> Term s PCurrencySymbol
forall (s :: S). Term s PScriptHash -> Term s PCurrencySymbol
pscriptHashToCurrencySymbol Term s PScriptHash
authorisedScriptHash
in Term s PString -> Term s PBool -> Term s PBool
forall (s :: S). Term s PString -> Term s PBool -> Term s PBool
ptraceInfoIfFalse Term s PString
"Minting policy does not match expected authorised minting policy" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$
Term s (PAsData PCurrencySymbol) -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger))
:--> PAsData PCurrencySymbol)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger))
:--> PAsData PCurrencySymbol)
-> Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger)))
-> Term s (PAsData PCurrencySymbol)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term
s
(PBuiltinPair
(PAsData PCurrencySymbol)
(PAsData (PMap 'Sorted PTokenName PInteger)))
authorisedScriptMint) Term s PCurrencySymbol -> Term s PCurrencySymbol -> Term s PBool
forall (s :: S).
Term s PCurrencySymbol -> Term s PCurrencySymbol -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PCurrencySymbol
currencySymbol
PAuthorisedScriptPurpose s
PSpending ->
let txInfoInputs :: Term s (PBuiltinList (PAsData PTxInInfo))
txInfoInputs = Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo))
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s (PBuiltinList (PAsData PTxInInfo))
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"inputs" Term s (PTxInfo :--> PAsData (PBuiltinList (PAsData PTxInInfo)))
-> Term s PTxInfo
-> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInfo
txInfo
authorisedScriptInput :: Term s (PAsData PTxInInfo)
authorisedScriptInput = Term s (PBuiltinList (PAsData PTxInInfo))
txInfoInputs Term s (PBuiltinList (PAsData PTxInInfo))
-> Term s PInteger -> Term s (PAsData PTxInInfo)
forall (l :: PType -> PType) (a :: PType) (s :: S).
PIsListLike l a =>
Term s (l a) -> Term s PInteger -> Term s a
#!! Term s PInteger
authorisedScriptIndex
out :: Term s (PAsData PTxOut)
out = forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p,
(as :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"resolved" Term s (PAsData PTxInInfo :--> PAsData PTxOut)
-> Term s (PAsData PTxInInfo) -> Term s (PAsData PTxOut)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PAsData PTxInInfo)
authorisedScriptInput
address :: Term s (PAsData PAddress)
address = forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p,
(as :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"address" Term s (PTxOut :--> PAsData PAddress)
-> Term s PTxOut -> Term s (PAsData PAddress)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PAsData PTxOut) -> Term s PTxOut
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData PTxOut)
out
credential :: Term s (PAsData PCredential)
credential = forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p,
(as :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"credential" Term s (PAddress :--> PAsData PCredential)
-> Term s PAddress -> Term s (PAsData PCredential)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PAsData PAddress) -> Term s PAddress
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData PAddress)
address
in Term s PCredential
-> (PCredential s -> Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch (Term s (PAsData PCredential) -> Term s PCredential
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData PCredential)
credential) ((PCredential s -> Term s PBool) -> Term s PBool)
-> (PCredential s -> Term s PBool) -> Term s PBool
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"_0" #) -> Term s PScriptHash
hash) ->
Term s PString -> Term s PBool -> Term s PBool
forall (s :: S). Term s PString -> Term s PBool -> Term s PBool
ptraceInfoIfFalse Term s PString
"Input does not match expected authorised validator" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$
Term s PScriptHash
hash Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PScriptHash
authorisedScriptHash
PPubKeyCredential Term
s
(PDataRecord
((':) @PLabeledType ("_0" ':= PPubKeyHash) ('[] @PLabeledType)))
_ ->
Term s PString -> Term s PBool
forall (a :: PType) (s :: S). Term s PString -> Term s a
ptraceInfoError Term s PString
"Input at specified index is not a script input"
PAuthorisedScriptPurpose s
PRewarding ->
let txInfoWithdrawals :: Term s (PMap 'Unsorted PStakingCredential PInteger)
txInfoWithdrawals = Term s (PAsData (PMap 'Unsorted PStakingCredential PInteger))
-> Term s (PMap 'Unsorted PStakingCredential PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PMap 'Unsorted PStakingCredential PInteger))
-> Term s (PMap 'Unsorted PStakingCredential PInteger))
-> Term s (PAsData (PMap 'Unsorted PStakingCredential PInteger))
-> Term s (PMap 'Unsorted PStakingCredential PInteger)
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"wdrl" Term
s
(PTxInfo :--> PAsData (PMap 'Unsorted PStakingCredential PInteger))
-> Term s PTxInfo
-> Term s (PAsData (PMap 'Unsorted PStakingCredential PInteger))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PTxInfo
txInfo
authorisedScriptWithdrawal :: Term
s (PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger))
authorisedScriptWithdrawal = Term s (PMap 'Unsorted PStakingCredential PInteger)
-> Term s (PInner (PMap 'Unsorted PStakingCredential PInteger))
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s (PMap 'Unsorted PStakingCredential PInteger)
txInfoWithdrawals Term
s
(PBuiltinList
(PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger)))
-> Term s PInteger
-> Term
s (PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger))
forall (l :: PType -> PType) (a :: PType) (s :: S).
PIsListLike l a =>
Term s (l a) -> Term s PInteger -> Term s a
#!! Term s PInteger
authorisedScriptIndex
in Term s PStakingCredential
-> (PStakingCredential s -> Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch (Term s (PAsData PStakingCredential) -> Term s PStakingCredential
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PStakingCredential) -> Term s PStakingCredential)
-> Term s (PAsData PStakingCredential) -> Term s PStakingCredential
forall a b. (a -> b) -> a -> b
$ Term
s
(PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger)
:--> PAsData PStakingCredential)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term
s
(PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger)
:--> PAsData PStakingCredential)
-> Term
s (PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger))
-> Term s (PAsData PStakingCredential)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term
s (PBuiltinPair (PAsData PStakingCredential) (PAsData PInteger))
authorisedScriptWithdrawal) ((PStakingCredential s -> Term s PBool) -> Term s PBool)
-> (PStakingCredential s -> Term s PBool) -> Term s PBool
forall a b. (a -> b) -> a -> b
$ \case
PStakingHash ((forall (name :: Symbol) (b :: PType) (p :: PType) (s :: S)
(a :: PType) (as :: [PLabeledType]) (n :: Nat).
(PDataFields p,
(as :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"_0" #) -> Term s PCredential
credential) ->
Term s PCredential
-> (PCredential s -> Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PCredential
credential ((PCredential s -> Term s PBool) -> Term s PBool)
-> (PCredential s -> Term s PBool) -> Term s PBool
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 :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
(n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
(a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
PFromDataable a b) =>
Term s (p :--> b)
pfield @"_0" #) -> Term s PScriptHash
hash) ->
Term s PString -> Term s PBool -> Term s PBool
forall (s :: S). Term s PString -> Term s PBool -> Term s PBool
ptraceInfoIfFalse Term s PString
"Withdrawal does not match expected authorised staking validator" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$
Term s PScriptHash
hash Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PScriptHash
authorisedScriptHash
PPubKeyCredential Term
s
(PDataRecord
((':) @PLabeledType ("_0" ':= PPubKeyHash) ('[] @PLabeledType)))
_ ->
Term s PString -> Term s PBool
forall (a :: PType) (s :: S). Term s PString -> Term s a
ptraceInfoError Term s PString
"Staking credential at specified index is not a script credential"
PStakingPtr Term
s
(PDataRecord
((':)
@PLabeledType
("_0" ':= PInteger)
((':)
@PLabeledType
("_1" ':= PInteger)
((':) @PLabeledType ("_2" ':= PInteger) ('[] @PLabeledType)))))
_ ->
Term s PString -> Term s PBool
forall (a :: PType) (s :: S). Term s PString -> Term s a
ptraceInfoError Term s PString
"No staking validator found"