filter SST by assetclass in governor

This commit is contained in:
Hongrui Fang 2022-10-28 22:20:43 +08:00
parent 5dca43f08d
commit 3059dbdb1c
No known key found for this signature in database
GPG key ID: F10AB2CCE24113DD
3 changed files with 18 additions and 52 deletions

View file

@ -37,8 +37,8 @@ import Agora.Proposal (
)
import Agora.Proposal.Time (validateProposalStartingTime)
import Agora.Stake (
PStakeDatum (..),
pnumCreatedProposals,
presolveStakeInputDatum,
)
import Agora.Utils (
plistEqualsBy,
@ -55,7 +55,7 @@ import Plutarch.Api.V2 (
PTxOutRef,
PValidator,
)
import Plutarch.Extra.AssetClass (passetClass)
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass, ptoScottEncoding)
import Plutarch.Extra.Field (pletAll, pletAllC)
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, pmapMaybe)
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
@ -264,14 +264,14 @@ governorValidator ::
-- | Lazy precompiled scripts.
ClosedTerm
( PAddress
:--> PCurrencySymbol
:--> PAssetClassData
:--> PCurrencySymbol
:--> PCurrencySymbol
:--> PCurrencySymbol
:--> PValidator
)
governorValidator =
plam $ \proposalValidatorAddress sstSymbol gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
plam $ \proposalValidatorAddress sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
ctxF <- pletAllC ctx
txInfo <- pletC $ pfromData ctxF.txInfo
txInfoF <-
@ -335,24 +335,6 @@ governorValidator =
----------------------------------------------------------------------------
getStakeDatum :: Term _ (PTxOut :--> PMaybe PStakeDatum) <-
pletC $
plam $
flip (pletFields @'["value", "datum"]) $ \txOutF ->
let isStakeUTxO =
psymbolValueOf
# sstSymbol
# txOutF.value
#== 1
datum =
ptrace "Resolve stake input datum" $
pfromData $
pfromOutputDatum
# txOutF.datum
# txInfoF.datums
in pif isStakeUTxO (pjust # datum) pnothing
getProposalDatum :: Term _ (PTxOut :--> PMaybe PProposalDatum) <-
pletC $
plam $
@ -424,7 +406,10 @@ governorValidator =
passertPJust
# "Stake input should present"
#$ pfindJust
# plam ((getStakeDatum #) . (pfield @"resolved" #))
# ( presolveStakeInputDatum
# (ptoScottEncoding # sstClass)
# txInfoF.datums
)
# pfromData txInfoF.inputs
stakeInputDatumF <- pletAllC stakeInputDatum

View file

@ -46,7 +46,7 @@ data AgoraScriptInfo = AgoraScriptInfo
linker :: Linker Governor (ScriptExport AgoraScriptInfo)
linker = do
govPol <- fetchTS @MintingPolicyRole @'[TxOutRef] "agora:governorPolicy"
govVal <- fetchTS @ValidatorRole @'[Address, CurrencySymbol, CurrencySymbol, CurrencySymbol, CurrencySymbol] "agora:governorValidator"
govVal <- fetchTS @ValidatorRole @'[Address, AssetClass, CurrencySymbol, CurrencySymbol, CurrencySymbol] "agora:governorValidator"
stkPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:stakePolicy"
stkVal <- fetchTS @ValidatorRole @'[CurrencySymbol, AssetClass, AssetClass] "agora:stakeValidator"
prpPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:proposalPolicy"
@ -63,7 +63,7 @@ linker = do
govVal' =
govVal
# propValAddress
# sstSymbol
# sstAssetClass
# gstSymbol
# pstSymbol
# atSymbol

View file

@ -32,6 +32,7 @@ import Agora.Stake (
pgetStakeRoles,
pisIrrelevant,
pisVoter,
presolveStakeInputDatum,
)
import Agora.Utils (
pfromSingleton,
@ -47,7 +48,6 @@ import Plutarch.Api.V2 (
PScriptPurpose (PMinting, PSpending),
PTxInInfo,
PTxInfo (PTxInfo),
PTxOut,
PValidator,
)
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass, ptoScottEncoding)
@ -68,7 +68,6 @@ import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef,
pfromOutputDatum,
pisTokenSpent,
ptryFromOutputDatum,
)
import Plutarch.Extra.Sum (PSum (PSum))
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
@ -309,35 +308,17 @@ proposalValidator =
-- Handle stake inputs/outputs.
-- Reslove stake datum if the given UTxO is a stake UTxO.
getStakeDatum :: Term _ (PTxOut :--> PMaybe PStakeDatum) <-
resolveStakeInputDatum <-
pletC $
plam $
flip (pletFields @'["value", "datum"]) $ \txOutF ->
let isStakeUTxO =
-- A stake UTxO is a UTxO that carries SST.
passetClassValueOf
# (ptoScottEncoding # sstClass)
# txOutF.value
#== 1
stake =
pfromData $
-- If we can't resolve the stake datum, error out.
passertPJust
# "Stake datum should present"
-- Use inline datum to avoid extra map lookup.
#$ ptryFromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum
# txInfoF.datums
in pif isStakeUTxO (pjust # stake) pnothing
presolveStakeInputDatum
# (ptoScottEncoding # sstClass)
# txInfoF.datums
spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <-
pletC $
plam $
let stakeInputs =
pmapMaybe
# plam ((getStakeDatum #) . (pfield @"resolved" #))
# resolveStakeInputDatum
# pfromData txInfoF.inputs
ctx = pcon $ PStakeInputsContext stakeInputs
@ -380,8 +361,8 @@ proposalValidator =
}
f :: Term _ (_ :--> PTxInInfo :--> _)
f = plam $ \ctx' ((pfield @"resolved" #) -> txOut) ->
let stakeDatum = getStakeDatum # txOut
f = plam $ \ctx' input ->
let stakeDatum = resolveStakeInputDatum # input
updateCtx' = updateCtx # ctx'
in pmaybe # ctx' # updateCtx' # stakeDatum