agora/agora-specs/Sample/Governor/Mutate.hs

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
            }
      }