add checks to cosign

agora-test/Spec/Proposal.hs

@@ -13,9 +13,26 @@ module Spec.Proposal (tests) where
 
 --------------------------------------------------------------------------------
 
-import Agora.Proposal (proposalPolicy)
+import Agora.Proposal (
+  ProposalDatum (ProposalDatum),
+  ProposalId (ProposalId),
+  ProposalRedeemer (Cosign),
+  ProposalStatus (Draft),
+  ProposalVotes (ProposalVotes),
+  ResultTag (ResultTag),
+  cosigners,
+  effects,
+  proposalId,
+  proposalPolicy,
+  proposalValidator,
+  status,
+  thresholds,
+  votes,
+ )
+import PlutusTx.AssocMap qualified as AssocMap
+import Spec.Sample.Proposal (propThresholds, signer, signer2)
 import Spec.Sample.Proposal qualified as Proposal
-import Spec.Util (policySucceedsWith)
+import Spec.Util (policySucceedsWith, validatorSucceedsWith)
 import Test.Tasty (TestTree, testGroup)
 
 --------------------------------------------------------------------------------
@@ -35,4 +52,25 @@ tests =
           ()
           Proposal.proposalCreation
       ]
+  , testGroup
+      "validator"
+      [ validatorSucceedsWith
+          "stakeCreation"
+          (proposalValidator Proposal.proposal)
+          ( ProposalDatum
+              { proposalId = ProposalId 0
+              , effects =
+                  AssocMap.fromList
+                    [ (ResultTag 0, [])
+                    , (ResultTag 1, [])
+                    ]
+              , status = Draft
+              , cosigners = [signer]
+              , thresholds = propThresholds
+              , votes = ProposalVotes AssocMap.empty
+              }
+          )
+          (Cosign [signer2])
+          (Proposal.cosignProposal [signer2])
+      ]
   ]

agora-test/Spec/Sample/Proposal.hs

@@ -7,13 +7,15 @@ This module tests primarily the happy path for Proposal interactions
 -}
 module Spec.Sample.Proposal (
   proposal,
-  policy,
-  policySymbol,
-  validatorHashTN,
+  propPolicy,
+  propPolicySymbol,
+  propThresholds,
   signer,
+  signer2,
 
   -- * Script contexts
   proposalCreation,
+  cosignProposal,
 ) where
 
 --------------------------------------------------------------------------------
@@ -37,11 +39,9 @@ import Plutus.V1.Ledger.Api (
   TxInfo (..),
   TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
   TxOutRef (TxOutRef),
-  ValidatorHash (ValidatorHash),
  )
 import Plutus.V1.Ledger.Interval qualified as Interval
-import Plutus.V1.Ledger.Scripts (Validator)
-import Plutus.V1.Ledger.Value (AssetClass (AssetClass), TokenName (TokenName))
+import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash)
 import Plutus.V1.Ledger.Value qualified as Value
 
 --------------------------------------------------------------------------------
@@ -52,13 +52,35 @@ import Agora.Governor (
   governorPolicy,
   governorValidator,
  )
-import Agora.Proposal
+import Agora.Proposal (
+  Proposal (..),
+  ProposalDatum (..),
+  ProposalId (..),
+  ProposalStatus (..),
+  ProposalThresholds (..),
+  ProposalVotes (..),
+  ResultTag (..),
+  proposalPolicy,
+  proposalValidator,
+ )
+import Agora.Stake (Stake (..), stakePolicy)
 import Plutarch.SafeMoney
+import Plutus.V1.Ledger.Address (scriptHashAddress)
 import PlutusTx.AssocMap qualified as AssocMap
 import Spec.Util (datumPair, toDatumHash)
 
 --------------------------------------------------------------------------------
 
+stake :: Stake
+stake =
+  Stake
+    { gtClassRef = Tagged $ Value.assetClass govSymbol ""
+    , proposalSTClass = Value.assetClass propPolicySymbol ""
+    }
+
+stakeSymbol :: CurrencySymbol
+stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef
+
 governor :: Governor
 governor = Governor
 
@@ -76,30 +98,35 @@ proposal =
   Proposal
     { governorSTAssetClass =
         -- TODO: if we had a governor here
-        AssetClass
-          ( govSymbol
-          , ""
-          )
+        Value.assetClass govSymbol ""
+    , stakeSTAssetClass =
+        Value.assetClass stakeSymbol ""
     }
 
 -- | 'Proposal' policy instance.
-policy :: MintingPolicy
-policy = mkMintingPolicy (proposalPolicy proposal)
+propPolicy :: MintingPolicy
+propPolicy = mkMintingPolicy (proposalPolicy proposal)
 
-policySymbol :: CurrencySymbol
-policySymbol = mintingPolicySymbol policy
+propPolicySymbol :: CurrencySymbol
+propPolicySymbol = mintingPolicySymbol propPolicy
 
 -- | A sample 'PubKeyHash'.
 signer :: PubKeyHash
 signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
 
