{-# 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 -fplugin-opt PlutusTx.Plugin:debug-context #-}
-- | A state machine with two states and two roles that take turns.
module Plutus.Contracts.PingPong(
    PingPongState(..),
    Input(..),
    PingPongError(..),
    PingPongSchema,
    runPing,
    runPong,
    ping,
    pong,
    initialise,
    runStop,
    runWaitForUpdate,
    combined,
    simplePingPong,
    simplePingPongAuto
    ) where

import Control.Lens
import Control.Monad (forever, void)
import Data.Aeson (FromJSON, ToJSON)
import Data.Monoid (Last (..))
import GHC.Generics (Generic)
import Ledger.Tx.Constraints (TxConstraints)
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Typed (ScriptContextV2)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as V2
import PlutusTx qualified
import PlutusTx.Prelude hiding (Applicative (..), check)

import Plutus.Contract
import Plutus.Contract.StateMachine (AsSMContractError (..), OnChainState, State (..), Void)
import Plutus.Contract.StateMachine qualified as SM
import Prelude qualified as Haskell

data PingPongState = Pinged | Ponged | Stopped
    deriving stock (PingPongState -> PingPongState -> Bool
(PingPongState -> PingPongState -> Bool)
-> (PingPongState -> PingPongState -> Bool) -> Eq PingPongState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PingPongState -> PingPongState -> Bool
$c/= :: PingPongState -> PingPongState -> Bool
== :: PingPongState -> PingPongState -> Bool
$c== :: PingPongState -> PingPongState -> Bool
Haskell.Eq, Int -> PingPongState -> ShowS
[PingPongState] -> ShowS
PingPongState -> String
(Int -> PingPongState -> ShowS)
-> (PingPongState -> String)
-> ([PingPongState] -> ShowS)
-> Show PingPongState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PingPongState] -> ShowS
$cshowList :: [PingPongState] -> ShowS
show :: PingPongState -> String
$cshow :: PingPongState -> String
showsPrec :: Int -> PingPongState -> ShowS
$cshowsPrec :: Int -> PingPongState -> ShowS
Haskell.Show, (forall x. PingPongState -> Rep PingPongState x)
-> (forall x. Rep PingPongState x -> PingPongState)
-> Generic PingPongState
forall x. Rep PingPongState x -> PingPongState
forall x. PingPongState -> Rep PingPongState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PingPongState x -> PingPongState
$cfrom :: forall x. PingPongState -> Rep PingPongState x
Generic)
    deriving anyclass ([PingPongState] -> Encoding
[PingPongState] -> Value
PingPongState -> Encoding
PingPongState -> Value
(PingPongState -> Value)
-> (PingPongState -> Encoding)
-> ([PingPongState] -> Value)
-> ([PingPongState] -> Encoding)
-> ToJSON PingPongState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PingPongState] -> Encoding
$ctoEncodingList :: [PingPongState] -> Encoding
toJSONList :: [PingPongState] -> Value
$ctoJSONList :: [PingPongState] -> Value
toEncoding :: PingPongState -> Encoding
$ctoEncoding :: PingPongState -> Encoding
toJSON :: PingPongState -> Value
$ctoJSON :: PingPongState -> Value
ToJSON, Value -> Parser [PingPongState]
Value -> Parser PingPongState
(Value -> Parser PingPongState)
-> (Value -> Parser [PingPongState]) -> FromJSON PingPongState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PingPongState]
$cparseJSONList :: Value -> Parser [PingPongState]
parseJSON :: Value -> Parser PingPongState
$cparseJSON :: Value -> Parser PingPongState
FromJSON)

instance Eq PingPongState where
    PingPongState
Pinged == :: PingPongState -> PingPongState -> Bool
== PingPongState
Pinged = Bool
True
    PingPongState
Ponged == PingPongState
Ponged = Bool
True
    PingPongState
_ == PingPongState
_           = Bool
False

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

type PingPongSchema =
        Endpoint "initialise" ()
        .\/ Endpoint "ping" ()
        .\/ Endpoint "pong" ()
        .\/ Endpoint "stop" () -- Transition the state machine instance to the final state
        .\/ Endpoint "wait" () -- Wait for a change to the on-chain state of the machine

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

makeClassyPrisms ''PingPongError

instance AsSMContractError PingPongError where
    _SMContractError :: p SMContractError (f SMContractError)
