fix tests for cosigning

agora-specs/Property/Governor.hs

@@ -18,7 +18,7 @@ import Agora.Proposal.Time (
   ProposalTimingConfig (ProposalTimingConfig),
  )
 import Data.Default.Class (Default (def))
-import Data.Tagged (Tagged (Tagged), untag)
+import Data.Tagged (Tagged (Tagged))
 import Data.Universe (Finite (..), Universe (..))
 import Plutarch.Api.V2 (PScriptContext)
 import Plutarch.Builtin (pforgetData)
@@ -65,6 +65,7 @@ data GovernorDatumCases
   | CreateLE0
   | ToVotingLE0
   | VoteLE0
+  | CosignLE0
   | Correct
   deriving stock (Eq, Show)
 
@@ -73,6 +74,7 @@ instance Universe GovernorDatumCases where
     [ ExecuteLE0
     , CreateLE0
     , VoteLE0
+    , CosignLE0
     , Correct
     ]
 
@@ -89,11 +91,12 @@ governorDatumValidProperty =
   classifiedPropertyNative gen (const []) expected classifier pisGovernorDatumValid
   where
     classifier :: GovernorDatum -> GovernorDatumCases
-    classifier ((.proposalThresholds) -> ProposalThresholds e c tv v)
+    classifier ((.proposalThresholds) -> ProposalThresholds e c tv v co)
       | e < 0 = ExecuteLE0
       | c < 0 = CreateLE0
       | tv < 0 = ToVotingLE0
       | v < 0 = VoteLE0
+      | co < 0 = CosignLE0
       | otherwise = Correct
 
     expected :: GovernorDatum -> Maybe Bool
@@ -114,25 +117,25 @@ governorDatumValidProperty =
           create <- validGT
           toVoting <- validGT
           vote <- validGT
+          cosign <- validGT
           le0 <- taggedInteger (-1000, -1)
 
           case c of
             ExecuteLE0 ->
               -- execute < 0
-              return $ ProposalThresholds le0 create toVoting vote
+              return $ ProposalThresholds le0 create toVoting vote cosign
             CreateLE0 ->
               -- c < 0
-              return $ ProposalThresholds execute le0 toVoting vote
+              return $ ProposalThresholds execute le0 toVoting vote cosign
             ToVotingLE0 ->
-              return $ ProposalThresholds execute create le0 vote
+              return $ ProposalThresholds execute create le0 vote cosign
             VoteLE0 ->
               -- vote < 0
-              return $ ProposalThresholds execute create toVoting le0
+              return $ ProposalThresholds execute create toVoting le0 cosign
-            Correct -> do
+            CosignLE0 ->
-              -- c <= vote < execute
+              return $ ProposalThresholds execute create toVoting vote le0
-              nv <- taggedInteger (0, untag execute - 1)
+            Correct ->
-              nc <- taggedInteger (0, untag nv)
+              return $ ProposalThresholds execute create toVoting vote cosign
-              return $ ProposalThresholds execute nc toVoting nv
 
 data GovernorPolicyCases
   = ReferenceUTXONotSpent

agora-specs/Sample/Governor/Initialize.hs

@@ -93,7 +93,7 @@ validGovernorOutputDatum =
     }
 
 invalidProposalThresholds :: ProposalThresholds
-invalidProposalThresholds = ProposalThresholds (-1) (-1) (-1) (-1)
+invalidProposalThresholds = ProposalThresholds (-1) (-1) (-1) (-1) (-1)
 
 invalidMaxTimeRangeWidth :: MaxTimeRangeWidth
 invalidMaxTimeRangeWidth = MaxTimeRangeWidth 0

agora-specs/Sample/Governor/Mutate.hs

@@ -122,6 +122,7 @@ mkGovernorOutputDatum ValueInvalid =
           , create = -1
           , toVoting = -1
           , vote = -1
+          , cosign = -1
           }
    in Just $
         toData $

agora-specs/Sample/Proposal/Cosign.hs

