allow multiple proposals in the samples of unlocking stake

agora-specs/Sample/Proposal.hs

@@ -19,14 +19,6 @@ module Sample.Proposal (
   advanceFinishedPropsoal,
   advanceProposalInsufficientVotes,
   advancePropsoalWithInvalidOutputStake,
-  voterUnlockStakeAndRetractVotesWhile,
-  voterUnlockStakeWhile,
-  creatorRetractVotesWhile,
-  creatorUnlockStakeWhile,
-  unlockStakeAndRetractVotesUsingIrrelevantStakeWhile,
-  unlockStakeUsingIrrelevantStakeWhile,
-  unlockStakeProposalId,
-  unlockStake,
 ) where
 
 import Agora.Governor (GovernorDatum (..))
@@ -87,13 +79,13 @@ import PlutusLedgerApi.V1.Value qualified as Value (
   singleton,
  )
 import PlutusTx.AssocMap qualified as AssocMap
+import Sample.Proposal.Shared (proposalRef, stakeRef)
 import Sample.Shared (
   govValidatorHash,
   minAda,
   proposal,
   proposalPolicySymbol,
   proposalStartingTimeFromTimeRange,
-  proposalValidatorAddress,
   proposalValidatorHash,
   signer,
   signer2,
@@ -169,12 +161,6 @@ proposalCreation =
           ]
    in buildMintingUnsafe builder
 
-proposalRef :: TxOutRef
-proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
-
-stakeRef :: TxOutRef
-stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
-
 -- | This script context should be a valid transaction.
 cosignProposal :: [PubKeyHash] -> TxInfo
 cosignProposal newSigners =
@@ -813,280 +799,3 @@ advancePropsoalWithInvalidOutputStake =
               <> templateTxInfo.txInfoData
         , txInfoSignatories = [stakeOwner]
         }
