fix tests; add negative tests for unlocking in cooldown

2022-11-14 20:42:52 +08:00 · 2022-11-14 20:42:52 +08:00 · 60b4ed9cf2
commit 60b4ed9cf2
parent a462e6a3d3
11 changed files with 124 additions and 50 deletions
--- a/agora-specs/Property/Governor.hs
+++ b/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
--- a/agora-specs/Sample/Governor/Initialize.hs
+++ b/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
--- a/agora-specs/Sample/Proposal/Cosign.hs
+++ b/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
--- a/agora-specs/Sample/Proposal/Create.hs
+++ b/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)
-            , Voted thisProposalId (ResultTag 1)
+            [ ProposalLock thisProposalId $ Voted (ResultTag 0) 100
+            , ProposalLock thisProposalId $ Voted (ResultTag 1) 100
            ]
-          else [Created thisProposalId]
+          else [ProposalLock thisProposalId Created]
      locks = newLocks <> inputDatum.lockedBy
      newOwner = mkOwner ps
   in inputDatum
--- a/agora-specs/Sample/Proposal/PrivilegeEscalate.hs
+++ b/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

--- a/agora-specs/Sample/Proposal/Unlock.hs
+++ b/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' Creator = [Created defProposalId]
+    mkStakeLocks' Voter =
+      [ 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)
-          , Created (ProposalId $ pid + 1)
+       in [ ProposalLock (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 $
-        not
-          . ( \case
-                Created pid -> c && pid == defProposalId
-                Cosigned pid -> c && pid == defProposalId
-                Voted pid _ -> v && pid == defProposalId
-            )
+      filter $ \(ProposalLock pid action) ->
+        pid == defProposalId
+          && case action of
+            Voted _ _ -> v
+            _ -> c

    stakeOutputDatum =
      stakeInputDatum
@ -355,9 +368,14 @@ unlock ps = builder
    ProposalStartingTime s = defStartingTime

    time = case ps.transactionParameters.timeRange of
-      WhileVoting ->
-        let lb = s + (def :: ProposalTimingConfig).draftTime
-            ub = lb + (def :: ProposalTimingConfig).votingTime
+      WhileVoting offset ->
+        let lb =
+              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
+                    }
+              }
+        }
--- a/agora-specs/Sample/Proposal/Vote.hs
+++ b/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)
-        , Voted (ProposalId 1) (ResultTag 2)
+        [ ProposalLock (ProposalId 0) $ Voted (ResultTag 0) 100
+        , 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
--- a/agora-specs/Sample/Shared.hs
+++ b/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'.
--- a/agora-specs/Sample/Stake/Create.hs
+++ b/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]
              }
    }
--- a/agora-specs/Sample/Stake/Destroy.hs
+++ b/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
--- a/agora-specs/Spec/Proposal.hs
+++ b/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