add new tests for creating proposals

agora-specs/Sample/Proposal.hs

@@ -1,115 +0,0 @@
-{- |
-Module     : Sample.Proposal
-Maintainer : emi@haskell.fyi
-Description: Sample based testing for Proposal utxos
-
-This module tests primarily the happy path for Proposal interactions
--}
-module Sample.Proposal (
-  -- * Script contexts
-  proposalCreation,
-) where
-
-import Agora.Governor (GovernorDatum (..))
-import Agora.Proposal (
-  Proposal (..),
-  ProposalDatum (..),
-  ProposalId (..),
-  ProposalStatus (..),
-  ResultTag (..),
-  emptyVotesFor,
- )
-import Data.Default.Class (Default (def))
-import Plutarch.Context (
-  MintingBuilder,
-  buildMintingUnsafe,
-  input,
-  mint,
-  output,
-  script,
-  signedWith,
-  txId,
-  withDatum,
-  withTxId,
-  withValue,
- )
-import PlutusLedgerApi.V1 (
-  ScriptContext (..),
- )
-import PlutusLedgerApi.V1.Value qualified as Value (
-  assetClassValue,
-  singleton,
- )
-import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Shared (
-  govValidatorHash,
-  proposal,
-  proposalPolicySymbol,
-  proposalStartingTimeFromTimeRange,
-  proposalValidatorHash,
-  signer,
- )
-import Test.Util (
-  closedBoundedInterval,
- )
-
-proposalCreation :: ScriptContext
-proposalCreation =
-  let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
-      effects =
-        AssocMap.fromList
-          [ (ResultTag 0, AssocMap.empty)
-          , (ResultTag 1, AssocMap.empty)
-          ]
-      proposalDatum :: ProposalDatum
-      proposalDatum =
-        ProposalDatum
-          { proposalId = ProposalId 0
-          , effects = effects
-          , status = Draft
-          , cosigners = [signer]
-          , thresholds = def
-          , votes = emptyVotesFor effects
-          , timingConfig = def
-          , startingTime = proposalStartingTimeFromTimeRange validTimeRange
-          }
-
-      govBefore :: GovernorDatum
-      govBefore =
-        GovernorDatum
-          { proposalThresholds = def
-          , nextProposalId = ProposalId 0
-          , proposalTimings = def
-          , createProposalTimeRangeMaxWidth = def
-          , maximumProposalsPerStake = 3
-          }
-
-      govAfter :: GovernorDatum
-      govAfter = govBefore {nextProposalId = ProposalId 1}
-
-      validTimeRange = closedBoundedInterval 10 15
-
-      builder :: MintingBuilder
-      builder =
-        mconcat
-          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-          , signedWith signer
-          , mint st
-          , input $
-              script govValidatorHash
-                . withValue (Value.assetClassValue proposal.governorSTAssetClass 1)
-                . withDatum govBefore
-                . withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-          , output $
-              script proposalValidatorHash
-                . withValue (st <> Value.singleton "" "" 10_000_000)
-                . withDatum proposalDatum
-          , output $
-              script govValidatorHash
-                . withValue
-                  ( Value.assetClassValue proposal.governorSTAssetClass 1
-                      <> Value.singleton "" "" 10_000_000
-                  )
-                . withDatum govAfter
-          ]
-   in buildMintingUnsafe builder

agora-specs/Sample/Proposal/Advance.hs

@@ -69,7 +69,7 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
+import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
   minAda,
   proposalPolicySymbol,
@@ -79,7 +79,7 @@ import Sample.Shared (
   stakeValidatorHash,
  )
 import Sample.Shared qualified as Shared
-import Test.Specification (SpecificationTree, group)
+import Test.Specification (SpecificationTree, group, testValidator)
 import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue, updateMap)
 
 -- | Parameters for state transition of proposals.
@@ -512,7 +512,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake]
 
     proposal =
       let proposalInputDatum = mkProposalInputDatum ps
-       in testFunc
+       in testValidator
             isValidForProposalValidator
             "propsoal"
             (proposalValidator Shared.proposal)
