moving the Game example to plutus-starter; minor cleanup

IntersectMBO · Apr 6, 2021 · 41c04ab · 41c04ab
1 parent 00f5075
commit 41c04ab
Show file tree

Hide file tree

Showing 18 changed files with 54 additions and 774 deletions.
diff --git a/plutus-contract/plutus-contract.cabal b/plutus-contract/plutus-contract.cabal
@@ -141,6 +141,7 @@ library
         build-depends:
             tasty -any,
             tasty-hunit -any,
+            tasty-golden -any,
 
 test-suite contract-doctests
     type: exitcode-stdio-1.0

diff --git a/plutus-contract/src/Plutus/Contract/Test.hs b/plutus-contract/src/Plutus/Contract/Test.hs
@@ -14,6 +14,7 @@
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns         #-}
 -- | Testing contracts with HUnit and Tasty
 module Plutus.Contract.Test(
       module X
@@ -46,6 +47,7 @@ module Plutus.Contract.Test(
     , waitingForSlot
     , walletWatchingAddress
     , valueAtAddress
+    , reasonable
     -- * Checking predicates
     , checkPredicate
     , checkPredicateOptions
@@ -57,6 +59,10 @@ module Plutus.Contract.Test(
     , minLogLevel
     , maxSlot
     , emulatorConfig
+    -- * Etc
+    , goldenPir
+    , timesFeeAdjust
+    , timesFeeAdjustV
     ) where
 
 import           Control.Applicative                    (liftA2)
@@ -69,8 +75,9 @@ import           Control.Monad.Freer.Error              (Error, runError)
 import           Control.Monad.Freer.Extras.Log         (LogLevel (..), LogMessage (..))
 import           Control.Monad.Freer.Reader
 import           Control.Monad.Freer.Writer             (Writer (..), tell)
+import           Control.Monad.IO.Class                 (MonadIO (liftIO))
 import           Data.Foldable                          (fold, toList, traverse_)
-import           Data.Maybe                             (mapMaybe)
+import           Data.Maybe                             (fromJust, mapMaybe)
 import           Data.Proxy                             (Proxy (..))
 import           Data.Row                               (Forall, HasType)
 import           Data.String                            (IsString (..))
@@ -83,9 +90,11 @@ import           GHC.TypeLits                           (KnownSymbol, Symbol, sy
 
 import           Hedgehog                               (Property, forAll, property)
 import qualified Hedgehog
+import           Test.Tasty.Golden                      (goldenVsString)
 import qualified Test.Tasty.HUnit                       as HUnit
 import           Test.Tasty.Providers                   (TestTree)
 
+import qualified Ledger.Ada                             as Ada
 import           Ledger.Constraints.OffChain            (UnbalancedTx)
 import           Ledger.Tx                              (Tx)
 import           Plutus.Contract.Effects.AwaitSlot      (SlotSymbol)
@@ -97,8 +106,11 @@ import           Plutus.Contract.Effects.WriteTx        (HasWriteTx)
 import           Plutus.Contract.Resumable              (Request (..), Response (..))
 import qualified Plutus.Contract.Resumable              as State
 import           Plutus.Contract.Types                  (Contract (..))
+import           PlutusTx                               (CompiledCode, getPir)
 import qualified PlutusTx.Prelude                       as P
 
+import           Ledger                                 (Validator)
+import qualified Ledger
 import           Ledger.Address                         (Address)
 import           Ledger.Generators                      (GeneratorModel, Mockchain (..))
 import qualified Ledger.Generators                      as Gen
@@ -582,3 +594,31 @@ assertAccumState contract inst p nm =
                 ]
         pure result
 
+-- | Assert that the size of a 'Validator' is below
+--   the maximum.
+reasonable :: Validator -> Integer -> HUnit.Assertion
+reasonable (Ledger.unValidatorScript -> s) maxSize = do
+    let sz = Ledger.scriptSize s
+        msg = "Script too big! Max. size: " <> show maxSize <> ". Actual size: " <> show sz
+    -- so the actual size is visible in the log
+    liftIO $ putStrLn ("Script size: " ++ show sz)
+    HUnit.assertBool msg (sz <= maxSize)
+
+-- | Compare a golden PIR file to the provided 'CompiledCode'.
+goldenPir :: FilePath -> CompiledCode a -> TestTree
+goldenPir path code = goldenVsString "PIR" path (pure $ fromString $ show $ pretty $ fromJust $ getPir code)
+
+staticFee :: Integer
+staticFee = 0
+
+-- | Deduct transaction fees from wallet funds, and make
+--   the fee amount explicit in the test specification
+timesFeeAdjust :: Integer -> Integer -> Value
+timesFeeAdjust multiplier change =
+    timesFeeAdjustV multiplier (Ada.lovelaceValueOf change)
+
+-- | Deduct transaction fees from wallet funds, and make
+--   the fee amount explicit in the test specification
+timesFeeAdjustV :: Integer -> Value -> Value
+timesFeeAdjustV multiplier change =
+    change P.- Ada.lovelaceValueOf (staticFee * multiplier)
diff --git a/plutus-use-cases/plutus-use-cases.cabal b/plutus-use-cases/plutus-use-cases.cabal
@@ -32,7 +32,6 @@ library
         Plutus.Contracts.Currency
         Plutus.Contracts.Escrow
         Plutus.Contracts.Future
-        Plutus.Contracts.Game
         Plutus.Contracts.GameStateMachine
         Plutus.Contracts.ErrorHandling
         Plutus.Contracts.MultiSig
@@ -98,9 +97,7 @@ test-suite plutus-use-cases-test
         Spec.ErrorHandling
         Spec.Escrow
         Spec.Future
-        Spec.Game
         Spec.GameStateMachine
-        Spec.Lib
         Spec.MultiSig
         Spec.MultiSigStateMachine
         Spec.PingPong
@@ -161,9 +158,7 @@ executable plutus-use-cases-scripts
         Spec.ErrorHandling
         Spec.Escrow
         Spec.Future
-        Spec.Game
         Spec.GameStateMachine
-        Spec.Lib
         Spec.MultiSig
         Spec.MultiSigStateMachine
         Spec.PingPong

diff --git a/plutus-use-cases/scripts/Main.hs b/plutus-use-cases/scripts/Main.hs
@@ -17,7 +17,6 @@ import qualified Wallet.Emulator.Folds         as Folds
 import           Wallet.Emulator.Stream        (defaultEmulatorConfig, foldEmulatorStreamM)
 
 import qualified Plutus.Contracts.Crowdfunding as Crowdfunding
-import qualified Plutus.Contracts.Game         as Game
 import           Spec.Auction                  as Auction
 import qualified Spec.Currency                 as Currency
 import qualified Spec.Escrow                   as Escrow
@@ -54,8 +53,6 @@ writeScripts fp = do
         , ("future-increase-margin", Future.increaseMarginTrace)
         , ("future-settle-early", Future.settleEarlyTrace)
         , ("future-pay-out", Future.payOutTrace)
-        , ("game-guess", Game.guessTrace)
-        , ("game-guessWrong", Game.guessWrongTrace)
         , ("game-sm-success", GameStateMachine.successTrace)
         , ("game-sm-success_2", GameStateMachine.successTrace2)
         , ("multisig-success", MultiSig.succeedingTrace)

diff --git a/plutus-use-cases/src/Plutus/Contracts/Game.hs b/plutus-use-cases/src/Plutus/Contracts/Game.hs
diff --git a/plutus-use-cases/test/Spec.hs b/plutus-use-cases/test/Spec.hs
@@ -7,7 +7,6 @@ import qualified Spec.Currency
 import qualified Spec.ErrorHandling
 import qualified Spec.Escrow
 import qualified Spec.Future
-import qualified Spec.Game
 import qualified Spec.GameStateMachine
 -- import qualified Spec.MultiSig
 import qualified Spec.MultiSigStateMachine
@@ -38,7 +37,6 @@ tests = localOption limit $ testGroup "use cases" [
     Spec.Vesting.tests,
     Spec.ErrorHandling.tests,
     Spec.Future.tests,
-    Spec.Game.tests,
     -- disable temporarily, because we need to adopt the signing API
     -- Spec.MultiSig.tests,
     Spec.MultiSigStateMachine.tests,

diff --git a/plutus-use-cases/test/Spec/Crowdfunding.hs b/plutus-use-cases/test/Spec/Crowdfunding.hs
@@ -17,8 +17,6 @@ import qualified Data.ByteString.Lazy                  as BSL
 import qualified Data.Text.Encoding                    as T
 import           Data.Text.Prettyprint.Doc             (Pretty (..), defaultLayoutOptions, layoutPretty, vsep)
 import           Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
-import           Spec.Lib                              (timesFeeAdjust)
-import qualified Spec.Lib                              as Lib
 import           Test.Tasty
 import           Test.Tasty.Golden                     (goldenVsString)
 import qualified Test.Tasty.HUnit                      as HUnit
@@ -100,14 +98,14 @@ tests = testGroup "crowdfunding"
             void $ makeContribution w3 (Ada.lovelaceValueOf 5)
             void $ Trace.waitUntilSlot 31
 
-    , Lib.goldenPir "test/Spec/crowdfunding.pir" $$(PlutusTx.compile [|| mkValidator ||])
+    , goldenPir "test/Spec/crowdfunding.pir" $$(PlutusTx.compile [|| mkValidator ||])
     ,   let
             deadline = 10
             target = Ada.lovelaceValueOf 1000
             collectionDeadline = 15
             owner = w1
             cmp = mkCampaign deadline target collectionDeadline owner
-        in HUnit.testCase "script size is reasonable" (Lib.reasonable (contributionScript cmp) 30000)
+        in HUnit.testCase "script size is reasonable" (reasonable (contributionScript cmp) 30000)
 
     , goldenVsString
         "renders the log of a single contract instance sensibly"

diff --git a/plutus-use-cases/test/Spec/Escrow.hs b/plutus-use-cases/test/Spec/Escrow.hs
@@ -9,7 +9,6 @@ import qualified Ledger.Ada              as Ada
 import qualified Ledger.Typed.Scripts    as Scripts
 import           Plutus.Contract
 import           Plutus.Contract.Test
-import qualified Spec.Lib                as Lib
 
 import           Plutus.Contracts.Escrow
 import qualified Plutus.Trace.Emulator   as Trace
@@ -69,7 +68,7 @@ tests = testGroup "escrow"
           .&&. assertDone con (Trace.walletInstanceTag w1) (const True) "refund should succeed")
         refundTrace
 
-    , HUnit.testCase "script size is reasonable" (Lib.reasonable (Scripts.validatorScript $ scriptInstance escrowParams) 32000)
+    , HUnit.testCase "script size is reasonable" (reasonable (Scripts.validatorScript $ scriptInstance escrowParams) 32000)
     ]
 
 w1, w2, w3 :: Wallet

diff --git a/plutus-use-cases/test/Spec/Future.hs b/plutus-use-cases/test/Spec/Future.hs
@@ -15,7 +15,6 @@ import           Control.Monad           (void)
 import           Test.Tasty
 import qualified Test.Tasty.HUnit        as HUnit
 
-import qualified Spec.Lib                as Lib
 import           Spec.TokenAccount       (assertAccountBalance)
 
 import qualified Ledger
@@ -61,9 +60,9 @@ tests =
         .&&. assertAccountBalance (ftoLong F.testAccounts) (== (Ada.lovelaceValueOf 2310)))
         payOutTrace
 
-    , Lib.goldenPir "test/Spec/future.pir" $$(PlutusTx.compile [|| F.futureStateMachine ||])
+    , goldenPir "test/Spec/future.pir" $$(PlutusTx.compile [|| F.futureStateMachine ||])
 
-    , HUnit.testCase "script size is reasonable" (Lib.reasonable (F.validator theFuture F.testAccounts) 63000)
+    , HUnit.testCase "script size is reasonable" (reasonable (F.validator theFuture F.testAccounts) 63000)
 
     ]