filter SST by assetclass in governor
This commit is contained in:
parent
5dca43f08d
commit
3059dbdb1c
3 changed files with 18 additions and 52 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue