Added review changes

agora-test/Spec.hs

@@ -1,14 +1,3 @@
-{- |
-Module: Main
-Description: Agora test suite.
-Maintainer: emi@haskell.fyi
-
-This module is the root of Agora's test suite.
--}
-module Main (main) where
-
---------------------------------------------------------------------------------
-
 import Prelude
 
 --------------------------------------------------------------------------------
@@ -42,6 +31,12 @@ main =
       , testGroup
           "Proposal tests"
           Proposal.tests
+      , testGroup
+          "AuthorityToken tests"
+          AuthorityToken.tests
+      , testGroup
+          "Treasury tests"
+          Treasury.tests
       , testGroup
           "Multisig tests"
           [ testGroup
@@ -50,10 +45,4 @@ main =
               , MultiSig.genTests
               ]
           ]
-      , testGroup
-          "AuthorityToken tests"
-          AuthorityToken.tests
-      , testGroup
-          "Treasury tests"
-          Treasury.tests
       ]

agora-test/Spec/Sample/Shared.hs

@@ -9,6 +9,8 @@ module Spec.Sample.Shared (
   -- * Misc
   signer,
   signer2,
+  minAda,
+  withMinAda,
 
   -- * Components
 
@@ -30,8 +32,16 @@ module Spec.Sample.Shared (
   proposalPolicySymbol,
   proposalValidatorHash,
   proposalValidatorAddress,
+
+  -- ** Treasury
+  treasuryOut,
+  gatTn,
+  gatCs,
+  mockTrEffect,
+  trCredential,
 ) where
 
+import Agora.Effect.NoOp (noOpValidator)
 import Agora.Governor (
   Governor (Governor),
   governorPolicy,
@@ -47,6 +57,8 @@ import Agora.Proposal.Scripts (
  )
 import Agora.Stake (Stake (..))
 import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Agora.Treasury (treasuryValidator)
+import Agora.Utils (validatorHashToTokenName)
 import Plutarch.Api.V1 (
   mintingPolicySymbol,
   mkMintingPolicy,
@@ -62,7 +74,11 @@ import Plutus.V1.Ledger.Api (
   MintingPolicy (..),
   PubKeyHash,
  )
+import Plutus.V1.Ledger.Contexts (
+  TxOut (..),
+ )
 import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash)
+import Plutus.V1.Ledger.Value (TokenName, Value)
 import Plutus.V1.Ledger.Value qualified as Value
 
 --------------------------------------------------------------------------------
@@ -131,3 +147,42 @@ defaultProposalThresholds =
     , create = Tagged 1
     , startVoting = Tagged 10
     }
+
+------------------------------------------------------------------
+
+treasuryOut :: TxOut
+treasuryOut =
+  TxOut
+    { txOutAddress = Address trCredential Nothing
+    , txOutValue = minAda
+    , txOutDatumHash = Nothing
+    }
+
+{- | Arbitrary 'CurrencySymbol', representing the 'CurrencySymbol'
+     of a valid governance authority token (GAT).
+-}
+gatCs :: CurrencySymbol
+gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+
+trValidator :: Validator
+trValidator = mkValidator (treasuryValidator gatCs)
+
+-- | `ScriptCredential` used for the dummy treasury validator.
+trCredential :: Credential
+trCredential = ScriptCredential $ validatorHash trValidator
+
+-- | `TokenName` for GAT generated from address of `mockTrEffect`.
+gatTn :: TokenName
+gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
+
+-- | Mock treasury effect script, used for testing.
+mockTrEffect :: Validator
+mockTrEffect = mkValidator $ noOpValidator gatCs
+
+------------------------------------------------------------------
+
+minAda :: Value
+minAda = Value.singleton "" "" 10_000_000
+
+withMinAda :: Value -> Value
+withMinAda v = v <> minAda

agora-test/Spec/Sample/Treasury.hs

@@ -9,27 +9,14 @@ This module contains sample data, used in the tests written in
 `Spec.Treasury`.
 -}
 module Spec.Sample.Treasury (
-  BadTreasuryRedeemer (NukeTheSystem),
   gatCs,
   validCtx,
   treasuryRef,
   gatTn,
   walletIn,
-  trCredential,
 ) where
 
