reduce 'PTxInfo' passing to functions

This commit is contained in:
Emily Martins 2022-04-26 15:37:54 +02:00
parent deaa5cf6f1
commit 7f62b04268
5 changed files with 140 additions and 97 deletions

View file

@ -40,9 +40,12 @@ import Plutus.V1.Ledger.Credential (Credential)
import Plutus.V1.Ledger.Value (CurrencySymbol, Value) import Plutus.V1.Ledger.Value (CurrencySymbol, Value)
import PlutusTx qualified import PlutusTx qualified
-- | Datum that encodes behavior of Treasury Withdrawal effect.
data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
{ receivers :: [(Credential, Value)] { receivers :: [(Credential, Value)]
-- ^ AssocMap for Value sent to each receiver from the treasury.
, treasuries :: [Credential] , treasuries :: [Credential]
-- ^ What Credentials is spending from legal.
} }
deriving stock (Show, GHC.Generic) deriving stock (Show, GHC.Generic)
deriving anyclass (Generic) deriving anyclass (Generic)
@ -77,7 +80,8 @@ deriving via
instance PTryFrom PData PTreasuryWithdrawalDatum where instance PTryFrom PData PTreasuryWithdrawalDatum where
type PTryFromExcess PData PTreasuryWithdrawalDatum = Const () type PTryFromExcess PData PTreasuryWithdrawalDatum = Const ()
ptryFrom' opq cont = ptryFrom' opq cont =
-- this will need to not use punsafeCoerce... -- TODO: This should not use 'punsafeCoerce'.
-- Blocked by 'PCredential', and 'PTuple'.
cont (punsafeCoerce opq, ()) cont (punsafeCoerce opq, ())
{- | Withdraws given list of values to specific target addresses. {- | Withdraws given list of values to specific target addresses.
@ -90,7 +94,7 @@ instance PTryFrom PData PTreasuryWithdrawalDatum where
Note: Note:
It should check... It should check...
1. Transaction outputs should contain all of what Datum specified 1. Transaction outputs should contain all of what Datum specified
2. Left over assests should be redirected back to Treasury 2. Left over assets should be redirected back to Treasury
It can be more flexiable over... It can be more flexiable over...
- The number of outputs themselves - The number of outputs themselves
-} -}

View file

@ -128,6 +128,9 @@ data ProposalThresholds = ProposalThresholds
-- ^ How much GT minimum must a particular 'ResultTag' accumulate for it to pass. -- ^ How much GT minimum must a particular 'ResultTag' accumulate for it to pass.
, create :: Tagged GTTag Integer , create :: Tagged GTTag Integer
-- ^ How much GT required to "create" a proposal. -- ^ How much GT required to "create" a proposal.
--
-- It is recommended this be a high enough amount, in order to prevent DOS from bad
-- actors.
, vote :: Tagged GTTag Integer , vote :: Tagged GTTag Integer
-- ^ How much GT required to allow voting to happen. -- ^ How much GT required to allow voting to happen.
-- (i.e. to move into 'VotingReady') -- (i.e. to move into 'VotingReady')

View file

