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

149
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,50 +193,56 @@ 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
ptrace "Resolve governor input datum" $ # pfromData gstSymbol
pfromData $ # txInfoF.inputs
ptryFromOutputDatum @(PAsData PGovernorDatum) )
# (pfield @"datum" # inputF.resolved)
# txInfoF.datums governorRef = pfield @"outRef" # governorInput
isGovernorInput =
foldl1 governorInputDatum =
(#&&) ptrace "Resolve governor input datum" $
[ ptraceIfFalse "Governor UTxO should carry GST" $ pfromData $
ptaggedSymbolValueOf ptryFromOutputDatum @(PAsData PGovernorDatum)
# pfromData gstSymbol # (pfield @"datum" #$ pfield @"resolved" # governorInput)
# (pfield @"value" # inputF.resolved) # txInfoF.datums
#== 1
, ptraceIfFalse "Can only modify the pinned governor" $ inputProposalId = pfield @"nextProposalId" # governorInputDatum
governorInputDatum #== effectDatumF.oldDatum
, ptraceIfFalse "Governor validator run" $ expectedInputDatum =
let inputScriptHash = replaceProposalId # effectDatumF.oldDatum # inputProposalId
pfromJust
#$ pscriptHashFromAddress pguardC "Governor input should be valid" $
#$ pfield @"address" ( pletAll governorInput $ \inputF ->
# inputF.resolved let
in inputScriptHash #== pfromData govValidatorHash isGovernorInput =
] foldl1
in isGovernorInput (#&&)
) [ ptraceIfFalse "Can only modify the pinned governor datum" $
# scriptInputs governorInputDatum #== expectedInputDatum
, ptraceIfFalse "Governor validator run" $
let inputScriptHash =
pfromJust
#$ pscriptHashFromAddress
#$ pfield @"address"
# inputF.resolved
in inputScriptHash #== pfromData govValidatorHash
]
in
isGovernorInput
)
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,36 +250,44 @@ mutateGovernorValidator =
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
let governorOutput = let
ptrace "Only governor output is allowed" $ governorOutput =
ptryFromSingleton # pfromData txInfoF.outputs ptrace "Only governor output is allowed" $
ptryFromSingleton # pfromData txInfoF.outputs
governorOutputDatum = governorOutputDatum =
ptrace "Resolve governor outoput datum" $ ptrace "Resolve governor outoput datum" $
pfromData $ pfromData $
ptryFromOutputDatum @(PAsData PGovernorDatum) ptryFromOutputDatum @(PAsData PGovernorDatum)
# (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