diff --git a/code/week08/hie.yaml b/code/week08/hie.yaml index d60a69e..7dc90d6 100644 --- a/code/week08/hie.yaml +++ b/code/week08/hie.yaml @@ -2,3 +2,5 @@ cradle: cabal: - path: "./src" component: "lib:plutus-pioneer-program-week08" + - path: "./test" + component: "test:plutus-pioneer-program-week08-tests" diff --git a/code/week08/plutus-pioneer-program-week08.cabal b/code/week08/plutus-pioneer-program-week08.cabal index 28c7d22..b315d79 100644 --- a/code/week08/plutus-pioneer-program-week08.cabal +++ b/code/week08/plutus-pioneer-program-week08.cabal @@ -11,14 +11,9 @@ License-files: LICENSE library hs-source-dirs: src exposed-modules: Week08.TokenSale - , Week08.TestTokenSale - , Week08.TraceTokenSale build-depends: aeson , base ^>=4.14.1.0 , containers - , data-default - , freer-extras - , lens , playground-common , plutus-contract , plutus-ledger @@ -27,7 +22,30 @@ library , plutus-tx , plutus-use-cases , prettyprinter - , QuickCheck , text default-language: Haskell2010 ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise + +test-suite plutus-pioneer-program-week08-tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: Spec.Model + , Spec.Trace + default-language: Haskell2010 + ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas + build-depends: base ^>=4.14.1.0 + , containers + , data-default + , freer-extras + , lens + , plutus-contract + , plutus-ledger + , plutus-pioneer-program-week08 + , plutus-tx + , QuickCheck + , tasty + , tasty-quickcheck + , text + if !(impl(ghcjs) || os(ghcjs)) + build-depends: plutus-tx-plugin -any diff --git a/code/week08/test/Spec.hs b/code/week08/test/Spec.hs new file mode 100644 index 0000000..8d6a170 --- /dev/null +++ b/code/week08/test/Spec.hs @@ -0,0 +1,16 @@ +module Main + ( main + ) where + +import qualified Spec.Model +import qualified Spec.Trace +import Test.Tasty + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "token sale" + [ Spec.Trace.tests + , Spec.Model.tests + ] diff --git a/code/week08/src/Week08/TestTokenSale.hs b/code/week08/test/Spec/Model.hs similarity index 93% rename from code/week08/src/Week08/TestTokenSale.hs rename to code/week08/test/Spec/Model.hs index 291cea9..597ccd3 100644 --- a/code/week08/src/Week08/TestTokenSale.hs +++ b/code/week08/test/Spec/Model.hs @@ -14,7 +14,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -module Week08.TestTokenSale where +module Spec.Model + ( tests + , test + ) where import Control.Lens hiding (elements) import Control.Monad (void, when) @@ -31,6 +34,8 @@ import Ledger hiding (singleton) import Ledger.Ada as Ada import Ledger.Value import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck import Week08.TokenSale (TokenSale (..), TSStartSchema', TSUseSchema, startEndpoint', useEndpoints, nftName) @@ -47,6 +52,9 @@ newtype TSModel = TSModel {_tsModel :: Map Wallet TSState} makeLenses ''TSModel +tests :: TestTree +tests = testProperty "token sale model" prop_TS + instance ContractModel TSModel where data Action TSModel = @@ -126,8 +134,11 @@ instance ContractModel TSModel where (BuyTokens v w n) -> callEndpoint @"buy tokens" (h $ UseKey v w) n >> delay 1 (Withdraw v w n l) -> callEndpoint @"withdraw" (h $ UseKey v w) (n, l) >> delay 1 - precondition s (Start w) = isNothing $ getTSState' s w - precondition _ _ = True + precondition s (Start w) = isNothing $ getTSState' s w + precondition s (SetPrice v _ _) = isJust $ getTSState' s v + precondition s (AddTokens v _ _) = isJust $ getTSState' s v + precondition s (BuyTokens v _ _) = isJust $ getTSState' s v + precondition s (Withdraw v _ _ _) = isJust $ getTSState' s v deriving instance Eq (ContractInstanceKey TSModel w s e) deriving instance Show (ContractInstanceKey TSModel w s e) @@ -193,7 +204,7 @@ tokenAmt :: Integer tokenAmt = 1_000 prop_TS :: Actions TSModel -> Property -prop_TS = withMaxSuccess 1000 . propRunActionsWithOptions +prop_TS = withMaxSuccess 100 . propRunActionsWithOptions (defaultCheckOptions & emulatorConfig .~ EmulatorConfig (Left d)) instanceSpec (const $ pure True) diff --git a/code/week08/src/Week08/TraceTokenSale.hs b/code/week08/test/Spec/Trace.hs similarity index 72% rename from code/week08/src/Week08/TraceTokenSale.hs rename to code/week08/test/Spec/Trace.hs index 9820575..9796228 100644 --- a/code/week08/src/Week08/TraceTokenSale.hs +++ b/code/week08/test/Spec/Trace.hs @@ -12,8 +12,12 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -module Week08.TraceTokenSale where +module Spec.Trace + ( tests + , runMyTrace + ) where +import Control.Lens import Control.Monad hiding (fmap) import Control.Monad.Freer.Extras as Extras import Data.Default (Default (..)) @@ -22,24 +26,32 @@ import Data.Monoid (Last (..)) import Ledger import Ledger.Value import Ledger.Ada as Ada +import Plutus.Contract.Test import Plutus.Trace.Emulator as Emulator import PlutusTx.Prelude import Prelude (IO, String, Show (..)) -import Wallet.Emulator.Wallet +import Test.Tasty import Week08.TokenSale -test :: IO () -test = runEmulatorTraceIO' def emCfg myTrace - where - emCfg :: EmulatorConfig - emCfg = EmulatorConfig $ Left $ Map.fromList - [ (Wallet w, v) - | w <- [1 .. 3] - ] +tests :: TestTree +tests = checkPredicateOptions + (defaultCheckOptions & emulatorConfig .~ emCfg) + "token sale trace" + ( walletFundsChange (Wallet 1) (Ada.lovelaceValueOf 10_000_000 <> assetClassValue token (-60)) + .&&. walletFundsChange (Wallet 2) (Ada.lovelaceValueOf (-20_000_000) <> assetClassValue token 20) + .&&. walletFundsChange (Wallet 3) (Ada.lovelaceValueOf (- 5_000_000) <> assetClassValue token 5) + ) + myTrace +runMyTrace :: IO () +runMyTrace = runEmulatorTraceIO' def emCfg myTrace + +emCfg :: EmulatorConfig +emCfg = EmulatorConfig $ Left $ Map.fromList [(Wallet w, v) | w <- [1 .. 3]] + where v :: Value - v = Ada.lovelaceValueOf 1000_000_000 <> assetClassValue token 1000 + v = Ada.lovelaceValueOf 1000_000_000 <> assetClassValue token 1000 currency :: CurrencySymbol currency = "aa"