@ -4,14 +4,18 @@ module Agora.Proposal.Scripts (
proposalDatumValid, proposalDatumValid,
) where ) where
import Agora.Proposal import Agora.Proposal (
PProposalDatum (PProposalDatum),
PProposalRedeemer (..),
PResultTag,
Proposal (governorSTAssetClass, stakeSTAssetClass),
)
import Agora.Record (mkRecordConstr, (.&), (.=)) import Agora.Record (mkRecordConstr, (.&), (.=))
import Agora.Stake (PStakeDatum) import Agora.Stake (findStakeOwnedBy)
import Agora.Utils ( import Agora.Utils (
anyOutput, anyOutput,
findTxOutByTxOutRef, findTxOutByTxOutRef,
passert, passert,
pfindDatum',
pnotNull, pnotNull,
psymbolValueOf, psymbolValueOf,
ptokenSpent, ptokenSpent,
@ -20,14 +24,10 @@ import Agora.Utils (
) )
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PDatumHash, PDatumHash,
PMaybeData (PDJust, PDNothing),
PMintingPolicy, PMintingPolicy,
PPubKeyHash,
PScriptContext (PScriptContext), PScriptContext (PScriptContext),
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTxInInfo (PTxInInfo),
PTxInfo (PTxInfo), PTxInfo (PTxInfo),
PTxOut (PTxOut),
PValidator, PValidator,
PValidatorHash, PValidatorHash,
mintingPolicySymbol, mintingPolicySymbol,
@ -47,20 +47,20 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
NOTE: The governor needs to check that the datum is correct NOTE: The governor needs to check that the datum is correct
and sent to the right address. and sent to the right address.
-} -}
proposalPolicy :: Proposal -> ClosedTerm PMintingPolicy proposalPolicy :: Agora.Proposal.Proposal -> ClosedTerm Plutarch.Api.V1.PMintingPolicy
proposalPolicy proposal = proposalPolicy proposal =
plam $ \_redeemer ctx' -> P.do plam $ \_redeemer ctx' -> P.do
PScriptContext ctx' <- pmatch ctx' Plutarch.Api.V1.PScriptContext ctx' <- pmatch ctx'
ctx <- pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFields @'["txInfo", "purpose"] ctx'
PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo Plutarch.Api.V1.PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
txInfo <- pletFields @'["inputs", "mint"] txInfo' txInfo <- pletFields @'["inputs", "mint"] txInfo'
PMinting _ownSymbol <- pmatch $ pfromData ctx.purpose Plutarch.Api.V1.PMinting _ownSymbol <- pmatch $ pfromData ctx.purpose
let inputs = txInfo.inputs let inputs = txInfo.inputs
mintedValue = pfromData txInfo.mint mintedValue = pfromData txInfo.mint
AssetClass (govCs, govTn) = proposal.governorSTAssetClass AssetClass (govCs, govTn) = proposal.governorSTAssetClass
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose Plutarch.Api.V1.PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
let mintedProposalST = passetClassValueOf # mintedValue # (passetClass # (pfield @"_0" # ownSymbol') # pconstant "") let mintedProposalST = passetClassValueOf # mintedValue # (passetClass # (pfield @"_0" # ownSymbol') # pconstant "")
passert "Governance state-thread token must move" $ passert "Governance state-thread token must move" $
@ -74,22 +74,22 @@ proposalPolicy proposal =
popaque (pconstant ()) popaque (pconstant ())
-- | Validator for Proposals. -- | Validator for Proposals.
proposalValidator :: Proposal -> ClosedTerm PValidator proposalValidator :: Agora.Proposal.Proposal -> ClosedTerm Plutarch.Api.V1.PValidator
proposalValidator proposal = proposalValidator proposal =
plam $ \datum redeemer ctx' -> P.do plam $ \datum redeemer ctx' -> P.do
PScriptContext ctx' <- pmatch ctx' Plutarch.Api.V1.PScriptContext ctx' <- pmatch ctx'
ctx <- pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFields @'["txInfo", "purpose"] ctx'
txInfo <- plet $ pfromData ctx.txInfo txInfo <- plet $ pfromData ctx.txInfo
PTxInfo txInfo' <- pmatch txInfo Plutarch.Api.V1.PTxInfo txInfo' <- pmatch txInfo
txInfoF <- pletFields @'["inputs", "mint"] txInfo' txInfoF <- pletFields @'["inputs", "mint", "datums", "signatories"] txInfo'
PSpending ((pfield @"_0" #) -> txOutRef) <- pmatch $ pfromData ctx.purpose Plutarch.Api.V1.PSpending ((pfield @"_0" #) -> txOutRef) <- pmatch $ pfromData ctx.purpose
PJust txOut <- pmatch $ findTxOutByTxOutRef # txOutRef # txInfoF.inputs PJust txOut <- pmatch $ findTxOutByTxOutRef # txOutRef # txInfoF.inputs
txOutF <- pletFields @'["address", "value"] $ txOut txOutF <- pletFields @'["address", "value"] $ txOut
let proposalDatum :: Term _ PProposalDatum let proposalDatum :: Term _ Agora.Proposal.PProposalDatum
proposalDatum = pfromData $ punsafeCoerce datum proposalDatum = pfromData $ punsafeCoerce datum
proposalRedeemer :: Term _ PProposalRedeemer proposalRedeemer :: Term _ Agora.Proposal.PProposalRedeemer
proposalRedeemer = pfromData $ punsafeCoerce redeemer proposalRedeemer = pfromData $ punsafeCoerce redeemer
proposalF <- proposalF <-
@ -105,73 +105,53 @@ proposalValidator proposal =
ownAddress <- plet $ txOutF.address ownAddress <- plet $ txOutF.address
stCurrencySymbol <- plet $ pconstant $ mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal) stCurrencySymbol <- plet $ pconstant $ Plutarch.Api.V1.mintingPolicySymbol $ Plutarch.Api.V1.mkMintingPolicy (proposalPolicy proposal)
valueSpent <- plet $ pvalueSpent # txInfoF.inputs valueSpent <- plet $ pvalueSpent # txInfoF.inputs
spentST <- plet $ psymbolValueOf # stCurrencySymbol #$ valueSpent spentST <- plet $ psymbolValueOf # stCurrencySymbol #$ valueSpent
let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
stakeSTAssetClass <- plet $ passetClass # pconstant stakeSym # pconstant stakeTn stakeSTAssetClass <- plet $ passetClass # pconstant stakeSym # pconstant stakeTn
spentStakeST <- plet $ passetClassValueOf # valueSpent # stakeSTAssetClass spentStakeST <- plet $ passetClassValueOf # valueSpent # stakeSTAssetClass
signedBy <- plet $ ptxSignedBy # txInfoF.signatories
pmatch proposalRedeemer $ \case pmatch proposalRedeemer $ \case
PVote _r -> P.do Agora.Proposal.PVote _r -> P.do
passert "ST at inputs must be 1" $ passert "ST at inputs must be 1" $
spentST #== 1 spentST #== 1
popaque (pconstant ()) popaque (pconstant ())
-------------------------------------------------------------------------- --------------------------------------------------------------------------
PCosign r -> P.do Agora.Proposal.PCosign r -> P.do
newSigs <- plet $ pfield @"newCosigners" # r newSigs <- plet $ pfield @"newCosigners" # r
passert "ST at inputs must be 1" $ passert "ST at inputs must be 1" $
spentST #== 1 spentST #== 1
passert "Signed by all new cosigners" $ passert "Signed by all new cosigners" $
pall # plam (\sig -> ptxSignedBy # ctx.txInfo # sig) # newSigs pall # signedBy # newSigs
passert "As many new cosigners as Stake datums" $ passert "As many new cosigners as Stake datums" $
spentStakeST #== plength # newSigs spentStakeST #== plength # newSigs
let stakeDatumOwnedBy :: Term _ (PPubKeyHash :--> PStakeDatum :--> PBool)
stakeDatumOwnedBy =
phoistAcyclic $
plam $ \pk stakeDatum -> P.do
stakeDatumF <- pletFields @'["owner"] $ pto stakeDatum
stakeDatumF.owner #== pdata pk
-- Does the input have a `Stake` owned by a particular PK?
let isInputStakeOwnedBy :: Term _ (PAsData PPubKeyHash :--> PAsData PTxInInfo :--> PBool)
isInputStakeOwnedBy =
plam $ \ss txInInfo' -> P.do
PTxInInfo ((pfield @"resolved" #) -> txOut) <- pmatch $ pfromData txInInfo'
PTxOut txOut' <- pmatch txOut
txOutF <- pletFields @'["value", "datumHash"] txOut'
outStakeST <- plet $ passetClassValueOf # txOutF.value # stakeSTAssetClass
pmatch txOutF.datumHash $ \case
PDNothing _ -> pcon PFalse
PDJust ((pfield @"_0" #) -> datumHash) ->
pif
(outStakeST #== 1)
-- TODO: use 'ptryFindDatum' instead in the future
( pmatch (pfindDatum' # datumHash # txInfo) $ \case
PNothing -> pcon PFalse
PJust v -> stakeDatumOwnedBy # pfromData ss # pfromData v
)
(pcon PFalse)
passert "All new cosigners are witnessed by their Stake datums" $ passert "All new cosigners are witnessed by their Stake datums" $
pall pall
# plam (\sig -> pany # (isInputStakeOwnedBy # sig) # txInfoF.inputs) # plam
( \sig ->
pmatch (findStakeOwnedBy # stakeSTAssetClass # pfromData sig # txInfoF.datums # txInfoF.inputs) $ \case
PNothing -> pcon PFalse
PJust _ -> pcon PTrue
)
# newSigs # newSigs
passert "Signatures are correctly added to cosignature list" $ passert "Signatures are correctly added to cosignature list" $
anyOutput @PProposalDatum # ctx.txInfo anyOutput @Agora.Proposal.PProposalDatum # ctx.txInfo
#$ plam #$ plam
$ \newValue address newProposalDatum -> P.do $ \newValue address newProposalDatum -> P.do
let correctDatum = let correctDatum =
pdata newProposalDatum pdata newProposalDatum
#== pdata #== pdata
( mkRecordConstr ( mkRecordConstr
PProposalDatum Agora.Proposal.PProposalDatum
( #proposalId .= proposalF.proposalId ( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects .& #effects .= proposalF.effects
.& #status .= proposalF.status .& #status .= proposalF.status
@ -191,13 +171,13 @@ proposalValidator proposal =
popaque (pconstant ()) popaque (pconstant ())
-------------------------------------------------------------------------- --------------------------------------------------------------------------
PUnlock _r -> P.do Agora.Proposal.PUnlock _r -> P.do
passert "ST at inputs must be 1" $ passert "ST at inputs must be 1" $
spentST #== 1 spentST #== 1
popaque (pconstant ()) popaque (pconstant ())
-------------------------------------------------------------------------- --------------------------------------------------------------------------
PAdvanceProposal _r -> P.do Agora.Proposal.PAdvanceProposal _r -> P.do
passert "ST at inputs must be 1" $ passert "ST at inputs must be 1" $
spentST #== 1 spentST #== 1
@ -207,13 +187,13 @@ proposalValidator proposal =
This can be used to check both upopn creation and This can be used to check both upopn creation and
upon any following state transitions in the proposal. upon any following state transitions in the proposal.
-} -}
proposalDatumValid :: Term s (PProposalDatum :--> PBool) proposalDatumValid :: Term s (Agora.Proposal.PProposalDatum :--> PBool)
proposalDatumValid = proposalDatumValid =
phoistAcyclic $ phoistAcyclic $
plam $ \datum' -> P.do plam $ \datum' -> P.do
datum <- pletFields @'["effects", "cosigners"] $ datum' datum <- pletFields @'["effects", "cosigners"] $ datum'
let effects :: Term _ (PBuiltinMap PResultTag (PBuiltinMap PValidatorHash PDatumHash)) let effects :: Term _ (PBuiltinMap Agora.Proposal.PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash))
effects = punsafeCoerce datum.effects effects = punsafeCoerce datum.effects
atLeastOneNegativeResult :: Term _ PBool atLeastOneNegativeResult :: Term _ PBool
@ -224,4 +204,5 @@ proposalDatumValid =
(#&&) (#&&)
[ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult [ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult
, ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners , ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners
, ptraceIfFalse "Proposal has at most five cosigners" $ plength # (pfromData datum.cosigners) #< 6
] ]

View file

@ -18,6 +18,7 @@ module Agora.Stake (
stakePolicy, stakePolicy,
stakeValidator, stakeValidator,
stakeLocked, stakeLocked,
findStakeOwnedBy,
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -35,11 +36,17 @@ import PlutusTx qualified
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (PPubKeyCredential, PScriptCredential), PCredential (PPubKeyCredential, PScriptCredential),
PDatum,
PDatumHash,
PMaybeData (PDJust, PDNothing),
PMintingPolicy, PMintingPolicy,
PPubKeyHash, PPubKeyHash,
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTokenName, PTokenName,
PTuple,
PTxInInfo (PTxInInfo),
PTxInfo, PTxInfo,
PTxOut (PTxOut),
PValidator, PValidator,
mintingPolicySymbol, mintingPolicySymbol,
mkMintingPolicy, mkMintingPolicy,
@ -63,6 +70,7 @@ import Agora.Utils (
anyOutput, anyOutput,
paddValue, paddValue,
passert, passert,
pfindDatum,
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pgeqByClass, pgeqByClass,
pgeqByClass', pgeqByClass',
@ -74,7 +82,7 @@ import Agora.Utils (
ptxSignedBy, ptxSignedBy,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Api.V1.Extra (passetClass) import Plutarch.Api.V1.Extra (PAssetClass, passetClass, passetClassValueOf)
import Plutarch.Numeric import Plutarch.Numeric
import Plutarch.SafeMoney ( import Plutarch.SafeMoney (
PDiscrete, PDiscrete,
@ -278,7 +286,7 @@ stakePolicy gtClassRef =
txInfo <- plet $ ctx.txInfo txInfo <- plet $ ctx.txInfo
let _a :: Term _ PTxInfo let _a :: Term _ PTxInfo
_a = txInfo _a = txInfo
txInfoF <- pletFields @'["mint", "inputs", "outputs"] txInfo txInfoF <- pletFields @'["mint", "inputs", "outputs", "signatories"] txInfo
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
ownSymbol <- plet $ pfield @"_0" # ownSymbol' ownSymbol <- plet $ pfield @"_0" # ownSymbol'
@ -337,7 +345,7 @@ stakePolicy gtClassRef =
# stValue # stValue
let ownerSignsTransaction = let ownerSignsTransaction =
ptxSignedBy ptxSignedBy
# ctx.txInfo # txInfoF.signatories
# stakeDatum.owner # stakeDatum.owner
-- TODO: This is quite inefficient now, as it does two lookups -- TODO: This is quite inefficient now, as it does two lookups
@ -371,7 +379,7 @@ stakeValidator stake =
plam $ \datum redeemer ctx' -> P.do plam $ \datum redeemer ctx' -> P.do
ctx <- pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFields @'["txInfo", "purpose"] ctx'
txInfo <- plet $ pfromData ctx.txInfo txInfo <- plet $ pfromData ctx.txInfo
txInfoF <- pletFields @'["mint", "inputs", "outputs"] txInfo txInfoF <- pletFields @'["mint", "inputs", "outputs", "signatories"] txInfo
(pfromData -> stakeRedeemer, _) <- ptryFrom redeemer (pfromData -> stakeRedeemer, _) <- ptryFrom redeemer
@ -387,7 +395,7 @@ stakeValidator stake =
let continuingValue = pfield @"value" #$ pfield @"resolved" # txInInfo let continuingValue = pfield @"value" #$ pfield @"resolved" # txInInfo
-- Whether the owner signs this transaction or not. -- Whether the owner signs this transaction or not.
ownerSignsTransaction <- plet $ ptxSignedBy # ctx.txInfo # stakeDatum.owner ownerSignsTransaction <- plet $ ptxSignedBy # txInfoF.signatories # stakeDatum.owner
stCurrencySymbol <- plet $ pconstant $ mintingPolicySymbol $ mkMintingPolicy (stakePolicy stake.gtClassRef) stCurrencySymbol <- plet $ pconstant $ mintingPolicySymbol $ mkMintingPolicy (stakePolicy stake.gtClassRef)
mintedST <- plet $ psymbolValueOf # stCurrencySymbol # txInfoF.mint mintedST <- plet $ psymbolValueOf # stCurrencySymbol # txInfoF.mint
@ -514,3 +522,60 @@ stakeLocked = phoistAcyclic $
let locks :: Term _ (PBuiltinList (PAsData PProposalLock)) let locks :: Term _ (PBuiltinList (PAsData PProposalLock))
locks = pfield @"lockedBy" # stakeDatum locks = pfield @"lockedBy" # stakeDatum
in pnotNull # locks in pnotNull # locks
-- | Find a stake owned by a particular PK.
findStakeOwnedBy ::
Term
s
( PAssetClass
:--> PPubKeyHash
:--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
:--> PBuiltinList (PAsData PTxInInfo)
:--> PMaybe PTxOut
)
findStakeOwnedBy = phoistAcyclic $
plam $ \ac pk datums inputs ->
pmatch (pfind # (isInputStakeOwnedBy # ac # pk # datums) # inputs) $ \case
PNothing -> pcon PNothing
PJust (pfromData -> v) -> P.do
let txOut = pfield @"resolved" # pto v
txOutF <- pletFields @'["datumHash"] $ txOut
pmatch txOutF.datumHash $ \case
PDNothing _ -> pcon PNothing
PDJust ((pfield @"_0" #) -> dh) ->
-- TODO: PTryFrom here
punsafeCoerce $ pfindDatum # dh # datums
stakeDatumOwnedBy :: Term _ (PPubKeyHash :--> PStakeDatum :--> PBool)
stakeDatumOwnedBy =
phoistAcyclic $
plam $ \pk stakeDatum -> P.do
stakeDatumF <- pletFields @'["owner"] $ pto stakeDatum
stakeDatumF.owner #== pdata pk
-- Does the input have a `Stake` owned by a particular PK?
isInputStakeOwnedBy ::
Term
_
( PAssetClass :--> PPubKeyHash
:--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
:--> PAsData PTxInInfo
:--> PBool
)
isInputStakeOwnedBy =
plam $ \ac ss datums txInInfo' -> P.do
PTxInInfo ((pfield @"resolved" #) -> txOut) <- pmatch $ pfromData txInInfo'
PTxOut txOut' <- pmatch txOut
txOutF <- pletFields @'["value", "datumHash"] txOut'
outStakeST <- plet $ passetClassValueOf # txOutF.value # ac
pmatch txOutF.datumHash $ \case
PDNothing _ -> pcon PFalse
PDJust ((pfield @"_0" #) -> datumHash) ->
pif
(outStakeST #== 1)
-- TODO: use 'ptryFindDatum' instead in the future
( pmatch (pfindDatum # datumHash # datums) $ \case
PNothing -> pcon PFalse
PJust v -> stakeDatumOwnedBy # ss # pfromData (punsafeCoerce v)
)
(pcon PFalse)

View file

@ -56,7 +56,7 @@ import Plutarch.Api.V1 (
PTokenName, PTokenName,
PTuple, PTuple,
PTxInInfo (PTxInInfo), PTxInInfo (PTxInInfo),
PTxInfo (PTxInfo), PTxInfo,
PTxOut (PTxOut), PTxOut (PTxOut),
PTxOutRef, PTxOutRef,
PValidatorHash, PValidatorHash,
@ -78,35 +78,30 @@ passert :: Term s PString -> Term s PBool -> Term s k -> Term s k
passert errorMessage check k = pif check k (ptraceError errorMessage) passert errorMessage check k = pif check k (ptraceError errorMessage)
-- | Find a datum with the given hash. -- | Find a datum with the given hash.
pfindDatum :: Term s (PDatumHash :--> PTxInfo :--> PMaybe PDatum) pfindDatum :: Term s (PDatumHash :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PMaybe PDatum)
pfindDatum = phoistAcyclic $ pfindDatum = phoistAcyclic $
plam $ \datumHash txInfo'' -> P.do plam $ \datumHash datums -> plookupTuple # datumHash # datums
PTxInfo txInfo' <- pmatch txInfo''
plookupTuple # datumHash #$ pfield @"datums" # txInfo'
-- | Find a datum with the given hash, and `ptryFrom` it. -- | Find a datum with the given hash, and `ptryFrom` it.
ptryFindDatum :: PTryFrom PData a => Term s (PDatumHash :--> PTxInfo :--> PMaybe a) ptryFindDatum :: PTryFrom PData a => Term s (PDatumHash :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PMaybe a)
ptryFindDatum = phoistAcyclic $ ptryFindDatum = phoistAcyclic $
plam $ \datumHash txInfo'' -> P.do plam $ \datumHash inputs -> P.do
PTxInfo txInfo' <- pmatch txInfo'' pmatch (pfindDatum # datumHash # inputs) $ \case
pmatch (plookupTuple # datumHash #$ pfield @"datums" # txInfo') $ \case
PNothing -> pcon PNothing PNothing -> pcon PNothing
PJust datum -> P.do PJust datum -> P.do
(datum', _) <- ptryFrom $ pto datum (datum', _) <- ptryFrom (pto datum)
pcon (PJust datum') pcon (PJust datum')
{- | Find a datum with the given hash. {- | Find a datum with the given hash.
NOTE: this is unsafe in the sense that, if the data layout is wrong, this is UB. NOTE: this is unsafe in the sense that, if the data layout is wrong, this is UB.
-} -}
pfindDatum' :: PIsData a => Term s (PDatumHash :--> PTxInfo :--> PMaybe (PAsData a)) pfindDatum' :: PIsData a => Term s (PDatumHash :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PMaybe (PAsData a))
pfindDatum' = phoistAcyclic $ plam $ \dh x -> punsafeCoerce $ pfindDatum # dh # x pfindDatum' = phoistAcyclic $ plam $ \dh x -> punsafeCoerce $ pfindDatum # dh # x
-- | Check if a PubKeyHash signs this transaction. -- | Check if a PubKeyHash signs this transaction.
ptxSignedBy :: Term s (PTxInfo :--> PAsData PPubKeyHash :--> PBool) ptxSignedBy :: Term s (PBuiltinList (PAsData PPubKeyHash) :--> PAsData PPubKeyHash :--> PBool)
ptxSignedBy = phoistAcyclic $ ptxSignedBy = phoistAcyclic $
plam $ \txInfo' pkh -> P.do plam $ \sigs sig -> pelem # sig # sigs
txInfo <- pletFields @'["signatories"] txInfo'
pelem @PBuiltinList # pkh # txInfo.signatories
-- | Get the first element that matches a predicate or return Nothing. -- | Get the first element that matches a predicate or return Nothing.
pfind' :: pfind' ::
@ -334,14 +329,14 @@ anyOutput ::
Term s (PTxInfo :--> (PValue :--> PAddress :--> datum :--> PBool) :--> PBool) Term s (PTxInfo :--> (PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
anyOutput = phoistAcyclic $ anyOutput = phoistAcyclic $
plam $ \txInfo' predicate -> P.do plam $ \txInfo' predicate -> P.do
txInfo <- pletFields @'["outputs"] txInfo' txInfo <- pletFields @'["outputs", "datums"] txInfo'
pany pany
# plam # plam
( \txOut'' -> P.do ( \txOut'' -> P.do
PTxOut txOut' <- pmatch (pfromData txOut'') PTxOut txOut' <- pmatch (pfromData txOut'')
txOut <- pletFields @'["value", "datumHash", "address"] txOut' txOut <- pletFields @'["value", "datumHash", "address"] txOut'
PDJust dh <- pmatch txOut.datumHash PDJust dh <- pmatch txOut.datumHash
pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo.datums) $ \case
PJust datum -> P.do PJust datum -> P.do
predicate # txOut.value # txOut.address # pfromData datum predicate # txOut.value # txOut.address # pfromData datum
PNothing -> pcon PFalse PNothing -> pcon PFalse
@ -356,14 +351,14 @@ allOutputs ::
Term s (PTxInfo :--> (PTxOut :--> PValue :--> PAddress :--> datum :--> PBool) :--> PBool) Term s (PTxInfo :--> (PTxOut :--> PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
allOutputs = phoistAcyclic $ allOutputs = phoistAcyclic $
plam $ \txInfo' predicate -> P.do plam $ \txInfo' predicate -> P.do
txInfo <- pletFields @'["outputs"] txInfo' txInfo <- pletFields @'["outputs", "datums"] txInfo'
pall pall
# plam # plam
( \txOut'' -> P.do ( \txOut'' -> P.do
PTxOut txOut' <- pmatch (pfromData txOut'') PTxOut txOut' <- pmatch (pfromData txOut'')
txOut <- pletFields @'["value", "datumHash", "address"] txOut' txOut <- pletFields @'["value", "datumHash", "address"] txOut'
PDJust dh <- pmatch txOut.datumHash PDJust dh <- pmatch txOut.datumHash
pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo.datums) $ \case
PJust datum -> P.do PJust datum -> P.do
predicate # pfromData txOut'' # txOut.value # txOut.address # pfromData datum predicate # pfromData txOut'' # txOut.value # txOut.address # pfromData datum
PNothing -> pcon PFalse PNothing -> pcon PFalse
@ -378,7 +373,7 @@ anyInput ::
Term s (PTxInfo :--> (PValue :--> PAddress :--> datum :--> PBool) :--> PBool) Term s (PTxInfo :--> (PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
anyInput = phoistAcyclic $ anyInput = phoistAcyclic $
plam $ \txInfo' predicate -> P.do plam $ \txInfo' predicate -> P.do
txInfo <- pletFields @'["inputs"] txInfo' txInfo <- pletFields @'["inputs", "datums"] txInfo'
pany pany
# plam # plam
( \txInInfo'' -> P.do ( \txInInfo'' -> P.do
@ -387,7 +382,7 @@ anyInput = phoistAcyclic $
PTxOut txOut' <- pmatch (pfromData txOut'') PTxOut txOut' <- pmatch (pfromData txOut'')
txOut <- pletFields @'["value", "datumHash", "address"] txOut' txOut <- pletFields @'["value", "datumHash", "address"] txOut'
PDJust dh <- pmatch txOut.datumHash PDJust dh <- pmatch txOut.datumHash
pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo.datums) $ \case
PJust datum -> P.do PJust datum -> P.do
predicate # txOut.value # txOut.address # pfromData datum predicate # txOut.value # txOut.address # pfromData datum
PNothing -> pcon PFalse PNothing -> pcon PFalse
@ -420,23 +415,18 @@ scriptHashFromAddress = phoistAcyclic $
_ -> pcon PNothing _ -> pcon PNothing
-- | Find all TxOuts sent to an Address -- | Find all TxOuts sent to an Address
findOutputsToAddress :: Term s (PTxInfo :--> PAddress :--> PBuiltinList (PAsData PTxOut)) findOutputsToAddress :: Term s (PBuiltinList (PAsData PTxOut) :--> PAddress :--> PBuiltinList (PAsData PTxOut))
findOutputsToAddress = phoistAcyclic $ findOutputsToAddress = phoistAcyclic $
plam $ \info address' -> P.do plam $ \outputs address' -> P.do
address <- plet $ pdata address' address <- plet $ pdata address'
let outputs = pfromData $ pfield @"outputs" # info pfilter # plam (\(pfromData -> txOut) -> pfield @"address" # txOut #== address)
filteredOutputs = # outputs
pfilter
# plam
(\(pfromData -> txOut) -> pfield @"address" # txOut #== address)
# outputs
filteredOutputs
-- | Find the data corresponding to a TxOut, if there is one -- | Find the data corresponding to a TxOut, if there is one
findTxOutDatum :: Term s (PTxInfo :--> PTxOut :--> PMaybe PDatum) findTxOutDatum :: Term s (PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PTxOut :--> PMaybe PDatum)
findTxOutDatum = phoistAcyclic $ findTxOutDatum = phoistAcyclic $
plam $ \info out -> P.do plam $ \datums out -> P.do
datumHash' <- pmatch $ pfromData $ pfield @"datumHash" # out datumHash' <- pmatch $ pfromData $ pfield @"datumHash" # out
case datumHash' of case datumHash' of
PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # info PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # datums
_ -> pcon PNothing _ -> pcon PNothing