Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Ignore proposal ID in governor mutation effect

Browse source
This commit is contained in:
Daniel Farrelly 2023-03-30 19:33:52 +01:00 • committed by Emily Martins
parent fd418181ff
commit 6677b05831
5 changed files with 121 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

20
agora-specs/Spec/Effect/GovernorMutation.hs
View file

@ -34,14 +34,14 @@ specs =
governorValidator governorValidator
( GovernorDatum ( GovernorDatum
def def
(ProposalId 0) nextProposalId
def def
def def
3 3
) )
MutateGovernor MutateGovernor
( ScriptContext ( ScriptContext
(mkEffectTxInfo validNewGovernorDatum) (mkEffectTxInfo validNewGovernorDatum')
(Spending govRef) (Spending govRef)
) )
, effectSucceedsWith , effectSucceedsWith
@ -50,14 +50,14 @@ specs =
( mkEffectDatum ( mkEffectDatum
( GovernorDatum ( GovernorDatum
def def
(ProposalId 0) nextProposalId
def def
def def
3 3
) )
validNewGovernorDatum validNewGovernorDatum
) )
(ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef)) (ScriptContext (mkEffectTxInfo validNewGovernorDatum') (Spending effectRef))
] ]
, group , group
"invalid new governor datum" "invalid new governor datum"
@ -66,7 +66,7 @@ specs =
governorValidator governorValidator
( GovernorDatum ( GovernorDatum
def def
(ProposalId 0) nextProposalId
def def
def def
3 3
@ -82,7 +82,7 @@ specs =
( mkEffectDatum ( mkEffectDatum
( GovernorDatum ( GovernorDatum
def def
(ProposalId 0) nextProposalId
def def
def def
3 3
@ -93,3 +93,11 @@ specs =
] ]
] ]
] ]
where
validNewGovernorDatum' :: GovernorDatum
validNewGovernorDatum' = validNewGovernorDatum {nextProposalId}
-- \^ The datum value pinned by the effect, disregarding the proposal ID and
-- taking this field from the governor input instead
nextProposalId :: ProposalId
nextProposalId = ProposalId 0

4
agora-test/goldens/agora-golden.json
View file

File diff suppressed because one or more lines are too long

4
agora-test/goldens/agoraDebug-golden.json
View file

File diff suppressed because one or more lines are too long

101
agora/Agora/Effect/GovernorMutation.hs
View file

