add proposalCreation Sample test

agora-test/Spec.hs

@@ -11,6 +11,7 @@ import Test.Tasty (defaultMain, testGroup)
 import Spec.AuthorityToken qualified as AuthorityToken
 import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
 import Spec.Model.MultiSig qualified as MultiSig
+import Spec.Proposal qualified as Proposal
 import Spec.Stake qualified as Stake
 
 -- | The Agora test suite.
@@ -28,6 +29,9 @@ main =
       , testGroup
           "Stake tests"
           Stake.tests
+      , testGroup
+          "Proposal tests"
+          Proposal.tests
       , testGroup
           "Multisig tests"
           [ testGroup

agora-test/Spec/Proposal.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+{- |
+Module     : Spec.Proposal
+Maintainer : emi@haskell.fyi
+Description: Tests for Proposal policy and validator
+
+Tests for Proposal policy and validator
+-}
+module Spec.Proposal (tests) where
+
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+
+import Agora.Proposal (proposalPolicy)
+import Spec.Sample.Proposal qualified as Proposal
+import Spec.Util (policySucceedsWith)
+import Test.Tasty (TestTree, testGroup)
+
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+
+-- | Stake tests.
+tests :: [TestTree]
+tests =
+  [ testGroup
+      "policy"
+      [ policySucceedsWith
+          "stakeCreation"
+          (proposalPolicy Proposal.proposal)
+          ()
+          Proposal.proposalCreation
+      ]
+  ]

agora-test/Spec/Sample/Proposal.hs

@@ -0,0 +1,198 @@
+{- |
+Module     : Spec.Sample.Proposal
+Maintainer : emi@haskell.fyi
+Description: Sample based testing for Proposal utxos
+
+This module tests primarily the happy path for Proposal interactions
+-}
+module Spec.Sample.Proposal (
+  proposal,
+  policy,
+  policySymbol,
+  validatorHashTN,
+  signer,
+
+  -- * Script contexts
+  proposalCreation,
+) where
+
+--------------------------------------------------------------------------------
+import Plutarch.Api.V1 (
+  mintingPolicySymbol,
+  mkMintingPolicy,
+  mkValidator,
+  validatorHash,
+ )
+import Plutus.V1.Ledger.Api (
+  Address (Address),
+  Credential (ScriptCredential),
+  CurrencySymbol,
+  Datum (Datum),
+  MintingPolicy (..),
+  PubKeyHash,
+  ScriptContext (..),
+  ScriptPurpose (..),
+  ToData (toBuiltinData),
+  TxInInfo (TxInInfo),
+  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.Value qualified as Value
+
+--------------------------------------------------------------------------------
+
+import Agora.Governor (
+  Governor (Governor),
+  GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds),
+  governorPolicy,
+  governorValidator,
+ )
+import Agora.Proposal
+import Plutarch.SafeMoney
+import PlutusTx.AssocMap qualified as AssocMap
+import Spec.Util (datumPair, toDatumHash)
+
+--------------------------------------------------------------------------------
+
+governor :: Governor
+governor = Governor
+
+govPolicy :: MintingPolicy
+govPolicy = mkMintingPolicy (governorPolicy governor)
+
+govValidator :: Validator
+govValidator = mkValidator (governorValidator governor)
+
+govSymbol :: CurrencySymbol
+govSymbol = mintingPolicySymbol govPolicy
+
+proposal :: Proposal
+proposal =
+  Proposal
+    { governorSTAssetClass =
+        -- TODO: if we had a governor here
+        AssetClass
+          ( govSymbol
+          , ""
+          )
+    }
+
+-- | 'Proposal' policy instance.
+policy :: MintingPolicy
+policy = mkMintingPolicy (proposalPolicy proposal)
+
+policySymbol :: CurrencySymbol
+policySymbol = mintingPolicySymbol policy
+
+-- | A sample 'PubKeyHash'.
+signer :: PubKeyHash
+signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
+
+-- | 'Proposal' validator instance.
+validator :: Validator
+validator = mkValidator (proposalValidator proposal)
+
+-- | 'TokenName' that represents the hash of the 'Proposal' validator.
+validatorHashTN :: TokenName
+validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
+
+propThresholds :: ProposalThresholds
+propThresholds =
+  ProposalThresholds
+    { countVoting = Tagged 1000
+    , create = Tagged 1
+    , vote = Tagged 10
+    }
+
+-- | This script context should be a valid transaction.
+proposalCreation :: ScriptContext
+proposalCreation =
+  let st = Value.singleton policySymbol "" 1 -- Proposal ST
+      proposalDatum :: Datum
+      proposalDatum =
+        Datum
+          ( toBuiltinData $
+              ProposalDatum
+                { proposalId = ProposalId 0
+                , effects =
+                    AssocMap.fromList
+                      [ (ResultTag 0, [])
+                      , (ResultTag 1, [])
+                      ]
+                , status = Draft
+                , cosigners = [signer]
+                , thresholds = propThresholds
+                , votes = ProposalVotes $ AssocMap.empty
+                }
+          )
+
+      govBefore :: Datum
+      govBefore =
+        Datum
+          ( toBuiltinData $
+              GovernorDatum
+                { proposalThresholds = propThresholds
+                , nextProposalId = ProposalId 0
+                }
+          )
+      govAfter :: Datum
+      govAfter =
+        Datum
+          ( toBuiltinData $
+              GovernorDatum
+                { proposalThresholds = propThresholds
+                , nextProposalId = ProposalId 1
+                }
+          )
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ TxInInfo
+                      (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+                      TxOut
+                        { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
+                        , txOutValue = Value.assetClassValue proposal.governorSTAssetClass 1
+                        , txOutDatumHash = Just (toDatumHash govBefore)
+                        }
+                  ]
+              , txInfoOutputs =
+                  [ TxOut
+                      { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
+                      , txOutValue =
+                          mconcat
+                            [ st
+                            , Value.singleton "" "" 10_000_000
+                            ]
+                      , txOutDatumHash = Just (toDatumHash proposalDatum)
+                      }
+                  , TxOut
+                      { txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
+                      , txOutValue =
+                          mconcat
+                            [ Value.assetClassValue proposal.governorSTAssetClass 1
+                            , Value.singleton "" "" 10_000_000
+                            ]
+                      , txOutDatumHash = Just (toDatumHash govAfter)
+                      }
+                  ]
+              , txInfoFee = Value.singleton "" "" 2
+              , txInfoMint = st
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = [signer]
+              , txInfoData =
+                  [ datumPair proposalDatum
+                  , datumPair govBefore
+                  , datumPair govAfter
+                  ]
+              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
+              }
+        , scriptContextPurpose = Minting policySymbol
+        }

