Plutus Playground Smart Contract

Playground.hs

import           Control.Monad                     (void, when)
import qualified Data.Map.Strict                   as Map
import qualified Data.Text                         as T
import           Data.Set                          (Set, (\\), fromList, toList, size)
import           Data.Functor                      ((<&>))
import           Data.Foldable                     (foldl')
import           Data.List                         (sortOn)
import           Data.Ord                          (Down)

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, scriptAddress)
import qualified Ledger.Ada                        as Ada
import           Ledger.Constraints                (TxConstraints, mustBeSignedBy, mustPayToTheScript, mustValidateIn, submitTxConstraints)
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 {refereeAddress :: 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 :: Set 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... and the documentation isn't clear either.
-- Just copy-paste, and pray for the compiler
data RoundRobin
instance Scripts.ScriptType RoundRobin where
    type instance RedeemerType RoundRobin = Player
    type instance DatumType RoundRobin = Tournament

-- WTF second edition. Sure this is rigth... isn't it?
tournamentInstance :: Tournament -> Scripts.ScriptInstance RoundRobin
tournamentInstance t = Scripts.validator @RoundRobin
    $$(PlutusTx.compile [|| validateTournament ||])
    $$(PlutusTx.compile [|| wrap ||]) where
        wrap = Scripts.wrapValidator @Tournament @Player

-- Auxiliar Function: Check if all games have been played
isTournamentCompleted :: Tournament -> Bool
isTournamentCompleted (Tournament _ _ plyrs _ gameMap) = toList plyrs <&> \p -> 
    case gameMap `Map.lookup` p of
        Nothing -> False -- In this case, the player hasn't played any game 
        Just gs -> let allWhitePlayers = fromList (whitePlayer <$> gs) -- Extract white players from games played by p
                       allBlackPlayers = fromList (blackPlayer <$> gs) -- Extract black players from games played by p
                    in null (plyrs \\ allWhitePlayers) && null (plyrs \\ allBlackPlayers)
    --                 ^-- The set-different between all players and (all player how had played against current player) is the empty-set. Equiv. Current player has played againts all in both sides

-- -- Auxiliar Function: Returns Players in order (win = 1 point; draw = 0.5 point; loose = 0 point)
rankPlayers :: Tournament -> [Player]     --               |- Sort the list in descending points order. Because sortDescOn is for newbies... damm you haskell!
rankPlayers (Tournament _ _ _ _ gameMap) = fst <$> sortOn (Down . Prelude.snd) $ toList $ mapWithKey summarizePoints gameMap
  where summarizePoints :: Player -> [Game] -> Double
        summarizePoints p gs = foldl' isPlayerWinner 0 gs 
        isPlayerWinner acc (Game wp bp BlackWins) = acc + if bp == p then 1.0 else 0.0
        isPlayerWinner acc (Game wp bp WhiteWins) = acc + if wp == p then 1.0 else 0.0
        isPlayerWinner acc (Game wp bp Draw)      = acc + 0.5


-- Begining of ignorance section. Completly don't know what I'm doing here... I just change word game for tournamet along the script... hope it works
validateTournament :: Tournament -> Player -> ValidatorCtx -> Bool
validateTournament t p _ = isTournamentCompleted

tournamentValidator :: Validator
tournamentValidator = Scripts.validatorScript tournamentInstance

gameAddress :: Address
gameAddress = Ledger.scriptAddress tournamentValidator
-- End of ignorance section

-- | The "joinTournament" contract endpoint. See note [Contract endpoints]
joinTournament :: AsContractError e => Tournament -> Contract TournamentSchema e ()
joinTournament tournament = do
    Player wallet <- endpoint @"joinTournament"
    if size tournament

    let tx = mustPayToTheScript wallet (fee tournament)
    void $ submitTxConstraints tournamentInstance tx

-- | The "guess" contract endpoint. See note [Contract endpoints]
guess :: AsContractError e => Contract GameSchema e ()
guess = do
    (referee, game) <- endpoint @"communicateGame"
    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,[]]