@ -22,32 +22,30 @@ import Agora.Effect (makeEffect)
import Agora.Governor ( import Agora.Governor (
GovernorDatum, GovernorDatum,
GovernorRedeemer (MutateGovernor), GovernorRedeemer (MutateGovernor),
PGovernorDatum, PGovernorDatum (PGovernorDatum),
PGovernorRedeemer, PGovernorRedeemer,
) )
import Agora.Proposal (PProposalId)
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (ptaggedSymbolValueOf) import Agora.Utils (pfindInputWithStateThreadToken)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCurrencySymbol, PTxOutRef) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PScriptHash, PScriptHash,
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
PTxInInfo,
PValidator, PValidator,
) )
import Plutarch.DataRepr ( import Plutarch.DataRepr (
PDataFields, PDataFields,
) )
import Plutarch.Extra.AssetClass (PAssetClass, passetClass)
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import Plutarch.Extra.Functor (pfmap)
import Plutarch.Extra.IsData ( import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList), DerivePConstantViaDataList (DerivePConstantViaDataList),
PlutusTypeDataList, PlutusTypeDataList,
ProductIsData (ProductIsData), ProductIsData (ProductIsData),
) )
import Plutarch.Extra.Maybe (passertPJust, pfromJust) import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pisScriptAddress, pisScriptAddress,
pscriptHashFromAddress, pscriptHashFromAddress,
@ -55,7 +53,6 @@ import Plutarch.Extra.ScriptContext (
ptryFromRedeemer, ptryFromRedeemer,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Extra.Value (passetClassValueOf)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import PlutusTx qualified import PlutusTx qualified
import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton) import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton)
@ -196,26 +193,37 @@ mutateGovernorValidator =
pguardC "Only self and governor script inputs are allowed" $ pguardC "Only self and governor script inputs are allowed" $
plength # scriptInputs #== 2 plength # scriptInputs #== 2
pguardC "Governor input should present" $ let
pany governorInput =
# plam passertPJust
( flip pletAll $ \inputF -> # "Governor UTXO should carry GST"
let governorInputDatum = # ( pfindInputWithStateThreadToken
# pfromData gstSymbol
# txInfoF.inputs
)
governorRef = pfield @"outRef" # governorInput
governorInputDatum =
ptrace "Resolve governor input datum" $ ptrace "Resolve governor input datum" $
pfromData $ pfromData $
ptryFromOutputDatum @(PAsData PGovernorDatum) ptryFromOutputDatum @(PAsData PGovernorDatum)
# (pfield @"datum" # inputF.resolved) # (pfield @"datum" #$ pfield @"resolved" # governorInput)
# txInfoF.datums # txInfoF.datums
inputProposalId = pfield @"nextProposalId" # governorInputDatum
expectedInputDatum =
replaceProposalId # effectDatumF.oldDatum # inputProposalId
pguardC "Governor input should be valid" $
( pletAll governorInput $ \inputF ->
let
isGovernorInput = isGovernorInput =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Governor UTxO should carry GST" $ [ ptraceIfFalse "Can only modify the pinned governor datum" $
ptaggedSymbolValueOf governorInputDatum #== expectedInputDatum
# pfromData gstSymbol
# (pfield @"value" # inputF.resolved)
#== 1
, ptraceIfFalse "Can only modify the pinned governor" $
governorInputDatum #== effectDatumF.oldDatum
, ptraceIfFalse "Governor validator run" $ , ptraceIfFalse "Governor validator run" $
let inputScriptHash = let inputScriptHash =
pfromJust pfromJust
@ -224,22 +232,17 @@ mutateGovernorValidator =
# inputF.resolved # inputF.resolved
in inputScriptHash #== pfromData govValidatorHash in inputScriptHash #== pfromData govValidatorHash
] ]
in isGovernorInput in
isGovernorInput
) )
# scriptInputs
let let
governorRef =
pfromJust
#$ findInputWithToken
# (passetClass # pfromData (pto gstSymbol) # pconstant "")
# txInfoF.inputs
governorRedeemer = governorRedeemer =
pfromData $ pfromData $
passertPJust passertPJust
# "Govenor redeemer should be resolved" # "Govenor redeemer should be resolved"
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer) #$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
# mkRecordConstr PSpending (#_0 .= pdata governorRef) # mkRecordConstr PSpending (#_0 .= governorRef)
# txInfoF.redeemers # txInfoF.redeemers
pguardC "Spend governor with redeemer MutateGovernor" $ pguardC "Spend governor with redeemer MutateGovernor" $
@ -247,7 +250,8 @@ mutateGovernorValidator =
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
let governorOutput = let
governorOutput =
ptrace "Only governor output is allowed" $ ptrace "Only governor output is allowed" $
ptryFromSingleton # pfromData txInfoF.outputs ptryFromSingleton # pfromData txInfoF.outputs
@ -258,25 +262,32 @@ mutateGovernorValidator =
# (pfield @"datum" # governorOutput) # (pfield @"datum" # governorOutput)
# txInfoF.datums # txInfoF.datums
expectedOutputDatum =
replaceProposalId # effectDatumF.newDatum # inputProposalId
pguardC "New governor datum correct" $ pguardC "New governor datum correct" $
governorOutputDatum #== effectDatumF.newDatum governorOutputDatum #== expectedOutputDatum
return $ popaque $ pconstant () return $ popaque $ pconstant ()
where where
findInputWithToken :: replaceProposalId ::
ClosedTerm ClosedTerm
( PAssetClass ( PGovernorDatum
:--> PBuiltinList PTxInInfo :--> PAsData PProposalId
:--> PMaybe PTxOutRef :--> PGovernorDatum
) )
findInputWithToken = plam $ \tokenClass inputs -> replaceProposalId = plam $ \datum proposalId ->
pfmap pletAll datum $ \datumF ->
# pfield @"outRef" mkRecordConstr
#$ pfind PGovernorDatum
# ( plam $ \input -> ( #proposalThresholds
0 .= datumF.proposalThresholds
#< passetClassValueOf .& #nextProposalId
# tokenClass .= proposalId
# (pfield @"value" # (pfield @"resolved" # input)) .& #proposalTimings
.= datumF.proposalTimings
.& #createProposalTimeRangeMaxWidth
.= datumF.createProposalTimeRangeMaxWidth
.& #maximumCreatedProposalsPerStake
.= datumF.maximumCreatedProposalsPerStake
) )
# inputs

23
agora/Agora/Utils.hs
View file

@ -21,6 +21,7 @@ module Agora.Utils (
puncurryTuple, puncurryTuple,
psubtractSortedValue, psubtractSortedValue,
pisSubValueOf, pisSubValueOf,
pfindInputWithStateThreadToken,
) where ) where
import Plutarch.Api.V1 (AmountGuarantees (Positive), KeyGuarantees (Sorted)) import Plutarch.Api.V1 (AmountGuarantees (Positive), KeyGuarantees (Sorted))
@ -32,6 +33,7 @@ import Plutarch.Api.V2 (
PCurrencySymbol, PCurrencySymbol,
PMaybeData (PDNothing), PMaybeData (PDNothing),
PTuple, PTuple,
PTxInInfo,
PValue, PValue,
) )
import Plutarch.Builtin (pforgetData, pserialiseData) import Plutarch.Builtin (pforgetData, pserialiseData)
@ -198,3 +200,24 @@ pisSubValueOf = phoistAcyclic $ plam $ \vl vr ->
#$ psubtractSortedValue #$ psubtractSortedValue
# vl # vl
# vr # vr
{- | Find an input containing exactly one token with the given currency symbol
@since 1.0.0
-}
pfindInputWithStateThreadToken ::
forall tag.
ClosedTerm
( PTagged tag PCurrencySymbol
:--> PBuiltinList PTxInInfo
:--> PMaybe PTxInInfo
)
pfindInputWithStateThreadToken = plam $ \tokenSymbol inputs ->
pfind
# ( plam $ \input ->
ptaggedSymbolValueOf
# tokenSymbol
# (pfield @"value" # (pfield @"resolved" # input))
#== 1
)
# inputs