fix tests; add negative tests for unlocking in cooldown

agora-specs/Property/Governor.hs

@@ -121,7 +121,7 @@ governorDatumValidProperty =
         genDatumForCase c = do
           thres <- genProposalThresholds c
 
-          let timing = ProposalTimingConfig 0 0 0 0
+          let timing = ProposalTimingConfig 0 0 0 0 0 0
           pure $
             GovernorDatum thres (ProposalId 0) timing (MaxTimeRangeWidth 1) 3
           where

agora-specs/Sample/Governor/Initialize.hs

@@ -106,7 +106,7 @@ invalidMaxTimeRangeWidth :: MaxTimeRangeWidth
 invalidMaxTimeRangeWidth = MaxTimeRangeWidth 0
 
 invalidProposalTimings :: ProposalTimingConfig
-invalidProposalTimings = ProposalTimingConfig (-1) (-1) (-1) (-1)
+invalidProposalTimings = ProposalTimingConfig (-1) (-1) (-1) (-1) (-1) (-1)
 
 witnessRef :: TxOutRef
 witnessRef = TxOutRef "b0353c22b0bd6c5296a8eef160ba25d90b5dc82a9bb8bdaa6823ffc19515d6ad" 0

agora-specs/Sample/Proposal/Cosign.hs

@@ -40,7 +40,8 @@ import Agora.Proposal.Time (
  )
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
-  ProposalLock (Cosigned, Created),
+  ProposalAction (Cosigned, Created),
+  ProposalLock (ProposalLock),
   StakeDatum (..),
   StakeRedeemer (PermitVote),
  )
@@ -196,7 +197,7 @@ mkStakeInputDatum ps =
       amount = mkStakeAmount sps.gtAmount
       owner = mkStakeOwner sps.stakeOwner
       locks = case sps.stakeOwner of
-        Creator -> [Created defProposalId]
+        Creator -> [ProposalLock defProposalId Created]
         _ -> []
    in StakeDatum
         { stakedAmount = amount
@@ -212,7 +213,7 @@ mkStakeOuputDatum ps =
       locks =
         if sps.dontUpdateLocks
           then inpDatum.lockedBy
-          else Cosigned defProposalId : inpDatum.lockedBy
+          else ProposalLock defProposalId Cosigned : inpDatum.lockedBy
    in inpDatum {lockedBy = locks}
 
 stakeRedeemer :: StakeRedeemer

agora-specs/Sample/Proposal/Create.hs

@@ -47,7 +47,8 @@ import Agora.Proposal.Time (
  )
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
-  ProposalLock (..),
+  ProposalAction (Created, Voted),
+  ProposalLock (ProposalLock),
   StakeDatum (..),
   StakeRedeemer (PermitVote),
  )
@@ -160,7 +161,7 @@ alteredStakeOwner = PubKeyCredential signer2
 
 -- | Locks the stake that the input stake already has.
 defLocks :: [ProposalLock]
-defLocks = [Created (ProposalId 0)]
+defLocks = [ProposalLock (ProposalId 0) Created]
 
 -- | The effect of the newly created proposal.
 defEffects :: StrictMap.Map ResultTag ProposalEffectGroup
@@ -207,7 +208,7 @@ mkStakeInputDatum ps =
   let locks =
         if ps.createdMoreThanMaximumProposals
           then
-            Created . ProposalId
+            flip ProposalLock Created . ProposalId
               <$> take
                 (fromInteger maxProposalPerStake)
                 [1 ..]
@@ -226,10 +227,10 @@ mkStakeOutputDatum ps =
       newLocks =
         if ps.invalidNewLocks
           then
