From aab8580ac2f7394e4b2d1dfe434e753f6336d8ee Mon Sep 17 00:00:00 2001 From: Daniel Farrelly Date: Wed, 29 Mar 2023 21:33:09 +0100 Subject: [PATCH] Apply governor mutation based on existing datum --- agora-specs/Sample/Effect/GovernorMutation.hs | 8 +-- agora-specs/Spec/Effect/GovernorMutation.hs | 22 ++++++- agora/Agora/Effect/GovernorMutation.hs | 62 ++++++++++++++----- 3 files changed, 71 insertions(+), 21 deletions(-) diff --git a/agora-specs/Sample/Effect/GovernorMutation.hs b/agora-specs/Sample/Effect/GovernorMutation.hs index c7520f3..8557c23 100644 --- a/agora-specs/Sample/Effect/GovernorMutation.hs +++ b/agora-specs/Sample/Effect/GovernorMutation.hs @@ -86,10 +86,10 @@ effectRef = 1 -- | The input effect datum in 'mkEffectTransaction'. -mkEffectDatum :: GovernorDatum -> MutateGovernorDatum -mkEffectDatum newGovDatum = +mkEffectDatum :: GovernorDatum -> GovernorDatum -> MutateGovernorDatum +mkEffectDatum oldGovDatum newGovDatum = MutateGovernorDatum - { governorRef = govRef + { oldDatum = oldGovDatum , newDatum = newGovDatum } @@ -131,7 +131,7 @@ mkEffectTxInfo newGovDatum = -- The effect should update 'nextProposalId' effectInputDatum' :: MutateGovernorDatum - effectInputDatum' = mkEffectDatum newGovDatum + effectInputDatum' = mkEffectDatum governorInputDatum' newGovDatum effectInputDatum :: Datum effectInputDatum = Datum $ toBuiltinData effectInputDatum' effectInput :: TxOut diff --git a/agora-specs/Spec/Effect/GovernorMutation.hs b/agora-specs/Spec/Effect/GovernorMutation.hs index 2190aed..7b0f271 100644 --- a/agora-specs/Spec/Effect/GovernorMutation.hs +++ b/agora-specs/Spec/Effect/GovernorMutation.hs @@ -47,7 +47,16 @@ specs = , effectSucceedsWith "effect validator should pass" effectValidator - (mkEffectDatum validNewGovernorDatum) + ( mkEffectDatum + ( GovernorDatum + def + (ProposalId 0) + def + def + 3 + ) + validNewGovernorDatum + ) (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef)) ] , group @@ -70,7 +79,16 @@ specs = , effectFailsWith "effect validator should fail" effectValidator - (mkEffectDatum validNewGovernorDatum) + ( mkEffectDatum + ( GovernorDatum + def + (ProposalId 0) + def + def + 3 + ) + validNewGovernorDatum + ) (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef)) ] ] diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 6f651df..01fdf3b 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -28,17 +28,19 @@ import Agora.Governor ( import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.Utils (ptaggedSymbolValueOf) import Generics.SOP qualified as SOP -import Plutarch.Api.V1 (PCurrencySymbol) +import Plutarch.Api.V1 (PCurrencySymbol, PTxOutRef) import Plutarch.Api.V2 ( PScriptHash, PScriptPurpose (PSpending), - PTxOutRef, + PTxInInfo, PValidator, ) import Plutarch.DataRepr ( PDataFields, ) +import Plutarch.Extra.AssetClass (PAssetClass, passetClass) import Plutarch.Extra.Field (pletAll, pletAllC) +import Plutarch.Extra.Functor (pfmap) import Plutarch.Extra.IsData ( DerivePConstantViaDataList (DerivePConstantViaDataList), PlutusTypeDataList, @@ -53,8 +55,8 @@ import Plutarch.Extra.ScriptContext ( ptryFromRedeemer, ) import Plutarch.Extra.Tagged (PTagged) +import Plutarch.Extra.Value (passetClassValueOf) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) -import PlutusLedgerApi.V1 (TxOutRef) import PlutusTx qualified import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton) 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 -} data MutateGovernorDatum = MutateGovernorDatum - { governorRef :: TxOutRef - -- ^ Referenced governor state UTXO should be updated by the effect. + { oldDatum :: GovernorDatum + -- ^ The governor datum hash on which this effect is valid , newDatum :: GovernorDatum -- ^ The new settings for the governor. } @@ -100,7 +102,7 @@ newtype PMutateGovernorDatum (s :: S) ( Term s ( PDataRecord - '[ "governorRef" ':= PTxOutRef + '[ "oldDatum" ':= PGovernorDatum , "newDatum" ':= PGovernorDatum ] ) @@ -198,7 +200,13 @@ mutateGovernorValidator = pany # plam ( flip pletAll $ \inputF -> - let isGovernorInput = + let governorInputDatum = + ptrace "Resolve governor input datum" $ + pfromData $ + ptryFromOutputDatum @(PAsData PGovernorDatum) + # (pfield @"datum" # inputF.resolved) + # txInfoF.datums + isGovernorInput = foldl1 (#&&) [ ptraceIfFalse "Governor UTxO should carry GST" $ @@ -207,7 +215,7 @@ mutateGovernorValidator = # (pfield @"value" # inputF.resolved) #== 1 , ptraceIfFalse "Can only modify the pinned governor" $ - inputF.outRef #== effectDatumF.governorRef + governorInputDatum #== effectDatumF.oldDatum , ptraceIfFalse "Governor validator run" $ let inputScriptHash = pfromJust @@ -220,13 +228,19 @@ mutateGovernorValidator = ) # scriptInputs - let governorRedeemer = - pfromData $ - passertPJust - # "Govenor redeemer should be resolved" - #$ ptryFromRedeemer @(PAsData PGovernorRedeemer) - # mkRecordConstr PSpending (#_0 .= effectDatumF.governorRef) - # txInfoF.redeemers + let + governorRef = + pfromJust + #$ findInputWithToken + # (passetClass # pfromData (pto gstSymbol) # pconstant "") + # txInfoF.inputs + governorRedeemer = + pfromData $ + passertPJust + # "Govenor redeemer should be resolved" + #$ ptryFromRedeemer @(PAsData PGovernorRedeemer) + # mkRecordConstr PSpending (#_0 .= pdata governorRef) + # txInfoF.redeemers pguardC "Spend governor with redeemer MutateGovernor" $ governorRedeemer #== pconstant MutateGovernor @@ -248,3 +262,21 @@ mutateGovernorValidator = governorOutputDatum #== effectDatumF.newDatum 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