Merge pull request #238 from Liqwid-Labs/df/governor-mutation-fix

Apply governor mutation based on existing datum value

CHANGELOG.md

@@ -181,6 +181,11 @@ the stake validator easily. The behaviour of the default stake validator remains
 
   Included by [#156](https://github.com/Liqwid-Labs/agora/pull/156).
 
+- Expected input datum value is pinned instead of out ref for governor mutation
+  effect.
+  
+  Included by [#238](https://github.com/Liqwid-Labs/agora/pull/238).
+
 ## 0.2.0 -- 2022-08-13
 
 ### Added

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

agora-specs/Spec/Effect/GovernorMutation.hs

@@ -34,21 +34,30 @@ specs =
               governorValidator
               ( GovernorDatum
                   def
-                  (ProposalId 0)
+                  nextProposalId
                   def
                   def
                   3
               )
               MutateGovernor
               ( ScriptContext
-                  (mkEffectTxInfo validNewGovernorDatum)
+                  (mkEffectTxInfo validNewGovernorDatum')
                   (Spending govRef)
               )
           , effectSucceedsWith
               "effect validator should pass"
               effectValidator
-              (mkEffectDatum validNewGovernorDatum)
-              (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
+              ( mkEffectDatum
+                  ( GovernorDatum
+                      def
+                      nextProposalId
+                      def
+                      def
+                      3
+                  )
+                  validNewGovernorDatum
+              )
+              (ScriptContext (mkEffectTxInfo validNewGovernorDatum') (Spending effectRef))
           ]
       , group
           "invalid new governor datum"
@@ -57,7 +66,7 @@ specs =
               governorValidator
               ( GovernorDatum
                   def
-                  (ProposalId 0)
+                  nextProposalId
                   def
                   def
                   3
@@ -70,8 +79,25 @@ specs =
           , effectFailsWith
               "effect validator should fail"
               effectValidator
-              (mkEffectDatum validNewGovernorDatum)
+              ( mkEffectDatum
+                  ( GovernorDatum
+                      def
+                      nextProposalId
+                      def
+                      def
+                      3
+                  )
+                  validNewGovernorDatum
+              )
               (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
           ]
       ]
   ]
+  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

agora/Agora/Effect/GovernorMutation.hs

@@ -22,17 +22,17 @@ import Agora.Effect (makeEffect)
 import Agora.Governor (
   GovernorDatum,
   GovernorRedeemer (MutateGovernor),
-  PGovernorDatum,
+  PGovernorDatum (PGovernorDatum),
   PGovernorRedeemer,
  )
+import Agora.Proposal (PProposalId)
 import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
-import Agora.Utils (ptaggedSymbolValueOf)
+import Agora.Utils (pfindInputWithStateThreadToken, pfindOutputWithStateThreadToken)
 import Generics.SOP qualified as SOP
 import Plutarch.Api.V1 (PCurrencySymbol)
 import Plutarch.Api.V2 (
   PScriptHash,
   PScriptPurpose (PSpending),
-  PTxOutRef,
   PValidator,
  )
 import Plutarch.DataRepr (
@@ -45,7 +45,7 @@ import Plutarch.Extra.IsData (
   ProductIsData (ProductIsData),
  )
 import Plutarch.Extra.Maybe (passertPJust, pfromJust)
-import Plutarch.Extra.Record (mkRecordConstr, (.=))
+import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
   pisScriptAddress,
   pscriptHashFromAddress,
@@ -54,9 +54,8 @@ import Plutarch.Extra.ScriptContext (
  )
 import Plutarch.Extra.Tagged (PTagged)
 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 +65,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 value on which this effect is valid
   , newDatum :: GovernorDatum
   -- ^ The new settings for the governor.
   }
@@ -100,7 +99,7 @@ newtype PMutateGovernorDatum (s :: S)
       ( Term
           s
           ( PDataRecord
-              '[ "governorRef" ':= PTxOutRef
+              '[ "oldDatum" ':= PGovernorDatum
                , "newDatum" ':= PGovernorDatum
                ]
           )
@@ -194,57 +193,104 @@ mutateGovernorValidator =
       pguardC "Only self and governor script inputs are allowed" $
         plength # scriptInputs #== 2
 
-      pguardC "Governor input should present" $
-        pany
-          # plam
-            ( flip pletAll $ \inputF ->
-                let isGovernorInput =
-                      foldl1
-                        (#&&)
-                        [ ptraceIfFalse "Governor UTxO should carry GST" $
-                            ptaggedSymbolValueOf
-                              # pfromData gstSymbol
-                              # (pfield @"value" # inputF.resolved)
-                              #== 1
-                        , ptraceIfFalse "Can only modify the pinned governor" $
-                            inputF.outRef #== effectDatumF.governorRef
-                        , ptraceIfFalse "Governor validator run" $
-                            let inputScriptHash =
-                                  pfromJust
-                                    #$ pscriptHashFromAddress
-                                    #$ pfield @"address"
-                                    # inputF.resolved
-                             in inputScriptHash #== pfromData govValidatorHash
-                        ]
-                 in isGovernorInput
-            )
-          # scriptInputs
+      let
+        governorInput =
+          passertPJust
+            # "Governor UTXO should carry GST"
+            # ( pfindInputWithStateThreadToken
+                  # pfromData gstSymbol
+                  # scriptInputs
+              )
 
-      let governorRedeemer =
+        governorRef = pfield @"outRef" # governorInput
+
+        governorInputDatum =
+          ptrace "Resolve governor input datum" $
             pfromData $
-              passertPJust
-                # "Govenor redeemer should be resolved"
-                #$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
-                # mkRecordConstr PSpending (#_0 .= effectDatumF.governorRef)
-                # txInfoF.redeemers
+              ptryFromOutputDatum @(PAsData PGovernorDatum)
+                # (pfield @"datum" #$ pfield @"resolved" # governorInput)
+                # txInfoF.datums
+
+        inputProposalId = pfield @"nextProposalId" # governorInputDatum
+
+        expectedInputDatum =
+          replaceProposalId # effectDatumF.oldDatum # inputProposalId
+
+      pguardC "Governor input should be valid" $
+        ( pletAll governorInput $ \inputF ->
+            let
+              isGovernorInput =
+                foldl1
+                  (#&&)
+                  [ ptraceIfFalse "Can only modify the pinned governor datum" $
+                      governorInputDatum #== expectedInputDatum
+                  , ptraceIfFalse "Governor validator run" $
+                      let inputScriptHash =
+                            pfromJust
+                              #$ pscriptHashFromAddress
+                              #$ pfield @"address"
+                              # inputF.resolved
+                       in inputScriptHash #== pfromData govValidatorHash
+                  ]
+             in
+              isGovernorInput
+        )
+
+      let
+        governorRedeemer =
+          pfromData $
+            passertPJust
+              # "Governor redeemer should be resolved"
+              #$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
+              # mkRecordConstr PSpending (#_0 .= governorRef)
+              # txInfoF.redeemers
 
       pguardC "Spend governor with redeemer MutateGovernor" $
         governorRedeemer #== pconstant MutateGovernor
 
       ----------------------------------------------------------------------------
 
-      let governorOutput =
-            ptrace "Only governor output is allowed" $
-              ptryFromSingleton # pfromData txInfoF.outputs
+      let
+        governorOutput =
+          passertPJust
+            # "No governor output found"
+            #$ pfindOutputWithStateThreadToken
+            # pfromData gstSymbol
+            # pfromData txInfoF.outputs
 
-          governorOutputDatum =
-            ptrace "Resolve governor outoput datum" $
-              pfromData $
-                ptryFromOutputDatum @(PAsData PGovernorDatum)
-                  # (pfield @"datum" # governorOutput)
-                  # txInfoF.datums
+        governorOutputDatum =
+          ptrace "Resolve governor outoput datum" $
+            pfromData $
+              ptryFromOutputDatum @(PAsData PGovernorDatum)
+                # (pfield @"datum" # governorOutput)
+                # txInfoF.datums
+
+        expectedOutputDatum =
+          replaceProposalId # effectDatumF.newDatum # inputProposalId
 
       pguardC "New governor datum correct" $
-        governorOutputDatum #== effectDatumF.newDatum
+        governorOutputDatum #== expectedOutputDatum
 
       return $ popaque $ pconstant ()
+  where
+    replaceProposalId ::
+      ClosedTerm
+        ( PGovernorDatum
+            :--> PAsData PProposalId
+            :--> PGovernorDatum
+        )
+    replaceProposalId = plam $ \datum proposalId ->
+      pletAll datum $ \datumF ->
+        mkRecordConstr
+          PGovernorDatum
+          ( #proposalThresholds
+              .= datumF.proposalThresholds
+              .& #nextProposalId
+              .= proposalId
+              .& #proposalTimings
+              .= datumF.proposalTimings
+              .& #createProposalTimeRangeMaxWidth
+              .= datumF.createProposalTimeRangeMaxWidth
+              .& #maximumCreatedProposalsPerStake
+              .= datumF.maximumCreatedProposalsPerStake
+          )

agora/Agora/Utils.hs

@@ -20,6 +20,8 @@ module Agora.Utils (
   phashDatum,
   puncurryTuple,
   psubtractSortedValue,
+  pfindInputWithStateThreadToken,
+  pfindOutputWithStateThreadToken,
   pisSubValueOf,
 ) where
 
@@ -32,6 +34,8 @@ import Plutarch.Api.V2 (
   PCurrencySymbol,
   PMaybeData (PDNothing),
   PTuple,
+  PTxInInfo,
+  PTxOut,
   PValue,
  )
 import Plutarch.Builtin (pforgetData, pserialiseData)
@@ -176,6 +180,49 @@ psubtractSortedValue = phoistAcyclic $ plam $ \a b ->
       # (pfmap # pnegate)
       # pto b
 
+{- | 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
+
+{- | Find an output containing exactly one token with the given currency symbol,
+
+     @since 1.0.0
+-}
+pfindOutputWithStateThreadToken ::
+  forall tag.
+  ClosedTerm
+    ( PTagged tag PCurrencySymbol
+        :--> PBuiltinList PTxOut
+        :--> PMaybe PTxOut
+    )
+pfindOutputWithStateThreadToken = plam $ \tokenSymbol outputs ->
+  pfind
+    # ( plam $ \output ->
+          ( ptaggedSymbolValueOf
+              # tokenSymbol
+              # (pfield @"value" # output)
+              #== 1
+          )
+      )
+    # outputs
+
 pisNonNegativeValue ::
   forall (kg :: KeyGuarantees) (am :: AmountGuarantees) (s :: S).
   Term s (PValue kg am :--> PBool)