@@ -6,11 +6,22 @@ Description: Generate sample data for testing the functionalities of cosigning p
 Sample and utilities for testing the functionalities of cosigning proposals.
 -}
 module Sample.Proposal.Cosign (
-  Parameters (..),
+  StakedAmount (..),
-  validCosignNParameters,
+  StakeOwner (..),
-  duplicateCosignersParameters,
+  StakeParameters (..),
-  statusNotDraftCosignNParameters,
+  SignedBy (..),
+  TransactionParameters (..),
+  ProposalParameters (..),
+  ParameterBundle (..),
+  Validity (..),
+  cosign,
   mkTestTree,
+  totallyValid,
+  insufficientStakedAmount,
+  duplicateCosigners,
+  locksNotUpdated,
+  cosignersNotUpdated,
+  cosignAfterDraft,
 ) where
 
 import Agora.Governor (Governor (..))
@@ -19,6 +30,7 @@ import Agora.Proposal (
   ProposalId (ProposalId),
   ProposalRedeemer (Cosign),
   ProposalStatus (..),
+  ProposalThresholds (..),
   ResultTag (ResultTag),
   emptyVotesFor,
  )
@@ -29,7 +41,9 @@ import Agora.Proposal.Time (
 import Agora.SafeMoney (GTTag)
 import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  StakeDatum (StakeDatum, owner),
+  ProposalLock (Cosigned, Created),
+  StakeDatum (..),
+  StakeRedeemer (PermitVote),
  )
 import Data.Coerce (coerce)
 import Data.Default (def)
@@ -38,25 +52,25 @@ import Data.Map.Strict qualified as StrictMap
 import Data.Tagged (untag)
 import Plutarch.Context (
   input,
+  normalizeValue,
   output,
-  referenceInput,
   script,
   signedWith,
   timeRange,
   txId,
   withDatum,
   withInlineDatum,
+  withRedeemer,
   withRef,
   withValue,
  )
-import Plutarch.SafeMoney (Discrete)
+import Plutarch.SafeMoney (Discrete (Discrete))
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusLedgerApi.V2 (
   Credential (PubKeyCredential),
-  POSIXTimeRange,
+  POSIXTime (POSIXTime),
   PubKeyHash,
-  TxOutRef (..),
+  TxOutRef (TxOutRef),
-  Value,
  )
 import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
@@ -66,36 +80,81 @@ import Sample.Shared (
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
-  signer,
   stakeAssetClass,
   stakeValidatorHash,
  )
 import Test.Specification (
   SpecificationTree,
+  group,
   testValidator,
  )
-import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes, sortValue)
+import Test.Util (
+  CombinableBuilder,
+  closedBoundedInterval,
+  mkSpending,
+  pubKeyHashes,
+ )
 
