Apply governor mutation based on existing datum

This commit is contained in:
Daniel Farrelly 2023-03-29 21:33:09 +01:00 committed by Emily Martins
parent 9e18c294f8
commit ad80e9f685
3 changed files with 71 additions and 21 deletions

View file

@ -86,10 +86,10 @@ effectRef =
1 1
-- | The input effect datum in 'mkEffectTransaction'. -- | The input effect datum in 'mkEffectTransaction'.
mkEffectDatum :: GovernorDatum -> MutateGovernorDatum mkEffectDatum :: GovernorDatum -> GovernorDatum -> MutateGovernorDatum
mkEffectDatum newGovDatum = mkEffectDatum oldGovDatum newGovDatum =
MutateGovernorDatum MutateGovernorDatum
{ governorRef = govRef { oldDatum = oldGovDatum
, newDatum = newGovDatum , newDatum = newGovDatum
} }
@ -131,7 +131,7 @@ mkEffectTxInfo newGovDatum =
-- The effect should update 'nextProposalId' -- The effect should update 'nextProposalId'
effectInputDatum' :: MutateGovernorDatum effectInputDatum' :: MutateGovernorDatum
effectInputDatum' = mkEffectDatum newGovDatum effectInputDatum' = mkEffectDatum governorInputDatum' newGovDatum
effectInputDatum :: Datum effectInputDatum :: Datum
effectInputDatum = Datum $ toBuiltinData effectInputDatum' effectInputDatum = Datum $ toBuiltinData effectInputDatum'
effectInput :: TxOut effectInput :: TxOut

View file

@ -47,7 +47,16 @@ specs =
, effectSucceedsWith , effectSucceedsWith
"effect validator should pass" "effect validator should pass"
effectValidator effectValidator
(mkEffectDatum validNewGovernorDatum) ( mkEffectDatum
( GovernorDatum
def
(ProposalId 0)
def
def
3
)
validNewGovernorDatum
)
(ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef)) (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
] ]
, group , group
@ -70,7 +79,16 @@ specs =
, effectFailsWith , effectFailsWith
"effect validator should fail" "effect validator should fail"
effectValidator effectValidator
(mkEffectDatum validNewGovernorDatum) ( mkEffectDatum
( GovernorDatum
def
(ProposalId 0)
def
def
3
)
validNewGovernorDatum
)
(ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef)) (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
] ]
] ]

View file

@ -28,17 +28,19 @@ import Agora.Governor (
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (ptaggedSymbolValueOf) import Agora.Utils (ptaggedSymbolValueOf)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V1 (PCurrencySymbol, PTxOutRef)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PScriptHash, PScriptHash,
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
PTxOutRef, 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,
@ -53,8 +55,8 @@ 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 PlutusLedgerApi.V1 (TxOutRef)
import PlutusTx qualified import PlutusTx qualified
import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton) import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
@ -66,8 +68,8 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFiel
@since 0.1.0 @since 0.1.0
-} -}
data MutateGovernorDatum = MutateGovernorDatum data MutateGovernorDatum = MutateGovernorDatum
{ governorRef :: TxOutRef { oldDatum :: GovernorDatum
-- ^ Referenced governor state UTXO should be updated by the effect. -- ^ The governor datum hash on which this effect is valid
, newDatum :: GovernorDatum , newDatum :: GovernorDatum
-- ^ The new settings for the governor. -- ^ The new settings for the governor.
} }
@ -100,7 +102,7 @@ newtype PMutateGovernorDatum (s :: S)
( Term ( Term
s s
( PDataRecord ( PDataRecord
'[ "governorRef" ':= PTxOutRef '[ "oldDatum" ':= PGovernorDatum
, "newDatum" ':= PGovernorDatum , "newDatum" ':= PGovernorDatum
] ]
) )
@ -198,7 +200,13 @@ mutateGovernorValidator =
pany pany
# plam # plam
( flip pletAll $ \inputF -> ( flip pletAll $ \inputF ->
let isGovernorInput = let governorInputDatum =
ptrace "Resolve governor input datum" $
pfromData $
ptryFromOutputDatum @(PAsData PGovernorDatum)
# (pfield @"datum" # inputF.resolved)
# txInfoF.datums
isGovernorInput =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Governor UTxO should carry GST" $ [ ptraceIfFalse "Governor UTxO should carry GST" $
@ -207,7 +215,7 @@ mutateGovernorValidator =
# (pfield @"value" # inputF.resolved) # (pfield @"value" # inputF.resolved)
#== 1 #== 1
, ptraceIfFalse "Can only modify the pinned governor" $ , ptraceIfFalse "Can only modify the pinned governor" $
inputF.outRef #== effectDatumF.governorRef governorInputDatum #== effectDatumF.oldDatum
, ptraceIfFalse "Governor validator run" $ , ptraceIfFalse "Governor validator run" $
let inputScriptHash = let inputScriptHash =
pfromJust pfromJust
@ -220,13 +228,19 @@ mutateGovernorValidator =
) )
# scriptInputs # scriptInputs
let governorRedeemer = let
pfromData $ governorRef =
passertPJust pfromJust
# "Govenor redeemer should be resolved" #$ findInputWithToken
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer) # (passetClass # pfromData (pto gstSymbol) # pconstant "")
# mkRecordConstr PSpending (#_0 .= effectDatumF.governorRef) # txInfoF.inputs
# txInfoF.redeemers governorRedeemer =
pfromData $
passertPJust
# "Govenor redeemer should be resolved"
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
# mkRecordConstr PSpending (#_0 .= pdata governorRef)
# txInfoF.redeemers
pguardC "Spend governor with redeemer MutateGovernor" $ pguardC "Spend governor with redeemer MutateGovernor" $
governorRedeemer #== pconstant MutateGovernor governorRedeemer #== pconstant MutateGovernor
@ -248,3 +262,21 @@ mutateGovernorValidator =
governorOutputDatum #== effectDatumF.newDatum governorOutputDatum #== effectDatumF.newDatum
return $ popaque $ pconstant () return $ popaque $ pconstant ()
where
findInputWithToken ::
ClosedTerm
( PAssetClass
:--> PBuiltinList PTxInInfo
:--> PMaybe PTxOutRef
)
findInputWithToken = plam $ \tokenClass inputs ->
pfmap
# pfield @"outRef"
#$ pfind
# ( plam $ \input ->
0
#< passetClassValueOf
# tokenClass
# (pfield @"value" # (pfield @"resolved" # input))
)
# inputs