{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -g -fplugin-opt PlutusTx.Plugin:coverage-all #-}
-- You need to use all of these to get coverage

-- | 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 Plutus.Contracts.GameStateMachine(
    contract
    , typedValidator
    , GameParam(..)
    , GameState(..)
    , GameInput(..)
    , GuessToken
    , mkValidator
    , mintingPolicy
    , LockArgs(..)
    , GuessArgs(..)
    , GameStateMachineSchema
    , GameError
    , token
    , covIdx
    ) where

import Control.Lens (makeClassyPrisms)
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString.Char8 qualified as C
import GHC.Generics (Generic)
import Ledger (Address, POSIXTime)
import Ledger.Address.Orphans ()
import Ledger.Tx.Constraints (TxConstraints)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract (AsContractError (_ContractError), Contract, ContractError, Endpoint, Promise, endpoint,
                        selectList, type (.\/))
import Plutus.Contract.Secrets (SecretArgument, escape_sha2_256, extractSecret)
import Plutus.Contract.StateMachine (State (State, stateData, stateValue), Void)
import Plutus.Contract.StateMachine qualified as SM
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.V2.Scripts (MintingPolicyHash)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as V2
import Plutus.Script.Utils.Value (TokenName, Value)
import Plutus.Script.Utils.Value qualified as Value
import PlutusTx qualified
import PlutusTx.Prelude (Bool (False, True), BuiltinByteString, Eq, Maybe (Just, Nothing), check, sha2_256, toBuiltin,
                         traceIfFalse, ($), (&&), (-), (.), (<$>), (<>), (==), (>>))

import Plutus.Contract.Test.Coverage.Analysis
import PlutusTx.Coverage
import Prelude qualified as Haskell


-- | Datatype for creating a parameterized validator.
data GameParam = GameParam
    { GameParam -> Address
gameParamPayeePkh  :: Address
    -- ^ Payment address of the wallet locking some funds
    , GameParam -> POSIXTime
gameParamStartTime :: POSIXTime
    -- ^ Starting time of the game
    } deriving (Int -> GameParam -> ShowS
[GameParam] -> ShowS
GameParam -> String
(Int -> GameParam -> ShowS)
-> (GameParam -> String)
-> ([GameParam] -> ShowS)
-> Show GameParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameParam] -> ShowS
$cshowList :: [GameParam] -> ShowS
show :: GameParam -> String
$cshow :: GameParam -> String
showsPrec :: Int -> GameParam -> ShowS
$cshowsPrec :: Int -> GameParam -> ShowS
Haskell.Show, (forall x. GameParam -> Rep GameParam x)
-> (forall x. Rep GameParam x -> GameParam) -> Generic GameParam
forall x. Rep GameParam x -> GameParam
forall x. GameParam -> Rep GameParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GameParam x -> GameParam
$cfrom :: forall x. GameParam -> Rep GameParam x
Generic)
      deriving anyclass ([GameParam] -> Encoding
[GameParam] -> Value
GameParam -> Encoding
GameParam -> Value
(GameParam -> Value)
-> (GameParam -> Encoding)
-> ([GameParam] -> Value)
-> ([GameParam] -> Encoding)
-> ToJSON GameParam
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GameParam] -> Encoding
$ctoEncodingList :: [GameParam] -> Encoding
toJSONList :: [GameParam] -> Value
$ctoJSONList :: [GameParam] -> Value
toEncoding :: GameParam -> Encoding
$ctoEncoding :: GameParam -> Encoding
toJSON :: GameParam -> Value
$ctoJSON :: GameParam -> Value
ToJSON, Value -> Parser [GameParam]
Value -> Parser GameParam
(Value -> Parser GameParam)
-> (Value -> Parser [GameParam]) -> FromJSON GameParam
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GameParam]
$cparseJSONList :: Value -> Parser [GameParam]
parseJSON :: Value -> Parser GameParam
$cparseJSON :: Value -> Parser GameParam
FromJSON)

PlutusTx.makeLift ''GameParam