-
---------------------------------------------------------------------------------
-
--- | Create empty effects for every result tag given the votes.
-emptyEffectFor ::
-  ProposalVotes ->
-  AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
-emptyEffectFor (ProposalVotes vs) =
-  AssocMap.fromList $
-    map (,AssocMap.empty) (AssocMap.keys vs)
-
--- | The proposal id shared by all the samples relate to unlocking stake.
-unlockStakeProposalId :: ProposalId
-unlockStakeProposalId = ProposalId 0
-
--- | A 'ProposalVotes' that has only two options, serves as a template for unlokcing stake samples.
-unlockStakePropsoalVotesTemplate :: ProposalVotes
-unlockStakePropsoalVotesTemplate =
-  ProposalVotes $
-    AssocMap.fromList
-      [ (ResultTag 0, 0)
-      , (ResultTag 1, 0)
-      ]
-
--- | Create a 'TxInfo' that unlocks a stake from a proposal. For internal use only.
-mkUnlockStakeTxInfo ::
-  -- | The current state of the proposal.
-  ProposalStatus ->
-  -- | The votes of the input propsoal
-  ProposalVotes ->
-  -- | The votes of the output proposal.
-  ProposalVotes ->
-  -- | Stake amount.
-  Integer ->
-  -- | Retract from option.
-  [ProposalLock] ->
-  -- | The locks of output stake.
-  [ProposalLock] ->
-  TxInfo
-mkUnlockStakeTxInfo
-  status
-  votesBefore
-  votesAfter
-  stakedAmount
-  locksBefore
-  locksAfter =
-    let stakeOwner = signer
-
-        stakeInputDatum' :: StakeDatum
-        stakeInputDatum' =
-          StakeDatum
-            { stakedAmount = Tagged stakedAmount
-            , owner = stakeOwner
-            , lockedBy = locksBefore
-            }
-
-        stakeOutputDatum' :: StakeDatum
-        stakeOutputDatum' =
-          stakeInputDatum'
-            { lockedBy = locksAfter
-            }
-
-        ---
-
-        effects = emptyEffectFor votesBefore
-
-        proposalInputDatum' :: ProposalDatum
-        proposalInputDatum' =
-          ProposalDatum
-            { proposalId = unlockStakeProposalId
-            , effects = effects
-            , status = status
-            , cosigners = [signer]
-            , thresholds = def
-            , votes = votesBefore
-            , timingConfig = def
-            , startingTime = ProposalStartingTime 0
-            }
-
-        proposalOutputDatum' :: ProposalDatum
-        proposalOutputDatum' =
-          proposalInputDatum'
-            { votes = votesAfter
-            }
-
-        ---
-
-        sst = Value.assetClassValue stakeAssetClass 1
-
-        stakeInputDatum :: Datum
-        stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
-        stakeInput :: TxOut
-        stakeInput =
-          TxOut
-            { txOutAddress = stakeAddress
-            , txOutValue =
-                mconcat
-                  [ sst
-                  , Value.assetClassValue (untag stake.gtClassRef) stakedAmount
-                  , minAda
-                  ]
-            , txOutDatumHash = Just $ toDatumHash stakeInputDatum
-            }
-
-        stakeOutputDatum :: Datum
-        stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
-        stakeOutput :: TxOut
-        stakeOutput =
-          stakeInput
-            { txOutDatumHash = Just $ toDatumHash stakeOutputDatum
-            }
-
-        ---
-
-        pst = Value.singleton proposalPolicySymbol "" 1
-
-        proposalInputDatum :: Datum
-        proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
-        proposalInput :: TxOut
-        proposalInput =
-          TxOut
-            { txOutAddress = proposalValidatorAddress
-            , txOutValue = pst
-            , txOutDatumHash = Just $ toDatumHash proposalInputDatum
-            }
-
-        ---
-
-        proposalOutputDatum :: Datum
-        proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
-        proposalOutput :: TxOut
-        proposalOutput =
-          proposalInput
-            { txOutValue = proposalInput.txOutValue <> minAda
-            , txOutDatumHash = Just $ toDatumHash proposalOutputDatum
-            }
-     in TxInfo
-          { txInfoInputs = [TxInInfo proposalRef proposalInput, TxInInfo stakeRef stakeInput]
-          , txInfoOutputs = [proposalOutput, stakeOutput]
-          , txInfoFee = Value.singleton "" "" 2
-          , txInfoMint = mempty
-          , txInfoDCert = []
-          , txInfoWdrl = []
-          , -- Time doesn't matter int this case.
-            txInfoValidRange = closedBoundedInterval 0 100
-          , txInfoSignatories = [signer]
-          , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum]
-          , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
-          }
-
--- | How a stake has been used on a particular proposal.
-data StakeUsage
-  = -- | The stake was spent to vote for a paraticular option.
-    VotedFor ResultTag
-  | -- | The stake was used to created the proposal.
-    Created
-  | -- | The stake has nothing to do with the proposal.
-    DidNothing
-
--- | Create a bunch of 'ProposalLock' given the 'StakeUsgae'.
-mkStakeLocks :: StakeUsage -> [ProposalLock]
-mkStakeLocks (VotedFor rt) = [ProposalLock rt unlockStakeProposalId]
-mkStakeLocks Created =
-  map (`ProposalLock` unlockStakeProposalId) $
-    AssocMap.keys $ getProposalVotes unlockStakePropsoalVotesTemplate
-mkStakeLocks _ = []
-
--- | Assemble the votes of the input propsoal based on 'unlockStakePropsoalVotesTemplate'.
-mkVotesBefore ::
-  StakeUsage ->
-  -- | The staked amount/votes.
-  Integer ->
-  ProposalVotes
-mkVotesBefore (VotedFor rt) vc =
-  ProposalVotes $
-    updateMap (Just . const vc) rt $
-      getProposalVotes unlockStakePropsoalVotesTemplate
-mkVotesBefore _ vc = mkVotesBefore (VotedFor $ ResultTag 0) vc
-
-{- | Create a 'TxInfo' that unlocks the stake from the proposal.
-     The last parameter controls whether votes should be retracted or not.
--}
-unlockStake ::
-  -- | The status of both the input and output propsoals.
-  ProposalStatus ->
-  StakeUsage ->
-  -- | Staked amount/vote count.
-  Integer ->
-  -- | Should we retract votes?
-  Bool ->
-  TxInfo
-unlockStake ps su staked shouldRetract =
-  let votesBefore = mkVotesBefore su staked
-      votesAfter =
-        if shouldRetract
-          then unlockStakePropsoalVotesTemplate
-          else votesBefore
-
-      locksBefore = mkStakeLocks su
-      locksAfter = []
-   in mkUnlockStakeTxInfo
-        ps
-        votesBefore
-        votesAfter
-        staked
-        locksBefore
-        locksAfter
-
-{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal.
-     Correct count of votes is also retracted. The 'TxInfo' is valid only if the given
-      proposal status is 'VotingReady'.
--}
-voterUnlockStakeAndRetractVotesWhile :: ProposalStatus -> TxInfo
-voterUnlockStakeAndRetractVotesWhile ps =
-  unlockStake
-    ps
-    (VotedFor $ ResultTag 0)
-    42
-    True
-
-{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal
-      without retracting the votes, given the status of the proposal.
-
-     The 'TxInfo' is valid only if the status of the propsoal is either 'Locked'
-      or 'Finished'.
--}
-voterUnlockStakeWhile :: ProposalStatus -> TxInfo
-voterUnlockStakeWhile ps =
-  unlockStake
-    ps
-    (VotedFor $ ResultTag 0)
-    42
-    False
-
-{- | Create an invalid 'TxInfo' that retracts votes using the stake
-      that is used to create the proposal.
--}
-creatorRetractVotesWhile :: ProposalStatus -> TxInfo
-creatorRetractVotesWhile ps =
-  unlockStake
-    ps
-    Created
-    42
-    True
-
-{- | Create a 'TxInfo' to unlock the stake that is used to create the propsoal.
-      The 'TxInfo' is valid only if the given proposal status is 'Finished'.
--}
-creatorUnlockStakeWhile :: ProposalStatus -> TxInfo
-creatorUnlockStakeWhile ps =
-  unlockStake
-    ps
-    Created
-    42
-    False
-
-{- | Create an invalid 'TxInfo' that tries to retract votes and also unlock a stake
-      which is not locked by the proposal, given the status of the proposal.
--}
-unlockStakeAndRetractVotesUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo
-unlockStakeAndRetractVotesUsingIrrelevantStakeWhile ps =
-  unlockStake
-    ps
-    DidNothing
-    42
-    True
-
-{- | Create an invalid 'TxInfo' that tries to unlock a stake which is not locked by the proposal,
-      given the status of the proposal.
--}
-unlockStakeUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo
-unlockStakeUsingIrrelevantStakeWhile ps =
-  unlockStake
-    ps
-    DidNothing
-    42
-    False

