{- | This module export a helper function that produces a two argument yielding script that
we use to implement the logic for yielding validator, minting policy and staking validator
-}
module Cardano.YTxP.Control.Yielding.Helper (yieldingHelper) where

import Cardano.YTxP.Control.Yielding (
  PAuthorisedScriptPurpose (PMinting, PRewarding, PSpending),
  authorisedScriptProofIndex,
  getAuthorisedScriptHash,
 )
import Plutarch.LedgerApi.AssocMap (PMap (PMap))
import Plutarch.LedgerApi.V3 (
  PCredential (PPubKeyCredential, PScriptCredential),
  PCurrencySymbol,
  PRedeemer (PRedeemer),
  PScriptContext,
  paddress'credential,
  pscriptContext'redeemer,
  pscriptContext'txInfo,
  ptxInInfo'resolved,
  ptxInfo'inputs,
  ptxInfo'mint,
  ptxInfo'referenceInputs,
  ptxInfo'wdrl,
  ptxOut'address,
 )
import Utils (pcheck, pscriptHashToCurrencySymbol)

-- -   Look at the UTxO at the `n` th entry in the `txInfoReferenceInputs`, where `n` is equal to `authorisedScriptIndex`.
--     -   Call this UTxO `authorisedScriptUTxO`.
--     -   Check that this UTxO is carrying exactly one token with the `authorisedScriptSTCS`. Blow up if not.
--     -   Obtain the hash of the reference script from the authorisedScriptUTxO. Call this hash `AuthorisedScriptHash`.
-- -   Obtain evidence that the a script with `AuthorisedScriptHash` was triggered.
--     If not, blow up. In practice, this will involve either:
--     -   Looking at the `txInfoWithdrawls` field for a staking validator being triggered with the correct StakingCredential
--     -   Looking at the `txInfoInputs` field for a UTxO being spent at the correct address
--     -   Looking at the `txInfoMints` field for a mint with the correct currency symbol

yieldingHelper ::
  forall (s :: S).
  Term s (PCurrencySymbol :--> PScriptContext :--> PUnit)
yieldingHelper :: forall (s :: S).
Term s (PCurrencySymbol :--> (PScriptContext :--> PUnit))
yieldingHelper = (Term s PCurrencySymbol -> Term s PScriptContext -> Term s PUnit)
-> Term s (PCurrencySymbol :--> (PScriptContext :--> PUnit))
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 PScriptContext -> Term s PUnit)
-> Term s (c :--> (PScriptContext :--> PUnit))
plam ((Term s PCurrencySymbol -> Term s PScriptContext -> Term s PUnit)
 -> Term s (PCurrencySymbol :--> (PScriptContext :--> PUnit)))
-> (Term s PCurrencySymbol
    -> Term s PScriptContext -> Term s PUnit)
-> Term s (PCurrencySymbol :--> (PScriptContext :--> PUnit))
forall a b. (a -> b) -> a -> b
$ \Term s PCurrencySymbol
pylstcs Term s PScriptContext
ctx' -> TermCont @PUnit s (Term s PUnit) -> Term s PUnit
forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @PUnit s (Term s PUnit) -> Term s PUnit)
-> TermCont @PUnit s (Term s PUnit) -> Term s PUnit
forall a b. (a -> b) -> a -> b
$ do
  PScriptContext s
ctx <- Term s PScriptContext -> TermCont @PUnit s (PScriptContext s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC Term s PScriptContext
ctx'
  Term s PRedeemer
redeemer' <- Term s PRedeemer -> TermCont @PUnit s (Term s PRedeemer)
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term s PRedeemer -> TermCont @PUnit s (Term s PRedeemer))
-> Term s PRedeemer -> TermCont @PUnit s (Term s PRedeemer)
forall a b. (a -> b) -> a -> b
$ PScriptContext s -> Term s PRedeemer
forall (s :: S). PScriptContext s -> Term s PRedeemer
pscriptContext'redeemer PScriptContext s
ctx
  PTxInfo s
txInfo <- Term s PTxInfo -> TermCont @PUnit s (PTxInfo s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC (Term s PTxInfo -> TermCont @PUnit s (PTxInfo s))
-> Term s PTxInfo -> TermCont @PUnit s (PTxInfo s)
forall a b. (a -> b) -> a -> b
$ PScriptContext s -> Term s PTxInfo
forall (s :: S). PScriptContext s -> Term s PTxInfo
pscriptContext'txInfo PScriptContext s
ctx
  PRedeemer Term s PData
redeemer <- Term s PRedeemer -> TermCont @PUnit s (PRedeemer s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC Term s PRedeemer
redeemer'
  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), ())
    -> Term s (PAsData PYieldingRedeemer))