newtype HashedString = HashedString BuiltinByteString
    deriving newtype (HashedString -> HashedString -> Bool
(HashedString -> HashedString -> Bool) -> Eq HashedString
forall a. (a -> a -> Bool) -> Eq a
== :: HashedString -> HashedString -> Bool
$c== :: HashedString -> HashedString -> Bool
Eq, HashedString -> BuiltinData
(HashedString -> BuiltinData) -> ToData HashedString
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: HashedString -> BuiltinData
$ctoBuiltinData :: HashedString -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe HashedString
(BuiltinData -> Maybe HashedString) -> FromData HashedString
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe HashedString
$cfromBuiltinData :: BuiltinData -> Maybe HashedString
PlutusTx.FromData, BuiltinData -> HashedString
(BuiltinData -> HashedString) -> UnsafeFromData HashedString
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> HashedString
$cunsafeFromBuiltinData :: BuiltinData -> HashedString
PlutusTx.UnsafeFromData)
    deriving stock (Int -> HashedString -> ShowS
[HashedString] -> ShowS
HashedString -> String
(Int -> HashedString -> ShowS)
-> (HashedString -> String)
-> ([HashedString] -> ShowS)
-> Show HashedString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashedString] -> ShowS
$cshowList :: [HashedString] -> ShowS
show :: HashedString -> String
$cshow :: HashedString -> String
showsPrec :: Int -> HashedString -> ShowS
$cshowsPrec :: Int -> HashedString -> ShowS
Haskell.Show, (forall x. HashedString -> Rep HashedString x)
-> (forall x. Rep HashedString x -> HashedString)
-> Generic HashedString
forall x. Rep HashedString x -> HashedString
forall x. HashedString -> Rep HashedString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HashedString x -> HashedString
$cfrom :: forall x. HashedString -> Rep HashedString x
Generic)
    deriving anyclass ([HashedString] -> Encoding
[HashedString] -> Value
HashedString -> Encoding
HashedString -> Value
(HashedString -> Value)
-> (HashedString -> Encoding)
-> ([HashedString] -> Value)
-> ([HashedString] -> Encoding)
-> ToJSON HashedString
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HashedString] -> Encoding
$ctoEncodingList :: [HashedString] -> Encoding
toJSONList :: [HashedString] -> Value
$ctoJSONList :: [HashedString] -> Value
toEncoding :: HashedString -> Encoding
$ctoEncoding :: HashedString -> Encoding
toJSON :: HashedString -> Value
$ctoJSON :: HashedString -> Value
ToJSON, Value -> Parser [HashedString]
Value -> Parser HashedString
(Value -> Parser HashedString)
-> (Value -> Parser [HashedString]) -> FromJSON HashedString
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HashedString]
$cparseJSONList :: Value -> Parser [HashedString]
parseJSON :: Value -> Parser HashedString
$cparseJSON :: Value -> Parser HashedString
FromJSON)

PlutusTx.makeLift ''HashedString

newtype ClearString = ClearString BuiltinByteString
    deriving newtype (ClearString -> ClearString -> Bool
(ClearString -> ClearString -> Bool) -> Eq ClearString
forall a. (a -> a -> Bool) -> Eq a
== :: ClearString -> ClearString -> Bool
$c== :: ClearString -> ClearString -> Bool
Eq, ClearString -> BuiltinData
(ClearString -> BuiltinData) -> ToData ClearString
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: ClearString -> BuiltinData
$ctoBuiltinData :: ClearString -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe ClearString
(BuiltinData -> Maybe ClearString) -> FromData ClearString
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe ClearString
$cfromBuiltinData :: BuiltinData -> Maybe ClearString
PlutusTx.FromData, BuiltinData -> ClearString
(BuiltinData -> ClearString) -> UnsafeFromData ClearString
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> ClearString
$cunsafeFromBuiltinData :: BuiltinData -> ClearString
PlutusTx.UnsafeFromData)
    deriving stock (Int -> ClearString -> ShowS
[ClearString] -> ShowS
ClearString -> String
(Int -> ClearString -> ShowS)
-> (ClearString -> String)
-> ([ClearString] -> ShowS)
-> Show ClearString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClearString] -> ShowS
$cshowList :: [ClearString] -> ShowS
show :: ClearString -> String
$cshow :: ClearString -> String
showsPrec :: Int -> ClearString -> ShowS
$cshowsPrec :: Int -> ClearString -> ShowS
Haskell.Show, (forall x. ClearString -> Rep ClearString x)
-> (forall x. Rep ClearString x -> ClearString)
-> Generic ClearString
forall x. Rep ClearString x -> ClearString
forall x. ClearString -> Rep ClearString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClearString x -> ClearString
$cfrom :: forall x. ClearString -> Rep ClearString x
Generic)
    deriving anyclass ([ClearString] -> Encoding
[ClearString] -> Value
ClearString -> Encoding
ClearString -> Value
(ClearString -> Value)
-> (ClearString -> Encoding)
-> ([ClearString] -> Value)
-> ([ClearString] -> Encoding)
-> ToJSON ClearString
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClearString] -> Encoding
$ctoEncodingList :: [ClearString] -> Encoding
toJSONList :: [ClearString] -> Value
$ctoJSONList :: [ClearString] -> Value
toEncoding :: ClearString -> Encoding
$ctoEncoding :: ClearString -> Encoding
toJSON :: ClearString -> Value
$ctoJSON :: ClearString -> Value
ToJSON, Value -> Parser [ClearString]
Value -> Parser ClearString
(Value -> Parser ClearString)
-> (Value -> Parser [ClearString]) -> FromJSON ClearString
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClearString]
$cparseJSONList :: Value -> Parser [ClearString]
parseJSON :: Value -> Parser ClearString
$cparseJSON :: Value -> Parser ClearString
FromJSON)

PlutusTx.makeLift ''ClearString