-            [ Voted thisProposalId (ResultTag 0)
+            [ ProposalLock thisProposalId $ Voted (ResultTag 0) 100
-            , Voted thisProposalId (ResultTag 1)
+            , ProposalLock thisProposalId $ Voted (ResultTag 1) 100
             ]
-          else [Created thisProposalId]
+          else [ProposalLock thisProposalId Created]
       locks = newLocks <> inputDatum.lockedBy
       newOwner = mkOwner ps
    in inputDatum

agora-specs/Sample/Proposal/PrivilegeEscalate.hs

@@ -20,9 +20,10 @@ import Agora.Proposal.Time (
  )
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
-  ProposalLock (
+  ProposalAction (
     Voted
   ),
+  ProposalLock (ProposalLock),
   StakeDatum (..),
   StakeRedeemer (PermitVote, RetractVotes),
  )
@@ -128,8 +129,19 @@ mkStakeInputOutputDatums op =
 
       allStakes = take 10 $ firstStake : otherStakes
 
+      createdAt = (def :: ProposalTimingConfig).votingTime - 1
+
       stakeWithLock =
-        (\stake -> stake {lockedBy = [Voted defProposalId defResultTag]})
+        ( \stake ->
+            stake
+              { lockedBy =
+                  [ ProposalLock defProposalId $
+                      Voted
+                        defResultTag
+                        createdAt
+                  ]
+              }
+        )
           <$> allStakes
    in wrap op (,) allStakes stakeWithLock
 

agora-specs/Sample/Proposal/Unlock.hs

@@ -28,6 +28,7 @@ module Sample.Proposal.Unlock (
   mkCreatorRetractVotes,
   mkChangeOutputStakeValue,
   mkUseFakeStakes,
+  mkDisrespectCooldown,
 ) where
 
 --------------------------------------------------------------------------------
@@ -42,13 +43,18 @@ import Agora.Proposal (
   ProposalVotes (..),
   ResultTag (..),
  )
-import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
+import Agora.Proposal.Time (
+  ProposalStartingTime (ProposalStartingTime),
+  ProposalTimingConfig (..),
+ )
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
+  ProposalAction (Created, Voted),
   ProposalLock (..),
   StakeDatum (..),
   StakeRedeemer (RetractVotes),
  )
+import Data.Coerce (coerce)
 import Data.Default.Class (Default (def))
 import Data.Map.Strict qualified as StrictMap
 import Data.Tagged (Tagged, untag)
@@ -70,6 +76,7 @@ import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusLedgerApi.V2 (
   Credential (PubKeyCredential),
+  POSIXTime,
   PubKeyHash,
   TxOutRef (..),
  )
@@ -142,7 +149,7 @@ data ParameterBundle = ParameterBundle
 
 data SignedBy = Owner | Delegatee | Unknown
 
-data TimeRange = WhileVoting | AfterVoting
+data TimeRange = WhileVoting {offset :: POSIXTime} | AfterVoting
 
 data TransactionParameters = TransactionParameters
   { signedBy :: SignedBy
@@ -177,6 +184,7 @@ data StakeParameters = StakeParameters
   , removeCreatorLock :: Bool
   , alterOutputValue :: Bool
   , sstOwner :: SSTOwner
+  , votingLockCreatedAt :: POSIXTime
   }
 
 data Validity = Validity
@@ -203,14 +211,20 @@ mkStakeInputDatum ps =
   where
     stakeLocks = mkStakeLocks' ps.stakeRole
 
-    mkStakeLocks' Voter = [Voted defProposalId defVoteFor]
+    mkStakeLocks' Voter =
-    mkStakeLocks' Creator = [Created defProposalId]
+      [ ProposalLock defProposalId $
+          Voted defVoteFor ps.votingLockCreatedAt
+      ]
+    mkStakeLocks' Creator = [ProposalLock defProposalId Created]
     mkStakeLocks' Both = mkStakeLocks' Voter <> mkStakeLocks' Creator
     mkStakeLocks' Irrelevant =
       let ProposalId pid = defProposalId
           ResultTag vid = defVoteFor