-> (Term s (PAsData PYieldingRedeemer), ())
-> Term s PYieldingRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term s (PAsData PYieldingRedeemer), ())
-> Term s (PAsData PYieldingRedeemer)
forall a b. (a, b) -> a
fst ((Term s (PAsData PYieldingRedeemer), ())
 -> Term s PYieldingRedeemer)
-> TermCont @PUnit s (Term s (PAsData PYieldingRedeemer), ())
-> TermCont @PUnit s (Term s PYieldingRedeemer)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Term s PData
-> TermCont
     @PUnit
     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
  PYieldingRedeemer s
yieldingRedeemer' <- Term s PYieldingRedeemer -> TermCont @PUnit s (PYieldingRedeemer s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC Term s PYieldingRedeemer
yieldingRedeemer
  Term
  s
  (PBuiltinPair
     (PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
scriptProofIndex <-
    Term
  s
  (PBuiltinPair
     (PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
-> TermCont
     @PUnit
     s
     (Term
        s
        (PBuiltinPair
           (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)))
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term
   s
   (PBuiltinPair
      (PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
 -> TermCont
      @PUnit
      s
      (Term
         s
         (PBuiltinPair
            (PAsData PAuthorisedScriptPurpose) (PAsData PInteger))))
-> Term
     s
     (PBuiltinPair
        (PAsData PAuthorisedScriptPurpose) (PAsData PInteger))
-> TermCont
     @PUnit
     s
     (Term
        s
        (PBuiltinPair
           (PAsData PAuthorisedScriptPurpose) (PAsData PInteger)))
forall a b. (a -> b) -> a -> b
$ 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
$ PYieldingRedeemer s -> Term s (PAsData PAuthorisedScriptProofIndex)
forall (s :: S).
PYieldingRedeemer s -> Term s (PAsData PAuthorisedScriptProofIndex)
authorisedScriptProofIndex PYieldingRedeemer s
yieldingRedeemer'

  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
$ PTxInfo s -> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
forall (s :: S).
PTxInfo s -> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
ptxInfo'referenceInputs PTxInfo s
txInfo
      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
      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))
scriptProofIndex
      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))
scriptProofIndex

  Term s PUnit -> TermCont @PUnit s (Term s PUnit)
forall a. a -> TermCont @PUnit s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s PUnit -> TermCont @PUnit s (Term s PUnit))
-> Term s PUnit -> TermCont @PUnit s (Term s PUnit)
forall a b. (a -> b) -> a -> b
$
    Term s PBool -> Term s PUnit
forall (s :: S). Term s PBool -> Term s PUnit
pcheck (Term s PBool -> Term s PUnit) -> Term s PBool -> Term s PUnit
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 'NonZero)
txInfoMints = Term s (PAsData (PValue 'Sorted 'NonZero))
-> Term s (PValue 'Sorted 'NonZero)
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PValue 'Sorted 'NonZero))
 -> Term s (PValue 'Sorted 'NonZero))
-> Term s (PAsData (PValue 'Sorted 'NonZero))
-> Term s (PValue 'Sorted 'NonZero)
forall a b. (a -> b) -> a -> b
$ PTxInfo s -> Term s (PAsData (PValue 'Sorted 'NonZero))
forall (s :: S).
PTxInfo s -> Term s (PAsData (PValue 'Sorted 'NonZero))
ptxInfo'mint PTxInfo s
txInfo
              authorisedScriptMint :: Term
  s
  (PBuiltinPair
     (PAsData PCurrencySymbol)
     (PAsData (PMap 'Sorted PTokenName PInteger)))
authorisedScriptMint = Term
  s (PMap 'Sorted PCurrencySymbol (PMap 'Sorted PTokenName PInteger))
-> Term
     s
     (PInner
        (PMap 'Sorted PCurrencySymbol (PMap 'Sorted PTokenName PInteger)))
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto (Term s (PValue 'Sorted 'NonZero)
-> Term s (PInner (PValue 'Sorted 'NonZero))
forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s (PValue 'Sorted 'NonZero)
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 -> TermCont @PBool s (Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @PBool s (Term s PBool) -> Term s PBool)
-> TermCont @PBool s (Term s PBool) -> Term s PBool
forall a b. (a -> b) -> a -> b
$ do
          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
$ PTxInfo s -> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
forall (s :: S).
PTxInfo s -> Term s (PAsData (PBuiltinList (PAsData PTxInInfo)))
ptxInfo'inputs PTxInfo s
txInfo
          PTxInInfo s
authorisedScriptInput <-
            Term s PTxInInfo -> TermCont @PBool s (PTxInInfo s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC (Term s PTxInInfo -> TermCont @PBool s (PTxInInfo s))
-> Term s PTxInInfo -> TermCont @PBool s (PTxInInfo s)
forall a b. (a -> b) -> a -> b
$ Term s (PAsData PTxInInfo) -> Term s PTxInInfo
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData PTxInInfo) -> Term s PTxInInfo)
-> Term s (PAsData PTxInInfo) -> Term s PTxInInfo
forall a b. (a -> b) -> a -> b
$ 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
          PTxOut s
out <- Term s PTxOut -> TermCont @PBool s (PTxOut s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC (Term s PTxOut -> TermCont @PBool s (PTxOut s))
-> Term s PTxOut -> TermCont @PBool s (PTxOut s)
forall a b. (a -> b) -> a -> b
$ PTxInInfo s -> Term s PTxOut
forall (s :: S). PTxInInfo s -> Term s PTxOut
ptxInInfo'resolved PTxInInfo s
authorisedScriptInput
          PAddress s
address <- Term s PAddress -> TermCont @PBool s (PAddress s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC (Term s PAddress -> TermCont @PBool s (PAddress s))
-> Term s PAddress -> TermCont @PBool s (PAddress s)
forall a b. (a -> b) -> a -> b
$ PTxOut s -> Term s PAddress
forall (s :: S). PTxOut s -> Term s PAddress
ptxOut'address PTxOut s
out
          let credential :: Term s PCredential
credential = PAddress s -> Term s PCredential
forall (s :: S). PAddress s -> Term s PCredential
paddress'credential PAddress s
address
          Term s PBool -> TermCont @PBool s (Term s PBool)
forall a. a -> TermCont @PBool s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Term s PBool -> TermCont @PBool s (Term s PBool))
-> Term s PBool -> TermCont @PBool s (Term s PBool)
forall a b. (a -> b) -> a -> b
$
            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 Term s (PAsData 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 (PAsData PScriptHash) -> Term s PScriptHash
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData 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 (PAsData PPubKeyHash)
_ ->
                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 -> TermCont @PBool s (Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @PBool s (Term s PBool) -> Term s PBool)
-> TermCont @PBool s (Term s PBool) -> Term s PBool
forall a b. (a -> b) -> a -> b
$ do
          PMap Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PCredential) (PAsData PLovelace)))
