claudiomaradonna/plutus-pioneer-program
1
0
Fork 0
mirror of https://github.com/FiloSpaTeam/plutus-pioneer-program.git synced 2024-11-25 00:02:18 +01:00
Code Issues Projects Releases Packages Wiki Activity

test suite

Browse source
This commit is contained in:
Lars Brünjes 2021-05-26 00:34:34 +02:00
parent f1664d6c31
commit 64d795fbb2
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
5 changed files with 80 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
code/week08/hie.yaml
View file

@ -2,3 +2,5 @@ cradle:
cabal:
- path: "./src"
component: "lib:plutus-pioneer-program-week08"
- path: "./test"
component: "test:plutus-pioneer-program-week08-tests"

30
code/week08/plutus-pioneer-program-week08.cabal
View file

@ -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

16
code/week08/test/Spec.hs Normal file
View file

@ -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
]

19
code/week08/src/Week08/TestTokenSale.hs → code/week08/test/Spec/Model.hs
View file

@ -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)

34
code/week08/src/Week08/TraceTokenSale.hs → code/week08/test/Spec/Trace.hs
View file

@ -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"