<p>Here, I've implemented a possible solution following Lars' approach.</p>
<p>Basically:</p>
<ol>
<li><p>When <strong>player1</strong> starts the contract, apart from locking the game stake value, <strong>player1</strong> will lock a value <strong>player1Deposit</strong> consisting of 2 ADAs (<strong>minAdaTxOut</strong>).</p>
</li>
<li><p>Add extra constraints to the validator script, which will check that <strong>player1Deposit</strong> keeps locked into the contract until the contracts terminates.</p>
</li>
</ol>
<p>This way, when the <strong>token</strong> gets sent back to <strong>player1</strong> along with the mandatory <strong>minAdaTxOut</strong>, <strong>player2</strong> won't have to pay <strong>minAdaTxOut</strong> because that value is already in the contract (the mentioned <strong>player1Deposit</strong>). </p>
<p>The evidence.</p>
<p><a href="https://i.sstatic.net/QkBCQ.png" rel="nofollow noreferrer"><img src="https://i.sstatic.net/QkBCQ.png" alt="enter image description here" /></a></p>
<p>Here's the code.</p>
<pre><code>{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE NumericUnderscores    #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Week07.EvenOdd
    ( Game (..)
    , GameChoice (..)
    , FirstParams (..)
    , SecondParams (..)
    , GameSchema
    , endpoints
    ) where

import           Control.Monad        hiding (fmap)
import           Data.Aeson           (FromJSON, ToJSON)
import qualified Data.Map             as Map
import           Data.Text            (Text)
import           GHC.Generics         (Generic)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import           Ledger.Ada           as Ada
import           Ledger.Value
import           Playground.Contract  (ToSchema)
import           Plutus.Contract      as Contract
import qualified PlutusTx
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Prelude              (Semigroup (..), Show (..), String)
import qualified Prelude

data Game = Game
    { gFirst          :: !PaymentPubKeyHash
    , gSecond         :: !PaymentPubKeyHash
    , gStake          :: !Integer
    , gPlayDeadline   :: !POSIXTime
    , gRevealDeadline :: !POSIXTime
    , gToken          :: !AssetClass
    } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord)

PlutusTx.makeLift ''Game

data GameChoice = Zero | One
    deriving (Show, Generic, FromJSON, ToJSON, ToSchema, Prelude.Eq, Prelude.Ord)