agora-test/Spec/Stake.hs

@@ -49,7 +49,10 @@ tests =
           (stakePolicy Stake.stake)
           ()
           Stake.stakeCreationUnsigned
-      , validatorSucceedsWith
+      ]
+  , testGroup
+      "validator"
+      [ validatorSucceedsWith
           "stakeDepositWithdraw deposit"
           (stakeValidator Stake.stake)
           (toDatum $ StakeDatum 100_000 signer [])

agora.cabal

@@ -162,6 +162,8 @@ test-suite agora-test
     Spec.Sample.Effect.TreasuryWithdrawal
     Spec.Sample.Stake
     Spec.Stake
+    Spec.Sample.Proposal
+    Spec.Proposal
     Spec.Util
 
   build-depends:  agora

agora/Agora/Governor.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 {- |
 Module     : Agora.Governor
 Maintainer : emi@haskell.fyi
@@ -21,6 +23,7 @@ module Agora.Governor (
 import Agora.Proposal (ProposalId, ProposalThresholds)
 import Plutarch (popaque)
 import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import PlutusTx qualified
 
 -- | Datum for the Governor script.
 data GovernorDatum = GovernorDatum
@@ -30,6 +33,8 @@ data GovernorDatum = GovernorDatum
   -- ^ What tag the next proposal will get upon creating.
   }
 
+PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
+
 {- | Redeemer for Governor script. The governor has two primary
      responsibilities:
 
@@ -43,6 +48,8 @@ data GovernorRedeemer
     --   and allows minting GATs for each effect script.
     MintGATs
 
+PlutusTx.makeIsDataIndexed ''GovernorRedeemer [('CreateProposal, 0), ('MintGATs, 1)]
+
 -- | Parameters for creating Governor scripts.
 data Governor
   = Governor

agora/Agora/Proposal.hs

@@ -73,6 +73,15 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
 --------------------------------------------------------------------------------
 -- Haskell-land
 
+{- | Identifies a Proposal, issued upon creation of a proposal. In practice,
+     this number starts at zero, and increments by one for each proposal.
+     The 100th proposal will be @'ProposalId' 99@. This counter lives
+     in the 'Agora.Governor.Governor', see 'Agora.Governor.nextProposalId'.
+-}
+newtype ProposalId = ProposalId {proposalTag :: Integer}
+  deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
+  deriving stock (Eq, Show, GHC.Generic)
+
 {- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this:
 
 @
@@ -162,7 +171,9 @@ newtype ProposalVotes = ProposalVotes
 
 -- | Haskell-level datum for Proposal scripts.
 data ProposalDatum = ProposalDatum
-  { -- TODO: could we encode this more efficiently?
+  { proposalId :: ProposalId
+  -- ^ Identification of the proposal.
+  , -- TODO: could we encode this more efficiently?
   -- This is shaped this way for future proofing.
   -- See https://github.com/Liqwid-Labs/agora/issues/39
   effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)]
@@ -227,15 +238,6 @@ PlutusTx.makeIsDataIndexed
   , ('AdvanceProposal, 3)
   ]
 
-{- | Identifies a Proposal, issued upon creation of a proposal. In practice,
-     this number starts at zero, and increments by one for each proposal.
-     The 100th proposal will be @'ProposalId' 99@. This counter lives
-     in the 'Agora.Governor.Governor', see 'Agora.Governor.nextProposalId'.
--}
-newtype ProposalId = ProposalId {proposalTag :: Integer}
-  deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
-  deriving stock (Eq, Show, GHC.Generic)
-
 -- | Parameters that identify the Proposal validator script.
 data Proposal = Proposal
   { governorSTAssetClass :: AssetClass
@@ -341,7 +343,8 @@ newtype PProposalDatum (s :: S) = PProposalDatum
     Term
       s
       ( PDataRecord
-          '[ "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash)
+          '[ "id" ':= PProposalId
+           , "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash)
            , "status" ':= PProposalStatus
            , "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
            , "thresholds" ':= PProposalThresholds