agora-specs/Sample/Proposal/Shared.hs

@@ -0,0 +1,9 @@
+module Sample.Proposal.Shared (proposalRef, stakeRef) where
+
+import PlutusLedgerApi.V1 (TxOutRef (..))
+
+proposalRef :: TxOutRef
+proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
+
+stakeRef :: TxOutRef
+stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0

agora-specs/Sample/Proposal/UnlockStake.hs

@@ -0,0 +1,275 @@
+module Sample.Proposal.UnlockStake (
+  unlockStake,
+  StakeRole (..),
+  UnlockStakeParameters (..),
+  votesTemplate,
+  emptyEffectFor,
+  mkProposalInputDatum,
+  mkStakeInputDatum,
+  mkProposalValidatorTestCase,
+) where
+
+--------------------------------------------------------------------------------
+
+import PlutusLedgerApi.V1 (
+  Datum (Datum),
+  DatumHash,
+  ScriptContext (..),
+  ScriptPurpose (Spending),
+  ToData (toBuiltinData),
+  TxInInfo (TxInInfo),
+  TxInfo (..),
+  TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
+  TxOutRef (..),
+  ValidatorHash,
+ )
+import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusTx.AssocMap qualified as AssocMap
+
+--------------------------------------------------------------------------------
+
+import Agora.Proposal (
+  ProposalDatum (..),
+  ProposalId (..),
+  ProposalRedeemer (Unlock),
+  ProposalStatus (..),
+  ProposalVotes (..),
+  ResultTag (..),
+ )
+import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
+import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
+import Sample.Shared (
+  minAda,
+  proposalPolicySymbol,
+  proposalValidatorAddress,
+  signer,
+  stake,
+  stakeAssetClass,
+ )
+import Test.Util (closedBoundedInterval, datumPair, sortValue, toDatumHash, updateMap)
+
+--------------------------------------------------------------------------------
+
+import Agora.Proposal.Scripts (proposalValidator)
+import Control.Monad (join)
+import Data.Default.Class (Default (def))
+import Data.Tagged (Tagged (..), untag)
+import Sample.Proposal.Shared (proposalRef, stakeRef)
+import Sample.Shared qualified as Shared
+import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith)
+
+--------------------------------------------------------------------------------
+
+-- | The template "shape" that votes of proposals generated by 'mkProposalDatumPair' have.
+votesTemplate :: ProposalVotes
+votesTemplate =
+  ProposalVotes $
+    AssocMap.fromList
+      [ (ResultTag 0, 0)
+      , (ResultTag 1, 0)
+      ]
+
+-- | Create empty effects for every result tag given the votes.
+emptyEffectFor ::
+  ProposalVotes ->
+  AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+emptyEffectFor (ProposalVotes vs) =
+  AssocMap.fromList $
+    map (,AssocMap.empty) (AssocMap.keys vs)
+
+-- | The default vote option that will be used by functions in this module.
+defaultVoteFor :: ResultTag
+defaultVoteFor = ResultTag 0
+
+-- | The default number of GTs the stake will have.
+defaultStakedGTs :: Tagged _ Integer
+defaultStakedGTs = Tagged 100000
+
+-- | How a stake has been used on a particular proposal.
+data StakeRole
+  = -- | The stake was spent to vote for a paraticular option.
+    Voter
+  | -- | The stake was used to created the proposal.
+    Creator
+  | -- | The stake has nothing to do with the proposal.
+    Irrelevant
+
+-- | Parameters for creating a 'TxOut' that unlocks a stake.
+data UnlockStakeParameters = UnlockStakeParameters
+  { proposalCount :: Integer
+  -- ^ The number of proposals in the 'TxOut'.
+  , stakeUsage :: StakeRole
+  -- ^ The role of the stake we're unlocking.
+  , retractVotes :: Bool
+  -- ^ Whether to retract votes or not.
+  , proposalStatus :: ProposalStatus
+  -- ^ The state of all the proposals.
+  }
+
+instance Show UnlockStakeParameters where
+  show p =
+    let role = case p.stakeUsage of
+          Voter -> "voter"
+          Creator -> "creator"
+          _ -> "irrelevant stake"
+
+        action =
+          if p.retractVotes
+            then "unlock stake + retract votes"
+            else "unlock stake"
+
+        while = show p.proposalStatus
+
+        proposalInfo = mconcat [show p.proposalCount, " proposals"]
+     in mconcat [proposalInfo, ", ", role, ", ", action, ", ", while]
+
+-- | Generate some input proposals and their corresponding output proposals.
+mkProposals :: UnlockStakeParameters -> ([ProposalDatum], [ProposalDatum])
+mkProposals p = unzip $ forEachProposalId p.proposalCount $ mkProposalDatumPair p
+
+-- | Iterate over the proposal id of every proposal, given the number of proposals.
+forEachProposalId :: Integer -> (ProposalId -> a) -> [a]
+forEachProposalId 0 _ = error "zero proposal"
+forEachProposalId n f = f . ProposalId <$> [0 .. n - 1]
+
+-- | Create a valid stake 'TxOut' given the stake datum.
+mkStakeTxOut :: StakeDatum -> TxOut
+mkStakeTxOut sd =
+  let sst = Value.assetClassValue stakeAssetClass 1
+      gts = Value.assetClassValue (untag stake.gtClassRef) (untag sd.stakedAmount)
+   in TxOut
+        { txOutAddress = proposalValidatorAddress
+        , txOutValue = sortValue $ sst <> minAda <> gts
+        , txOutDatumHash = Just $ toDatumHash sd
+        }
+
+-- | Create the input stake and its corresponding output stake.
+mkStakeDatumPair :: UnlockStakeParameters -> (StakeDatum, StakeDatum)
+mkStakeDatumPair c =
+  let output =
+        StakeDatum
+          { stakedAmount = defaultStakedGTs
+          , owner = signer
+          , lockedBy = []
+          }
+
+      inputLocks = join $ forEachProposalId c.proposalCount (mkStakeLocks c.stakeUsage)
+
+      input = output {lockedBy = inputLocks}
+   in (input, output)
+  where
+    mkStakeLocks :: StakeRole -> ProposalId -> [ProposalLock]
+    mkStakeLocks Voter pid = [ProposalLock defaultVoteFor pid]
+    mkStakeLocks Creator pid =
+      map (`ProposalLock` pid) $
+        AssocMap.keys $ getProposalVotes votesTemplate
+    mkStakeLocks _ _ = []
+
+-- | Create a valid proposal 'TxOut' given the proposal datum.
+mkProposalTxOut :: ProposalDatum -> TxOut
+mkProposalTxOut pd =
+  let pst = Value.singleton proposalPolicySymbol "" 1
+   in TxOut
+        { txOutAddress = proposalValidatorAddress
+        , txOutValue = sortValue $ pst <> minAda
+        , txOutDatumHash = Just $ toDatumHash pd
+        }
+
+-- | Create a input proposal and its corresponding output proposal.
+mkProposalDatumPair ::
+  UnlockStakeParameters ->
+  ProposalId ->
+  (ProposalDatum, ProposalDatum)
+mkProposalDatumPair params pid =
+  let owner = signer
+
+      inputVotes = mkInputVotes params.stakeUsage $ untag defaultStakedGTs
+
+      input =
+        ProposalDatum
+          { proposalId = pid
+          , effects = emptyEffectFor votesTemplate
+          , status = params.proposalStatus
+          , cosigners = [owner]
+          , thresholds = def
+          , votes = inputVotes
+          , timingConfig = def
+          , startingTime = ProposalStartingTime 0
+          }
+
+      output =
+        if params.retractVotes
+          then input {votes = votesTemplate}
+          else input
+   in (input, output)
+  where
+    -- Assemble the votes of the input proposal based on 'votesTemplate'.
+    mkInputVotes ::
+      StakeRole ->
+      -- The staked amount/votes.
+      Integer ->
+      ProposalVotes
+    mkInputVotes Voter vc =
+      ProposalVotes $
+        updateMap (Just . const vc) defaultVoteFor $
+          getProposalVotes votesTemplate
+    mkInputVotes Creator _ =
+      ProposalVotes $
+        updateMap (Just . const 1000) defaultVoteFor $
+          getProposalVotes votesTemplate
+    mkInputVotes _ _ = votesTemplate
+
+-- | Create a 'TxInfo' that tries to unlock a stake.
+unlockStake :: UnlockStakeParameters -> TxInfo
+unlockStake p =
+  let (pInDatums, pOutDatums) = mkProposals p
+      (sInDatum, sOutDatum) = mkStakeDatumPair p
+
+      pIns =
+        zipWith
+          ( \i d ->
+              ( let txOut = mkProposalTxOut d
+                    ref = proposalRef {txOutRefIdx = i}
+                 in TxInInfo ref txOut
+              )
+          )
+          [1 ..]
+          pInDatums
+      pOuts = map mkProposalTxOut pOutDatums
+
+      sIn = TxInInfo stakeRef $ mkStakeTxOut sInDatum
+      sOut = mkStakeTxOut sOutDatum
+
+      mkDatum :: forall d. (ToData d) => d -> Datum
+      mkDatum = Datum . toBuiltinData
+   in TxInfo
+        { txInfoInputs = sIn : pIns
+        , txInfoOutputs = sOut : pOuts
+        , txInfoFee = Value.singleton "" "" 2
+        , txInfoMint = mempty
+        , txInfoDCert = []
+        , txInfoWdrl = []
+        , -- Time doesn't matter int this case.
+          txInfoValidRange = closedBoundedInterval 0 100
+        , txInfoSignatories = [signer]
+        , txInfoData = datumPair <$> (mkDatum <$> [sInDatum, sOutDatum]) <> (mkDatum <$> pInDatums <> pOutDatums)
+        , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
+        }
+
+-- | Create the input proposal datum.
+mkProposalInputDatum :: UnlockStakeParameters -> ProposalId -> ProposalDatum
+mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid
+
+-- | Create the input stake datum.
+mkStakeInputDatum :: UnlockStakeParameters -> StakeDatum
+mkStakeInputDatum = fst . mkStakeDatumPair
+
+-- | Create a test case that tests the proposal validator's @'Unlock' _@ redeemer.
+mkProposalValidatorTestCase :: UnlockStakeParameters -> Bool -> SpecificationTree
+mkProposalValidatorTestCase p shouldSucceed =
+  let datum = mkProposalInputDatum p $ ProposalId 0
+      redeemer = Unlock (ResultTag 0)
+      name = show p
+      scriptContext = ScriptContext (unlockStake p) (Spending proposalRef)
+      f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith
+   in f name (proposalValidator Shared.proposal) datum redeemer scriptContext

