diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 1a88bca..1c09ae1 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -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 diff --git a/agora/Agora/Linker.hs b/agora/Agora/Linker.hs index 492cd49..1db1a43 100644 --- a/agora/Agora/Linker.hs +++ b/agora/Agora/Linker.hs @@ -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 diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 856295a..2eacd55 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -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