--- | 'Proposal' validator instance.
-validator :: Validator
-validator = mkValidator (proposalValidator proposal)
+-- | Another sample 'PubKeyHash'.
+signer2 :: PubKeyHash
+signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
 
--- | 'TokenName' that represents the hash of the 'Proposal' validator.
-validatorHashTN :: TokenName
-validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
+-- | 'Proposal' validator instance.
+propValidator :: Validator
+propValidator = mkValidator (proposalValidator proposal)
+
+propValidatorHash :: ValidatorHash
+propValidatorHash = validatorHash propValidator
+
+propValidatorAddress :: Address
+propValidatorAddress = scriptHashAddress propValidatorHash
 
 propThresholds :: ProposalThresholds
 propThresholds =
@@ -112,7 +139,7 @@ propThresholds =
 -- | This script context should be a valid transaction.
 proposalCreation :: ScriptContext
 proposalCreation =
-  let st = Value.singleton policySymbol "" 1 -- Proposal ST
+  let st = Value.singleton propPolicySymbol "" 1 -- Proposal ST
       proposalDatum :: Datum
       proposalDatum =
         Datum
@@ -163,7 +190,7 @@ proposalCreation =
                   ]
               , txInfoOutputs =
                   [ TxOut
-                      { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
+                      { txOutAddress = Address (ScriptCredential $ validatorHash propValidator) Nothing
                       , txOutValue =
                           mconcat
                             [ st
@@ -194,5 +221,68 @@ proposalCreation =
                   ]
               , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
               }
-        , scriptContextPurpose = Minting policySymbol
+        , scriptContextPurpose = Minting propPolicySymbol
+        }
+
+-- | This script context should be a valid transaction.
+cosignProposal :: [PubKeyHash] -> ScriptContext
+cosignProposal newSigners =
+  let st = Value.singleton propPolicySymbol "" 1 -- Proposal ST
+      proposalBefore :: ProposalDatum
+      proposalBefore =
+        ProposalDatum
+          { proposalId = ProposalId 0
+          , effects =
+              AssocMap.fromList
+                [ (ResultTag 0, [])
+                , (ResultTag 1, [])
+                ]
+          , status = Draft
+          , cosigners = [signer]
+          , thresholds = propThresholds
+          , votes = ProposalVotes AssocMap.empty
+          }
+      proposalAfter :: ProposalDatum
+      proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners}
+      proposalRef = (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ TxInInfo
+                      proposalRef
+                      TxOut
+                        { txOutAddress = propValidatorAddress
+                        , txOutValue =
+                            mconcat
+                              [ st
+                              , Value.singleton "" "" 10_000_000
+                              ]
+                        , txOutDatumHash = Just (toDatumHash proposalBefore)
+                        }
+                  ]
+              , txInfoOutputs =
+                  [ TxOut
+                      { txOutAddress = Address (ScriptCredential $ validatorHash propValidator) Nothing
+                      , txOutValue =
+                          mconcat
+                            [ st
+                            , Value.singleton "" "" 10_000_000
+                            ]
+                      , txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
+                      }
+                  ]
+              , txInfoFee = Value.singleton "" "" 2
+              , txInfoMint = st
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = newSigners
+              , txInfoData =
+                  [ datumPair . Datum $ toBuiltinData proposalBefore
+                  , datumPair . Datum $ toBuiltinData proposalAfter
+                  ]
+              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
+              }
+        , scriptContextPurpose = Spending proposalRef
         }

agora-test/Spec/Sample/Stake.hs

@@ -69,11 +69,12 @@ stake =
               , "LQ"
               )
           )
+    , proposalSTClass = AssetClass ("", "")
     }
 
 -- | 'Stake' policy instance.
 policy :: MintingPolicy
-policy = mkMintingPolicy (stakePolicy stake)
+policy = mkMintingPolicy (stakePolicy stake.gtClassRef)
 
 policySymbol :: CurrencySymbol
 policySymbol = mintingPolicySymbol policy

agora-test/Spec/Stake.hs

@@ -19,7 +19,7 @@ import Test.Tasty (TestTree, testGroup)
 
 --------------------------------------------------------------------------------
 
-import Agora.Stake (StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw), stakePolicy, stakeValidator)
+import Agora.Stake (Stake (..), StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw), stakePolicy, stakeValidator)
 
 --------------------------------------------------------------------------------
 
@@ -36,17 +36,17 @@ tests =
       "policy"
       [ policySucceedsWith
           "stakeCreation"
-          (stakePolicy Stake.stake)
+          (stakePolicy Stake.stake.gtClassRef)
           ()
           Stake.stakeCreation
       , policyFailsWith
           "stakeCreationWrongDatum"
-          (stakePolicy Stake.stake)
+          (stakePolicy Stake.stake.gtClassRef)
           ()
           Stake.stakeCreationWrongDatum
       , policyFailsWith
           "stakeCreationUnsigned"
-          (stakePolicy Stake.stake)
+          (stakePolicy Stake.stake.gtClassRef)
           ()
           Stake.stakeCreationUnsigned
       ]