txInfoWithdrawals <- Term s (PMap 'Unsorted PCredential PLovelace)
-> TermCont @PBool s (PMap 'Unsorted PCredential PLovelace s)
forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont @r s (a s)
pmatchC (Term s (PMap 'Unsorted PCredential PLovelace)
 -> TermCont @PBool s (PMap 'Unsorted PCredential PLovelace s))
-> Term s (PMap 'Unsorted PCredential PLovelace)
-> TermCont @PBool s (PMap 'Unsorted PCredential PLovelace s)
forall a b. (a -> b) -> a -> b
$ Term s (PAsData (PMap 'Unsorted PCredential PLovelace))
-> Term s (PMap 'Unsorted PCredential PLovelace)
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData (Term s (PAsData (PMap 'Unsorted PCredential PLovelace))
 -> Term s (PMap 'Unsorted PCredential PLovelace))
-> Term s (PAsData (PMap 'Unsorted PCredential PLovelace))
-> Term s (PMap 'Unsorted PCredential PLovelace)
forall a b. (a -> b) -> a -> b
$ PTxInfo s
-> Term s (PAsData (PMap 'Unsorted PCredential PLovelace))
forall (s :: S).
PTxInfo s
-> Term s (PAsData (PMap 'Unsorted PCredential PLovelace))
ptxInfo'wdrl PTxInfo s
txInfo
          let authorisedScriptWithdrawal :: Term s (PBuiltinPair (PAsData PCredential) (PAsData PLovelace))
authorisedScriptWithdrawal = Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PCredential) (PAsData PLovelace)))
txInfoWithdrawals Term
  s
  (PBuiltinList
     (PBuiltinPair (PAsData PCredential) (PAsData PLovelace)))
-> Term s PInteger
-> Term s (PBuiltinPair (PAsData PCredential) (PAsData PLovelace))
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
          Term s PBool -> TermCont @PBool s (Term s PBool)
forall a. a -> TermCont @PBool s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Term s PBool -> TermCont @PBool s (Term s PBool))
-> Term s PBool -> TermCont @PBool s (Term s PBool)
forall a b. (a -> b) -> a -> b
$
            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) -> Term s PCredential)
-> Term s (PAsData PCredential) -> Term s PCredential
forall a b. (a -> b) -> a -> b
$ Term
  s
  (PBuiltinPair (PAsData PCredential) (PAsData PLovelace)
   :--> PAsData PCredential)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term
  s
  (PBuiltinPair (PAsData PCredential) (PAsData PLovelace)
   :--> PAsData PCredential)
-> Term s (PBuiltinPair (PAsData PCredential) (PAsData PLovelace))
-> Term s (PAsData PCredential)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair (PAsData PCredential) (PAsData PLovelace))
authorisedScriptWithdrawal) ((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 Term s (PAsData 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 (PAsData PScriptHash) -> Term s PScriptHash
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData 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 (PAsData PPubKeyHash)
_ ->
                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"