@@ -527,7 +527,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake]
       let idx = 0
           stakeInputDatum = mkStakeInputDatums ps !! idx
           isValid = not $ ps.alterOutputStakes
-       in testFunc
+       in testValidator
             isValid
             "stake"
             (stakeValidator Shared.stake)

agora-specs/Sample/Proposal/Cosign.hs

@@ -57,7 +57,7 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
+import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
   minAda,
   proposalPolicySymbol,
@@ -71,6 +71,7 @@ import Sample.Shared qualified as Shared
 import Test.Specification (
   SpecificationTree,
   group,
+  testValidator,
  )
 import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue)
 
@@ -317,7 +318,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
 
     proposal =
       let proposalInputDatum = mkProposalInputDatum ps
-       in testFunc
+       in testValidator
             isValid
             "propsoal"
             (proposalValidator Shared.proposal)
@@ -332,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
       let idx = 0
           stakeInputDatum = mkStakeInputDatums ps !! idx
           isValid = not ps.alterOutputStakes
-       in testFunc
+       in testValidator
             isValid
             "stake"
             (stakeValidator Shared.stake)

agora-specs/Sample/Proposal/Create.hs

@@ -0,0 +1,454 @@
+module Sample.Proposal.Create (
+  Parameters (..),
+  mkTestTree,
+  totallyValidParameters,
+  invalidOutputGovernorDatumParameters,
+  useStakeOwnBySomeoneElseParameters,
+  invalidOutputStakeParameters,
+  addInvalidLocksParameters,
+  exceedMaximumProposalsParameters,
+  timeRangeNotTightParameters,
+  timeRangeNotClosedParameters,
+  invalidProposalStatusParameters,
+) where
+
+import Agora.Governor (
+  GovernorDatum (..),
+  GovernorRedeemer (CreateProposal),
+ )
+import Agora.Governor.Scripts (governorValidator)
+import Agora.Proposal (
+  Proposal (governorSTAssetClass),
+  ProposalDatum (..),
+  ProposalId (ProposalId),
+  ProposalStatus (..),
+  ResultTag (ResultTag),
+  emptyVotesFor,
+ )
+import Agora.Proposal.Scripts (proposalPolicy)
+import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..))
+import Agora.Stake (
+  ProposalLock (..),
+  Stake (gtClassRef),
+  StakeDatum (..),
+  StakeRedeemer (PermitVote),
+ )
+import Agora.Stake.Scripts (stakeValidator)
+import Data.Coerce (coerce)
+import Data.Default (Default (def))
+import Data.Tagged (Tagged, untag)
+import Plutarch.Context (
+  BaseBuilder,
+  buildTxInfoUnsafe,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  timeRange,
+  txId,
+  withDatum,
+  withOutRef,
+  withValue,
+ )
+import PlutusLedgerApi.V1 (
+  DatumHash,
+  POSIXTime (POSIXTime),
+  POSIXTimeRange,
+  PubKeyHash,
+  ScriptContext (ScriptContext),
+  ScriptPurpose (Minting, Spending),
+  TxInfo,
+  TxOutRef (TxOutRef),
+  ValidatorHash,
+  always,
+ )
+import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusTx.AssocMap qualified as AssocMap
+import Sample.Proposal.Shared (stakeTxRef)
+import Sample.Shared (
+  govValidatorHash,
+  minAda,
+  proposal,
+  proposalPolicySymbol,
+  proposalStartingTimeFromTimeRange,
+  proposalValidatorHash,
+  signer,
+  signer2,
+  stake,
+  stakeAssetClass,
+  stakeValidatorHash,
+ )
+import Sample.Shared qualified as Shared
+import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
+import Test.Util (closedBoundedInterval, sortValue)
+
+-- | Parameters for creating a proposal.
+data Parameters = Parameters
+  { advanceNextProposalId :: Bool
+  -- ^ Whether to advance 'GovernorDatum.nextProposalId'.
+  , createdMoreThanMaximumProposals :: Bool
+  -- ^ Try creating more than maximum amount of proposals.
+  , stakeOwnerSignsTheTransaction :: Bool
+  -- ^ Should the stake owner sign the transaction?
+  , invalidNewLocks :: Bool
+  -- ^ Place invalid new locks on the output stake.
+  , alterOutputStakeOwner :: Bool
+  -- ^ Whether to change the 'owner' field of the output stake datum.
+  , timeRangeTightEnough :: Bool
+  -- ^ Is 'TxInfo.validTimeRange' tight enough?
+  , timeRangeClosed :: Bool
+  -- ^ Is 'TxInfo.validTimeRange' closed?
+  , proposalStatus :: ProposalStatus
+  -- ^ The status of the newly created proposal.
+  }
+
+--------------------------------------------------------------------------------
+
+-- | See 'GovernorDatum.maximumProposalsPerStake'.
+maxProposalPerStake :: Integer
+maxProposalPerStake = 3
+
+-- | The id of the proposal we are creating.
+thisProposalId :: ProposalId
+thisProposalId = ProposalId 25
+
+-- | The arbitrary staked amount. Doesn;t really matter in this case.
+stakedGTs :: Tagged _ Integer
+stakedGTs = 5
+
+-- | The owner of the stake.
+stakeOwner :: PubKeyHash
+stakeOwner = signer
+
+{- | The invalid stake owner. If the 'alterOutputStakeOwner' is set to true,
+      the output stake owner will be set to this.
+-}
+alteredStakeOwner :: PubKeyHash
+alteredStakeOwner = signer2
+
+-- | Locks the stake that the input stake already has.
+defLocks :: [ProposalLock]
+defLocks = [Created (ProposalId 0)]
+
+-- | The effect of the newly created proposal.
+defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+defEffects =
+  AssocMap.fromList
+    [ (ResultTag 0, AssocMap.empty)
+    , (ResultTag 1, AssocMap.empty)
+    ]
+
+--------------------------------------------------------------------------------
+
+-- | The governor input datum.
+governorInputDatum :: GovernorDatum
+governorInputDatum =
+  GovernorDatum
+    { proposalThresholds = def
+    , nextProposalId = thisProposalId
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
+    , maximumProposalsPerStake = maxProposalPerStake
+    }
+
+-- | Create governor output datum given the parameters.
+mkGovernorOutputDatum :: Parameters -> GovernorDatum
+mkGovernorOutputDatum ps =
+  let nextPid =
+        if ps.advanceNextProposalId
+          then ProposalId $ coerce thisProposalId + 1
+          else thisProposalId
+   in GovernorDatum
+        { proposalThresholds = def
+        , nextProposalId = nextPid
+        , proposalTimings = def
+        , createProposalTimeRangeMaxWidth = def
+        , maximumProposalsPerStake = maxProposalPerStake
+        }
+
+--------------------------------------------------------------------------------
+
+-- | Create the stake input datum given the parameters.
+mkStakeInputDatum :: Parameters -> StakeDatum
+mkStakeInputDatum ps =
+  let locks =
+        if ps.createdMoreThanMaximumProposals
+          then
+            Created . ProposalId
+              <$> take
+                (fromInteger maxProposalPerStake)
+                [1 ..]
+          else defLocks
+   in StakeDatum
+        { stakedAmount = stakedGTs
+        , owner = stakeOwner
+        , lockedBy = locks
+        }
+
+-- | Create the stake output datum given the parameters.
+mkStakeOutputDatum :: Parameters -> StakeDatum
+mkStakeOutputDatum ps =
+  let inputDatum = mkStakeInputDatum ps
+      newLocks =
+        if ps.invalidNewLocks
+          then
+            [ Voted thisProposalId (ResultTag 0)
+            , Voted thisProposalId (ResultTag 1)
+            ]
+          else [Created thisProposalId]
+      locks = newLocks <> inputDatum.lockedBy
+      newOwner = mkOwner ps
+   in inputDatum
+        { owner = newOwner
+        , lockedBy = locks
+        }
+
+--------------------------------------------------------------------------------
+
+{- | Create the proposal datum for the newly created proposal, given the
+      parameters.
+-}
+mkProposalOutputDatum :: Parameters -> ProposalDatum
+mkProposalOutputDatum ps =
+  ProposalDatum
+    { proposalId = thisProposalId
+    , effects = defEffects
+    , status = ps.proposalStatus
+    , cosigners = [mkOwner ps]
+    , thresholds = def
+    , votes = emptyVotesFor defEffects
+    , timingConfig = def
+    , startingTime = mkProposalStartingTime ps
+    }
+
+--------------------------------------------------------------------------------
+
+-- | Create time range for 'TxInfo.validTimeRange'.
+mkTimeRange :: Parameters -> POSIXTimeRange
+mkTimeRange ps =
+  if ps.timeRangeClosed
+    then
+      let s = 0
+          di :: POSIXTime = coerce (def @MaxTimeRangeWidth)
+          o = if ps.timeRangeTightEnough then (-1) else 1
+       in closedBoundedInterval s $ o + di
+    else always
+
+-- | Get the starting time of the propsoal.
+mkProposalStartingTime :: Parameters -> ProposalStartingTime
+mkProposalStartingTime ps =
+  if ps.timeRangeClosed
+    then proposalStartingTimeFromTimeRange $ mkTimeRange ps
+    else ProposalStartingTime 0
+
+-- | Who should be the 'owner' of the output stake.
+mkOwner :: Parameters -> PubKeyHash
+mkOwner ps =
+  if ps.alterOutputStakeOwner
+    then alteredStakeOwner
+    else stakeOwner
+
+--------------------------------------------------------------------------------
+
+-- | Reference to the input stake UTXO.
+stakeRef :: TxOutRef
+stakeRef = TxOutRef stakeTxRef 1
+
+-- | Reference to the input governor UTXO.
+governorRef :: TxOutRef
+governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 3
+
+--------------------------------------------------------------------------------
+
+-- | Create a 'TxInfo' that spends a stake to create a new proposal.
+createProposal :: Parameters -> TxInfo
+createProposal ps = buildTxInfoUnsafe builder
+  where
+    pst = Value.singleton proposalPolicySymbol "" 1
+    sst = Value.assetClassValue stakeAssetClass 1
+    gst = Value.assetClassValue proposal.governorSTAssetClass 1
+
+    ---
+
+    governorValue = sortValue $ gst <> minAda
+    stakeValue =
+      sortValue $
+        sortValue $
+          sst
+            <> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs)
+            <> minAda
+    proposalValue = sortValue $ pst <> minAda
+
+    ---
+
+    withSig =
+      if ps.stakeOwnerSignsTheTransaction
+        then signedWith stakeOwner
+        else mempty
+
+    ---
+
+    builder :: BaseBuilder
+    builder =
+      mconcat
+        [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
+        , ---
+          withSig
+        , ---
+          mint pst
+        , ---
+          timeRange $ mkTimeRange ps
+        , input $
+            script govValidatorHash
+              . withValue governorValue
+              . withDatum governorInputDatum
+              . withOutRef governorRef
+        , output $
+            script govValidatorHash
+              . withValue governorValue
+              . withDatum (mkGovernorOutputDatum ps)
+        , ---
+          input $
+            script stakeValidatorHash
+              . withValue stakeValue
+              . withDatum (mkStakeInputDatum ps)
+              . withOutRef stakeRef
+        , output $
+            script stakeValidatorHash
+              . withValue stakeValue
+              . withDatum (mkStakeOutputDatum ps)
+        , ---
+          output $
+            script proposalValidatorHash
+              . withValue proposalValue
+              . withDatum (mkProposalOutputDatum ps)
+        ]
+
+--------------------------------------------------------------------------------
+
+-- | Spend the stake with the 'PermitVote' redeemer.
+stakeRedeemer :: StakeRedeemer
+stakeRedeemer = PermitVote
+
+-- | Spend the governor with the 'CreateProposal' redeemer.
+governorRedeemer :: GovernorRedeemer
+governorRedeemer = CreateProposal
+
+-- | Mint the PST with an arbitrary redeemer. Doesn't really matter.
+proposalPolicyRedeemer :: ()
+proposalPolicyRedeemer = ()
+
+--------------------------------------------------------------------------------
+
+totallyValidParameters :: Parameters
+totallyValidParameters =
+  Parameters
+    { advanceNextProposalId = True
+    , createdMoreThanMaximumProposals = False
+    , stakeOwnerSignsTheTransaction = True
+    , invalidNewLocks = False
+    , alterOutputStakeOwner = False
+    , timeRangeTightEnough = True
+    , timeRangeClosed = True
+    , proposalStatus = Draft
+    }
+
+invalidOutputGovernorDatumParameters :: Parameters
+invalidOutputGovernorDatumParameters =
+  totallyValidParameters
+    { advanceNextProposalId = False
+    }
+
+useStakeOwnBySomeoneElseParameters :: Parameters
+useStakeOwnBySomeoneElseParameters =
+  totallyValidParameters
+    { stakeOwnerSignsTheTransaction = False
+    }
+
+invalidOutputStakeParameters :: Parameters
+invalidOutputStakeParameters =
+  totallyValidParameters
+    { alterOutputStakeOwner = True
+    }
+
+addInvalidLocksParameters :: Parameters
+addInvalidLocksParameters =
+  totallyValidParameters
+    { invalidNewLocks = True
+    }
+
+exceedMaximumProposalsParameters :: Parameters
+exceedMaximumProposalsParameters =
+  totallyValidParameters
+    { createdMoreThanMaximumProposals = True
+    }
+
+timeRangeNotTightParameters :: Parameters
+timeRangeNotTightParameters =
+  totallyValidParameters
+    { timeRangeTightEnough = False
+    }
+
+timeRangeNotClosedParameters :: Parameters
+timeRangeNotClosedParameters =
+  totallyValidParameters
+    { timeRangeClosed = False
+    }
+
+invalidProposalStatusParameters :: [Parameters]
+invalidProposalStatusParameters =
+  map
+    ( \st ->
+        totallyValidParameters {proposalStatus = st}
+    )
+    [VotingReady, Locked, Finished]
+
+--------------------------------------------------------------------------------
+
+{- | Create a test tree that runs the propsoal minting policy, the governor
+      validator and the stake validator to test the functionalities of creting
+      proposals
+-}
+mkTestTree :: String -> Parameters -> Bool -> Bool -> Bool -> SpecificationTree
+mkTestTree
+  name
+  ps
+  validForProposalPolicy
+  validForGovernorValidator
+  validForStakeValidator =
+    group name [proposalTest, governorTest, stakeTest]
+    where
+      txInfo = createProposal ps
+
+      proposalTest =
+        testPolicy
+          validForProposalPolicy
+          "proposal"
+          (proposalPolicy Shared.proposal.governorSTAssetClass)
+          proposalPolicyRedeemer
+          (ScriptContext txInfo (Minting proposalPolicySymbol))
+
+      governorTest =
+        testValidator
+          validForGovernorValidator
+          "governor"
+          (governorValidator Shared.governor)
+          governorInputDatum
+          governorRedeemer
+          ( ScriptContext
+              txInfo
+              (Spending governorRef)
+          )
+
+      stakeTest =
+        testValidator
+          validForStakeValidator
+          "stake"
+          (stakeValidator Shared.stake)
+          (mkStakeInputDatum ps)
+          stakeRedeemer
+          ( ScriptContext
+              txInfo
+              (Spending stakeRef)
+          )