-- | Arguments for the @"lock"@ endpoint
data LockArgs =
    LockArgs
        { LockArgs -> GameParam
lockArgsGameParam :: GameParam
        -- ^ The parameters for parameterizing the validator.
        , LockArgs -> SecretArgument String
lockArgsSecret    :: SecretArgument Haskell.String
        -- ^ The secret
        , LockArgs -> Value
lockArgsValue     :: Value
        -- ^ Value that is locked by the contract initially
        } deriving stock (Int -> LockArgs -> ShowS
[LockArgs] -> ShowS
LockArgs -> String
(Int -> LockArgs -> ShowS)
-> (LockArgs -> String) -> ([LockArgs] -> ShowS) -> Show LockArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockArgs] -> ShowS
$cshowList :: [LockArgs] -> ShowS
show :: LockArgs -> String
$cshow :: LockArgs -> String
showsPrec :: Int -> LockArgs -> ShowS
$cshowsPrec :: Int -> LockArgs -> ShowS
Haskell.Show, (forall x. LockArgs -> Rep LockArgs x)
-> (forall x. Rep LockArgs x -> LockArgs) -> Generic LockArgs
forall x. Rep LockArgs x -> LockArgs
forall x. LockArgs -> Rep LockArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockArgs x -> LockArgs
$cfrom :: forall x. LockArgs -> Rep LockArgs x
Generic)
          deriving anyclass ([LockArgs] -> Encoding
[LockArgs] -> Value
LockArgs -> Encoding
LockArgs -> Value
(LockArgs -> Value)
-> (LockArgs -> Encoding)
-> ([LockArgs] -> Value)
-> ([LockArgs] -> Encoding)
-> ToJSON LockArgs
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LockArgs] -> Encoding
$ctoEncodingList :: [LockArgs] -> Encoding
toJSONList :: [LockArgs] -> Value
$ctoJSONList :: [LockArgs] -> Value
toEncoding :: LockArgs -> Encoding
$ctoEncoding :: LockArgs -> Encoding
toJSON :: LockArgs -> Value
$ctoJSON :: LockArgs -> Value
ToJSON, Value -> Parser [LockArgs]
Value -> Parser LockArgs
(Value -> Parser LockArgs)
-> (Value -> Parser [LockArgs]) -> FromJSON LockArgs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LockArgs]
$cparseJSONList :: Value -> Parser [LockArgs]
parseJSON :: Value -> Parser LockArgs
$cparseJSON :: Value -> Parser LockArgs
FromJSON)

-- | Arguments for the @"guess"@ endpoint
data GuessArgs =
    GuessArgs
        { GuessArgs -> GameParam
guessArgsGameParam     :: GameParam
        -- ^ The parameters for parameterizing the validator.
        , GuessArgs -> Address
guessTokenTarget       :: Address
        -- ^ The recipient of the guess token
        , GuessArgs -> String
guessArgsOldSecret     :: Haskell.String
        -- ^ The guess
        , GuessArgs -> SecretArgument String
guessArgsNewSecret     :: SecretArgument Haskell.String
        -- ^ The new secret
        , GuessArgs -> Value
guessArgsValueTakenOut :: Value
        -- ^ How much to extract from the contract
        } deriving stock (Int -> GuessArgs -> ShowS
[GuessArgs] -> ShowS
GuessArgs -> String
(Int -> GuessArgs -> ShowS)
-> (GuessArgs -> String)
-> ([GuessArgs] -> ShowS)
-> Show GuessArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuessArgs] -> ShowS
$cshowList :: [GuessArgs] -> ShowS
show :: GuessArgs -> String
$cshow :: GuessArgs -> String
showsPrec :: Int -> GuessArgs -> ShowS
$cshowsPrec :: Int -> GuessArgs -> ShowS
Haskell.Show, (forall x. GuessArgs -> Rep GuessArgs x)
-> (forall x. Rep GuessArgs x -> GuessArgs) -> Generic GuessArgs
forall x. Rep GuessArgs x -> GuessArgs
forall x. GuessArgs -> Rep GuessArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GuessArgs x -> GuessArgs
$cfrom :: forall x. GuessArgs -> Rep GuessArgs x
Generic)
          deriving anyclass ([GuessArgs] -> Encoding
[GuessArgs] -> Value
GuessArgs -> Encoding
GuessArgs -> Value
(GuessArgs -> Value)
-> (GuessArgs -> Encoding)
-> ([GuessArgs] -> Value)
-> ([GuessArgs] -> Encoding)
-> ToJSON GuessArgs
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GuessArgs] -> Encoding
$ctoEncodingList :: [GuessArgs] -> Encoding
toJSONList :: [GuessArgs] -> Value
$ctoJSONList :: [GuessArgs] -> Value
toEncoding :: GuessArgs -> Encoding
$ctoEncoding :: GuessArgs -> Encoding
toJSON :: GuessArgs -> Value
$ctoJSON :: GuessArgs -> Value
ToJSON, Value -> Parser [GuessArgs]
Value -> Parser GuessArgs
(Value -> Parser GuessArgs)
-> (Value -> Parser [GuessArgs]) -> FromJSON GuessArgs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GuessArgs]
$cparseJSONList :: Value -> Parser [GuessArgs]
parseJSON :: Value -> Parser GuessArgs
$cparseJSON :: Value -> Parser GuessArgs
FromJSON)

-- | The schema of the contract. It consists of the two endpoints @"lock"@
--   and @"guess"@ with their respective argument types.
type GameStateMachineSchema =
        Endpoint "lock" LockArgs
        .\/ Endpoint "guess" GuessArgs