--- | Parameters for cosigning a proposal.
+data StakedAmount = Sufficient | Insufficient
-data Parameters = Parameters
+
-  { newCosigners :: [Credential]
+data StakeOwner = Creator | Other
-  -- ^ New cosigners to be added, and the owners of the generated stakes.
+
-  , proposalStatus :: ProposalStatus
+data StakeParameters = StakeParameters
-  -- ^ Current state of the proposal.
+  { gtAmount :: StakedAmount
+  , stakeOwner :: StakeOwner
+  , dontUpdateLocks :: Bool
   }
 
--- | Owner of the creator stake, doesn't really matter in this case.
+data SignedBy = Owner | Delegatee | Unknown
-proposalCreator :: PubKeyHash
-proposalCreator = signer
 
--- | The amount of GTs every generated stake has, doesn't really matter in this case.
+newtype TransactionParameters = TransactionParameters
-perStakedGTs :: Discrete GTTag
+  { signedBy :: SignedBy
-perStakedGTs = 5
+  }
 
-{- | Create input proposal datum given the parameters.
+data ProposalParameters = ProposalParameters
-   In particular, 'status' is set to 'proposalStstus'.
+  { proposalStatus :: ProposalStatus
--}
+  , dontUpdateCosigners :: Bool
-mkProposalInputDatum :: Parameters -> ProposalDatum
+  }
+
+-- | Parameters for cosigning a proposal.
+data ParameterBundle = ParameterBundle
+  { stakeParameters :: StakeParameters
+  , proposalParameters :: ProposalParameters
+  , transactionParameters :: TransactionParameters
+  }
+
+data Validity = Validity
+  { forProposalValidator :: Bool
+  , forStakeValidator :: Bool
+  }
+
+--------------------------------------------------------------------------------
+
+mkStakeAmount :: StakedAmount -> Discrete GTTag
+mkStakeAmount Sufficient = Discrete $ (def @ProposalThresholds).cosign
+mkStakeAmount Insufficient = mkStakeAmount Sufficient - 1
+
+mkStakeOwner :: StakeOwner -> PubKeyHash
+mkStakeOwner Creator = creator
+mkStakeOwner Other = pubKeyHashes !! 2
+
+mkSigner :: StakeOwner -> SignedBy -> PubKeyHash
+mkSigner so Owner = mkStakeOwner so
+mkSigner _ Delegatee = delegatee
+mkSigner _ Unknown = pubKeyHashes !! 4
+
+creator :: PubKeyHash
+creator = pubKeyHashes !! 1
+
+delegatee :: PubKeyHash
+delegatee = pubKeyHashes !! 3
+
+--------------------------------------------------------------------------------
+
+defProposalId :: ProposalId
+defProposalId = ProposalId 0
+
+mkProposalInputDatum :: ParameterBundle -> ProposalDatum
 mkProposalInputDatum ps =
   let effects =
         StrictMap.fromList
@@ -105,98 +164,136 @@ mkProposalInputDatum ps =
    in ProposalDatum
         { proposalId = ProposalId 0
         , effects = effects
-        , status = ps.proposalStatus
+        , status = ps.proposalParameters.proposalStatus
-        , cosigners = [PubKeyCredential proposalCreator]
+        , cosigners = [PubKeyCredential creator]
         , thresholds = def
         , votes = emptyVotesFor effects
         , timingConfig = def
         , startingTime = ProposalStartingTime 0
         }
 
-{- | Create the output proposal datum given the parameters.
+mkProposalOutputDatum :: ParameterBundle -> ProposalDatum
-   The 'newCosigners' is added to the exisiting list of cosigners, note the said list should be sorted in
-     ascending order.
--}
-mkProposalOutputDatum :: Parameters -> ProposalDatum
 mkProposalOutputDatum ps =
   let inputDatum = mkProposalInputDatum ps
-   in inputDatum
+      stakeOwner =
-        { cosigners = sort $ inputDatum.cosigners <> ps.newCosigners
+        PubKeyCredential $
+          mkStakeOwner ps.stakeParameters.stakeOwner
+      newCosigners =
+        if ps.proposalParameters.dontUpdateCosigners
+          then inputDatum.cosigners
+          else sort $ stakeOwner : inputDatum.cosigners
+   in inputDatum {cosigners = newCosigners}
+
+proposalRedeemer :: ProposalRedeemer
+proposalRedeemer = Cosign
+
+proposalRef :: TxOutRef
+proposalRef = TxOutRef proposalTxRef 1
+
+--------------------------------------------------------------------------------
+
+mkStakeInputDatum :: ParameterBundle -> StakeDatum
+mkStakeInputDatum ps =
+  let sps = ps.stakeParameters
+      amount = mkStakeAmount sps.gtAmount
+      owner = mkStakeOwner sps.stakeOwner
+      locks = case sps.stakeOwner of
+        Creator -> [Created defProposalId]
+        _ -> []
+   in StakeDatum
+        { stakedAmount = amount
+        , owner = PubKeyCredential owner
+        , delegatedTo = Just $ PubKeyCredential delegatee
+        , lockedBy = locks
         }
 
--- | Create all the input stakes given the parameters.
+mkStakeOuputDatum :: ParameterBundle -> StakeDatum
-mkStakeInputDatums :: Parameters -> [StakeDatum]
+mkStakeOuputDatum ps =
-mkStakeInputDatums =
+  let sps = ps.stakeParameters
-  fmap (\pk -> StakeDatum perStakedGTs pk Nothing [])
+      inpDatum = mkStakeInputDatum ps
-    . (.newCosigners)
+      locks =
+        if sps.dontUpdateLocks
+          then inpDatum.lockedBy
+          else Cosigned defProposalId : inpDatum.lockedBy
+   in inpDatum {lockedBy = locks}
+
+stakeRedeemer :: StakeRedeemer
+stakeRedeemer = PermitVote
+
+stakeRef :: TxOutRef
+stakeRef = TxOutRef stakeTxRef 0
+
+--------------------------------------------------------------------------------
 
 -- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
-cosign :: forall b. CombinableBuilder b => Parameters -> b
+cosign :: forall b. CombinableBuilder b => ParameterBundle -> b
 cosign ps = builder
   where
     pst = Value.singleton proposalPolicySymbol "" 1
     sst = Value.assetClassValue stakeAssetClass 1
 
-    ---
+    ----------------------------------------------------------------------------
 
-    stakeInputDatums :: [StakeDatum]
+    stakeInputDatum = mkStakeInputDatum ps
-    stakeInputDatums = mkStakeInputDatums ps
+    stakeOutputDatum = mkStakeOuputDatum ps
 
-    stakeValue :: Value
     stakeValue =
-      sortValue $
+      normalizeValue $
         minAda
           <> Value.assetClassValue
             (untag governor.gtClassRef)
-            (fromDiscrete perStakedGTs)
+            ( fromDiscrete $
+                mkStakeAmount ps.stakeParameters.gtAmount
+            )
           <> sst
 
     stakeBuilder =
-      foldMap
-        ( \(stakeDatum, refIdx) ->
       mconcat
-              [ referenceInput $
+        [ input $
             mconcat
               [ script stakeValidatorHash
               , withValue stakeValue
-                    , withInlineDatum stakeDatum
+              , withInlineDatum stakeInputDatum
-                    , withRef (mkStakeRef refIdx)
+              , withRef stakeRef
+              , withRedeemer stakeRedeemer
+              ]
+        , output $
+            mconcat
+              [ script stakeValidatorHash
+              , withValue stakeValue
+              , withInlineDatum stakeOutputDatum
               ]
-              , case stakeDatum.owner of
-                  PubKeyCredential k -> signedWith k
-                  _ -> mempty
         ]
-        )
-        $ zip
-          stakeInputDatums
-          [0 ..]
 
-    ---
+    ----------------------------------------------------------------------------
 
-    proposalInputDatum :: ProposalDatum
     proposalInputDatum = mkProposalInputDatum ps
-
-    proposalOutputDatum :: ProposalDatum
     proposalOutputDatum = mkProposalOutputDatum ps
 
+    proposalValue =
+      normalizeValue $
+        pst <> minAda
+
     proposalBuilder =
       mconcat
         [ input $
             mconcat
               [ script proposalValidatorHash
-              , withValue pst
+              , withValue proposalValue
               , withDatum proposalInputDatum
               , withRef proposalRef
+              , withRedeemer proposalRedeemer
               ]
         , output $
             mconcat
               [ script proposalValidatorHash
-              , withValue (sortValue (pst <> minAda))
+              , withValue proposalValue
               , withDatum proposalOutputDatum
               ]
         ]
 
-    validTimeRange :: POSIXTimeRange
+    ----------------------------------------------------------------------------
+
     validTimeRange =
       closedBoundedInterval
         (coerce proposalInputDatum.startingTime + 1)
@@ -204,7 +301,12 @@ cosign ps = builder
             + proposalInputDatum.timingConfig.draftTime - 1
         )
 
-    ---
+    sig =
+      mkSigner
+        ps.stakeParameters.stakeOwner
+        ps.transactionParameters.signedBy
+
+    ----------------------------------------------------------------------------
 
     builder =
       mconcat
@@ -212,87 +314,107 @@ cosign ps = builder
         , timeRange validTimeRange
         , proposalBuilder
         , stakeBuilder
+        , signedWith sig
         ]
 
--- | Reference index of the proposal UTXO.
+--------------------------------------------------------------------------------
-proposalRefIdx :: Integer
-proposalRefIdx = 1
 
--- | Spend the proposal ST.
-proposalRef :: TxOutRef
-proposalRef = TxOutRef proposalTxRef proposalRefIdx
-
--- | Consume the given stake.
-mkStakeRef :: Int -> TxOutRef
-mkStakeRef idx =
-  TxOutRef
-    stakeTxRef
-    $ proposalRefIdx + 1 + fromIntegral idx
-
--- | Create a proposal redeemer which cosigns with the new cosginers.
-mkProposalRedeemer :: Parameters -> ProposalRedeemer
-mkProposalRedeemer = Cosign . sort . (.newCosigners)
-
----
-
--- | Create a valid parameters that cosign the proposal with a given number of cosigners.
-validCosignNParameters :: Int -> Parameters
-validCosignNParameters n
-  | n > 0 =
-      Parameters
-        { newCosigners = take n (fmap PubKeyCredential pubKeyHashes)
-        , proposalStatus = Draft
-        }
-  | otherwise = error "Number of cosigners should be positive"
-
----
-
-{- | Parameters that make 'cosign' yield duplicate cosigners.
-   Invalid for the ptoposal validator, perfectly valid for stake validator.
--}
-duplicateCosignersParameters :: Parameters
-duplicateCosignersParameters =
-  Parameters
-    { newCosigners = [PubKeyCredential proposalCreator]
-    , proposalStatus = Draft
-    }
-
----
-
-{- | Generate a list of parameters that sets proposal status to something other than 'Draft'.
-   Invalid for the ptoposal validator, perfectly valid for stake validator.
--}
-statusNotDraftCosignNParameters :: Int -> [Parameters]
-statusNotDraftCosignNParameters n =
-  map
-    ( \st ->
-        Parameters
-          { newCosigners = take n (fmap PubKeyCredential pubKeyHashes)
-          , proposalStatus = st
-          }
-    )
-    [VotingReady, Locked, Finished]
-
----
-
--- | Create a test tree given the parameters. Both the proposal validator and stake validator will be run.
 mkTestTree ::
-  -- | The name of the test group.
   String ->
-  Parameters ->
+  ParameterBundle ->
-  -- | Are the parameters valid for the proposal validator?
+  Validity ->
-  Bool ->
   SpecificationTree
-mkTestTree name ps isValid = proposal
+mkTestTree name ps val =
+  group name [proposal, stake]
   where
     spend = mkSpending cosign ps
 
     proposal =
-      let proposalInputDatum = mkProposalInputDatum ps
+      testValidator
-       in testValidator
+        val.forProposalValidator
-            isValid
+        "proposal"
-            (name <> ": proposal")
         agoraScripts.compiledProposalValidator
-            proposalInputDatum
+        (mkProposalInputDatum ps)
-            (mkProposalRedeemer ps)
+        proposalRedeemer
         (spend proposalRef)
+
+    stake =
+      testValidator
+        val.forStakeValidator
+        "stake"
+        agoraScripts.compiledStakeValidator
+        (mkStakeInputDatum ps)
+        stakeRedeemer
+        (spend stakeRef)
+
+--------------------------------------------------------------------------------
+
+totallyValid :: ParameterBundle
+totallyValid =
+  ParameterBundle
+    { stakeParameters =
+        StakeParameters
+          { gtAmount = Sufficient
+          , stakeOwner = Other
+          , dontUpdateLocks = False
+          }
+    , proposalParameters =
+        ProposalParameters
+          { proposalStatus = Draft
+          , dontUpdateCosigners = False
+          }
+    , transactionParameters =
+        TransactionParameters
+          { signedBy =
+              Owner
+          }
+    }
+
+insufficientStakedAmount :: ParameterBundle
+insufficientStakedAmount =
+  totallyValid
+    { stakeParameters =
+        totallyValid.stakeParameters
+          { gtAmount = Insufficient
+          }
+    }
+
+locksNotUpdated :: ParameterBundle
+locksNotUpdated =
+  totallyValid
+    { stakeParameters =
+        totallyValid.stakeParameters
+          { dontUpdateLocks = True
+          }
+    }
+
+duplicateCosigners :: ParameterBundle
+duplicateCosigners =
+  totallyValid
+    { stakeParameters =
+        totallyValid.stakeParameters
+          { stakeOwner = Creator
+          }
+    }
+
+cosignersNotUpdated :: ParameterBundle
+cosignersNotUpdated =
+  totallyValid
+    { proposalParameters =
+        totallyValid.proposalParameters
+          { dontUpdateCosigners = True
+          }
+    }
+
+cosignAfterDraft :: [ParameterBundle]
+cosignAfterDraft =
+  map
+    ( \s ->
+        totallyValid
+          { proposalParameters =
+              totallyValid.proposalParameters
+                { proposalStatus = s
+                }
+          }
+    )
+    [VotingReady, Locked, Finished]

agora-specs/Sample/Proposal/Unlock.hs

@@ -284,6 +284,7 @@ unlock ps = builder
         not
           . ( \case
                 Created pid -> c && pid == defProposalId
+                Cosigned pid -> c && pid == defProposalId
                 Voted pid _ -> v && pid == defProposalId
             )
 

agora-specs/Sample/Shared.hs

@@ -191,6 +191,7 @@ instance Default ProposalThresholds where
       , create = Tagged 1
       , toVoting = Tagged 100
       , vote = Tagged 100
+      , cosign = Tagged 100
       }
 
 authorityTokenSymbol :: CurrencySymbol