agora-specs/Sample/Proposal/Shared.hs

@@ -1,13 +1,6 @@
-module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) where
+module Sample.Proposal.Shared (proposalTxRef, stakeTxRef) where
 
-import Plutarch.Api.V1 (PValidator)
+import PlutusLedgerApi.V1 (TxId)
-import Plutarch.Lift (PUnsafeLiftDecl (..))
-import PlutusLedgerApi.V1 (ScriptContext, ToData, TxId)
-import Test.Specification (
-  SpecificationTree,
-  validatorFailsWith,
-  validatorSucceedsWith,
- )
 
 -- | 'TxId' of all the propsoal inputs in the samples.
 proposalTxRef :: TxId
@@ -16,24 +9,3 @@ proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
 -- | 'TxId' of all the stake inputs in the samples.
 stakeTxRef :: TxId
 stakeTxRef = "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15"
-
--- | Get the test function given whether a test case is valid.
-testFunc ::
-  forall {datum :: PType} {redeemer :: PType}.
-  ( PUnsafeLiftDecl datum
-  , PUnsafeLiftDecl redeemer
-  , ToData (PLifted datum)
-  , ToData (PLifted redeemer)
-  ) =>
-  -- | Should the validator pass?
-  Bool ->
-  String ->
-  ClosedTerm PValidator ->
-  PLifted datum ->
-  PLifted redeemer ->
-  ScriptContext ->
-  SpecificationTree
-testFunc isValid =
-  if isValid
-    then validatorSucceedsWith
-    else validatorFailsWith

