add tests for governor mutation

agora-specs/Sample/Governor/Mutate.hs

@@ -0,0 +1,264 @@
+module Sample.Governor.Mutate (
+  -- * Testing Utilities
+  GovernorOutputDatumValidity (..),
+  GATValidity (..),
+  GovernorParameters (..),
+  MockEffectParameters (..),
+  ParameterBundle (..),
+
+  -- * Testing Utilities
+  Validity (..),
+  mutate,
+  mkTestCase,
+
+  -- * Parameters Bundles
+  totallyValidBundle,
+  invalidBundles,
+) where
+
+import Agora.Effect.NoOp (noOpValidator)
+import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
+import Agora.Governor.Scripts (governorValidator)
+import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..))
+import Agora.Utils (validatorHashToTokenName)
+import Data.Default (def)
+import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash)
+import Plutarch.Context (
+  BaseBuilder,
+  buildTxInfoUnsafe,
+  input,
+  mint,
+  output,
+  pubKey,
+  script,
+  withDatum,
+  withOutRef,
+  withValue,
+ )
+import PlutusLedgerApi.V1 (
+  Data,
+  ScriptContext (ScriptContext),
+  ScriptPurpose (Spending),
+  TxInfo,
+  TxOutRef (TxOutRef),
+  ValidatorHash,
+  Value,
+  toData,
+ )
+import PlutusLedgerApi.V1.Value qualified as Value
+import Sample.Shared (
+  authorityTokenSymbol,
+  govAssetClass,
+  govValidatorHash,
+  governor,
+  minAda,
+ )
+import Test.Specification (SpecificationTree, testValidator)
+import Test.Util (pubKeyHashes, sortValue, validatorHashes, withOptional)
+
+--------------------------------------------------------------------------------
+
+data GovernorOutputDatumValidity
+  = DatumValid
+  | ValueInvalid
+  | WrongType
+  | NoDatum
+  deriving stock (Bounded, Enum)
+
+data GATValidity
+  = GATValid
+  | WrongTag
+  | NoGAT
+  deriving stock (Bounded, Enum)
+
+data GovernorParameters = GovernorParameters
+  { governorOutputDatumValidity :: GovernorOutputDatumValidity
+  , stealGST :: Bool
+  }
+
+data MockEffectParameters = MockEffectParameters
+  { gatValidity :: GATValidity
+  , burnGAT :: Bool
+  }
+
+data ParameterBundle = ParameterBundle
+  { governorParameters :: GovernorParameters
+  , mockEffectParameters :: MockEffectParameters
+  }
+
+newtype Validity = Validity {forGovernorValidator :: Bool}
+
+--------------------------------------------------------------------------------
+
+governorInputDatum :: GovernorDatum
+governorInputDatum =
+  GovernorDatum
+    { proposalThresholds = def
+    , nextProposalId = ProposalId 0
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
+    , maximumProposalsPerStake = 3
+    }
+
+mkGovernorOutputDatum ::
+  GovernorOutputDatumValidity ->
+  Maybe Data
+mkGovernorOutputDatum DatumValid =
+  Just $
+    toData $
+      governorInputDatum
+        { maximumProposalsPerStake = 4
+        }
+mkGovernorOutputDatum ValueInvalid =
+  let invalidProposalThresholds =
+        ProposalThresholds
+          { execute = -1
+          , create = -1
+          , vote = -1
+          }
+   in Just $
+        toData $
+          governorInputDatum
+            { proposalThresholds =
+                invalidProposalThresholds
+            }
+mkGovernorOutputDatum WrongType = Just $ toData ()
+mkGovernorOutputDatum NoDatum = Nothing
+
+governorRef :: TxOutRef
+governorRef =
+  TxOutRef
+    "6cce6dfbb697f9e2c4fe9786bb576eb7bd6cbcf7801a4ba13d596006c2d5b957"
+    1
+
+governorScriptPurpose :: ScriptPurpose
+governorScriptPurpose = Spending governorRef
+
+governorRedeemer :: GovernorRedeemer
+governorRedeemer = MutateGovernor
+
+mkGovernorBuilder :: GovernorParameters -> BaseBuilder
+mkGovernorBuilder ps =
+  let gst = Value.assetClassValue govAssetClass 1
+      value = sortValue $ gst <> minAda
+      gstOutput =
+        if ps.stealGST
+          then pubKey $ head pubKeyHashes
+          else script govValidatorHash
+      withGSTDatum =
+        withOptional withDatum $
+          mkGovernorOutputDatum ps.governorOutputDatumValidity
+   in mconcat
+        [ input $
+            script govValidatorHash
+              . withDatum governorInputDatum
+              . withValue value
+              . withOutRef governorRef
+        , output $
+            gstOutput
+              . withGSTDatum
+              . withValue value
+        ]
+
+--------------------------------------------------------------------------------
+
+mockEffectValidator :: ClosedTerm PValidator
+mockEffectValidator = noOpValidator authorityTokenSymbol
+
+mockEffectValidatorHash :: ValidatorHash
+mockEffectValidatorHash = validatorHash $ mkValidator mockEffectValidator
+
+mkGATValue :: GATValidity -> Integer -> Value
+mkGATValue NoGAT _ = mempty
+mkGATValue v q =
+  let gatOwner = case v of
+        GATValid -> mockEffectValidatorHash
+        WrongTag -> head validatorHashes
+   in Value.singleton
+        authorityTokenSymbol
+        (validatorHashToTokenName gatOwner)
+        q
+
+mkMockEffectBuilder :: MockEffectParameters -> BaseBuilder
+mkMockEffectBuilder ps =
+  let mkGATValue' = mkGATValue ps.gatValidity
+      inputValue = mkGATValue' 1
+      outputValue = inputValue <> burnt
+      burnt =
+        if ps.burnGAT
+          then mkGATValue' (-1)
+          else mempty
+   in mconcat
+        [ mint burnt
+        , input $
+            script mockEffectValidatorHash
+              . withValue inputValue
+        , output $
+            script mockEffectValidatorHash
+              . withValue outputValue
+        ]
+
+--------------------------------------------------------------------------------
+
+mutate :: ParameterBundle -> TxInfo
+mutate pb =
+  buildTxInfoUnsafe $
+    mconcat
+      [ mkGovernorBuilder pb.governorParameters
+      , mkMockEffectBuilder pb.mockEffectParameters
+      ]
+
+--------------------------------------------------------------------------------
+
+mkTestCase :: String -> ParameterBundle -> Validity -> SpecificationTree
+mkTestCase name pb (Validity forGov) =
+  testValidator
+    forGov
+    name
+    (governorValidator governor)
+    governorInputDatum
+    governorRedeemer
+    ( ScriptContext
+        (mutate pb)
+        governorScriptPurpose
+    )
+
+--------------------------------------------------------------------------------
+
+totallyValidBundle :: ParameterBundle
+totallyValidBundle =
+  ParameterBundle
+    { governorParameters =
+        GovernorParameters
+          { governorOutputDatumValidity = DatumValid
+          , stealGST = False
+          }
+    , mockEffectParameters =
+        MockEffectParameters
+          { gatValidity = GATValid
+          , burnGAT = True
+          }
+    }
+
+--------------------------------------------------------------------------------
+
+invalidBundles :: [ParameterBundle]
+invalidBundles = do
+  gdv <- enumFrom ValueInvalid
+  sg <- [True, False]
+  gtv <- enumFrom WrongTag
+  bgt <- [True, False]
+
+  pure $
+    ParameterBundle
+      { governorParameters =
+          GovernorParameters
+            { governorOutputDatumValidity = gdv
+            , stealGST = sg
+            }
+      , mockEffectParameters =
+          MockEffectParameters
+            { gatValidity = gtv
+            , burnGAT = bgt
+            }
+      }