Plutus Playground Smart Contract

Playground.hs

{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-- | A guessing game that
--
--   * Uses a state machine to keep track of the current secret word
--   * Uses a token to keep track of who is allowed to make a guess
--

module GameStateMachine where

import qualified Data.Map                     as Map
import           Data.Maybe                   (maybeToList)
import qualified Data.Set                     as Set
import qualified Data.Text                    as Text
import qualified Language.PlutusTx            as PlutusTx
import           Language.PlutusTx.Prelude    hiding (check)
import           Ledger                       hiding (to)
import           Ledger.Value                 (TokenName)
import qualified Ledger.Value                 as V
import qualified Ledger.Validation            as Validation
import           Wallet
import qualified Wallet                       as WAPI
import           Playground.Contract

import qualified Data.ByteString.Lazy.Char8   as C

import qualified Language.PlutusTx.StateMachine as SM
import           Language.PlutusTx.StateMachine ()

newtype HashedString = HashedString ByteString

PlutusTx.makeLift ''HashedString

newtype ClearString = ClearString ByteString

PlutusTx.makeLift ''ClearString

-- | State of the guessing game
data GameState =
    Initialised HashedString
    -- ^ Initial state. In this state only the 'ForgeTokens' action is allowed.
    | Locked TokenName HashedString
    -- ^ Funds have been locked. In this state only the 'Guess' action is
    --   allowed.

instance Eq GameState where
    {-# INLINABLE (==) #-}
    (Initialised (HashedString s)) == (Initialised (HashedString s')) = s == s'
    (Locked (V.TokenName n) (HashedString s)) == (Locked (V.TokenName n') (HashedString s')) = s == s' && n == n'
    _ == _ = traceIfFalseH "states not equal" False

PlutusTx.makeLift ''GameState

-- | Check whether a 'ClearString' is the preimage of a
--   'HashedString'
checkGuess :: HashedString -> ClearString -> Bool
checkGuess (HashedString actual) (ClearString gss) = actual == (sha2_256 gss)

-- | Inputs (actions)
data GameInput =
      ForgeToken TokenName
    -- ^ Forge the "guess" token
    | Guess ClearString HashedString
    -- ^ Make a guess and lock the remaining funds using a new secret word.

PlutusTx.makeLift ''GameInput

{-# INLINABLE step #-}
step :: GameState -> GameInput -> Maybe GameState
step state input = case (state, input) of
    (Initialised s, ForgeToken tn) -> Just $ Locked tn s
    (Locked tn _, Guess _ nextSecret) -> Just $ Locked tn nextSecret
    _ -> Nothing

{-# INLINABLE check #-}
check :: GameState -> GameInput -> PendingTx -> Bool
check state input ptx = case (state, input) of
    (Initialised _, ForgeToken tn) -> checkForge (tokenVal tn)
    (Locked tn currentSecret, Guess theGuess _) -> checkGuess currentSecret theGuess && tokenPresent tn && checkForge zero
    _ -> False
    where
        -- | Given a 'TokeName', get the value that contains
        --   exactly one token of that name in the contract's
        --   currency.
        tokenVal :: TokenName -> V.Value
        tokenVal tn =
            let ownSymbol = Validation.ownCurrencySymbol ptx
            in V.singleton ownSymbol tn 1
        -- | Check whether the token that was forged at the beginning of the
        --   contract is present in the pending transaction
        tokenPresent :: TokenName -> Bool
        tokenPresent tn =
            let vSpent = Validation.valueSpent ptx
            in  V.geq vSpent (tokenVal tn)
        -- | Check whether the value forged by the  pending transaction 'p' is
        --   equal to the argument.
        checkForge :: Value -> Bool
        checkForge vl = vl == (Validation.pendingTxForge ptx)

{-# INLINABLE mkValidator #-}
mkValidator :: SM.StateMachineValidator GameState GameInput
mkValidator = SM.mkValidator (SM.StateMachine step check (const False))

gameValidator :: ValidatorScript
gameValidator = ValidatorScript $$(Ledger.compileScript [|| mkValidator ||])

mkRedeemer :: GameInput -> RedeemerScript
mkRedeemer i = RedeemerScript $
    $$(Ledger.compileScript [|| SM.mkStepRedeemer @GameState @GameInput ||])
        `Ledger.applyScript`
            (Ledger.lifted i)

gameToken :: TokenName
gameToken = "guess"

-- | The 'Value' forged by the 'curValidator' contract
gameTokenVal :: Value
gameTokenVal =
    let
        -- see note [Obtaining the currency symbol]
        cur = plcCurrencySymbol (Ledger.scriptAddress gameValidator)
    in
        V.singleton cur gameToken 1

-- | Make a guess, take out some funds, and lock the remaining 'Value' with a new
--   secret
guess ::
    (WalletAPI m, WalletDiagnostics m)
    => String
    -- ^ The guess
    -> String
    -- ^ A new secret
    -> Value
    -- ^ How much ada to take out
    -> Value
    -- ^ How much to put back into the contract
    -> m ()
guess gss new keepVal restVal = do

    let addr = Ledger.scriptAddress gameValidator
        guessedSecret = ClearString (C.pack gss)
        newSecret = HashedString (plcSHA2_256 (C.pack new))
        input = Guess guessedSecret newSecret
        newState = Locked gameToken newSecret
        redeemer = mkRedeemer input
    ins <- WAPI.spendScriptOutputs addr gameValidator redeemer
    ownOutput <- WAPI.ownPubKeyTxOut (keepVal <> gameTokenVal)

    let scriptOut = scriptTxOut restVal gameValidator (DataScript (Ledger.lifted newState))

    (i, own) <- createPaymentWithChange gameTokenVal

    let tx = Ledger.Tx
                { txInputs = Set.union i (Set.fromList $ fmap fst ins)
                , txOutputs = [ownOutput, scriptOut] ++ maybeToList own
                , txForge = zero
                , txFee   = zero
                , txValidRange = defaultSlotRange
                , txSignatures = Map.empty
                }

    WAPI.signTxAndSubmit_ tx

forge :: (WalletAPI m, WalletDiagnostics m) => String -> Value -> m ()
forge initialWord vl = do
    let secret = HashedString (plcSHA2_256 (C.pack initialWord))
        addr = Ledger.scriptAddress gameValidator
        state = Initialised secret
        ds   = DataScript (Ledger.lifted state)
    ownOutput <- WAPI.ownPubKeyTxOut gameTokenVal
    let input = ForgeToken gameToken
        newState = Locked gameToken secret
        redeemer = mkRedeemer input
        scriptOut = scriptTxOut vl gameValidator (DataScript (Ledger.lifted newState))
    ins <- WAPI.spendScriptOutputs addr gameValidator redeemer

    let tx = Ledger.Tx
                { txInputs = Set.fromList (fmap fst ins)
                , txOutputs = [ownOutput, scriptOut]
                , txForge = gameTokenVal
                , txFee   = zero
                , txValidRange = defaultSlotRange
                , txSignatures = Map.empty
                }

    WAPI.logMsg $ Text.pack $ "The forging transaction is: " <> show (Ledger.hashTx tx)
    WAPI.signTxAndSubmit_ tx

-- | Transfer the game token to another wallet
transferToken :: (WalletAPI m, WalletDiagnostics m) => Wallet -> m ()
transferToken = payToWallet_ gameTokenVal

-- | Lock some funds in the guessing game. Produces the token that is required
--   when submitting a guess.
lock :: (WalletAPI m, WalletDiagnostics m) => String -> Value -> m ()
lock initialWord vl = do
    let secret = HashedString (plcSHA2_256 (C.pack initialWord))
        addr = Ledger.scriptAddress gameValidator
        state = Initialised secret
        ds   = DataScript (Ledger.lifted state)

    payToScript_ defaultSlotRange addr vl ds

-- | Tell the wallet to start watching the address of the game script
startGame :: WalletAPI m => m ()
startGame = startWatching (Ledger.scriptAddress gameValidator)

$(mkFunctions 
    ['lock
    , 'guess
    , 'startGame
    , 'transferToken
    , 'forge
    ])

Simulation.json

[0,[{"wallets":[{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}}],"signatures":[{"functionName":"lock","argumentSchema":[{"tag":"FormSchemaString"},{"tag":"FormSchemaValue"}]},{"functionName":"guess","argumentSchema":[{"tag":"FormSchemaString"},{"tag":"FormSchemaString"},{"tag":"FormSchemaValue"},{"tag":"FormSchemaValue"}]},{"functionName":"startGame","argumentSchema":[]},{"functionName":"transferToken","argumentSchema":[{"contents":[["getWallet",{"tag":"FormSchemaInt"}]],"tag":"FormSchemaObject"}]},{"functionName":"forge","argumentSchema":[{"tag":"FormSchemaString"},{"tag":"FormSchemaValue"}]},{"functionName":"payToWallet_","argumentSchema":[{"tag":"FormSchemaValue"},{"contents":[["getWallet",{"tag":"FormSchemaInt"}]],"tag":"FormSchemaObject"}]}],"currencies":[{"knownTokens":[{"unTokenName":""}],"hash":"","friendlyName":"Ada"}],"actions":[{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"startGame","argumentSchema":[]},"tag":"Action"},{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"startGame","argumentSchema":[]},"tag":"Action"},{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"lock","argumentSchema":[{"contents":"secret","tag":"FormString"},{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},5]]]],"tag":"FormValue"}]},"tag":"Action"},{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"forge","argumentSchema":[{"contents":"secret","tag":"FormString"},{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},5]]]],"tag":"FormValue"}]},"tag":"Action"},{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"transferToken","argumentSchema":[{"contents":[["getWallet",{"contents":2,"tag":"FormInt"}]],"tag":"FormObject"}]},"tag":"Action"},{"simulatorWallet":{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},"functionSchema":{"functionName":"guess","argumentSchema":[{"contents":"secret","tag":"FormString"},{"contents":"new-secret","tag":"FormString"},{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},3]]]],"tag":"FormValue"},{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},2]]]],"tag":"FormValue"}]},"tag":"Action"}]}]]