-> p PingPongError (f PingPongError)
_SMContractError = p SMContractError (f SMContractError)
-> p PingPongError (f PingPongError)
forall r. AsPingPongError r => Prism' r SMContractError
_PingPongSMError

instance AsContractError PingPongError where
    _ContractError :: p ContractError (f ContractError)
-> p PingPongError (f PingPongError)
_ContractError = p ContractError (f ContractError)
-> p PingPongError (f PingPongError)
forall r. AsPingPongError r => Prism' r ContractError
_PingPongContractError

{-# INLINABLE transition #-}
transition :: State PingPongState -> Input -> Maybe (TxConstraints Void Void, State PingPongState)
transition :: State PingPongState
-> Input -> Maybe (TxConstraints Void Void, State PingPongState)
transition State{stateData :: forall s. State s -> s
stateData=PingPongState
oldData,Value
stateValue :: forall s. State s -> Value
stateValue :: Value
stateValue} Input
input = case (PingPongState
oldData, Input
input) of
    (PingPongState
_,      Input
Stop) -> (TxConstraints Void Void, State PingPongState)
-> Maybe (TxConstraints Void Void, State PingPongState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
forall a. Monoid a => a
mempty, State :: forall s. s -> Value -> State s
State{stateData :: PingPongState
stateData=PingPongState
Stopped, stateValue :: Value
stateValue=Value
forall a. Monoid a => a
mempty})
    (PingPongState
Pinged, Input
Pong) -> (TxConstraints Void Void, State PingPongState)
-> Maybe (TxConstraints Void Void, State PingPongState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
forall a. Monoid a => a
mempty, State :: forall s. s -> Value -> State s
State{stateData :: PingPongState
stateData=PingPongState
Ponged, Value
stateValue :: Value
stateValue :: Value
stateValue})
    (PingPongState
Ponged, Input
Ping) -> (TxConstraints Void Void, State PingPongState)
-> Maybe (TxConstraints Void Void, State PingPongState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
forall a. Monoid a => a
mempty, State :: forall s. s -> Value -> State s
State{stateData :: PingPongState
stateData=PingPongState
Pinged, Value
stateValue :: Value
stateValue :: Value
stateValue})
    (PingPongState, Input)
_              -> Maybe (TxConstraints Void Void, State PingPongState)
forall a. Maybe a
Nothing

{-# INLINABLE machine #-}
machine :: SM.StateMachine PingPongState Input
machine :: StateMachine PingPongState Input
machine = Maybe ThreadToken
-> (State PingPongState
    -> Input -> Maybe (TxConstraints Void Void, State PingPongState))
-> (PingPongState -> Bool)
-> StateMachine PingPongState Input
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 State PingPongState
-> Input -> Maybe (TxConstraints Void Void, State PingPongState)
transition PingPongState -> Bool
isFinal where
    isFinal :: PingPongState -> Bool
isFinal PingPongState
Stopped = Bool
True
    isFinal PingPongState
_       = Bool
False

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

typedValidator :: V2.TypedValidator (SM.StateMachine PingPongState Input)
typedValidator :: TypedValidator (StateMachine PingPongState Input)
typedValidator = CompiledCode (ValidatorType (StateMachine PingPongState Input))
-> CompiledCode
     (ValidatorType (StateMachine PingPongState Input)
      -> UntypedValidator)
-> TypedValidator (StateMachine PingPongState Input)
forall a.
CompiledCode (ValidatorType a)
-> CompiledCode (ValidatorType a -> UntypedValidator)
-> TypedValidator a
V2.mkTypedValidator @(SM.StateMachine PingPongState Input)
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap :: (PingPongState -> Input -> ScriptContext -> Bool)
-> UntypedValidator
wrap = (UnsafeFromData PingPongState, UnsafeFromData Input) =>
(PingPongState -> Input -> ScriptContext -> Bool)
-> UntypedValidator
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool) -> UntypedValidator
Scripts.mkUntypedValidator @ScriptContextV2 @PingPongState @Input

machineInstance :: SM.StateMachineInstance PingPongState Input
machineInstance :: StateMachineInstance PingPongState Input
machineInstance = StateMachine PingPongState Input
-> TypedValidator (StateMachine PingPongState Input)
-> StateMachineInstance PingPongState Input
forall s i.
StateMachine s i
-> TypedValidator (StateMachine s i) -> StateMachineInstance s i
SM.StateMachineInstance StateMachine PingPongState Input
machine TypedValidator (StateMachine PingPongState Input)
typedValidator

client :: SM.StateMachineClient PingPongState Input
client :: StateMachineClient PingPongState Input
client = StateMachineInstance PingPongState Input
-> StateMachineClient PingPongState Input
forall state input.
StateMachineInstance state input -> StateMachineClient state input
SM.mkStateMachineClient StateMachineInstance PingPongState Input
machineInstance

initialise :: forall w. Promise w PingPongSchema PingPongError ()
initialise :: Promise w PingPongSchema PingPongError ()
initialise = forall a w (s :: Row *) e b.
(HasEndpoint "initialise" 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 @"initialise" ((()
  -> Contract
       w
       ('R
          '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
             "ping" ':-> (EndpointValue (), ActiveEndpoint),
             "pong" ':-> (EndpointValue (), ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "wait" ':-> (EndpointValue (), ActiveEndpoint)])
       PingPongError
       ())
 -> Promise
      w
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> (()
    -> Contract
         w
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Promise
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  PingPongState
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   w
   ('R
      '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
         "ping" ':-> (EndpointValue (), ActiveEndpoint),
         "pong" ':-> (EndpointValue (), ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "wait" ':-> (EndpointValue (), ActiveEndpoint)])
   PingPongError
   PingPongState
 -> Contract
      w
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     PingPongState
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient PingPongState Input
-> PingPongState
-> Value
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     PingPongState
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 StateMachineClient PingPongState Input
client PingPongState
Pinged (Integer -> Value
Ada.lovelaceValueOf Integer
1)

run ::
    forall w.
    PingPongState
    -> Promise w PingPongSchema PingPongError ()
    -> Contract w PingPongSchema PingPongError ()
run :: PingPongState
-> Promise w PingPongSchema PingPongError ()
-> Contract w PingPongSchema PingPongError ()
run PingPongState
expectedState Promise w PingPongSchema PingPongError ()
action = do
    let go :: Maybe (OnChainState PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
go Maybe (OnChainState PingPongState Input)
Nothing = PingPongError
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PingPongError
StoppedUnexpectedly
        go (Just OnChainState PingPongState Input
currentState)
            | OnChainState PingPongState Input -> PingPongState
forall s i. OnChainState s i -> s
SM.getStateData OnChainState PingPongState Input
currentState PingPongState -> PingPongState -> Bool
forall a. Eq a => a -> a -> Bool
== PingPongState
expectedState = Promise
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise w PingPongSchema PingPongError ()
Promise
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
action
            | Bool
otherwise = Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (Maybe (OnChainState PingPongState Input))
forall w.
Contract
  w
  PingPongSchema
  PingPongError
  (Maybe (OnChainState PingPongState Input))
runWaitForUpdate Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (Maybe (OnChainState PingPongState Input))
-> (Maybe (OnChainState PingPongState Input)
    -> Contract
         w
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (OnChainState PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
go
    Maybe
  (OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut)
maybeState <- StateMachineClient PingPongState Input
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     (Maybe
        (OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut))
forall e state i w (schema :: Row *).
(AsSMContractError e, FromData state, ToData state) =>
StateMachineClient state i
-> Contract
     w
     schema
     e
     (Maybe (OnChainState state i, Map TxOutRef DecoratedTxOut))
SM.getOnChainState StateMachineClient PingPongState Input
client
    let datum :: Maybe (OnChainState PingPongState Input)
datum = ((OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut)
 -> OnChainState PingPongState Input)
-> Maybe
     (OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut)
-> Maybe (OnChainState PingPongState Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut)
-> OnChainState PingPongState Input
forall a b. (a, b) -> a
fst Maybe
  (OnChainState PingPongState Input, Map TxOutRef DecoratedTxOut)
maybeState
    Maybe (OnChainState PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
go Maybe (OnChainState PingPongState Input)
datum

runPing :: forall w. Contract w PingPongSchema PingPongError ()
runPing :: Contract w PingPongSchema PingPongError ()
runPing = PingPongState
-> Promise w PingPongSchema PingPongError ()
-> Contract w PingPongSchema PingPongError ()
forall w.
PingPongState
-> Promise w PingPongSchema PingPongError ()
-> Contract w PingPongSchema PingPongError ()
run PingPongState
Ponged Promise w PingPongSchema PingPongError ()
forall w. Promise w PingPongSchema PingPongError ()
ping

ping :: forall w. Promise w PingPongSchema PingPongError ()
ping :: Promise w PingPongSchema PingPongError ()
ping = forall a w (s :: Row *) e b.
(HasEndpoint "ping" 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 @"ping" ((()
  -> Contract
       w
       ('R
          '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
             "ping" ':-> (EndpointValue (), ActiveEndpoint),
             "pong" ':-> (EndpointValue (), ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "wait" ':-> (EndpointValue (), ActiveEndpoint)])
       PingPongError
       ())
 -> Promise
      w
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> (()
    -> Contract
         w
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Promise
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (TransitionResult PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateMachineClient PingPongState Input
-> Input
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     (TransitionResult PingPongState Input)
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 StateMachineClient PingPongState Input
client Input
Ping)

runPong :: forall w. Contract w PingPongSchema PingPongError ()
runPong :: Contract w PingPongSchema PingPongError ()
runPong = PingPongState
-> Promise w PingPongSchema PingPongError ()
-> Contract w PingPongSchema PingPongError ()
forall w.
PingPongState
-> Promise w PingPongSchema PingPongError ()
-> Contract w PingPongSchema PingPongError ()
run PingPongState
Pinged Promise w PingPongSchema PingPongError ()
forall w. Promise w PingPongSchema PingPongError ()
pong

pong :: forall w. Promise w PingPongSchema PingPongError ()
pong :: Promise w PingPongSchema PingPongError ()
pong = forall a w (s :: Row *) e b.
(HasEndpoint "pong" 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 @"pong" ((()
  -> Contract
       w
       ('R
          '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
             "ping" ':-> (EndpointValue (), ActiveEndpoint),
             "pong" ':-> (EndpointValue (), ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "wait" ':-> (EndpointValue (), ActiveEndpoint)])
       PingPongError
       ())
 -> Promise
      w
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> (()
    -> Contract
         w
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Promise
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (TransitionResult PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateMachineClient PingPongState Input
-> Input
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     (TransitionResult PingPongState Input)
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 StateMachineClient PingPongState Input
client Input
Pong)

runStop :: forall w. Promise w PingPongSchema PingPongError ()
runStop :: Promise w PingPongSchema PingPongError ()
runStop = forall a w (s :: Row *) e b.
(HasEndpoint "stop" 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 @"stop" ((()
  -> Contract
       w
       ('R
          '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
             "ping" ':-> (EndpointValue (), ActiveEndpoint),
             "pong" ':-> (EndpointValue (), ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "wait" ':-> (EndpointValue (), ActiveEndpoint)])
       PingPongError
       ())
 -> Promise
      w
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> (()
    -> Contract
         w
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Promise
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> Contract
  w
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (TransitionResult PingPongState Input)
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateMachineClient PingPongState Input
-> Input
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     (TransitionResult PingPongState Input)
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 StateMachineClient PingPongState Input
client Input
Stop)

runWaitForUpdate :: forall w. Contract w PingPongSchema PingPongError (Maybe (OnChainState PingPongState Input))
runWaitForUpdate :: Contract
  w
  PingPongSchema
  PingPongError
  (Maybe (OnChainState PingPongState Input))
runWaitForUpdate = StateMachineClient PingPongState Input
-> Contract
     w
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     (Maybe (OnChainState PingPongState Input))
forall state i w (schema :: Row *) e.
(AsSMContractError e, AsContractError e, FromData state,
 ToData state, FromData i) =>
StateMachineClient state i
-> Contract w schema e (Maybe (OnChainState state i))
SM.waitForUpdate StateMachineClient PingPongState Input
client

combined :: Contract (Last PingPongState) PingPongSchema PingPongError ()
combined :: Contract (Last PingPongState) PingPongSchema PingPongError ()
combined = Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever ([Promise
   (Last PingPongState)
   ('R
      '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
         "ping" ':-> (EndpointValue (), ActiveEndpoint),
         "pong" ':-> (EndpointValue (), ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "wait" ':-> (EndpointValue (), ActiveEndpoint)])
   PingPongError
   ()]
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. [Promise w s e a] -> Contract w s e a
selectList [Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
initialise, Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
ping, Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
pong, Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
runStop, Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
wait]) where
    wait :: Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
wait = forall a w (s :: Row *) e b.
(HasEndpoint "wait" 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 @"wait" ((()
  -> Contract
       (Last PingPongState)
       ('R
          '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
             "ping" ':-> (EndpointValue (), ActiveEndpoint),
             "pong" ':-> (EndpointValue (), ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "wait" ':-> (EndpointValue (), ActiveEndpoint)])
       PingPongError
       ())
 -> Promise
      (Last PingPongState)
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> (()
    -> Contract
         (Last PingPongState)
         ('R
            '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
               "ping" ':-> (EndpointValue (), ActiveEndpoint),
               "pong" ':-> (EndpointValue (), ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "wait" ':-> (EndpointValue (), ActiveEndpoint)])
         PingPongError
         ())
-> Promise
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> do
        String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"runWaitForUpdate"
        Maybe (OnChainState PingPongState Input)
newState <- Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  (Maybe (OnChainState PingPongState Input))
forall w.
Contract
  w
  PingPongSchema
  PingPongError
  (Maybe (OnChainState PingPongState Input))
runWaitForUpdate
        case Maybe (OnChainState PingPongState Input)
newState of
            Maybe (OnChainState PingPongState Input)
Nothing -> String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logWarn @Haskell.String String
"runWaitForUpdate: Nothing"
            Just OnChainState PingPongState Input
ocs -> do
                String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String
 -> Contract
      (Last PingPongState)
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ String
"new state: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PingPongState -> String
forall a. Show a => a -> String
Haskell.show (OnChainState PingPongState Input -> PingPongState
forall s i. OnChainState s i -> s
SM.getStateData OnChainState PingPongState Input
ocs)
                Last PingPongState
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Maybe PingPongState -> Last PingPongState
forall a. Maybe a -> Last a
Last (Maybe PingPongState -> Last PingPongState)
-> Maybe PingPongState -> Last PingPongState
forall a b. (a -> b) -> a -> b
$ PingPongState -> Maybe PingPongState
forall a. a -> Maybe a
Just (PingPongState -> Maybe PingPongState)
-> PingPongState -> Maybe PingPongState
forall a b. (a -> b) -> a -> b
$ OnChainState PingPongState Input -> PingPongState
forall s i. OnChainState s i -> s
SM.getStateData OnChainState PingPongState Input
ocs)

simplePingPongAuto :: Contract (Last PingPongState) PingPongSchema PingPongError ()
simplePingPongAuto :: Contract (Last PingPongState) PingPongSchema PingPongError ()
simplePingPongAuto = do
  String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"Initialising PingPongAuto"
  Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  PingPongState
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   (Last PingPongState)
   ('R
      '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
         "ping" ':-> (EndpointValue (), ActiveEndpoint),
         "pong" ':-> (EndpointValue (), ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "wait" ':-> (EndpointValue (), ActiveEndpoint)])
   PingPongError
   PingPongState
 -> Contract
      (Last PingPongState)
      ('R
         '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
            "ping" ':-> (EndpointValue (), ActiveEndpoint),
            "pong" ':-> (EndpointValue (), ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "wait" ':-> (EndpointValue (), ActiveEndpoint)])
      PingPongError
      ())
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     PingPongState
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient PingPongState Input
-> PingPongState
-> Value
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     PingPongState
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 StateMachineClient PingPongState Input
client PingPongState
Pinged (Integer -> Value
Ada.lovelaceValueOf Integer
2)
  String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"Waiting for PONG"
  Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
pong
  String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"Waiting for PING"
  Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
ping
  String
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"Waiting for PONG"
  Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
pong

simplePingPong :: Contract (Last PingPongState) PingPongSchema PingPongError ()
simplePingPong :: Contract (Last PingPongState) PingPongSchema PingPongError ()
simplePingPong =
  Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
initialise
  Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
pong
  Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
ping
  Contract
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
-> Contract
     (Last PingPongState)
     ('R
        '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
           "ping" ':-> (EndpointValue (), ActiveEndpoint),
           "pong" ':-> (EndpointValue (), ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "wait" ':-> (EndpointValue (), ActiveEndpoint)])
     PingPongError
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise Promise
  (Last PingPongState)
  ('R
     '[ "initialise" ':-> (EndpointValue (), ActiveEndpoint),
        "ping" ':-> (EndpointValue (), ActiveEndpoint),
        "pong" ':-> (EndpointValue (), ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "wait" ':-> (EndpointValue (), ActiveEndpoint)])
  PingPongError
  ()
forall w. Promise w PingPongSchema PingPongError ()
pong

PlutusTx.unstableMakeIsData ''PingPongState
PlutusTx.makeLift ''PingPongState
PlutusTx.unstableMakeIsData ''Input
PlutusTx.makeLift ''Input