data GameError =
    GameContractError ContractError
    | GameSMError SM.SMContractError
    deriving stock (Int -> GameError -> ShowS
[GameError] -> ShowS
GameError -> String
(Int -> GameError -> ShowS)
-> (GameError -> String)
-> ([GameError] -> ShowS)
-> Show GameError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameError] -> ShowS
$cshowList :: [GameError] -> ShowS
show :: GameError -> String
$cshow :: GameError -> String
showsPrec :: Int -> GameError -> ShowS
$cshowsPrec :: Int -> GameError -> ShowS
Haskell.Show, (forall x. GameError -> Rep GameError x)
-> (forall x. Rep GameError x -> GameError) -> Generic GameError
forall x. Rep GameError x -> GameError
forall x. GameError -> Rep GameError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GameError x -> GameError
$cfrom :: forall x. GameError -> Rep GameError x
Generic)
    deriving anyclass ([GameError] -> Encoding
[GameError] -> Value
GameError -> Encoding
GameError -> Value
(GameError -> Value)
-> (GameError -> Encoding)
-> ([GameError] -> Value)
-> ([GameError] -> Encoding)
-> ToJSON GameError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GameError] -> Encoding
$ctoEncodingList :: [GameError] -> Encoding
toJSONList :: [GameError] -> Value
$ctoJSONList :: [GameError] -> Value
toEncoding :: GameError -> Encoding
$ctoEncoding :: GameError -> Encoding
toJSON :: GameError -> Value
$ctoJSON :: GameError -> Value
ToJSON, Value -> Parser [GameError]
Value -> Parser GameError
(Value -> Parser GameError)
-> (Value -> Parser [GameError]) -> FromJSON GameError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GameError]
$cparseJSONList :: Value -> Parser [GameError]
parseJSON :: Value -> Parser GameError
$cparseJSON :: Value -> Parser GameError
FromJSON)

makeClassyPrisms ''GameError

instance AsContractError GameError where
    _ContractError :: p ContractError (f ContractError) -> p GameError (f GameError)
_ContractError = p ContractError (f ContractError) -> p GameError (f GameError)
forall r. AsGameError r => Prism' r ContractError
_GameContractError (p ContractError (f ContractError) -> p GameError (f GameError))
-> (p ContractError (f ContractError)
    -> p ContractError (f ContractError))
-> p ContractError (f ContractError)
-> p GameError (f GameError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ContractError (f ContractError)
-> p ContractError (f ContractError)
forall r. AsContractError r => Prism' r ContractError
_ContractError

instance SM.AsSMContractError GameError where
    _SMContractError :: p SMContractError (f SMContractError) -> p GameError (f GameError)
_SMContractError = p SMContractError (f SMContractError) -> p GameError (f GameError)
forall r. AsGameError r => Prism' r SMContractError
_GameSMError (p SMContractError (f SMContractError)
 -> p GameError (f GameError))
-> (p SMContractError (f SMContractError)
    -> p SMContractError (f SMContractError))
-> p SMContractError (f SMContractError)
-> p GameError (f GameError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p SMContractError (f SMContractError)
-> p SMContractError (f SMContractError)
forall r. AsSMContractError r => Prism' r SMContractError
SM._SMContractError

-- | Top-level contract, exposing both endpoints.
contract :: Contract () GameStateMachineSchema GameError ()
contract :: Contract () GameStateMachineSchema GameError ()
contract = [Promise
   ()
   ('R
      '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
         "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
   GameError
   ()]
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall w (s :: Row *) e a. [Promise w s e a] -> Contract w s e a
selectList [Promise () GameStateMachineSchema GameError ()
Promise
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  ()
lock, Promise () GameStateMachineSchema GameError ()
Promise
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  ()
guess] Contract
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  ()
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Contract () GameStateMachineSchema GameError ()
Contract
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  ()
contract

-- | The token that represents the right to make a guess
newtype GuessToken = GuessToken { GuessToken -> Value
unGuessToken :: Value }
    deriving newtype (GuessToken -> GuessToken -> Bool
(GuessToken -> GuessToken -> Bool) -> Eq GuessToken
forall a. (a -> a -> Bool) -> Eq a
== :: GuessToken -> GuessToken -> Bool
$c== :: GuessToken -> GuessToken -> Bool
Eq, Int -> GuessToken -> ShowS
[GuessToken] -> ShowS
GuessToken -> String
(Int -> GuessToken -> ShowS)
-> (GuessToken -> String)
-> ([GuessToken] -> ShowS)
-> Show GuessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuessToken] -> ShowS
$cshowList :: [GuessToken] -> ShowS
show :: GuessToken -> String
$cshow :: GuessToken -> String
showsPrec :: Int -> GuessToken -> ShowS
$cshowsPrec :: Int -> GuessToken -> ShowS
Haskell.Show)

token :: MintingPolicyHash -> TokenName -> Value
token :: MintingPolicyHash -> TokenName -> Value
token MintingPolicyHash
mps TokenName
tn = CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol MintingPolicyHash
mps) TokenName
tn Integer
1

-- | State of the guessing game
data GameState =
    Initialised MintingPolicyHash TokenName HashedString
    -- ^ Initial state. In this state only the 'MintTokens' action is allowed.
    | Locked MintingPolicyHash TokenName HashedString
    -- ^ Funds have been locked. In this state only the 'Guess' action is
    --   allowed.
    | Finished
    -- ^ All funds were unlocked.
    deriving stock (Int -> GameState -> ShowS
[GameState] -> ShowS
GameState -> String
(Int -> GameState -> ShowS)
-> (GameState -> String)
-> ([GameState] -> ShowS)
-> Show GameState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameState] -> ShowS
$cshowList :: [GameState] -> ShowS
show :: GameState -> String
$cshow :: GameState -> String
showsPrec :: Int -> GameState -> ShowS
$cshowsPrec :: Int -> GameState -> ShowS
Haskell.Show, (forall x. GameState -> Rep GameState x)
-> (forall x. Rep GameState x -> GameState) -> Generic GameState
forall x. Rep GameState x -> GameState
forall x. GameState -> Rep GameState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GameState x -> GameState
$cfrom :: forall x. GameState -> Rep GameState x
Generic)
    deriving anyclass ([GameState] -> Encoding
[GameState] -> Value
GameState -> Encoding
GameState -> Value
(GameState -> Value)
-> (GameState -> Encoding)
-> ([GameState] -> Value)
-> ([GameState] -> Encoding)
-> ToJSON GameState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GameState] -> Encoding
$ctoEncodingList :: [GameState] -> Encoding
toJSONList :: [GameState] -> Value
$ctoJSONList :: [GameState] -> Value
toEncoding :: GameState -> Encoding
$ctoEncoding :: GameState -> Encoding
toJSON :: GameState -> Value
$ctoJSON :: GameState -> Value
ToJSON, Value -> Parser [GameState]
Value -> Parser GameState
(Value -> Parser GameState)
-> (Value -> Parser [GameState]) -> FromJSON GameState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GameState]
$cparseJSONList :: Value -> Parser [GameState]
parseJSON :: Value -> Parser GameState
$cparseJSON :: Value -> Parser GameState
FromJSON)