-import Agora.Effect.NoOp (noOpValidator)
-import Agora.Treasury (
-  treasuryValidator,
- )
-import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, I (I))
-import Plutarch.Api.V1 (mkValidator, validatorHash)
-import Plutarch.DataRepr (
-  DerivePConstantViaData (..),
-  PIsDataReprInstances (..),
- )
-import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
+import Plutarch.Api.V1 (validatorHash)
 import Plutus.V1.Ledger.Address (Address (..))
 import Plutus.V1.Ledger.Api (
   BuiltinByteString,
@@ -47,26 +34,18 @@ import Plutus.V1.Ledger.Contexts (
 import Plutus.V1.Ledger.Credential (Credential (ScriptCredential))
 import Plutus.V1.Ledger.Interval qualified as Interval
 import Plutus.V1.Ledger.Scripts (
-  Validator,
   ValidatorHash (ValidatorHash),
  )
-import Plutus.V1.Ledger.Value (
-  CurrencySymbol,
-  TokenName (TokenName),
- )
 import Plutus.V1.Ledger.Value qualified as Value
-import PlutusTx qualified
-import Spec.Sample.Shared (signer)
-import Spec.Util (datumPair, toDatumHash)
-
-{- | Arbitrary 'CurrencySymbol', representing the 'CurrencySymbol'
-     of a valid governance authority token (GAT).
--}
-gatCs :: CurrencySymbol
-gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
-
-trValidator :: Validator
-trValidator = mkValidator (treasuryValidator gatCs)
+import Spec.Sample.Shared (
+  gatCs,
+  gatTn,
+  mockTrEffect,
+  signer,
+  treasuryOut,
+  withMinAda,
+ )
+import Spec.Util (datumPair)
 
 {- | A `ScriptContext` that should be compatible with treasury
      transactions.
@@ -113,17 +92,11 @@ validCtx =
         , txInInfoResolved =
             TxOut
               { txOutAddress =
-                  Address (ScriptCredential $ validatorHash mockEffect) Nothing
-              , txOutValue = Value.singleton gatCs gatTn 1
-              , txOutDatumHash = Just (toDatumHash ())
+                  Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
+              , txOutValue = withMinAda $ Value.singleton gatCs gatTn 1
+              , txOutDatumHash = Nothing
               }
         }
-    treasuryOut :: TxOut =
-      TxOut
-        { txOutAddress = Address trCredential Nothing
-        , txOutValue = Value.singleton "" "" 0
-        , txOutDatumHash = Just (toDatumHash ())
-        }
 
 -- | Reference to treasury output.
 treasuryRef :: TxOutRef
@@ -139,22 +112,6 @@ effectRef =
     "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
     0
 
--- | `ScriptCredential` used for the dummy treasury validator.
-trCredential :: Credential
-trCredential = ScriptCredential $ validatorHash trValidator
-
--- | Mock effect script, used for testing.
-mockEffect :: Validator
-mockEffect = mkValidator $ noOpValidator gatCs
-
--- | The hash of the mock effect script.
-addressBs :: BuiltinByteString
-(ValidatorHash addressBs) = validatorHash mockEffect
-
--- | `TokenName` for GAT generated from address of `mockEffect`.
-gatTn :: TokenName
-gatTn = TokenName addressBs
-
 -- | Input representing a user wallet with a valid GAT.
 walletIn :: TxInInfo
 walletIn =
@@ -174,33 +131,5 @@ walletIn =
           }
     }
 
--- | Unsupported treasury redeemer.
-newtype BadTreasuryRedeemer
-  = -- | Unsupported treasury redeemer.
-    NukeTheSystem Integer
-  deriving stock (Eq, Show, GHC.Generic)
-
-PlutusTx.makeIsDataIndexed
-  ''BadTreasuryRedeemer
-  [ ('NukeTheSystem, 0)
-  ]
-
--- | Plutarch implementation of `BadTreasuryRedeemer`.
-newtype PBadTreasuryRedeemer (s :: S)
-  = PNukeTheSystem (Term s (PDataRecord '["_0" ':= PInteger]))
-  deriving stock (GHC.Generic)
-  deriving anyclass (Generic)
-  deriving anyclass (PIsDataRepr)
-  deriving
-    (PlutusType, PIsData)
-    via PIsDataReprInstances PBadTreasuryRedeemer
-
-instance PUnsafeLiftDecl PBadTreasuryRedeemer where
-  type PLifted PBadTreasuryRedeemer = BadTreasuryRedeemer
-deriving via
-  ( DerivePConstantViaData
-      BadTreasuryRedeemer
-      PBadTreasuryRedeemer
-  )
-  instance
-    (PConstantDecl BadTreasuryRedeemer)
+addressBs :: BuiltinByteString
+(ValidatorHash addressBs) = validatorHash mockTrEffect

agora-test/Spec/Treasury.hs

@@ -45,11 +45,15 @@ import Plutus.V1.Ledger.Scripts (
   ValidatorHash (ValidatorHash),
  )
 import Plutus.V1.Ledger.Value qualified as Value
+
+-- BadTreasuryRedeemer (NukeTheSystem),
+
+import Spec.Sample.Shared (
+  trCredential,
+ )
 import Spec.Sample.Treasury (
-  -- BadTreasuryRedeemer (NukeTheSystem),
   gatCs,
   gatTn,
-  trCredential,
   treasuryRef,
   validCtx,
   walletIn,
@@ -104,14 +108,7 @@ tests =
                             StakingHash trCredential
                     }
               ]
-          , -- , validatorFailsWith -- TODO: Check.
-            --     "Fails with invalid redeemer"
-            --     (treasuryValidator gatCs)
-            --     ()
-            --     (NukeTheSystem 72)
-            --     validCtx
-
-            validatorFailsWith -- TODO: Use QuickCheck.
+          , validatorFailsWith -- TODO: Use QuickCheck.
               "Fails when multiple GATs burned"
               (treasuryValidator gatCs)
               ()

agora.cabal

@@ -111,6 +111,7 @@ common deps
 
 common test-deps
   build-depends:
+    , agora
     , apropos
     , apropos-tx
     , lens
@@ -137,11 +138,10 @@ library
     Agora.Stake
     Agora.Stake.Scripts
     Agora.Treasury
-
-  other-modules:
     Agora.Utils
     Agora.Utils.Value
 
+  other-modules:
   hs-source-dirs:  agora
 
 library pprelude