instance Eq GameChoice where
    {-# INLINABLE (==) #-}
    Zero == Zero = True
    One  == One  = True
    _    == _    = False

PlutusTx.unstableMakeIsData ''GameChoice

data GameDatum = GameDatum BuiltinByteString (Maybe GameChoice)
    deriving Show

instance Eq GameDatum where
    {-# INLINABLE (==) #-}
    GameDatum bs mc == GameDatum bs' mc' = (bs == bs') &amp;&amp; (mc == mc')

PlutusTx.unstableMakeIsData ''GameDatum

data GameRedeemer = Play GameChoice | Reveal BuiltinByteString | ClaimFirst | ClaimSecond
    deriving Show

PlutusTx.unstableMakeIsData ''GameRedeemer

{-# INLINABLE lovelaces #-}
lovelaces :: Value -&gt; Integer
lovelaces = Ada.getLovelace . Ada.fromValue

{-# INLINABLE gameDatum #-}
gameDatum :: Maybe Datum -&gt; Maybe GameDatum
gameDatum md = do
    Datum d &lt;- md
    PlutusTx.fromBuiltinData d

{-# INLINABLE choiceToBuiltinByteString #-}
choiceToBuiltinByteString :: GameChoice -&gt; BuiltinByteString
choiceToBuiltinByteString Zero = &quot;0&quot;
choiceToBuiltinByteString One  = &quot;1&quot;

{-# INLINABLE player1Deposit #-}
player1Deposit :: Integer
player1Deposit = Ada.getLovelace minAdaTxOut

{-# INLINABLE mkGameValidator #-}
mkGameValidator :: Game -&gt; GameDatum -&gt; GameRedeemer -&gt; ScriptContext -&gt; Bool
mkGameValidator game dat red ctx =
    traceIfFalse &quot;token missing from input&quot; (assetClassValueOf (txOutValue ownInput) (gToken game) == 1) &amp;&amp;
    case (dat, red) of
        (GameDatum bs Nothing, Play c) -&gt;
            traceIfFalse &quot;not signed by second player&quot;       (txSignedBy info (unPaymentPubKeyHash $ gSecond game))                    &amp;&amp;
            traceIfFalse &quot;first player's stake missing&quot;      (lovelaces (txOutValue ownInput) == gStake game + player1Deposit)         &amp;&amp; 
            traceIfFalse &quot;second player's stake missing&quot;     (lovelaces (txOutValue ownOutput) == (2 * gStake game + player1Deposit))  &amp;&amp;
            traceIfFalse &quot;wrong output datum&quot;                (outputDatum == GameDatum bs (Just c))                                    &amp;&amp;
            traceIfFalse &quot;missed deadline&quot;                   (to (gPlayDeadline game) `contains` txInfoValidRange info)                &amp;&amp;
            traceIfFalse &quot;token missing from output&quot;         (assetClassValueOf (txOutValue ownOutput) (gToken game) == 1)

        (GameDatum bs (Just c), Reveal nonce) -&gt;
            traceIfFalse &quot;not signed by first player&quot;        (txSignedBy info (unPaymentPubKeyHash $ gFirst game))                     &amp;&amp;
            traceIfFalse &quot;commit mismatch&quot;                   (checkNonce bs nonce c)                                                   &amp;&amp;
            traceIfFalse &quot;missed deadline&quot;                   (to (gRevealDeadline game) `contains` txInfoValidRange info)              &amp;&amp;
            traceIfFalse &quot;wrong stake&quot;                       (lovelaces (txOutValue ownInput) == (2 * gStake game + player1Deposit))   &amp;&amp;
            traceIfFalse &quot;NFT must go to first player&quot;       nftToFirst                                                                &amp;&amp;
            traceIfFalse &quot;Player1 must get back the deposit&quot; player1DepositBack 

        -- Here we mustn't set player1Deposit constraint. 
        -- If we did it and player1 didn't put the deposit at the beginning, the funds would block forever in the validator.    
        (GameDatum _ Nothing, ClaimFirst) -&gt;
            traceIfFalse &quot;not signed by first player&quot;        (txSignedBy info (unPaymentPubKeyHash $ gFirst game))                     &amp;&amp;
            traceIfFalse &quot;too early&quot;                         (from (1 + gPlayDeadline game) `contains` txInfoValidRange info)          &amp;&amp;
            traceIfFalse &quot;first player's stake missing&quot;      (lovelaces (txOutValue ownInput) == gStake game)                          &amp;&amp;  
            traceIfFalse &quot;NFT must go to first player&quot;       nftToFirst                                                               

        (GameDatum _ (Just _), ClaimSecond) -&gt;
            traceIfFalse &quot;not signed by second player&quot;       (txSignedBy info (unPaymentPubKeyHash $ gSecond game))                    &amp;&amp;
            traceIfFalse &quot;too early&quot;                         (from (1 + gRevealDeadline game) `contains` txInfoValidRange info)        &amp;&amp;
            traceIfFalse &quot;wrong stake&quot;                       (lovelaces (txOutValue ownInput) == (2 * gStake game + player1Deposit))   &amp;&amp;
            traceIfFalse &quot;NFT must go to first player&quot;       nftToFirst                                                                &amp;&amp;
            traceIfFalse &quot;Player1 must get back the deposit&quot; player1DepositBack 

        _ -&gt; False
  where
    info :: TxInfo
    info = scriptContextTxInfo ctx

    ownInput :: TxOut
    ownInput = case findOwnInput ctx of
        Nothing -&gt; traceError &quot;game input missing&quot;
        Just i  -&gt; txInInfoResolved i

    ownOutput :: TxOut
    ownOutput = case getContinuingOutputs ctx of
        [o] -&gt; o
        _   -&gt; traceError &quot;expected exactly one game output&quot;

    outputDatum :: GameDatum
    outputDatum = case gameDatum $ txOutDatumHash ownOutput &gt;&gt;= flip findDatum info of
        Nothing -&gt; traceError &quot;game output datum not found&quot;
        Just d  -&gt; d

    checkNonce :: BuiltinByteString -&gt; BuiltinByteString -&gt; GameChoice -&gt; Bool
    checkNonce bs nonce cSecond = sha2_256 (nonce `appendByteString` choiceToBuiltinByteString cSecond) == bs

    nftToFirst :: Bool
    nftToFirst = assetClassValueOf (valuePaidTo info $ unPaymentPubKeyHash $ gFirst game) (gToken game) == 1

    player1DepositBack :: Bool
    player1DepositBack = valuePaidTo info (unPaymentPubKeyHash $ gFirst game) `geq` Ada.lovelaceValueOf player1Deposit

data Gaming
instance Scripts.ValidatorTypes Gaming where
    type instance DatumType Gaming = GameDatum
    type instance RedeemerType Gaming = GameRedeemer

typedGameValidator :: Game -&gt; Scripts.TypedValidator Gaming
typedGameValidator game = Scripts.mkTypedValidator @Gaming
    ($$(PlutusTx.compile [|| mkGameValidator ||])
        `PlutusTx.applyCode` PlutusTx.liftCode game)
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = Scripts.wrapValidator @GameDatum @GameRedeemer

gameValidator :: Game -&gt; Validator
gameValidator = Scripts.validatorScript . typedGameValidator

gameAddress :: Game -&gt; Ledger.Address
gameAddress = scriptAddress . gameValidator

findGameOutput :: Game -&gt; Contract w s Text (Maybe (TxOutRef, ChainIndexTxOut, GameDatum))
findGameOutput game = do
    utxos &lt;- utxosAt $ gameAddress game
    return $ do
        (oref, o) &lt;- find f $ Map.toList utxos
        dat       &lt;- gameDatum $ either (const Nothing) Just $ _ciTxOutDatum o
        return (oref, o, dat)
  where
    f :: (TxOutRef, ChainIndexTxOut) -&gt; Bool
    f (_, o) = assetClassValueOf (_ciTxOutValue o) (gToken game) == 1

waitUntilTimeHasPassed :: AsContractError e =&gt; POSIXTime -&gt; Contract w s e ()
waitUntilTimeHasPassed t = do
    s1 &lt;- currentSlot
    logInfo @String $ &quot;current slot: &quot; ++ show s1 ++ &quot;, waiting until &quot; ++ show t
    void $ awaitTime t &gt;&gt; waitNSlots 1
    s2 &lt;- currentSlot
    logInfo @String $ &quot;waited until: &quot; ++ show s2

data FirstParams = FirstParams
    { fpSecond         :: !PaymentPubKeyHash
    , fpStake          :: !Integer
    , fpPlayDeadline   :: !POSIXTime
    , fpRevealDeadline :: !POSIXTime
    , fpNonce          :: !BuiltinByteString
    , fpCurrency       :: !CurrencySymbol
    , fpTokenName      :: !TokenName
    , fpChoice         :: !GameChoice
    } deriving (Show, Generic, FromJSON, ToJSON, ToSchema)

firstGame :: forall w s. FirstParams -&gt; Contract w s Text ()
firstGame fp = do
    pkh &lt;- Contract.ownPaymentPubKeyHash
    let game = Game
            { gFirst          = pkh
            , gSecond         = fpSecond fp
            , gStake          = fpStake fp
            , gPlayDeadline   = fpPlayDeadline fp
            , gRevealDeadline = fpRevealDeadline fp
            , gToken          = AssetClass (fpCurrency fp, fpTokenName fp)
            }
        v    = lovelaceValueOf (fpStake fp) &lt;&gt; assetClassValue (gToken game) 1 &lt;&gt; Ada.lovelaceValueOf player1Deposit
        c    = fpChoice fp
        bs   = sha2_256 $ fpNonce fp `appendByteString` choiceToBuiltinByteString c
        tx   = Constraints.mustPayToTheScript (GameDatum bs Nothing) v
    ledgerTx &lt;- submitTxConstraints (typedGameValidator game) tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ &quot;made first move: &quot; ++ show (fpChoice fp)

    waitUntilTimeHasPassed $ fpPlayDeadline fp

    m   &lt;- findGameOutput game
    now &lt;- currentTime
    case m of
        Nothing             -&gt; throwError &quot;game output not found&quot;
        Just (oref, o, dat) -&gt; case dat of
            GameDatum _ Nothing -&gt; do
                logInfo @String &quot;second player did not play&quot;
                let lookups = Constraints.unspentOutputs (Map.singleton oref o) &lt;&gt;
                              Constraints.otherScript (gameValidator game)
                    tx'     = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData ClaimFirst) &lt;&gt;
                              Constraints.mustValidateIn (from now)
                ledgerTx' &lt;- submitTxConstraintsWith @Gaming lookups tx'
                void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                logInfo @String &quot;reclaimed stake&quot;

            GameDatum _ (Just c') | c' == c -&gt; do

                logInfo @String &quot;second player played and lost&quot;
                let lookups = Constraints.unspentOutputs (Map.singleton oref o) &lt;&gt;
                              Constraints.otherScript (gameValidator game)
                    tx'     = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData $ Reveal $ fpNonce fp) &lt;&gt;
                              Constraints.mustValidateIn (to $ now + 1000)
                ledgerTx' &lt;- submitTxConstraintsWith @Gaming lookups tx'
                void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                logInfo @String &quot;victory&quot;

            _ -&gt; logInfo @String &quot;second player played and won&quot;

data SecondParams = SecondParams
    { spFirst          :: !PaymentPubKeyHash
    , spStake          :: !Integer
    , spPlayDeadline   :: !POSIXTime
    , spRevealDeadline :: !POSIXTime
    , spCurrency       :: !CurrencySymbol
    , spTokenName      :: !TokenName
    , spChoice         :: !GameChoice
    } deriving (Show, Generic, FromJSON, ToJSON, ToSchema)

secondGame :: forall w s. SecondParams -&gt; Contract w s Text ()
secondGame sp = do
    pkh &lt;- Contract.ownPaymentPubKeyHash
    let game = Game
            { gFirst          = spFirst sp
            , gSecond         = pkh
            , gStake          = spStake sp
            , gPlayDeadline   = spPlayDeadline sp
            , gRevealDeadline = spRevealDeadline sp
            , gToken          = AssetClass (spCurrency sp, spTokenName sp)
            }
    m &lt;- findGameOutput game
    case m of
        Just (oref, o, GameDatum bs Nothing) -&gt; do
            logInfo @String &quot;running game found&quot;
            now &lt;- currentTime
            let token   = assetClassValue (gToken game) 1
            let v       = let x = lovelaceValueOf (spStake sp) in x &lt;&gt; x &lt;&gt; token &lt;&gt; Ada.lovelaceValueOf player1Deposit
                c       = spChoice sp
                lookups = Constraints.unspentOutputs (Map.singleton oref o)                                   &lt;&gt;
                          Constraints.otherScript (gameValidator game)                                        &lt;&gt;
                          Constraints.typedValidatorLookups (typedGameValidator game)
                tx      = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData $ Play c) &lt;&gt;
                          Constraints.mustPayToTheScript (GameDatum bs $ Just c) v                            &lt;&gt;
                          Constraints.mustValidateIn (to now)
            ledgerTx &lt;- submitTxConstraintsWith @Gaming lookups tx
            let tid = getCardanoTxId ledgerTx
            void $ awaitTxConfirmed tid
            logInfo @String $ &quot;made second move: &quot; ++ show (spChoice sp)

            waitUntilTimeHasPassed $ spRevealDeadline sp

            m'   &lt;- findGameOutput game
            now' &lt;- currentTime
            case m' of
                Nothing             -&gt; logInfo @String &quot;first player won&quot;
                Just (oref', o', _) -&gt; do
                    logInfo @String &quot;first player didn't reveal&quot;
                    let lookups' = Constraints.unspentOutputs (Map.singleton oref' o')                                     &lt;&gt;
                                   Constraints.otherScript (gameValidator game)
                        tx'      = Constraints.mustSpendScriptOutput oref' (Redeemer $ PlutusTx.toBuiltinData ClaimSecond) &lt;&gt;
                                   Constraints.mustValidateIn (from now')                                                  &lt;&gt;
                                   Constraints.mustPayToPubKey (spFirst sp) (token &lt;&gt; Ada.lovelaceValueOf player1Deposit)
                    ledgerTx' &lt;- submitTxConstraintsWith @Gaming lookups' tx'
                    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                    logInfo @String &quot;second player won&quot;

        _ -&gt; logInfo @String &quot;no running game found&quot;

type GameSchema = Endpoint &quot;first&quot; FirstParams .\/ Endpoint &quot;second&quot; SecondParams

endpoints :: Contract () GameSchema Text ()
endpoints = awaitPromise (first `select` second) &gt;&gt; endpoints
  where
    first  = endpoint @&quot;first&quot;  firstGame
    second = endpoint @&quot;second&quot; secondGame
</code></pre>

CC BY-SA 4.0
2022-03-03T18:09:20.607Z
2022-03-03T20:15:19.963Z
2022-03-03T20:15:19.963Z
kindofdev
<p>In <strong>week07</strong> lecture Lars refers that <code>Week07.EvenOdd</code> contract is a bit unfair with player2 in the case of player2 wins .</p>
<p>Why  ?</p>
<p>Well, <strong>player2</strong> has to pay <strong>minAdaTxOut</strong> (2 ADA) to <strong>player1</strong> in order to send back the <strong>token</strong> to <strong>player1</strong>. (Remember: an UTXO must include a minimum value of 2 ADAs ) Therefore, <strong>player2</strong> wins <strong>2 ADAs less</strong> than he/she should. </p>
<p>Lars says that a possible solution is to create some kind of deposit from player1 locked in the validator.</p>

<plutus><plutus-pioneer-program><nft><week07><minadatxout>
How to make module Week07.EvenOdd fairer with player2 in case player2 wins the game
# How to make module Week07.EvenOdd fairer with player2 in case player2 wins the game

(Asked by: username_0 on 2022-03-03)

In **week07** lecture Lars refers that `Week07.EvenOdd` contract is a bit unfair with player2 in the case of player2 wins .

Why ?

Well, **player2** has to pay **minAdaTxOut** (2 ADA) to **player1** in order to send back the **token** to **player1**. (Remember: an UTXO must include a minimum value of 2 ADAs ) Therefore, **player2** wins **2 ADAs less** than he/she should.

Lars says that a possible solution is to create some kind of deposit from player1 locked in the validator.

**Tags:** plutus, plutus-pioneer-program, nft, week07, minadatxout

---

## 1 answers

### Answer by username_0 on 2022-03-03. Score: 3 | Accepted answer

Here, I've implemented a possible solution following Lars' approach.
Basically:

When player1 starts the contract, apart from locking the game stake value, player1 will lock a value player1Deposit consisting of 2 ADAs (minAdaTxOut).

Add extra constraints to the validator script, which will check that player1Deposit keeps locked into the contract until the contracts terminates.


This way, when the token gets sent back to player1 along with the mandatory minAdaTxOut, player2 won't have to pay minAdaTxOut because that value is already in the contract (the mentioned player1Deposit). 
The evidence.

Here's the code.
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE NumericUnderscores    #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Week07.EvenOdd
    ( Game (..)
    , GameChoice (..)
    , FirstParams (..)
    , SecondParams (..)
    , GameSchema
    , endpoints
    ) where

import           Control.Monad        hiding (fmap)
import           Data.Aeson           (FromJSON, ToJSON)
import qualified Data.Map             as Map
import           Data.Text            (Text)
import           GHC.Generics         (Generic)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import           Ledger.Ada           as Ada
import           Ledger.Value
import           Playground.Contract  (ToSchema)
import           Plutus.Contract      as Contract
import qualified PlutusTx
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Prelude              (Semigroup (..), Show (..), String)
import qualified Prelude

data Game = Game
    { gFirst          :: !PaymentPubKeyHash
    , gSecond         :: !PaymentPubKeyHash
    , gStake          :: !Integer
    , gPlayDeadline   :: !POSIXTime
    , gRevealDeadline :: !POSIXTime
    , gToken          :: !AssetClass
    } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord)

PlutusTx.makeLift ''Game

data GameChoice = Zero | One
    deriving (Show, Generic, FromJSON, ToJSON, ToSchema, Prelude.Eq, Prelude.Ord)

instance Eq GameChoice where
    {-# INLINABLE (==) #-}
    Zero == Zero = True
    One  == One  = True
    _    == _    = False

PlutusTx.unstableMakeIsData ''GameChoice

data GameDatum = GameDatum BuiltinByteString (Maybe GameChoice)
    deriving Show

instance Eq GameDatum where
    {-# INLINABLE (==) #-}
    GameDatum bs mc == GameDatum bs' mc' = (bs == bs') && (mc == mc')

PlutusTx.unstableMakeIsData ''GameDatum

data GameRedeemer = Play GameChoice | Reveal BuiltinByteString | ClaimFirst | ClaimSecond
    deriving Show

PlutusTx.unstableMakeIsData ''GameRedeemer

{-# INLINABLE lovelaces #-}
lovelaces :: Value -> Integer
lovelaces = Ada.getLovelace . Ada.fromValue

{-# INLINABLE gameDatum #-}
gameDatum :: Maybe Datum -> Maybe GameDatum
gameDatum md = do
    Datum d <- md
    PlutusTx.fromBuiltinData d

{-# INLINABLE choiceToBuiltinByteString #-}
choiceToBuiltinByteString :: GameChoice -> BuiltinByteString
choiceToBuiltinByteString Zero = "0"
choiceToBuiltinByteString One  = "1"

{-# INLINABLE player1Deposit #-}
player1Deposit :: Integer
player1Deposit = Ada.getLovelace minAdaTxOut

{-# INLINABLE mkGameValidator #-}
mkGameValidator :: Game -> GameDatum -> GameRedeemer -> ScriptContext -> Bool
mkGameValidator game dat red ctx =
    traceIfFalse "token missing from input" (assetClassValueOf (txOutValue ownInput) (gToken game) == 1) &&
    case (dat, red) of
        (GameDatum bs Nothing, Play c) ->
            traceIfFalse "not signed by second player"       (txSignedBy info (unPaymentPubKeyHash $ gSecond game))                    &&
            traceIfFalse "first player's stake missing"      (lovelaces (txOutValue ownInput) == gStake game + player1Deposit)         && 
            traceIfFalse "second player's stake missing"     (lovelaces (txOutValue ownOutput) == (2 * gStake game + player1Deposit))  &&
            traceIfFalse "wrong output datum"                (outputDatum == GameDatum bs (Just c))                                    &&
            traceIfFalse "missed deadline"                   (to (gPlayDeadline game) `contains` txInfoValidRange info)                &&
            traceIfFalse "token missing from output"         (assetClassValueOf (txOutValue ownOutput) (gToken game) == 1)

        (GameDatum bs (Just c), Reveal nonce) ->
            traceIfFalse "not signed by first player"        (txSignedBy info (unPaymentPubKeyHash $ gFirst game))                     &&
            traceIfFalse "commit mismatch"                   (checkNonce bs nonce c)                                                   &&
            traceIfFalse "missed deadline"                   (to (gRevealDeadline game) `contains` txInfoValidRange info)              &&
            traceIfFalse "wrong stake"                       (lovelaces (txOutValue ownInput) == (2 * gStake game + player1Deposit))   &&
            traceIfFalse "NFT must go to first player"       nftToFirst                                                                &&
            traceIfFalse "Player1 must get back the deposit" player1DepositBack 

        -- Here we mustn't set player1Deposit constraint. 
        -- If we did it and player1 didn't put the deposit at the beginning, the funds would block forever in the validator.    
        (GameDatum _ Nothing, ClaimFirst) ->
            traceIfFalse "not signed by first player"        (txSignedBy info (unPaymentPubKeyHash $ gFirst game))                     &&
            traceIfFalse "too early"                         (from (1 + gPlayDeadline game) `contains` txInfoValidRange info)          &&
            traceIfFalse "first player's stake missing"      (lovelaces (txOutValue ownInput) == gStake game)                          &&  
            traceIfFalse "NFT must go to first player"       nftToFirst                                                               

        (GameDatum _ (Just _), ClaimSecond) ->
            traceIfFalse "not signed by second player"       (txSignedBy info (unPaymentPubKeyHash $ gSecond game))                    &&
            traceIfFalse "too early"                         (from (1 + gRevealDeadline game) `contains` txInfoValidRange info)        &&
            traceIfFalse "wrong stake"                       (lovelaces (txOutValue ownInput) == (2 * gStake game + player1Deposit))   &&
            traceIfFalse "NFT must go to first player"       nftToFirst                                                                &&
            traceIfFalse "Player1 must get back the deposit" player1DepositBack 

        _ -> False
  where
    info :: TxInfo
    info = scriptContextTxInfo ctx

    ownInput :: TxOut
    ownInput = case findOwnInput ctx of
        Nothing -> traceError "game input missing"
        Just i  -> txInInfoResolved i

    ownOutput :: TxOut
    ownOutput = case getContinuingOutputs ctx of
        [o] -> o
        _   -> traceError "expected exactly one game output"

    outputDatum :: GameDatum
    outputDatum = case gameDatum $ txOutDatumHash ownOutput >>= flip findDatum info of
        Nothing -> traceError "game output datum not found"
        Just d  -> d

    checkNonce :: BuiltinByteString -> BuiltinByteString -> GameChoice -> Bool
    checkNonce bs nonce cSecond = sha2_256 (nonce `appendByteString` choiceToBuiltinByteString cSecond) == bs

    nftToFirst :: Bool
    nftToFirst = assetClassValueOf (valuePaidTo info $ unPaymentPubKeyHash $ gFirst game) (gToken game) == 1

    player1DepositBack :: Bool
    player1DepositBack = valuePaidTo info (unPaymentPubKeyHash $ gFirst game) `geq` Ada.lovelaceValueOf player1Deposit

data Gaming
instance Scripts.ValidatorTypes Gaming where
    type instance DatumType Gaming = GameDatum
    type instance RedeemerType Gaming = GameRedeemer

typedGameValidator :: Game -> Scripts.TypedValidator Gaming
typedGameValidator game = Scripts.mkTypedValidator @Gaming
    ($$(PlutusTx.compile [|| mkGameValidator ||])
        `PlutusTx.applyCode` PlutusTx.liftCode game)
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = Scripts.wrapValidator @GameDatum @GameRedeemer

gameValidator :: Game -> Validator
gameValidator = Scripts.validatorScript . typedGameValidator

gameAddress :: Game -> Ledger.Address
gameAddress = scriptAddress . gameValidator

findGameOutput :: Game -> Contract w s Text (Maybe (TxOutRef, ChainIndexTxOut, GameDatum))
findGameOutput game = do
    utxos <- utxosAt $ gameAddress game
    return $ do
        (oref, o) <- find f $ Map.toList utxos
        dat       <- gameDatum $ either (const Nothing) Just $ _ciTxOutDatum o
        return (oref, o, dat)
  where
    f :: (TxOutRef, ChainIndexTxOut) -> Bool
    f (_, o) = assetClassValueOf (_ciTxOutValue o) (gToken game) == 1

waitUntilTimeHasPassed :: AsContractError e => POSIXTime -> Contract w s e ()
waitUntilTimeHasPassed t = do
    s1 <- currentSlot
    logInfo @String $ "current slot: " ++ show s1 ++ ", waiting until " ++ show t
    void $ awaitTime t >> waitNSlots 1
    s2 <- currentSlot
    logInfo @String $ "waited until: " ++ show s2

data FirstParams = FirstParams
    { fpSecond         :: !PaymentPubKeyHash
    , fpStake          :: !Integer
    , fpPlayDeadline   :: !POSIXTime
    , fpRevealDeadline :: !POSIXTime
    , fpNonce          :: !BuiltinByteString
    , fpCurrency       :: !CurrencySymbol
    , fpTokenName      :: !TokenName
    , fpChoice         :: !GameChoice
    } deriving (Show, Generic, FromJSON, ToJSON, ToSchema)

firstGame :: forall w s. FirstParams -> Contract w s Text ()
firstGame fp = do
    pkh <- Contract.ownPaymentPubKeyHash
    let game = Game
            { gFirst          = pkh
            , gSecond         = fpSecond fp
            , gStake          = fpStake fp
            , gPlayDeadline   = fpPlayDeadline fp
            , gRevealDeadline = fpRevealDeadline fp
            , gToken          = AssetClass (fpCurrency fp, fpTokenName fp)
            }
        v    = lovelaceValueOf (fpStake fp) <> assetClassValue (gToken game) 1 <> Ada.lovelaceValueOf player1Deposit
        c    = fpChoice fp
        bs   = sha2_256 $ fpNonce fp `appendByteString` choiceToBuiltinByteString c
        tx   = Constraints.mustPayToTheScript (GameDatum bs Nothing) v
    ledgerTx <- submitTxConstraints (typedGameValidator game) tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ "made first move: " ++ show (fpChoice fp)

    waitUntilTimeHasPassed $ fpPlayDeadline fp

    m   <- findGameOutput game
    now <- currentTime
    case m of
        Nothing             -> throwError "game output not found"
        Just (oref, o, dat) -> case dat of
            GameDatum _ Nothing -> do
                logInfo @String "second player did not play"
                let lookups = Constraints.unspentOutputs (Map.singleton oref o) <>
                              Constraints.otherScript (gameValidator game)
                    tx'     = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData ClaimFirst) <>
                              Constraints.mustValidateIn (from now)
                ledgerTx' <- submitTxConstraintsWith @Gaming lookups tx'
                void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                logInfo @String "reclaimed stake"

            GameDatum _ (Just c') | c' == c -> do

                logInfo @String "second player played and lost"
                let lookups = Constraints.unspentOutputs (Map.singleton oref o) <>
                              Constraints.otherScript (gameValidator game)
                    tx'     = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData $ Reveal $ fpNonce fp) <>
                              Constraints.mustValidateIn (to $ now + 1000)
                ledgerTx' <- submitTxConstraintsWith @Gaming lookups tx'
                void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                logInfo @String "victory"

            _ -> logInfo @String "second player played and won"

data SecondParams = SecondParams
    { spFirst          :: !PaymentPubKeyHash
    , spStake          :: !Integer
    , spPlayDeadline   :: !POSIXTime
    , spRevealDeadline :: !POSIXTime
    , spCurrency       :: !CurrencySymbol
    , spTokenName      :: !TokenName
    , spChoice         :: !GameChoice
    } deriving (Show, Generic, FromJSON, ToJSON, ToSchema)

secondGame :: forall w s. SecondParams -> Contract w s Text ()
secondGame sp = do
    pkh <- Contract.ownPaymentPubKeyHash
    let game = Game
            { gFirst          = spFirst sp
            , gSecond         = pkh
            , gStake          = spStake sp
            , gPlayDeadline   = spPlayDeadline sp
            , gRevealDeadline = spRevealDeadline sp
            , gToken          = AssetClass (spCurrency sp, spTokenName sp)
            }
    m <- findGameOutput game
    case m of
        Just (oref, o, GameDatum bs Nothing) -> do
            logInfo @String "running game found"
            now <- currentTime
            let token   = assetClassValue (gToken game) 1
            let v       = let x = lovelaceValueOf (spStake sp) in x <> x <> token <> Ada.lovelaceValueOf player1Deposit
                c       = spChoice sp
                lookups = Constraints.unspentOutputs (Map.singleton oref o)                                   <>
                          Constraints.otherScript (gameValidator game)                                        <>
                          Constraints.typedValidatorLookups (typedGameValidator game)
                tx      = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData $ Play c) <>
                          Constraints.mustPayToTheScript (GameDatum bs $ Just c) v                            <>
                          Constraints.mustValidateIn (to now)
            ledgerTx <- submitTxConstraintsWith @Gaming lookups tx
            let tid = getCardanoTxId ledgerTx
            void $ awaitTxConfirmed tid
            logInfo @String $ "made second move: " ++ show (spChoice sp)

            waitUntilTimeHasPassed $ spRevealDeadline sp

            m'   <- findGameOutput game
            now' <- currentTime
            case m' of
                Nothing             -> logInfo @String "first player won"
                Just (oref', o', _) -> do
                    logInfo @String "first player didn't reveal"
                    let lookups' = Constraints.unspentOutputs (Map.singleton oref' o')                                     <>
                                   Constraints.otherScript (gameValidator game)
                        tx'      = Constraints.mustSpendScriptOutput oref' (Redeemer $ PlutusTx.toBuiltinData ClaimSecond) <>
                                   Constraints.mustValidateIn (from now')                                                  <>
                                   Constraints.mustPayToPubKey (spFirst sp) (token <> Ada.lovelaceValueOf player1Deposit)
                    ledgerTx' <- submitTxConstraintsWith @Gaming lookups' tx'
                    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx'
                    logInfo @String "second player won"

        _ -> logInfo @String "no running game found"

type GameSchema = Endpoint "first" FirstParams .\/ Endpoint "second" SecondParams

endpoints :: Contract () GameSchema Text ()
endpoints = awaitPromise (first `select` second) >> endpoints
  where
    first  = endpoint @"first"  firstGame
    second = endpoint @"second" secondGame


---

