module Sample.Governor.Mutate ( -- * Testing Utilities GovernorOutputDatumValidity (..), GATValidity (..), GovernorParameters (..), MockEffectParameters (..), ParameterBundle (..), -- * Testing Utilities Validity (..), mutate, mkTestCase, -- * Parameters Bundles totallyValidBundle, invalidBundles, ) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..)) import Data.Default (def) import Data.Map ((!)) import Data.Text qualified as T import Plutarch (Script) import Plutarch.Api.V2 (PMintingPolicy, scriptHash) import Plutarch.Context ( input, mint, output, pubKey, script, withDatum, withRef, withValue, ) import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( Data, ScriptHash, TxOutRef (TxOutRef), Value, toData, ) import Sample.Shared ( agoraScripts, authorityTokenSymbol, governorAssetClass, governorScriptHash, governorValidator, minAda, ) import Test.Specification (SpecificationTree, testValidator) import Test.Util ( CombinableBuilder, mkSpending, pubKeyHashes, sortValue, ) -------------------------------------------------------------------------------- -- | Represent the validity property of the governor output datum. data GovernorOutputDatumValidity = DatumValid | ValueInvalid | WrongType | NoDatum deriving stock (Bounded, Enum) -- | Represent the validity property of the authority token UTxO. data GATValidity = GATValid | WrongTag | NoGAT deriving stock (Bounded, Enum) data GovernorParameters = GovernorParameters { governorOutputDatumValidity :: GovernorOutputDatumValidity , stealGST :: Bool -- ^ Send the GST to somewhere else other than the govenor validator. } data MockEffectParameters = MockEffectParameters { gatValidity :: GATValidity , burnGAT :: Bool -- ^ Whether to burn the GAT in the transaction or not. } 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 , maximumCreatedProposalsPerStake = 3 } mkGovernorOutputDatum :: GovernorOutputDatumValidity -> Maybe Data mkGovernorOutputDatum DatumValid = Just $ toData $ governorInputDatum { maximumCreatedProposalsPerStake = 4 } mkGovernorOutputDatum ValueInvalid = let invalidProposalThresholds = ProposalThresholds { execute = -1 , create = -1 , toVoting = -1 , vote = -1 , cosign = -1 } in Just $ toData $ governorInputDatum { proposalThresholds = invalidProposalThresholds } mkGovernorOutputDatum WrongType = Just $ toData () mkGovernorOutputDatum NoDatum = Nothing governorRef :: TxOutRef governorRef = TxOutRef "6cce6dfbb697f9e2c4fe9786bb576eb7bd6cbcf7801a4ba13d596006c2d5b957" 1 governorRedeemer :: GovernorRedeemer governorRedeemer = MutateGovernor mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b mkGovernorBuilder ps = let gst = assetClassValue governorAssetClass 1 value = sortValue $ gst <> minAda gstOutput = if ps.stealGST then pubKey $ head pubKeyHashes else script governorScriptHash withGSTDatum = maybe mempty withDatum $ mkGovernorOutputDatum ps.governorOutputDatumValidity in mconcat [ input $ mconcat [ script governorScriptHash , withDatum governorInputDatum , withValue value , withRef governorRef ] , output $ mconcat [ gstOutput , withGSTDatum , withValue value ] ] -------------------------------------------------------------------------------- mockEffectValidator :: Script mockEffectValidator = agoraScripts ! "agora:noOpValidator" mockEffectScriptHash :: ScriptHash mockEffectScriptHash = scriptHash mockEffectValidator mockAuthScript :: ClosedTerm PMintingPolicy mockAuthScript = plam $ \_ _ -> popaque $ pcon PUnit mockAuthScriptHash :: ScriptHash mockAuthScriptHash = scriptHash . either (error . T.unpack) id $ compile def mockAuthScript mkGATValue :: GATValidity -> Integer -> Value mkGATValue NoGAT _ = mempty mkGATValue v q = let authScript = case v of GATValid -> mockAuthScriptHash WrongTag -> "" in Value.singleton authorityTokenSymbol (scriptHashToTokenName authScript) q mkMockEffectBuilder :: forall b. CombinableBuilder b => MockEffectParameters -> b 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 $ mconcat [ script mockEffectScriptHash , withValue inputValue ] , output $ mconcat [ script mockEffectScriptHash , withValue outputValue ] ] -------------------------------------------------------------------------------- mutate :: forall b. CombinableBuilder b => ParameterBundle -> b mutate pb = mconcat [ mkGovernorBuilder pb.governorParameters , mkMockEffectBuilder pb.mockEffectParameters ] -------------------------------------------------------------------------------- -- | Run the governor to test the mutation functionality. mkTestCase :: String -> ParameterBundle -> Validity -> SpecificationTree mkTestCase name pb (Validity forGov) = testValidator forGov name governorValidator governorInputDatum governorRedeemer (mkSpending mutate pb governorRef) -------------------------------------------------------------------------------- -- | The only one valid combination of all the parameters. totallyValidBundle :: ParameterBundle totallyValidBundle = ParameterBundle { governorParameters = GovernorParameters { governorOutputDatumValidity = DatumValid , stealGST = False } , mockEffectParameters = MockEffectParameters { gatValidity = GATValid , burnGAT = True } } -------------------------------------------------------------------------------- {- | All the invalid combination of the parameters. TODO: use 'Gen'? -} 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 } }