instance Eq GameState where
    {-# INLINABLE (==) #-}
    (Initialised MintingPolicyHash
sym TokenName
tn HashedString
s) == :: GameState -> GameState -> Bool
== (Initialised MintingPolicyHash
sym' TokenName
tn' HashedString
s') = MintingPolicyHash
sym MintingPolicyHash -> MintingPolicyHash -> Bool
forall a. Eq a => a -> a -> Bool
== MintingPolicyHash
sym' Bool -> Bool -> Bool
&& HashedString
s HashedString -> HashedString -> Bool
forall a. Eq a => a -> a -> Bool
== HashedString
s' Bool -> Bool -> Bool
&& TokenName
tn TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
tn'
    (Locked MintingPolicyHash
sym TokenName
tn HashedString
s) == (Locked MintingPolicyHash
sym' TokenName
tn' HashedString
s')           = MintingPolicyHash
sym MintingPolicyHash -> MintingPolicyHash -> Bool
forall a. Eq a => a -> a -> Bool
== MintingPolicyHash
sym' Bool -> Bool -> Bool
&& HashedString
s HashedString -> HashedString -> Bool
forall a. Eq a => a -> a -> Bool
== HashedString
s' Bool -> Bool -> Bool
&& TokenName
tn TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
tn'
    GameState
Finished == GameState
Finished                                = Bool
True
    GameState
_ == GameState
_                                              = BuiltinString -> Bool -> Bool
traceIfFalse BuiltinString
"states not equal" Bool
False

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

-- | Inputs (actions)
data GameInput =
      MintToken
    -- ^ Mint the "guess" token
    | Guess Address ClearString HashedString Value
    -- ^ Make a guess, extract the funds, and lock the remaining funds using a
    --   new secret word.
    deriving stock (Int -> GameInput -> ShowS
[GameInput] -> ShowS
GameInput -> String
(Int -> GameInput -> ShowS)
-> (GameInput -> String)
-> ([GameInput] -> ShowS)
-> Show GameInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameInput] -> ShowS
$cshowList :: [GameInput] -> ShowS
show :: GameInput -> String
$cshow :: GameInput -> String
showsPrec :: Int -> GameInput -> ShowS
$cshowsPrec :: Int -> GameInput -> ShowS
Haskell.Show, (forall x. GameInput -> Rep GameInput x)
-> (forall x. Rep GameInput x -> GameInput) -> Generic GameInput
forall x. Rep GameInput x -> GameInput
forall x. GameInput -> Rep GameInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GameInput x -> GameInput
$cfrom :: forall x. GameInput -> Rep GameInput x
Generic)
    deriving anyclass ([GameInput] -> Encoding
[GameInput] -> Value
GameInput -> Encoding
GameInput -> Value
(GameInput -> Value)
-> (GameInput -> Encoding)
-> ([GameInput] -> Value)
-> ([GameInput] -> Encoding)
-> ToJSON GameInput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GameInput] -> Encoding
$ctoEncodingList :: [GameInput] -> Encoding
toJSONList :: [GameInput] -> Value
$ctoJSONList :: [GameInput] -> Value
toEncoding :: GameInput -> Encoding
$ctoEncoding :: GameInput -> Encoding
toJSON :: GameInput -> Value
$ctoJSON :: GameInput -> Value
ToJSON, Value -> Parser [GameInput]
Value -> Parser GameInput
(Value -> Parser GameInput)
-> (Value -> Parser [GameInput]) -> FromJSON GameInput
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GameInput]
$cparseJSONList :: Value -> Parser [GameInput]
parseJSON :: Value -> Parser GameInput
$cparseJSON :: Value -> Parser GameInput
FromJSON)