agora-specs/Sample/Proposal/UnlockStake.hs

@@ -55,7 +55,7 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Proposal.Shared (stakeTxRef, testFunc)
+import Sample.Proposal.Shared (stakeTxRef)
 import Sample.Shared (
   minAda,
   proposalPolicySymbol,
@@ -66,7 +66,7 @@ import Sample.Shared (
   stakeValidatorHash,
  )
 import Sample.Shared qualified as Shared
-import Test.Specification (SpecificationTree, group)
+import Test.Specification (SpecificationTree, group, testValidator)
 import Test.Util (sortValue, updateMap)
 
 --------------------------------------------------------------------------------
@@ -519,7 +519,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
     txInfo = unlockStake ps
 
     stake =
-      testFunc
+      testValidator
         (not ps.alterOutputStake)
         "stake"
         (stakeValidator Shared.stake)
@@ -531,7 +531,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
       let idx = 0
           pid = ProposalId $ fromIntegral idx
           ref = mkProposalRef idx
-       in testFunc
+       in testValidator
             isValid
             "propsoal"
             (proposalValidator Shared.proposal)

agora-specs/Sample/Proposal/Vote.hs

@@ -47,7 +47,7 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
+import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
   minAda,
   proposalPolicySymbol,
@@ -61,6 +61,7 @@ import Sample.Shared qualified as Shared
 import Test.Specification (
   SpecificationTree,
   group,
+  testValidator,
   validatorSucceedsWith,
  )
 import Test.Util (closedBoundedInterval, sortValue, updateMap)
@@ -243,7 +244,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
     txInfo = vote ps
 
     proposal =
-      testFunc
+      testValidator
         isValid
         "propsoal"
         (proposalValidator Shared.proposal)

agora-specs/Spec/Proposal.hs

@@ -7,32 +7,83 @@ Tests for Proposal policy and validator
 -}
 module Spec.Proposal (specs) where
 