-       in [ Voted (ProposalId $ pid + 1) (ResultTag $ vid + 1)
+       in [ ProposalLock (ProposalId $ pid + 1) $
-          , Created (ProposalId $ pid + 1)
+              Voted
+                (ResultTag $ vid + 1)
+                ps.votingLockCreatedAt
+          , ProposalLock (ProposalId $ pid + 1) Created
           ]
 
 --------------------------------------------------------------------------------
@@ -292,14 +306,13 @@ unlock ps = builder
 
     stakeInputDatum = mkStakeInputDatum ps.stakeParameters
 
+    -- TODO respect timing
     removeLocks v c =
-      filter $
+      filter $ \(ProposalLock pid action) ->
-        not
+        pid == defProposalId
-          . ( \case
+          && case action of
-                Created pid -> c && pid == defProposalId
+            Voted _ _ -> v
-                Cosigned pid -> c && pid == defProposalId
+            _ -> c
-                Voted pid _ -> v && pid == defProposalId
-            )
 
     stakeOutputDatum =
       stakeInputDatum
@@ -355,9 +368,14 @@ unlock ps = builder
     ProposalStartingTime s = defStartingTime
 
     time = case ps.transactionParameters.timeRange of
-      WhileVoting ->
+      WhileVoting offset ->
-        let lb = s + (def :: ProposalTimingConfig).draftTime
+        let lb =
-            ub = lb + (def :: ProposalTimingConfig).votingTime
+              ps.stakeParameters.votingLockCreatedAt
+                + offset
+            ub =
+              s
+                + (def :: ProposalTimingConfig).draftTime
+                + (def :: ProposalTimingConfig).votingTime
          in closedBoundedInterval (lb + 1) (ub - 1)
       AfterVoting ->
         let lb =
@@ -429,12 +447,21 @@ mkValidVoterRetractVotes i =
           , removeCreatorLock = False
           , alterOutputValue = False
           , sstOwner = StakeValidator
+          , votingLockCreatedAt =
+              coerce defStartingTime
+                + (def :: ProposalTimingConfig).draftTime
+                + 1
           }
     , transactionParameters =
         TransactionParameters
           { signedBy = Owner
           , timeRange =
               WhileVoting
+                { offset =
+                    coerce
+                      (def :: ProposalTimingConfig).minStakeVotingTime
+                      + 5
+                }
           }
     }
 
@@ -544,10 +571,6 @@ mkCreatorRetractVotes i =
             template.stakeParameters
               { stakeRole = Creator
               }
-        , transactionParameters =
-            template.transactionParameters
-              { timeRange = WhileVoting
-              }
         }
 
 mkChangeOutputStakeValue :: Integer -> ParameterBundle
@@ -569,3 +592,19 @@ mkUseFakeStakes i =
               { sstOwner = Attacker
               }
         }
+
+mkDisrespectCooldown :: Integer -> ParameterBundle
+mkDisrespectCooldown i =
+  let template = mkValidVoterCreatorRetractVotes i
+   in template
+        { transactionParameters =
+            template.transactionParameters
+              { timeRange =
+                  WhileVoting
+                    { offset =
+                        coerce
+                          (def :: ProposalTimingConfig).minStakeVotingTime
+                          - 5
+                    }
+              }
+        }

agora-specs/Sample/Proposal/Vote.hs

@@ -46,7 +46,8 @@ import Agora.Proposal.Time (
  )
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
-  ProposalLock (Voted),
+  ProposalAction (Voted),
+  ProposalLock (ProposalLock),
   StakeDatum (..),
   StakeRedeemer (Destroy, PermitVote),
  )
@@ -68,7 +69,7 @@ import Plutarch.Context (
   withValue,
  )
 import Plutarch.Extra.AssetClass (adaClass, assetClassValue)