-- The 'GameParam' parameter is not used in the validation. It is meant to
-- parameterize the script address depending based on the value of 'GaramParam'.
{-# INLINABLE transition #-}
transition
    :: GameParam
    -> State GameState
    -> GameInput
    -> Maybe (TxConstraints Void Void, State GameState)
transition :: GameParam
-> State GameState
-> GameInput
-> Maybe (TxConstraints Void Void, State GameState)
transition GameParam
_ State{stateData :: forall s. State s -> s
stateData=GameState
oldData, stateValue :: forall s. State s -> Value
stateValue=Value
oldValue} GameInput
input = case (GameState
oldData, GameInput
input) of
    (Initialised MintingPolicyHash
mph TokenName
tn HashedString
s, GameInput
MintToken) ->
        let constraints :: TxConstraints i o
constraints = MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
forall i o.
MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
Constraints.mustMintCurrency MintingPolicyHash
mph TokenName
tn Integer
1 in
        (TxConstraints Void Void, State GameState)
-> Maybe (TxConstraints Void Void, State GameState)
forall a. a -> Maybe a
Just ( TxConstraints Void Void
forall i o. TxConstraints i o
constraints
             , State :: forall s. s -> Value -> State s
State
                { stateData :: GameState
stateData = MintingPolicyHash -> TokenName -> HashedString -> GameState
Locked MintingPolicyHash
mph TokenName
tn HashedString
s
                , stateValue :: Value
stateValue = Value
oldValue
                }
             )
    (Locked MintingPolicyHash
mph TokenName
tn HashedString
currentSecret, Guess Address
guessTokenRecipient ClearString
theGuess HashedString
nextSecret Value
takenOut)
        | HashedString -> ClearString -> Bool
checkGuess HashedString
currentSecret ClearString
theGuess ->
        let constraints :: TxConstraints i o
constraints = Address -> Value -> TxConstraints i o
forall i o. Address -> Value -> TxConstraints i o
Constraints.mustPayToAddress Address
guessTokenRecipient (MintingPolicyHash -> TokenName -> Value
token MintingPolicyHash
mph TokenName
tn)
                       TxConstraints i o -> TxConstraints i o -> TxConstraints i o
forall a. Semigroup a => a -> a -> a
<> MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
forall i o.
MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
Constraints.mustMintCurrency MintingPolicyHash
mph TokenName
tn Integer
0
            newValue :: Value
newValue = Value
oldValue Value -> Value -> Value
forall a. AdditiveGroup a => a -> a -> a
- Value
takenOut
         in (TxConstraints Void Void, State GameState)
-> Maybe (TxConstraints Void Void, State GameState)
forall a. a -> Maybe a
Just ( TxConstraints Void Void
forall i o. TxConstraints i o
constraints
                 , State :: forall s. s -> Value -> State s
State
                    { stateData :: GameState
stateData = if Value -> Bool
Value.isZero (Ada -> Value
Ada.toValue (Ada -> Value) -> Ada -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Ada
Ada.fromValue Value
newValue)
                                     then GameState
Finished
                                     else MintingPolicyHash -> TokenName -> HashedString -> GameState
Locked MintingPolicyHash
mph TokenName
tn HashedString
nextSecret
                    , stateValue :: Value
stateValue = Value
newValue
                    }
                 )
    (GameState, GameInput)
_ -> Maybe (TxConstraints Void Void, State GameState)
forall a. Maybe a
Nothing

type GameStateMachine = SM.StateMachine GameState GameInput

{-# INLINABLE machine #-}
machine :: GameParam -> GameStateMachine
machine :: GameParam -> GameStateMachine
machine GameParam
gameParam = Maybe ThreadToken
-> (State GameState
    -> GameInput -> Maybe (TxConstraints Void Void, State GameState))
-> (GameState -> Bool)
-> GameStateMachine
forall s i.
Maybe ThreadToken
-> (State s -> i -> Maybe (TxConstraints Void Void, State s))
-> (s -> Bool)
-> StateMachine s i
SM.mkStateMachine Maybe ThreadToken
forall a. Maybe a
Nothing (GameParam
-> State GameState
-> GameInput
-> Maybe (TxConstraints Void Void, State GameState)
transition GameParam
gameParam) GameState -> Bool
isFinal where
    isFinal :: GameState -> Bool
isFinal GameState
Finished = Bool
True
    isFinal GameState
_        = Bool
False

{-# INLINABLE mkValidator #-}
mkValidator :: GameParam -> V2.ValidatorType GameStateMachine
mkValidator :: GameParam -> ValidatorType GameStateMachine
mkValidator GameParam
gameParam = GameStateMachine -> ValidatorType GameStateMachine
forall s i.
ToData s =>
StateMachine s i -> ValidatorType (StateMachine s i)
SM.mkValidator (GameParam -> GameStateMachine
machine GameParam
gameParam)

typedValidator :: GameParam -> V2.TypedValidator GameStateMachine
typedValidator :: GameParam -> TypedValidator GameStateMachine
typedValidator = CompiledCode (GameParam -> ValidatorType GameStateMachine)
-> CompiledCode
     (ValidatorType GameStateMachine -> UntypedValidator)
-> GameParam
-> TypedValidator GameStateMachine
forall a param.
Lift DefaultUni param =>
CompiledCode (param -> ValidatorType a)
-> CompiledCode (ValidatorType a -> UntypedValidator)
-> param
-> TypedValidator a
V2.mkTypedValidatorParam @GameStateMachine
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap :: (GameState -> GameInput -> ScriptContext -> Bool)
-> UntypedValidator
wrap = (GameState -> GameInput -> ScriptContext -> Bool)
-> UntypedValidator
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool) -> UntypedValidator
Scripts.mkUntypedValidator

mintingPolicy :: GameParam -> Scripts.MintingPolicy
mintingPolicy :: GameParam -> MintingPolicy
mintingPolicy GameParam
gp = TypedValidator GameStateMachine -> MintingPolicy
forall a. TypedValidator a -> MintingPolicy
Scripts.forwardingMintingPolicy (TypedValidator GameStateMachine -> MintingPolicy)
-> TypedValidator GameStateMachine -> MintingPolicy
forall a b. (a -> b) -> a -> b
$ GameParam -> TypedValidator GameStateMachine
typedValidator GameParam
gp

client :: GameParam -> SM.StateMachineClient GameState GameInput
client :: GameParam -> StateMachineClient GameState GameInput
client GameParam
gp = StateMachineInstance GameState GameInput
-> StateMachineClient GameState GameInput
forall state input.
StateMachineInstance state input -> StateMachineClient state input
SM.mkStateMachineClient (StateMachineInstance GameState GameInput
 -> StateMachineClient GameState GameInput)
-> StateMachineInstance GameState GameInput
-> StateMachineClient GameState GameInput
forall a b. (a -> b) -> a -> b
$ GameStateMachine
-> TypedValidator GameStateMachine
-> StateMachineInstance GameState GameInput
forall s i.
StateMachine s i
-> TypedValidator (StateMachine s i) -> StateMachineInstance s i
SM.StateMachineInstance (GameParam -> GameStateMachine
machine GameParam
gp) (TypedValidator GameStateMachine
 -> StateMachineInstance GameState GameInput)
-> TypedValidator GameStateMachine
-> StateMachineInstance GameState GameInput
forall a b. (a -> b) -> a -> b
$ GameParam -> TypedValidator GameStateMachine
typedValidator GameParam
gp

-- | The @"lock"@ endpoint.
lock :: Promise () GameStateMachineSchema GameError ()
lock :: Promise () GameStateMachineSchema GameError ()
lock = forall a w (s :: Row *) e b.
(HasEndpoint "lock" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"lock" ((LockArgs
  -> Contract
       ()
       ('R
          '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
             "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
       GameError
       ())
 -> Promise
      ()
      ('R
         '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
            "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
      GameError
      ())
-> (LockArgs
    -> Contract
         ()
         ('R
            '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
               "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
         GameError
         ())
-> Promise
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall a b. (a -> b) -> a -> b
$ \LockArgs{GameParam
lockArgsGameParam :: GameParam
lockArgsGameParam :: LockArgs -> GameParam
lockArgsGameParam, SecretArgument String
lockArgsSecret :: SecretArgument String
lockArgsSecret :: LockArgs -> SecretArgument String
lockArgsSecret, Value
lockArgsValue :: Value
lockArgsValue :: LockArgs -> Value
lockArgsValue} -> do
    let secret :: HashedString
secret = BuiltinByteString -> HashedString
HashedString (Secret BuiltinByteString -> BuiltinByteString
escape_sha2_256 (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> (String -> ByteString) -> String -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C.pack (String -> BuiltinByteString)
-> Secret String -> Secret BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretArgument String -> Secret String
forall a. SecretArgument a -> Secret a
extractSecret SecretArgument String
lockArgsSecret))
        sym :: MintingPolicyHash
sym = TypedValidator GameStateMachine -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
Scripts.forwardingMintingPolicyHash (TypedValidator GameStateMachine -> MintingPolicyHash)
-> TypedValidator GameStateMachine -> MintingPolicyHash
forall a b. (a -> b) -> a -> b
$ GameParam -> TypedValidator GameStateMachine
typedValidator GameParam
lockArgsGameParam
    GameState
_ <- StateMachineClient GameState GameInput
-> GameState
-> Value
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     GameState
forall w e state (schema :: Row *) input.
(FromData state, ToData state, ToData input,
 AsSMContractError e) =>
StateMachineClient state input
-> state -> Value -> Contract w schema e state
SM.runInitialise (GameParam -> StateMachineClient GameState GameInput
client GameParam
lockArgsGameParam) (MintingPolicyHash -> TokenName -> HashedString -> GameState
Initialised MintingPolicyHash
sym TokenName
"guess" HashedString
secret) Value
lockArgsValue
    Contract
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  (TransitionResult GameState GameInput)
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
         "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
   GameError
   (TransitionResult GameState GameInput)
 -> Contract
      ()
      ('R
         '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
            "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
      GameError
      ())
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     (TransitionResult GameState GameInput)
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GameState GameInput
-> GameInput
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     (TransitionResult GameState GameInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep (GameParam -> StateMachineClient GameState GameInput
client GameParam
lockArgsGameParam) GameInput
MintToken

-- | The @"guess"@ endpoint.
guess :: Promise () GameStateMachineSchema GameError ()
guess :: Promise () GameStateMachineSchema GameError ()
guess = forall a w (s :: Row *) e b.
(HasEndpoint "guess" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"guess" ((GuessArgs
  -> Contract
       ()
       ('R
          '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
             "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
       GameError
       ())
 -> Promise
      ()
      ('R
         '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
            "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
      GameError
      ())
-> (GuessArgs
    -> Contract
         ()
         ('R
            '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
               "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
         GameError
         ())
-> Promise
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall a b. (a -> b) -> a -> b
$ \GuessArgs{GameParam
guessArgsGameParam :: GameParam
guessArgsGameParam :: GuessArgs -> GameParam
guessArgsGameParam, Address
guessTokenTarget :: Address
guessTokenTarget :: GuessArgs -> Address
guessTokenTarget, String
guessArgsOldSecret :: String
guessArgsOldSecret :: GuessArgs -> String
guessArgsOldSecret, SecretArgument String
guessArgsNewSecret :: SecretArgument String
guessArgsNewSecret :: GuessArgs -> SecretArgument String
guessArgsNewSecret, Value
guessArgsValueTakenOut :: Value
guessArgsValueTakenOut :: GuessArgs -> Value
guessArgsValueTakenOut} -> do

    let guessedSecret :: ClearString
guessedSecret = BuiltinByteString -> ClearString
ClearString (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (String -> ByteString
C.pack String
guessArgsOldSecret))
        newSecret :: HashedString
newSecret     = BuiltinByteString -> HashedString
HashedString (Secret BuiltinByteString -> BuiltinByteString
escape_sha2_256 (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> (String -> ByteString) -> String -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C.pack (String -> BuiltinByteString)
-> Secret String -> Secret BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretArgument String -> Secret String
forall a. SecretArgument a -> Secret a
extractSecret SecretArgument String
guessArgsNewSecret))

    Contract
  ()
  ('R
     '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
        "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
  GameError
  (TransitionResult GameState GameInput)
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        (Contract
   ()
   ('R
      '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
         "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
   GameError
   (TransitionResult GameState GameInput)
 -> Contract
      ()
      ('R
         '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
            "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
      GameError
      ())
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     (TransitionResult GameState GameInput)
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GameState GameInput
-> GameInput
-> Contract
     ()
     ('R
        '[ "guess" ':-> (EndpointValue GuessArgs, ActiveEndpoint),
           "lock" ':-> (EndpointValue LockArgs, ActiveEndpoint)])
     GameError
     (TransitionResult GameState GameInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep (GameParam -> StateMachineClient GameState GameInput
client GameParam
guessArgsGameParam)
            (Address -> ClearString -> HashedString -> Value -> GameInput
Guess Address
guessTokenTarget ClearString
guessedSecret HashedString
newSecret Value
guessArgsValueTakenOut)

covIdx :: CoverageIndex
covIdx :: CoverageIndex
covIdx = Int
String
String -> Int -> CoverageIndex -> CoverageIndex
CompiledCodeIn
  DefaultUni
  DefaultFun
  (GameParam -> GameState -> GameInput -> ScriptContext -> ())
-> CoverageIndex
(CoverageIndex -> CoverageIndex)
-> (CompiledCodeIn
      DefaultUni
      DefaultFun
      (GameParam -> GameState -> GameInput -> ScriptContext -> ())
    -> CoverageIndex)
-> CompiledCodeIn
     DefaultUni
     DefaultFun
     (GameParam -> GameState -> GameInput -> ScriptContext -> ())
-> CoverageIndex
forall a. CompiledCodeIn DefaultUni DefaultFun a -> CoverageIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
unsafeIgnoreLocationInCoverageIndex :: String -> Int -> CoverageIndex -> CoverageIndex
computeRefinedCoverageIndex :: forall a. CompiledCodeIn DefaultUni DefaultFun a -> CoverageIndex
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$refinedCoverageIndex $$(PlutusTx.compile [|| \a b c d -> check (mkValidator a b c d) ||])

PlutusTx.unstableMakeIsData ''GameState
PlutusTx.makeLift ''GameState
PlutusTx.unstableMakeIsData ''GameInput
PlutusTx.makeLift ''GameInput
PlutusTx.makeLift ''GuessToken
PlutusTx.unstableMakeIsData ''GuessToken