-import Agora.Proposal (
-  Proposal (..),
- )
-import Agora.Proposal.Scripts (proposalPolicy)
-import Sample.Proposal qualified as Proposal
 import Sample.Proposal.Advance qualified as Advance
 import Sample.Proposal.Cosign qualified as Cosign
+import Sample.Proposal.Create qualified as Create
 import Sample.Proposal.UnlockStake qualified as UnlockStake
 import Sample.Proposal.Vote qualified as Vote
-import Sample.Shared qualified as Shared (proposal)
 import Test.Specification (
   SpecificationTree,
   group,
-  policySucceedsWith,
  )
 
 -- | Stake specs.
 specs :: [SpecificationTree]
 specs =
   [ group
-      "policy"
+      "policy (proposal creation)"
-      [ policySucceedsWith
+      [ Create.mkTestTree
-          "proposalCreation"
+          "legal"
-          (proposalPolicy Shared.proposal.governorSTAssetClass)
+          Create.totallyValidParameters
-          ()
+          True
-          Proposal.proposalCreation
+          True
+          True
+      , group
+          "illegal"
+          [ Create.mkTestTree
+              "invalid next proposal id"
+              Create.invalidOutputGovernorDatumParameters
+              True
+              False
+              True
+          , Create.mkTestTree
+              "use other's stake"
+              Create.useStakeOwnBySomeoneElseParameters
+              True
+              False
+              False
+          , Create.mkTestTree
+              "altered stake"
+              Create.invalidOutputStakeParameters
+              True
+              False
+              False
+          , Create.mkTestTree
+              "invalid stake locks"
+              Create.addInvalidLocksParameters
+              True
+              False
+              True
+          , Create.mkTestTree
+              "has reached maximum proposals limit"
+              Create.exceedMaximumProposalsParameters
+              True
+              False
+              True
+          , Create.mkTestTree
+              "loose time range"
+              Create.timeRangeNotTightParameters
+              True
+              False
+              True
+          , Create.mkTestTree
+              "open time range"
+              Create.timeRangeNotClosedParameters
+              True
+              False
+              True
+          , group "invalid proposal status" $
+              map
+                ( \ps ->
+                    Create.mkTestTree
+                      (show ps.proposalStatus)
+                      ps
+                      True
+                      False
+                      True
+                )
+                Create.invalidProposalStatusParameters
+          ]
       ]
   , group
       "validator"

agora-testlib/Test/Specification.hs

@@ -42,6 +42,8 @@ module Test.Specification (
   validatorFailsWith,
   effectSucceedsWith,
   effectFailsWith,
+  testValidator,
+  testPolicy,
 
   -- * Converters
   toTestTree,
@@ -253,3 +255,37 @@ effectFailsWith ::
   ScriptContext ->
   SpecificationTree
 effectFailsWith tag eff datum = validatorFailsWith tag eff datum ()
+
+testValidator ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  , PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  -- | Should the validator pass?
+  Bool ->
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+testValidator isValid =
+  if isValid
+    then validatorSucceedsWith
+    else validatorFailsWith
+
+testPolicy ::
+  ( PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  Bool ->
+  String ->
+  ClosedTerm PMintingPolicy ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+testPolicy isValid =
+  if isValid
+    then policySucceedsWith
+    else policyFailsWith

agora.cabal

@@ -188,9 +188,9 @@ library agora-specs
     Sample.Effect.GovernorMutation
     Sample.Effect.TreasuryWithdrawal
     Sample.Governor
-    Sample.Proposal
     Sample.Proposal.Advance
     Sample.Proposal.Cosign
+    Sample.Proposal.Create
     Sample.Proposal.Shared
     Sample.Proposal.UnlockStake
     Sample.Proposal.Vote

bench.csv

@@ -7,7 +7,27 @@ Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect
 Agora/Stake/policy/stakeCreation,51008580,149029,2522
 Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4745
 Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4733
-Agora/Proposal/policy/proposalCreation,23140177,69194,1517
+Agora/Proposal/policy (proposal creation)/legal/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/legal/governor,327971301,871386,9322
+Agora/Proposal/policy (proposal creation)/legal/stake,152415805,398403,5404
+Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/stake,152415805,398403,5404
+Agora/Proposal/policy (proposal creation)/illegal/use other's stake/proposal,34975627,103548,2086
+Agora/Proposal/policy (proposal creation)/illegal/altered stake/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/proposal,34975627,103548,2125
+Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/stake,157849465,413053,5412
+Agora/Proposal/policy (proposal creation)/illegal/has reached maximum proposals limit/proposal,34975627,103548,2137
+Agora/Proposal/policy (proposal creation)/illegal/has reached maximum proposals limit/stake,158878297,416511,5434
+Agora/Proposal/policy (proposal creation)/illegal/loose time range/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/loose time range/stake,152415805,398403,5404
+Agora/Proposal/policy (proposal creation)/illegal/open time range/proposal,34975627,103548,2113
+Agora/Proposal/policy (proposal creation)/illegal/open time range/stake,152415805,398403,5400
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/VotingReady/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/VotingReady/stake,152415805,398403,5404
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Locked/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Locked/stake,152415805,398403,5404
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Finished/proposal,34975627,103548,2117
+Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Finished/stake,152415805,398403,5404
 Agora/Proposal/validator/cosignature/legal/with 1 cosigners/propsoal,231665387,648239,8164
 Agora/Proposal/validator/cosignature/legal/with 1 cosigners/stake,122255811,317464,5213
 Agora/Proposal/validator/cosignature/legal/with 5 cosigners/propsoal,662329378,1846986,10794