Plutus Playground Smart Contract

Playground.hs

-- A game with two players. Player 1 thinks of a secret word
-- and uses its hash, and the game validator script, to lock
-- some funds (the prize) in a pay-to-script transaction output.
-- Player 2 guesses the word by attempting to spend the transaction
-- output. If the guess is correct, the validator script releases the funds.
-- If it isn't, the funds stay locked.
import           Control.Monad                     (void, when)
import qualified Data.Map                          as Map
import qualified Data.Text                         as T

import           Language.Plutus.Contract          hiding (when)
import qualified Language.Plutus.Contract.Typed.Tx as Typed
import qualified Language.PlutusTx                 as PlutusTx
import           Language.PlutusTx.Prelude         hiding (Semigroup (..), fold)
import           Ledger                            (Address, PubKeyHash, Slot (Slot), Validator, pubKeyHash)
import qualified Ledger.Ada                        as Ada
import           Ledger.Constraints                (TxConstraints, mustBeSignedBy, mustPayToTheScript, mustValidateIn)
import           Ledger.Contexts                   (TxInfo (..), ValidatorCtx (..))
import qualified Ledger.Contexts                   as Validation
import qualified Ledger.Interval                   as Interval
import qualified Ledger.Slot                       as Slot
import qualified Ledger.Tx                         as Tx
import qualified Ledger.Typed.Scripts              as Scripts
import           Ledger.Value                      (Value)
import qualified Ledger.Value                      as Value
import           Playground.Contract
import qualified Prelude                           as Prelude
import           Wallet.Emulator.Types             (walletPubKey)
import           Wallet.Emulator.Wallet

------------------------------------------------------------

-- Define Chess logic
data PlayerSide = Black | White

 -- Boilerplate to make this types Plutus-friendly
PlutusTx.makeIsData ''PlayerSide
PlutusTx.makeLift ''PlayerSide

data GameEnd = BlackWins | WhiteWins | Draw

PlutusTx.makeIsData ''GameEnd
PlutusTx.makeLift ''GameEnd

newtype Player = Player {playerAddress :: Wallet}
    -- Don't know all instances I need to derived... Would be nice to have a type synonim you can derive.
    deriving newtype (FromJSON, ToJSON, IotsType, ToSchema, Prelude.Show, Generic, Prelude.Eq)

-- The whole point of crytpo-tournament is not having a human referee to deal with the money.
-- This should a machine-trusted client. Could an App (like lichess) comunicate with this endpoint?
newtype Referee = Referee {playerAddress :: Wallet}
    deriving newtype (FromJSON, ToJSON, IotsType, ToSchema, Prelude.Show, Generic, Prelude.Eq)

data Game = Game { whitePlayer :: Player
                 , blackPlayer :: Player
                 , end :: GameEnd
                 }
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, IotsType, ToSchema, ToArgument)

data Tournament = Tournament { fee :: Value
                             , maxPlayers :: Int
                             , actualPlayers :: [Player]
                             , Referee :: Referee
                             , games :: Map.Map Player [Game]
                             }
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, IotsType, ToSchema, ToArgument)


type TournamentSchema =
    BlockchainActions
        .\/ Endpoint "joinTournament" Player           -- This Endpoint will ask for the player fee is there is a vacant
        .\/ Endpoint "communicateGame" (Referee, Game) -- This Will check the referee is valid, and anotate the game result
        .\/ Endpoint "takePot" Player                  -- This Will check all games has been played (thats, each player against all other in both sides, black and white) and the rank of the player

-- WTF? are Redeemer and Datum contractual english-jargon? Direct translation is missleading...
-- Just copy-paste, and pray for the compiler
instance Scripts.ScriptType Tournament where
    type instance RedeemerType Tournament = Player
    type instance DatumType Tournament = Tournament

tournamentInstance :: Scripts.ScriptInstance Tournament
tournamentInstance = Scripts.validator @Tournament
    $$(PlutusTx.compile [|| validateTournamentResult ||])
    $$(PlutusTx.compile [|| wrap ||]) where
        wrap = Scripts.wrapValidator @HashedString @ClearString

-- create a data script for the guessing game by hashing the string
-- and lifting the hash to its on-chain representation
hashString :: String -> HashedString
hashString = HashedString . sha2_256 . C.pack

-- create a redeemer script for the guessing game by lifting the
-- string to its on-chain representation
clearString :: String -> ClearString
clearString = ClearString . C.pack

-- | The validation function (Datum -> Redeemer -> ValidatorCtx -> Bool)
validateGuess :: HashedString -> ClearString -> ValidatorCtx -> Bool
validateGuess (HashedString actual) (ClearString guess') _ = actual == sha2_256 guess'

-- | The validator script of the game.
gameValidator :: Validator
gameValidator = Scripts.validatorScript gameInstance

-- | The address of the game (the hash of its validator script)
gameAddress :: Address
gameAddress = Ledger.scriptAddress gameValidator

-- | Parameters for the "lock" endpoint
data LockParams = LockParams
    { secretWord :: String
    , amount     :: Value
    }
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, IotsType, ToSchema, ToArgument)

--  | Parameters for the "guess" endpoint
newtype GuessParams = GuessParams
    { guessWord :: String
    }
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, IotsType, ToSchema, ToArgument)

-- | The "lock" contract endpoint. See note [Contract endpoints]
lock :: AsContractError e => Contract GameSchema e ()
lock = do
    LockParams secret amt <- endpoint @"lock" @LockParams
    let tx         = Constraints.mustPayToTheScript (hashString secret) amt
    void (submitTxConstraints gameInstance tx)

-- | The "guess" contract endpoint. See note [Contract endpoints]
guess :: AsContractError e => Contract GameSchema e ()
guess = do
    GuessParams theGuess <- endpoint @"guess" @GuessParams
    unspentOutputs <- utxoAt gameAddress
    let redeemer = clearString theGuess
        tx       = collectFromScript unspentOutputs redeemer
    void (submitTxConstraintsSpending gameInstance unspentOutputs tx)

game :: AsContractError e => Contract GameSchema e ()
game = lock `select` guess

{- Note [Contract endpoints]

A contract endpoint is a function that uses the wallet API to interact with the
blockchain. We can look at contract endpoints from two different points of view.

1. Contract users

Contract endpoints are the visible interface of the contract. They provide a
UI (HTML form) for entering the parameters of the actions we may take as part
of the contract.

2. Contract authors

As contract authors we define endpoints as functions that return a value of
type 'MockWallet ()'. This type indicates that the function uses the wallet API
to produce and spend transaction outputs on the blockchain.

Endpoints can have any number of parameters: 'lock' has two
parameters, 'guess' has one and 'startGame' has none. For each endpoint we
include a call to 'mkFunction' at the end of the contract definition. This
causes the Haskell compiler to generate a schema for the endpoint. The Plutus
Playground then uses this schema to present an HTML form to the user where the
parameters can be entered.

-}

endpoints :: AsContractError e => Contract GameSchema e ()
endpoints = game

mkSchemaDefinitions ''GameSchema

$(mkKnownCurrencies [])

Simulation.json

[0,[]]