diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 18f7429c4..7acd3b041 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -321,6 +321,8 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: + Test.Governance.Contract + Test.Governance.Init Test.Demo.Contract.Mint Test.Lending.Contract Test.Lending.Init diff --git a/mlabs/src/Mlabs/Governance/Contract/Server.hs b/mlabs/src/Mlabs/Governance/Contract/Server.hs index 79c4921fd..ed4f3253f 100644 --- a/mlabs/src/Mlabs/Governance/Contract/Server.hs +++ b/mlabs/src/Mlabs/Governance/Contract/Server.hs @@ -14,6 +14,7 @@ import Control.Monad (forever, guard, void) import Data.Semigroup (Last(..), sconcat) import Plutus.Contract qualified as Contract import Plutus.V1.Ledger.Crypto (pubKeyHash) +import Ledger.Contexts (scriptCurrencySymbol) import Plutus.V1.Ledger.Tx (txId) import Plutus.V1.Ledger.Value (CurrencySymbol) import Ledger.Constraints qualified as Constraints @@ -37,13 +38,15 @@ governanceEndpoints csym = forever $ selects deposit :: CurrencySymbol -> Api.Deposit -> GovernanceContract () deposit csym (Api.Deposit amnt) = do - let tx = sconcat [ - Constraints.mustForgeValue $ Validation.xgovValueOf csym amnt + let mintingPolicy = Validation.xGovMintingPolicy csym + tx = sconcat [ + Constraints.mustForgeValue $ Validation.xgovValueOf (scriptCurrencySymbol mintingPolicy) amnt , Constraints.mustPayToTheScript () $ Validation.govValueOf csym amnt -- here () is the datum type, for now ] lookups = sconcat [ - Constraints.monetaryPolicy (Validation.xGovMintingPolicy csym) - , Constraints.otherScript (Validation.scrValidator csym) + Constraints.monetaryPolicy (Validation.xGovMintingPolicy csym) + , Constraints.otherScript (Validation.scrValidator csym) + , Constraints.scriptInstanceLookups (Validation.scrInstance csym) ] ledgerTx <- Contract.submitTxConstraintsWith @Validation.Governance lookups tx void $ Contract.awaitTxConfirmed $ txId ledgerTx @@ -58,6 +61,7 @@ withdraw csym (Api.Withdraw amnt) = do ] lookups = sconcat [ Constraints.otherScript (Validation.scrValidator csym) + , Constraints.scriptInstanceLookups (Validation.scrInstance csym) ] ledgerTx <- Contract.submitTxConstraintsWith @Validation.Governance lookups tx void $ Contract.awaitTxConfirmed $ txId ledgerTx diff --git a/mlabs/src/Mlabs/Governance/Contract/Validation.hs b/mlabs/src/Mlabs/Governance/Contract/Validation.hs index 1f127bf6b..49955f7ea 100644 --- a/mlabs/src/Mlabs/Governance/Contract/Validation.hs +++ b/mlabs/src/Mlabs/Governance/Contract/Validation.hs @@ -7,6 +7,8 @@ module Mlabs.Governance.Contract.Validation ( , xgovValueOf , xGovMintingPolicy , Governance + , govToken + , xgovToken ) where import PlutusTx qualified diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index e35e0d3fd..801a722b9 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -3,22 +3,24 @@ module Main where import Test.Tasty (defaultMain, testGroup) import Test.Tasty.ExpectedFailure (ignoreTest) -import qualified Test.Demo.Contract.Mint as Demo.Contract.Mint -import qualified Test.Lending.QuickCheck as Lending.QuickCheck -import qualified Test.Lending.Contract as Lending.Contract -import qualified Test.Lending.Logic as Lending.Logic -import qualified Test.Nft.Logic as Nft.Logic -import qualified Test.Nft.Contract as Nft.Contract +import qualified Test.Demo.Contract.Mint as Demo.Contract.Mint +import qualified Test.Lending.QuickCheck as Lending.QuickCheck +import qualified Test.Lending.Contract as Lending.Contract +import qualified Test.Lending.Logic as Lending.Logic +import qualified Test.Nft.Logic as Nft.Logic +import qualified Test.Nft.Contract as Nft.Contract +import qualified Test.Governance.Contract as Governance.Contract main :: IO () main = defaultMain $ testGroup "tests" - [ testGroup "NFT" [ Nft.Logic.test - , contract Nft.Contract.test ] - , testGroup "Lending" [ Lending.Logic.test - , contract Lending.Contract.test - , Lending.QuickCheck.test ] - , contract Lending.Contract.test - , testGroup "Demo" [ Demo.Contract.Mint.test ] + [ testGroup "NFT" [ Nft.Logic.test + , contract Nft.Contract.test ] + , testGroup "Lending" [ Lending.Logic.test + , contract Lending.Contract.test + , Lending.QuickCheck.test ] + , contract Lending.Contract.test + , testGroup "Demo" [ Demo.Contract.Mint.test ] + , testGroup "Governance" [ Governance.Contract.test ] ] where contract diff --git a/mlabs/test/Test/Governance/Contract.hs b/mlabs/test/Test/Governance/Contract.hs new file mode 100644 index 000000000..764d69621 --- /dev/null +++ b/mlabs/test/Test/Governance/Contract.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} + +module Test.Governance.Contract( + test +) where + +import Prelude ( + ($) + , negate + , (==) + , (-) + ) +import Data.Functor (void) +import Data.Monoid ((<>), mempty) + +import Plutus.Contract.Test + ( checkPredicateOptions + , assertNoFailedTransactions + , assertContractError + , walletFundsChange + , valueAtAddress + , not + , (.&&.) + ) +import qualified Plutus.Trace.Emulator as Trace +import Mlabs.Plutus.Contract (callEndpoint') + + +import Test.Tasty (TestTree, testGroup) +import Data.Text as T (isInfixOf) + +import Test.Utils (next) +import Test.Governance.Init as Test +import qualified Mlabs.Governance.Contract.Server as Gov +import qualified Mlabs.Governance.Contract.Emulator.Client as Gov (callDeposit, ) +import qualified Mlabs.Governance.Contract.Api as Api + +theContract :: Gov.GovernanceContract () +theContract = Gov.governanceEndpoints Test.testGovCurrencySymbol + +test :: TestTree +test = testGroup "Contract" + [ testGroup "Deposit" + [ testDepositHappyPath + , testInsuficcientGOVFails + , testCantDepositWithoutGov + , testCantDepositNegativeAmount + ] + , testGroup "Withdraw" + [ testFullWithdraw + , testPartialWithdraw + , testCantWithdrawMoreThandeposited + , testCantWithdrawNegativeAmount + ] + ] + +-- deposit tests + +testDepositHappyPath :: TestTree +testDepositHappyPath = + let + testWallet = Test.fstWalletWithGOV + depoAmt = 50 + in + checkPredicateOptions Test.checkOptions "Deopsit" + ( assertNoFailedTransactions + .&&. walletFundsChange testWallet (Test.gov (negate depoAmt) <> Test.xgov depoAmt) + .&&. valueAtAddress Test.scriptAddress (== Test.gov depoAmt) + ) + $ Gov.callDeposit Test.testGovCurrencySymbol testWallet (Api.Deposit depoAmt) + +testInsuficcientGOVFails :: TestTree +testInsuficcientGOVFails = + let + testWallet = Test.fstWalletWithGOV + tag = Trace.walletInstanceTag testWallet + errCheck = ("InsufficientFunds" `T.isInfixOf`) -- todo probably matching some concrete error type will be better + in + checkPredicateOptions Test.checkOptions "Can't deposit more GOV than wallet owns" + ( assertNoFailedTransactions + .&&. assertContractError theContract tag errCheck "Should fail with `InsufficientFunds`" + .&&. walletFundsChange testWallet mempty -- todo factor out + .&&. valueAtAddress Test.scriptAddress (== mempty) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit 1000) -- TODO get value from wallet + +testCantDepositWithoutGov :: TestTree +testCantDepositWithoutGov = + let + pred = ("InsufficientFunds" `T.isInfixOf`) + testWallet = Test.walletNoGOV + tag = Trace.walletInstanceTag testWallet + in + checkPredicateOptions Test.checkOptions "Can't deposit with no GOV in wallet" + (assertNoFailedTransactions + .&&. assertContractError theContract tag pred "Should fail with `InsufficientFunds`" + .&&. walletFundsChange testWallet mempty + .&&. valueAtAddress Test.scriptAddress (== mempty) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit 50) + +testCantDepositNegativeAmount :: TestTree +testCantDepositNegativeAmount = + let + testWallet = Test.fstWalletWithGOV + tag = Trace.walletInstanceTag testWallet + depoAmt = 50 + in + checkPredicateOptions Test.checkOptions "Can't depositing negative GOV amount" + ( -- just check that some contract error was thrown before we get more concrete errors + Test.assertHasErrorOutcome theContract tag "Should fail depositing negative GOV amount" + .&&. walletFundsChange testWallet (Test.gov (negate depoAmt) <> Test.xgov depoAmt) + .&&. valueAtAddress Test.scriptAddress (== Test.gov depoAmt) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + {- setup some initial funds to make sure we aren't failing with insufficient funds + while trying to burn xGOV tokens + -} + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit (50)) + next + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit (negate 2)) + + +-- withdraw tests + +testFullWithdraw :: TestTree +testFullWithdraw = + let + testWallet = Test.fstWalletWithGOV + depoAmt = 50 + in + checkPredicateOptions Test.checkOptions "Full withdraw" + ( assertNoFailedTransactions + .&&. walletFundsChange testWallet mempty + .&&. valueAtAddress Test.scriptAddress (== mempty) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + next + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit depoAmt) + next + void $ callEndpoint' @Api.Withdraw hdl (Api.Withdraw depoAmt) + +testPartialWithdraw :: TestTree +testPartialWithdraw = + let + testWallet = Test.fstWalletWithGOV + depoAmt = 50 + withdrawAmt = 20 + diff = depoAmt - withdrawAmt + in + checkPredicateOptions Test.checkOptions "Partial withdraw" + ( assertNoFailedTransactions + .&&. walletFundsChange testWallet (Test.gov (negate diff) <> Test.xgov diff) + .&&. valueAtAddress Test.scriptAddress (== Test.gov diff) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + next + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit depoAmt) + next + void $ callEndpoint' @Api.Withdraw hdl (Api.Withdraw depoAmt) + + +testCantWithdrawMoreThandeposited :: TestTree +testCantWithdrawMoreThandeposited = + checkPredicateOptions Test.checkOptions "Can't withdraw more GOV than deposited" + -- todo + {- not sure what behaviour expected here: failed transaction, contract error + or user just gets back all his deposit? + assuming for now, that transaction should fail + -} + ( not assertNoFailedTransactions ) + $ do + h1 <- Trace.activateContractWallet Test.fstWalletWithGOV theContract + h2 <- Trace.activateContractWallet Test.sndWalletWithGOV theContract + next + void $ callEndpoint' @Api.Deposit h1 (Api.Deposit 50) + next + void $ callEndpoint' @Api.Deposit h2 (Api.Deposit 50) + next + void $ callEndpoint' @Api.Withdraw h2 (Api.Withdraw 60) + +testCantWithdrawNegativeAmount :: TestTree +testCantWithdrawNegativeAmount = + let + testWallet = Test.fstWalletWithGOV + tag = Trace.walletInstanceTag testWallet + depoAmt = 50 + in + checkPredicateOptions Test.checkOptions "Can't withdraw negative GOV amount" + ( -- just check that some contract error was thrown before we get more concrete errors + Test.assertHasErrorOutcome theContract tag "Can't withdraw negative GOV amount" + .&&. walletFundsChange testWallet (Test.gov (negate depoAmt) <> Test.xgov depoAmt) + .&&. valueAtAddress Test.scriptAddress (== Test.gov depoAmt) + ) + $ do + hdl <- Trace.activateContractWallet testWallet theContract + void $ callEndpoint' @Api.Deposit hdl (Api.Deposit depoAmt) + next + void $ callEndpoint' @Api.Withdraw hdl (Api.Withdraw (negate 2)) + \ No newline at end of file diff --git a/mlabs/test/Test/Governance/Init.hs b/mlabs/test/Test/Governance/Init.hs new file mode 100644 index 000000000..7d2e5c6f4 --- /dev/null +++ b/mlabs/test/Test/Governance/Init.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Init blockchain state for tests +module Test.Governance.Init where + +import Prelude () +import PlutusTx.Prelude + +import Control.Lens ((&), (.~)) +import Data.Map (Map) +import qualified Data.Map as M + +import qualified Mlabs.Governance.Contract.Validation as Gov +import qualified Mlabs.Governance.Contract.Server as Gov + +import Plutus.Contract.Test ( + CheckOptions, defaultCheckOptions, emulatorConfig + , Wallet(..), walletPubKey, assertOutcome, Outcome(..)) +import Plutus.Trace.Emulator ( initialChainState) +import Ledger (Address, Value, CurrencySymbol) +import qualified Ledger +import Plutus.V1.Ledger.Ada (adaSymbol, adaToken) +-- import Plutus.V1.Ledger.Value (Value) +import qualified Plutus.V1.Ledger.Value as Value (singleton) + +import Test.Utils (next) + + +checkOptions :: CheckOptions +checkOptions = defaultCheckOptions & emulatorConfig . initialChainState .~ Left initialDistribution + +-- | Wallets that are used for testing. +fstWalletWithGOV, sndWalletWithGOV, walletNoGOV :: Wallet +fstWalletWithGOV = Wallet 1 +sndWalletWithGOV = Wallet 2 +walletNoGOV = Wallet 3 + +testGovCurrencySymbol :: CurrencySymbol +testGovCurrencySymbol = "ff" + +scriptAddress :: Address +scriptAddress = Gov.scrAddress testGovCurrencySymbol + +-- | Make `GOV` `Value` +gov :: Integer -> Value +gov = Gov.govValueOf testGovCurrencySymbol +-- | Make `GOV` `Value` + +xgov :: Integer -> Value +xgov = Value.singleton + (Ledger.scriptCurrencySymbol $ Gov.xGovMintingPolicy testGovCurrencySymbol) + (Gov.xgovToken) + +-- | Make `Ada` `Value` +ada :: Integer -> Value +ada x = Value.singleton adaSymbol adaToken x + +-- | wallets for tests +initialDistribution :: M.Map Wallet Value +initialDistribution = M.fromList + [ (fstWalletWithGOV, ada 1000_000_000 <> gov 100) + , (sndWalletWithGOV, ada 1000_000_000 <> gov 100) + , (walletNoGOV, ada 1000_000_000) + ] + +-- | Assert that contract finished excution with arbitrary error +assertHasErrorOutcome contract tag message = + assertOutcome contract tag isFailed message + where + isFailed e + | (Failed _) <- e = True + | otherwise = False \ No newline at end of file