agora-specs/Spec/Proposal.hs

@@ -36,34 +36,13 @@ import Agora.Stake (
   StakeRedeemer (PermitVote, WitnessStake),
  )
 import Agora.Stake.Scripts (stakeValidator)
+import Control.Monad (join)
 import Data.Default.Class (Default (def))
 import Data.Tagged (Tagged (Tagged), untag)
 import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..))
-import PlutusTx.AssocMap qualified as AssocMap (empty, fromList)
+import PlutusTx.AssocMap qualified as AssocMap
-import Sample.Proposal qualified as Proposal (
+import Sample.Proposal qualified as Proposal
-  TransitionParameters (
+import Sample.Proposal.UnlockStake qualified as UnlockStake
-    TransitionParameters,
-    initialProposalStatus,
-    proposalStartingTime
-  ),
-  VotingParameters (VotingParameters, voteCount, voteFor),
-  advanceFinishedPropsoal,
-  advanceProposalFailureTimeout,
-  advanceProposalInsufficientVotes,
-  advanceProposalSuccess,
-  advancePropsoalWithInvalidOutputStake,
-  cosignProposal,
-  creatorRetractVotesWhile,
-  creatorUnlockStakeWhile,
-  proposalCreation,
-  proposalRef,
-  stakeRef,
-  unlockStakeAndRetractVotesUsingIrrelevantStakeWhile,
-  unlockStakeUsingIrrelevantStakeWhile,
-  voteOnProposal,
-  voterUnlockStakeAndRetractVotesWhile,
-  voterUnlockStakeWhile,
- )
 import Sample.Shared (signer, signer2)
 import Sample.Shared qualified as Shared (proposal, stake)
 import Test.Specification (
@@ -364,247 +343,110 @@ specs =
           ]
       , group
           "unlocking"