agora-specs/Spec/Proposal.hs

@@ -90,41 +90,39 @@ specs =
       "validator"
       [ group
           "cosignature"
-          $ let cosignerCases = [1, 5, 10]
+          [ Cosign.mkTestTree
-
+              "legal"
-                mkLegalGroup nCosigners =
+              Cosign.totallyValid
-                  Cosign.mkTestTree
+              (Cosign.Validity True True)
-                    (unwords ["with", show nCosigners, "cosigners"])
+          , group
-                    (Cosign.validCosignNParameters nCosigners)
-                    True
-                legalGroup =
-                  group "legal" $
-                    map mkLegalGroup cosignerCases
-
-                mkIllegalStatusNotDraftGroup nCosigners =
-                  group (unwords ["with", show nCosigners, "cosigners"]) $
-                    map
-                      ( \ps ->
-                          Cosign.mkTestTree
-                            ("status: " <> show ps.proposalStatus)
-                            ps
-                            False
-                      )
-                      (Cosign.statusNotDraftCosignNParameters nCosigners)
-                illegalStatusNotDraftGroup =
-                  group "proposal status not Draft" $
-                    map mkIllegalStatusNotDraftGroup cosignerCases
-
-                illegalGroup =
-                  group
               "illegal"
               [ Cosign.mkTestTree
+                  "insufficient staked amount"
+                  Cosign.insufficientStakedAmount
+                  (Cosign.Validity False True)
+              , Cosign.mkTestTree
+                  "proposal locks not updated"
+                  Cosign.locksNotUpdated
+                  (Cosign.Validity True False)
+              , Cosign.mkTestTree
                   "duplicate cosigners"
-                        Cosign.duplicateCosignersParameters
+                  Cosign.duplicateCosigners
-                        False
+                  (Cosign.Validity False True)
-                    , illegalStatusNotDraftGroup
+              , Cosign.mkTestTree
+                  "cosigners not updated"
+                  Cosign.cosignersNotUpdated
+                  (Cosign.Validity False True)
+              , group "cosign after draft" $
+                  map
+                    ( \b ->
+                        Cosign.mkTestTree
+                          "(negative test)"
+                          b
+                          (Cosign.Validity False True)
+                    )
+                    Cosign.cosignAfterDraft
+              ]
           ]
-             in [legalGroup, illegalGroup]
       , group
           "voting"
           [ group