-import PlutusLedgerApi.V2 (Credential (PubKeyCredential), PubKeyHash)
+import PlutusLedgerApi.V2 (Credential (PubKeyCredential), Interval, POSIXTime, PubKeyHash)
 import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef))
 import Sample.Proposal.Shared (proposalTxRef)
 import Sample.Shared (
@@ -145,6 +146,24 @@ delegatee = pubKeyHashes !! 1
 unknownSig :: PubKeyHash
 unknownSig = pubKeyHashes !! 2
 
+validTimeRangeLowerBound :: POSIXTime
+validTimeRangeLowerBound =
+  0
+    + (def :: ProposalTimingConfig).draftTime
+    + 1
+
+validTimeRangeUpperBound :: POSIXTime
+validTimeRangeUpperBound =
+  validTimeRangeLowerBound
+    + (def :: ProposalTimingConfig).votingTime
+    - 2
+
+validTimeRange :: Interval POSIXTime
+validTimeRange =
+  closedBoundedInterval
+    validTimeRangeLowerBound
+    validTimeRangeUpperBound
+
 --------------------------------------------------------------------------------
 
 initialVotes :: StrictMap.Map ResultTag Integer
@@ -197,8 +216,8 @@ mkStakeInputDatum params =
     , owner = PubKeyCredential stakeOwner
     , delegatedTo = Just (PubKeyCredential delegatee)
     , lockedBy =
-        [ Voted (ProposalId 0) (ResultTag 0)
+        [ ProposalLock (ProposalId 0) $ Voted (ResultTag 0) 100
-        , Voted (ProposalId 1) (ResultTag 2)
+        , ProposalLock (ProposalId 1) $ Voted (ResultTag 2) 200
         ]
     }
 
@@ -227,9 +246,11 @@ vote params =
             <> minAda
 
       newLock =
-        Voted
+        ProposalLock
           proposalInputDatum.proposalId
-          params.voteParameters.voteFor
+          $ Voted
+            params.voteParameters.voteFor
+            validTimeRangeUpperBound
 
       updatedLocks =
         if params.stakeParameters.stakeOutputParameters.dontAddNewLock
@@ -357,13 +378,6 @@ vote params =
 
       --------------------------------------------------------------------------
 
-      validTimeRange =
-        closedBoundedInterval
-          ((def :: ProposalTimingConfig).draftTime + 1)
-          ((def :: ProposalTimingConfig).votingTime - 1)
-
-      --------------------------------------------------------------------------
-
       miscBuilder :: b
       miscBuilder =
         mconcat

agora-specs/Sample/Shared.hs

@@ -240,6 +240,8 @@ instance Default ProposalTimingConfig where
       , votingTime = 1000
       , lockingTime = 2000
       , executingTime = 3000
+      , minStakeVotingTime = 100
+      , votingTimeRangeMaxWidth = 1000000
       }
 
 {- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'.

agora-specs/Sample/Stake/Create.hs

@@ -20,7 +20,7 @@ module Sample.Stake.Create (
 import Agora.Governor (Governor (gtClassRef))
 import Agora.Proposal (ProposalId (ProposalId))
 import Agora.SafeMoney (GTTag)
-import Agora.Stake (ProposalLock (Created), StakeDatum (..))
+import Agora.Stake (ProposalAction (Created), ProposalLock (ProposalLock), StakeDatum (..))
 import Data.Semigroup (stimesMonoid)
 import Data.Tagged (Tagged)
 import Plutarch.Context (
@@ -255,6 +255,6 @@ alreadyHasLocks =
               { stakedAmount = 114514
               , owner = PubKeyCredential signer
               , delegatedTo = Nothing
-              , lockedBy = [Created $ ProposalId 0]
+              , lockedBy = [ProposalLock (ProposalId 0) Created]
               }
     }

agora-specs/Sample/Stake/Destroy.hs

@@ -20,7 +20,8 @@ module Sample.Stake.Destroy (
 
 import Agora.Proposal (ProposalId (..))
 import Agora.Stake (
-  ProposalLock (Created),
+  ProposalAction (Created),
+  ProposalLock (ProposalLock),
   StakeDatum (..),
   StakeRedeemer (Destroy),
  )
@@ -105,7 +106,7 @@ mkStakeInputDatum ps =
     { stakedAmount = 114514
     , owner = PubKeyCredential owner
     , delegatedTo = Just $ PubKeyCredential delegatee
-    , lockedBy = [Created $ ProposalId 0 | ps.notUnlocked]
+    , lockedBy = [ProposalLock (ProposalId 0) Created | ps.notUnlocked]
     }
 
 mkStakeRef :: Int -> TxOutRef

agora-specs/Spec/Proposal.hs

@@ -437,6 +437,10 @@ specs =
                       "use fake stake"
                       (Unlock.mkUseFakeStakes nStakes)
                       (Unlock.Validity False False)
+                  , Unlock.mkTestTree
+                      "retract votes in cooldown"
+                      (Unlock.mkDisrespectCooldown nStakes)
+                      (Unlock.Validity True False)
                   ]
 
               legalGroup = group "legal" $ map mkLegalGroup stakeCountCases