-          [ group
+          $ map
-              "legal"
+            ( \pc ->
-              [ validatorSucceedsWith
+                group
-                  "retract votes and unlock stake while voting"
+                  (show pc <> " proposals")
-                  (proposalValidator Shared.proposal)
+                  [ group
-                  ( ProposalDatum
+                      "legal"
-                      { proposalId = ProposalId 0
+                      [ group
-                      , effects =
+                          "retract votes and unlock stake while voting"
-                          AssocMap.fromList
+                          [ UnlockStake.mkProposalValidatorTestCase
-                            [ (ResultTag 0, AssocMap.empty)
+                              ( UnlockStake.UnlockStakeParameters
-                            , (ResultTag 1, AssocMap.empty)
+                                  pc
-                            ]
+                                  UnlockStake.Voter
-                      , status = VotingReady
+                                  True
-                      , cosigners = [signer]
+                                  VotingReady
-                      , thresholds = def
+                              )
-                      , votes =
+                              True
-                          ProposalVotes
+                          ]
-                            ( AssocMap.fromList
+                      , group
-                                [ (ResultTag 0, 42)
+                          "unlock the stake that has been used to create the proposal"
-                                , (ResultTag 1, 0)
+                          [ UnlockStake.mkProposalValidatorTestCase
-                                ]
+                              ( UnlockStake.UnlockStakeParameters
+                                  pc
+                                  UnlockStake.Creator
+                                  False
+                                  Finished
+                              )
+                              True
+                          ]
+                      , group "unlock stake after voting" $
+                          map
+                            ( \ps ->
+                                UnlockStake.mkProposalValidatorTestCase
+                                  ( UnlockStake.UnlockStakeParameters
+                                      pc
+                                      UnlockStake.Voter
+                                      False
+                                      ps
+                                  )
+                                  True
                             )
-                      , timingConfig = def
+                            [Finished, Locked]
-                      , startingTime = ProposalStartingTime 0
+                      ]
-                      }
+                  , group
-                  )
+                      "illegal"
-                  (Unlock (ResultTag 0))
+                      [ group "retract votes while the proposal is not voting ready" $
-                  ( ScriptContext
+                          map
-                      (Proposal.voterUnlockStakeAndRetractVotesWhile VotingReady)
+                            ( \ps ->
-                      (Spending Proposal.proposalRef)
+                                UnlockStake.mkProposalValidatorTestCase
-                  )
+                                  ( UnlockStake.UnlockStakeParameters
-              , validatorSucceedsWith
+                                      pc
-                  "unlock the stake that has been used to create the proposal"
+                                      UnlockStake.Voter
-                  (proposalValidator Shared.proposal)
+                                      True
-                  ( ProposalDatum
+                                      ps
-                      { proposalId = ProposalId 0
+                                  )
-                      , effects =
+                                  False
-                          AssocMap.fromList
-                            [ (ResultTag 0, AssocMap.empty)
-                            , (ResultTag 1, AssocMap.empty)
-                            ]
-                      , status = Finished
-                      , cosigners = [signer]
-                      , thresholds = def
-                      , votes =
-                          ProposalVotes
-                            ( AssocMap.fromList
-                                [ (ResultTag 0, 42)
-                                , (ResultTag 1, 0)
-                                ]
                             )
-                      , timingConfig = def
+                            [Draft, Locked, Finished]
-                      , startingTime = ProposalStartingTime 0
+                      , group "irrelevant stake" $
-                      }
+                          join $
-                  )
+                            map
-                  (Unlock (ResultTag 0))
+                              ( \rv ->
-                  ( ScriptContext
+                                  map
-                      (Proposal.creatorUnlockStakeWhile Finished)
+                                    ( \ps ->
-                      (Spending Proposal.proposalRef)
+                                        UnlockStake.mkProposalValidatorTestCase
-                  )
+                                          ( UnlockStake.UnlockStakeParameters
-              , group "unlock stake after voting" $
+                                              pc
-                  map
+                                              UnlockStake.Irrelevant
-                    ( \ps ->
+                                              rv
-                        validatorSucceedsWith
+                                              ps
-                          (show ps)
-                          (proposalValidator Shared.proposal)
-                          ( ProposalDatum
-                              { proposalId = ProposalId 0
-                              , effects =
-                                  AssocMap.fromList
-                                    [ (ResultTag 0, AssocMap.empty)
-                                    , (ResultTag 1, AssocMap.empty)
-                                    ]
-                              , status = ps
-                              , cosigners = [signer]
-                              , thresholds = def
-                              , votes =
-                                  ProposalVotes
-                                    ( AssocMap.fromList
-                                        [ (ResultTag 0, 42)
-                                        , (ResultTag 1, 0)
-                                        ]
-                                    )
-                              , timingConfig = def
-                              , startingTime = ProposalStartingTime 0
-                              }
-                          )
-                          (Unlock (ResultTag 0))
-                          ( ScriptContext
-                              (Proposal.voterUnlockStakeWhile ps)
-                              (Spending Proposal.proposalRef)
-                          )
-                    )
-                    [Locked, Finished]
-              ]
-          , group
-              "illegal"
-              [ group "retract votes while the proposal is not voting ready" $
-                  map
-                    ( \ps ->
-                        validatorFailsWith
-                          (show ps)
-                          (proposalValidator Shared.proposal)
-                          ( ProposalDatum
-                              { proposalId = ProposalId 0
-                              , effects =
-                                  AssocMap.fromList
-                                    [ (ResultTag 0, AssocMap.empty)
-                                    , (ResultTag 1, AssocMap.empty)
-                                    ]
-                              , status = ps
-                              , cosigners = [signer]
-                              , thresholds = def
-                              , votes =
-                                  ProposalVotes
-                                    ( AssocMap.fromList
-                                        [ (ResultTag 0, 42)
-                                        , (ResultTag 1, 0)
-                                        ]
-                                    )
-                              , timingConfig = def
-                              , startingTime = ProposalStartingTime 0
-                              }
-                          )
-                          (Unlock (ResultTag 0))
-                          ( ScriptContext
-                              (Proposal.voterUnlockStakeAndRetractVotesWhile ps)
-                              (Spending Proposal.proposalRef)
-                          )
-                    )
-                    [Draft, Locked, Finished]
-              , group
-                  "irrelevant stake"
-                  $ foldMap
-                    ( \(f, s) ->
-                        map
-                          ( \ps ->
-                              validatorFailsWith
-                                (s <> " (" <> show ps <> ")")
-                                (proposalValidator Shared.proposal)
-                                ( ProposalDatum
-                                    { proposalId = ProposalId 0
-                                    , effects =
-                                        AssocMap.fromList
-                                          [ (ResultTag 0, AssocMap.empty)
-                                          , (ResultTag 1, AssocMap.empty)
-                                          ]
-                                    , status = ps
-                                    , cosigners = [signer]
-                                    , thresholds = def
-                                    , votes =
-                                        ProposalVotes
-                                          ( AssocMap.fromList
-                                              [ (ResultTag 0, 42)
-                                              , (ResultTag 1, 0)
-                                              ]
                                           )
-                                    , timingConfig = def
+                                          False
-                                    , startingTime = ProposalStartingTime 0
-                                    }
-                                )
-                                (Unlock (ResultTag 0))
-                                ( ScriptContext
-                                    (f ps)
-                                    (Spending Proposal.proposalRef)
-                                )
-                          )
-                          [Draft, VotingReady, Locked, Finished]
-                    )
-                    [ (Proposal.unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, "unlock stake + retract votes")
-                    , (Proposal.unlockStakeUsingIrrelevantStakeWhile, "unlock stake")
-                    ]
-              , group "unlock stake that has been used to create the proposal before finished" $
-                  map
-                    ( \ps ->
-                        validatorFailsWith
-                          (show ps)
-                          (proposalValidator Shared.proposal)
-                          ( ProposalDatum
-                              { proposalId = ProposalId 0
-                              , effects =
-                                  AssocMap.fromList
-                                    [ (ResultTag 0, AssocMap.empty)
-                                    , (ResultTag 1, AssocMap.empty)
-                                    ]
-                              , status = ps
-                              , cosigners = [signer]
-                              , thresholds = def
-                              , votes =
-                                  ProposalVotes
-                                    ( AssocMap.fromList
-                                        [ (ResultTag 0, 42)
-                                        , (ResultTag 1, 0)
-                                        ]
                                     )
-                              , timingConfig = def
+                                    [Draft, VotingReady, Locked, Finished]
-                              , startingTime = ProposalStartingTime 0
+                              )
-                              }
+                              [True, False]
-                          )
+                      , group "unlock stake that has been used to create the proposal before finished" $
-                          (Unlock (ResultTag 0))
+                          map
-                          ( ScriptContext
+                            ( \ps ->
-                              (Proposal.creatorUnlockStakeWhile ps)
+                                UnlockStake.mkProposalValidatorTestCase
-                              (Spending Proposal.proposalRef)
+                                  ( UnlockStake.UnlockStakeParameters
-                          )
+                                      pc
-                    )
+                                      UnlockStake.Creator
-                    [Draft, VotingReady, Locked]
+                                      False
-              , group "creator stake retract votes" $
+                                      ps
-                  map
+                                  )
-                    ( \ps ->
+                                  False
-                        validatorFailsWith
+                            )
-                          (show ps)
+                            [Draft, VotingReady, Locked]
-                          (proposalValidator Shared.proposal)
+                      , group "creator stake retract votes" $
-                          ( ProposalDatum
+                          map
-                              { proposalId = ProposalId 0
+                            ( \ps ->
-                              , effects =
+                                UnlockStake.mkProposalValidatorTestCase
-                                  AssocMap.fromList
+                                  ( UnlockStake.UnlockStakeParameters
-                                    [ (ResultTag 0, AssocMap.empty)
+                                      pc
-                                    , (ResultTag 1, AssocMap.empty)
+                                      UnlockStake.Creator
-                                    ]
+                                      True
-                              , status = ps
+                                      ps
-                              , cosigners = [signer]
+                                  )
-                              , thresholds = def
+                                  False
-                              , votes =
+                            )
-                                  ProposalVotes
+                            [Draft, VotingReady, Locked, Finished]
-                                    ( AssocMap.fromList
+                      ]
-                                        [ (ResultTag 0, 42)
+                  ]
-                                        , (ResultTag 1, 0)
+            )
-                                        ]
+            [1, 25]
-                                    )
-                              , timingConfig = def
-                              , startingTime = ProposalStartingTime 0
-                              }
-                          )
-                          (Unlock (ResultTag 0))
-                          ( ScriptContext
-                              (Proposal.creatorRetractVotesWhile ps)
-                              (Spending Proposal.proposalRef)
-                          )
-                    )
-                    [Draft, VotingReady, Locked, Finished]
-              ]
-          ]
       ]
   ]

agora-testlib/Test/Util.hs

@@ -11,6 +11,8 @@ module Test.Util (
   datumPair,
   closedBoundedInterval,
   updateMap,
+  sortMap,
+  sortValue,
 ) where
 
 --------------------------------------------------------------------------------
@@ -24,9 +26,12 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy
 
 --------------------------------------------------------------------------------
 
+import Data.Bifunctor (second)
+import Data.List (sortBy)
 import Plutarch.Crypto (pblake2b_256)
-import PlutusLedgerApi.V1.Interval as PlutusTx
+import PlutusLedgerApi.V1.Interval qualified as PlutusTx
 import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
+import PlutusLedgerApi.V1.Value (Value (..))
 import PlutusTx.AssocMap qualified as AssocMap
 import PlutusTx.Builtins qualified as PlutusTx
 import PlutusTx.IsData qualified as PlutusTx
@@ -84,3 +89,19 @@ updateMap f k =
           then f v
           else Just v
     )
+
+--------------------------------------------------------------------------------
+
+sortMap :: forall k v. Ord k => AssocMap.Map k v -> AssocMap.Map k v
+sortMap (AssocMap.toList -> l) =
+  AssocMap.fromList $
+    sortBy
+      ( \(k1, _)
+         (k2, _) -> compare k1 k2
+      )
+      l
+
+sortValue :: Value -> Value
+sortValue (AssocMap.toList . getValue -> l) =
+  let innerSorted = second sortMap <$> l
+   in Value $ sortMap $ AssocMap.fromList innerSorted

agora.cabal

@@ -182,6 +182,8 @@ library agora-specs
     Sample.Effect.TreasuryWithdrawal
     Sample.Governor
     Sample.Proposal
+    Sample.Proposal.Shared
+    Sample.Proposal.UnlockStake
     Sample.Shared
     Sample.Stake
     Sample.Treasury

bench.csv

@@ -18,10 +18,14 @@ Agora/Proposal/validator/advancing/successfully advance to next state/Locked ->
 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6483
 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6484
 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6484
-Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171454676,461966,6556
+"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",189052005,492891,6583
-Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6563
+"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167586302,438831,6587
-Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6557
+"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166653391,439126,6587
-Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6557
+"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166653391,439126,6587
+"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105824237,3030675,19333
+"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935680982,2549151,19483
+"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934748071,2549446,19434
+"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934748071,2549446,19434
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390