Skip to content

Commit

Permalink
Fix the game example
Browse files Browse the repository at this point in the history
  • Loading branch information
berewt committed Feb 8, 2023
1 parent 38c0f1c commit 6972eab
Show file tree
Hide file tree
Showing 4 changed files with 23 additions and 35 deletions.
34 changes: 20 additions & 14 deletions examples/src/Plutus/Contracts/Game.hs
Expand Up @@ -39,16 +39,18 @@ module Plutus.Contracts.Game
, correctGuessTrace
) where

import Cardano.Node.Emulator.Params (testnet)
import Control.Lens (_2, (^?))
import Control.Monad (void)
import qualified Data.ByteString.Char8 as C
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Plutus.V1.Ledger.Api (Address, ScriptContext, Validator, Value, Datum(Datum))
import qualified Ledger
import Plutus.V2.Ledger.Api (ScriptContext, Validator, Value, Datum(Datum))
import Ledger (CardanoAddress, DecoratedTxOut)
import qualified Ledger.Ada as Ada
import qualified Ledger.Constraints as Constraints
import Ledger.Tx (ChainIndexTxOut (..))
import qualified Ledger
import Playground.Contract
import Plutus.Contract
import Plutus.Contract.Trace as X
Expand All @@ -57,7 +59,10 @@ import PlutusTx.Prelude hiding (pure, (<$>))
import qualified Prelude as Haskell
import Plutus.Trace.Emulator (EmulatorTrace)
import qualified Plutus.Trace.Emulator as Trace
import qualified Plutus.Script.Utils.V1.Typed.Scripts as Scripts
import qualified Plutus.Script.Utils.V2.Address as Address
import qualified Plutus.Script.Utils.V2.Typed.Scripts as Scripts
import qualified Plutus.Script.Utils.V1.Typed.Scripts as V1
import qualified Ledger.Typed.Scripts as Script

newtype HashedString = HashedString BuiltinByteString deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)

Expand All @@ -80,7 +85,7 @@ gameInstance :: Scripts.TypedValidator Game
gameInstance = Scripts.mkTypedValidator @Game
$$(PlutusTx.compile [|| validateGuess ||])
$$(PlutusTx.compile [|| wrap ||]) where
wrap = Scripts.mkUntypedValidator @HashedString @ClearString
wrap = V1.mkUntypedValidator @ScriptContext @HashedString @ClearString

-- create a data script for the guessing game by hashing the string
-- and lifting the hash to its on-chain representation
Expand All @@ -104,13 +109,13 @@ gameValidator :: Validator
gameValidator = Scripts.validatorScript gameInstance

-- | The address of the game (the hash of its validator script)
gameAddress :: Address
gameAddress = Ledger.scriptAddress gameValidator
gameAddress :: CardanoAddress
gameAddress = Address.mkValidatorCardanoAddress testnet $ Script.validatorScript gameInstance

-- | Parameters for the "lock" endpoint
data LockParams = LockParams
{ secretWord :: Haskell.String
, amount :: Value
{ secretWord :: !Haskell.String
, amount :: !Value
}
deriving stock (Haskell.Eq, Haskell.Show, Generic)
deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument)
Expand All @@ -126,7 +131,7 @@ newtype GuessParams = GuessParams
lock :: AsContractError e => Promise () GameSchema e ()
lock = endpoint @"lock" @LockParams $ \(LockParams secret amt) -> do
logInfo @Haskell.String $ "Pay " <> Haskell.show amt <> " to the script"
let tx = Constraints.mustPayToTheScript (hashString secret) amt
let tx = Constraints.mustPayToTheScriptWithDatumInTx (hashString secret) amt
void (submitTxConstraints gameInstance tx)

-- | The "guess" contract endpoint. See note [Contract endpoints]
Expand All @@ -137,7 +142,7 @@ guess = endpoint @"guess" @GuessParams $ \(GuessParams theGuess) -> do
utxos <- fundsAtAddressGeq gameAddress (Ada.lovelaceValueOf 1)

let redeemer = clearString theGuess
tx = collectFromScript utxos redeemer
tx = Constraints.collectFromTheScript utxos redeemer

-- Log a message saying if the secret word was correctly guessed
let hashedSecretWord = findSecretWordValue utxos
Expand All @@ -153,14 +158,15 @@ guess = endpoint @"guess" @GuessParams $ \(GuessParams theGuess) -> do
void (submitTxConstraintsSpending gameInstance utxos tx)

-- | Find the secret word in the Datum of the UTxOs
findSecretWordValue :: Map TxOutRef ChainIndexTxOut -> Maybe HashedString
-- | Find the secret word in the Datum of the UTxOs
findSecretWordValue :: Map TxOutRef DecoratedTxOut -> Maybe HashedString
findSecretWordValue =
listToMaybe . catMaybes . Map.elems . Map.map secretWordValue

-- | Extract the secret word in the Datum of a given transaction output is possible
secretWordValue :: ChainIndexTxOut -> Maybe HashedString
secretWordValue :: DecoratedTxOut -> Maybe HashedString
secretWordValue o = do
Datum d <- either (const Nothing) Just (_ciTxOutDatum o)
Datum d <- o ^? Ledger.decoratedTxOutDatum . _2 . Ledger.datumInDatumFromQuery
PlutusTx.fromBuiltinData d

game :: AsContractError e => Contract () GameSchema e ()
Expand Down
3 changes: 2 additions & 1 deletion examples/test/Spec/Game.hs
Expand Up @@ -37,9 +37,10 @@ tests = testGroup "game"
$ void $ Trace.activateContractWallet w1 (lock @ContractError)

, checkPredicate "'lock' endpoint submits a transaction"
(anyTx theContract t1)
(anyUnbalancedTx theContract t1)
$ do
hdl <- Trace.activateContractWallet w1 theContract
void $ Trace.waitNSlots 1
Trace.callEndpoint @"lock" hdl (LockParams "secret" (Ada.adaValueOf 10))

, checkPredicate "'guess' endpoint is available after locking funds"
Expand Down
1 change: 0 additions & 1 deletion pab/Main.hs
Expand Up @@ -28,7 +28,6 @@ import qualified Plutus.PAB.Webserver.Server as PAB.Server
import Plutus.Contracts.Game as Game
import Plutus.Trace.Emulator.Extract (writeScriptsTo, ScriptsConfig (..), Command (..))
import Prettyprinter (Pretty (..), viaShow)
import Ledger.Index (ValidatorMode(..))
import qualified Wallet.Emulator.Wallet as Wallet

main :: IO ()
Expand Down
20 changes: 1 addition & 19 deletions plutus-starter.cabal
Expand Up @@ -47,6 +47,7 @@ library
base >= 4.9 && < 5,
aeson -any,
bytestring -any,
cardano-node-emulator -any,
containers -any,
freer-extras -any,
playground-common -any,
Expand Down Expand Up @@ -82,22 +83,3 @@ test-suite plutus-example-projects-test
text -any,
tasty-hedgehog >=0.2.0.0


executable plutus-starter-pab
import: lang
main-is: Main.hs
hs-source-dirs: pab
ghc-options:
-threaded
build-depends:
base >= 4.9 && < 5,
data-default -any,
plutus-contract -any,
plutus-pab -any,
plutus-starter -any,
aeson -any,
freer-simple -any,
prettyprinter -any,
freer-extras -any,
plutus-ledger -any,
openapi3 -any,

0 comments on commit 6972eab

Please sign in to comment.