{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
module Plutus.Contract.State(
    -- * Contract state
    -- $contractstate
    Contract
    , State(..)
    , ContractRequest(..)
    , ContractResponse(..)
    , mapE
    , mapW
    , insertAndUpdateContract
    , initialiseContract
    , mkResponse
    ) where

import Control.Monad.Freer.Extras.Log (LogMessage)
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Bifunctor (Bifunctor (..))
import Data.Foldable (toList)
import GHC.Generics (Generic)

import Plutus.Contract.Checkpoint (CheckpointKey, CheckpointStore)
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Resumable
import Plutus.Contract.Types hiding (lastLogs, lastState, logs, observableState)
import Prettyprinter.Extras (Pretty, PrettyShow (..))

-- $contractstate
-- Types for initialising and running instances of 'Contract's. The types and
-- functions in this module are convenient wrappers around types and functions
-- from 'Plutus.Contract.Types', exposing an interface that is suitable
-- for consumption by the PAB. In particular this means that
-- 'insertAndUpdateContract' has a single argument, and its argument & return
-- types can be serialised to JSON easily.
--
-- To actually run a contract, follow this workflow:
--
-- 1. Call 'initialiseContract' to get the initial 'ContractResponse'.
-- 2. Look at the 'hooks' of this value and generate an answer to one of them.
--    This answer is a 'Response' @s@ value.
-- 3. Call 'insertAndUpdateContract' with a 'ContractRequest' whose 'oldState'
--    field has the value of 'newState' of the previous response, and whose
--    'event' is the next answer (step 2).
-- 4. Take the new 'ContractResponse' and go back to step 2, until you get a
--    response with no requests, or an error.

-- | The state of a 'Contract', containing all responses that have been fed to
--   it, and checkpoints that it produced.
data State w e = State
    { State w e -> Responses e
record          :: Responses e
    , State w e -> CheckpointStore
checkpoints     :: CheckpointStore
    , State w e -> w
observableState :: w
    }
    deriving stock ((forall x. State w e -> Rep (State w e) x)
-> (forall x. Rep (State w e) x -> State w e)
-> Generic (State w e)
forall x. Rep (State w e) x -> State w e
forall x. State w e -> Rep (State w e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w e x. Rep (State w e) x -> State w e
forall w e x. State w e -> Rep (State w e) x
$cto :: forall w e x. Rep (State w e) x -> State w e
$cfrom :: forall w e x. State w e -> Rep (State w e) x
Generic, State w e -> State w e -> Bool
(State w e -> State w e -> Bool)
-> (State w e -> State w e -> Bool) -> Eq (State w e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w e. (Eq e, Eq w) => State w e -> State w e -> Bool
/= :: State w e -> State w e -> Bool
$c/= :: forall w e. (Eq e, Eq w) => State w e -> State w e -> Bool
== :: State w e -> State w e -> Bool
$c== :: forall w e. (Eq e, Eq w) => State w e -> State w e -> Bool
Eq, Int -> State w e -> ShowS
[State w e] -> ShowS
State w e -> String
(Int -> State w e -> ShowS)
-> (State w e -> String)
-> ([State w e] -> ShowS)
-> Show (State w e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w e. (Show e, Show w) => Int -> State w e -> ShowS
forall w e. (Show e, Show w) => [State w e] -> ShowS
forall w e. (Show e, Show w) => State w e -> String
showList :: [State w e] -> ShowS
$cshowList :: forall w e. (Show e, Show w) => [State w e] -> ShowS
show :: State w e -> String
$cshow :: forall w e. (Show e, Show w) => State w e -> String
showsPrec :: Int -> State w e -> ShowS
$cshowsPrec :: forall w e. (Show e, Show w) => Int -> State w e -> ShowS
Show, a -> State w b -> State w a
(a -> b) -> State w a -> State w b
(forall a b. (a -> b) -> State w a -> State w b)
-> (forall a b. a -> State w b -> State w a) -> Functor (State w)
forall a b. a -> State w b -> State w a
forall a b. (a -> b) -> State w a -> State w b
forall w a b. a -> State w b -> State w a
forall w a b. (a -> b) -> State w a -> State w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> State w b -> State w a
$c<$ :: forall w a b. a -> State w b -> State w a
fmap :: (a -> b) -> State w a -> State w b
$cfmap :: forall w a b. (a -> b) -> State w a -> State w b
Functor, State w a -> Bool
(a -> m) -> State w a -> m
(a -> b -> b) -> b -> State w a -> b
(forall m. Monoid m => State w m -> m)
-> (forall m a. Monoid m => (a -> m) -> State w a -> m)
-> (forall m a. Monoid m => (a -> m) -> State w a -> m)
-> (forall a b. (a -> b -> b) -> b -> State w a -> b)
-> (forall a b. (a -> b -> b) -> b -> State w a -> b)
-> (forall b a. (b -> a -> b) -> b -> State w a -> b)
-> (forall b a. (b -> a -> b) -> b -> State w a -> b)
-> (forall a. (a -> a -> a) -> State w a -> a)
-> (forall a. (a -> a -> a) -> State w a -> a)
-> (forall a. State w a -> [a])
-> (forall a. State w a -> Bool)
-> (forall a. State w a -> Int)
-> (forall a. Eq a => a -> State w a -> Bool)
-> (forall a. Ord a => State w a -> a)
-> (forall a. Ord a => State w a -> a)
-> (forall a. Num a => State w a -> a)
-> (forall a. Num a => State w a -> a)
-> Foldable (State w)
forall a. Eq a => a -> State w a -> Bool
forall a. Num a => State w a -> a
forall a. Ord a => State w a -> a
forall m. Monoid m => State w m -> m
forall a. State w a -> Bool
forall a. State w a -> Int
forall a. State w a -> [a]
forall a. (a -> a -> a) -> State w a -> a
forall w a. Eq a => a -> State w a -> Bool
forall w a. Num a => State w a -> a
forall w a. Ord a => State w a -> a
forall m a. Monoid m => (a -> m) -> State w a -> m
forall w m. Monoid m => State w m -> m
forall w a. State w a -> Bool
forall w a. State w a -> Int
forall w a. State w a -> [a]
forall b a. (b -> a -> b) -> b -> State w a -> b
forall a b. (a -> b -> b) -> b -> State w a -> b
forall w a. (a -> a -> a) -> State w a -> a
forall w m a. Monoid m => (a -> m) -> State w a -> m
forall w b a. (b -> a -> b) -> b -> State w a -> b
forall w a b. (a -> b -> b) -> b -> State w a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: State w a -> a
$cproduct :: forall w a. Num a => State w a -> a
sum :: State w a -> a
$csum :: forall w a. Num a => State w a -> a
minimum :: State w a -> a
$cminimum :: forall w a. Ord a => State w a -> a
maximum :: State w a -> a
$cmaximum :: forall w a. Ord a => State w a -> a
elem :: a -> State w a -> Bool
$celem :: forall w a. Eq a => a -> State w a -> Bool
length :: State w a -> Int
$clength :: forall w a. State w a -> Int
null :: State w a -> Bool
$cnull :: forall w a. State w a -> Bool
toList :: State w a -> [a]
$ctoList :: forall w a. State w a -> [a]
foldl1 :: (a -> a -> a) -> State w a -> a
$cfoldl1 :: forall w a. (a -> a -> a) -> State w a -> a
foldr1 :: (a -> a -> a) -> State w a -> a
$cfoldr1 :: forall w a. (a -> a -> a) -> State w a -> a
foldl' :: (b -> a -> b) -> b -> State w a -> b
$cfoldl' :: forall w b a. (b -> a -> b) -> b -> State w a -> b
foldl :: (b -> a -> b) -> b -> State w a -> b
$cfoldl :: forall w b a. (b -> a -> b) -> b -> State w a -> b
foldr' :: (a -> b -> b) -> b -> State w a -> b
$cfoldr' :: forall w a b. (a -> b -> b) -> b -> State w a -> b
foldr :: (a -> b -> b) -> b -> State w a -> b
$cfoldr :: forall w a b. (a -> b -> b) -> b -> State w a -> b
foldMap' :: (a -> m) -> State w a -> m
$cfoldMap' :: forall w m a. Monoid m => (a -> m) -> State w a -> m
foldMap :: (a -> m) -> State w a -> m
$cfoldMap :: forall w m a. Monoid m => (a -> m) -> State w a -> m
fold :: State w m -> m
$cfold :: forall w m. Monoid m => State w m -> m
Foldable, Functor (State w)
Foldable (State w)
Functor (State w)
-> Foldable (State w)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> State w a -> f (State w b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    State w (f a) -> f (State w a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> State w a -> m (State w b))
-> (forall (m :: * -> *) a.
    Monad m =>
    State w (m a) -> m (State w a))
-> Traversable (State w)
(a -> f b) -> State w a -> f (State w b)
forall w. Functor (State w)
forall w. Foldable (State w)
forall w (m :: * -> *) a. Monad m => State w (m a) -> m (State w a)
forall w (f :: * -> *) a.
Applicative f =>
State w (f a) -> f (State w a)
forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> State w a -> m (State w b)
forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> State w a -> f (State w b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => State w (m a) -> m (State w a)
forall (f :: * -> *) a.
Applicative f =>
State w (f a) -> f (State w a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> State w a -> m (State w b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> State w a -> f (State w b)
sequence :: State w (m a) -> m (State w a)
$csequence :: forall w (m :: * -> *) a. Monad m => State w (m a) -> m (State w a)
mapM :: (a -> m b) -> State w a -> m (State w b)
$cmapM :: forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> State w a -> m (State w b)
sequenceA :: State w (f a) -> f (State w a)
$csequenceA :: forall w (f :: * -> *) a.
Applicative f =>
State w (f a) -> f (State w a)
traverse :: (a -> f b) -> State w a -> f (State w b)
$ctraverse :: forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> State w a -> f (State w b)
$cp2Traversable :: forall w. Foldable (State w)
$cp1Traversable :: forall w. Functor (State w)
Traversable)
    deriving anyclass ([State w e] -> Encoding
[State w e] -> Value
State w e -> Encoding
State w e -> Value
(State w e -> Value)
-> (State w e -> Encoding)
-> ([State w e] -> Value)
-> ([State w e] -> Encoding)
-> ToJSON (State w e)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall w e. (ToJSON w, ToJSON e) => [State w e] -> Encoding
forall w e. (ToJSON w, ToJSON e) => [State w e] -> Value
forall w e. (ToJSON w, ToJSON e) => State w e -> Encoding
forall w e. (ToJSON w, ToJSON e) => State w e -> Value
toEncodingList :: [State w e] -> Encoding
$ctoEncodingList :: forall w e. (ToJSON w, ToJSON e) => [State w e] -> Encoding
toJSONList :: [State w e] -> Value
$ctoJSONList :: forall w e. (ToJSON w, ToJSON e) => [State w e] -> Value
toEncoding :: State w e -> Encoding
$ctoEncoding :: forall w e. (ToJSON w, ToJSON e) => State w e -> Encoding
toJSON :: State w e -> Value
$ctoJSON :: forall w e. (ToJSON w, ToJSON e) => State w e -> Value
ToJSON, Value -> Parser [State w e]
Value -> Parser (State w e)
(Value -> Parser (State w e))
-> (Value -> Parser [State w e]) -> FromJSON (State w e)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall w e. (FromJSON e, FromJSON w) => Value -> Parser [State w e]
forall w e. (FromJSON e, FromJSON w) => Value -> Parser (State w e)
parseJSONList :: Value -> Parser [State w e]
$cparseJSONList :: forall w e. (FromJSON e, FromJSON w) => Value -> Parser [State w e]
parseJSON :: Value -> Parser (State w e)
$cparseJSON :: forall w e. (FromJSON e, FromJSON w) => Value -> Parser (State w e)
FromJSON)

instance Bifunctor State where
    bimap :: (a -> b) -> (c -> d) -> State a c -> State b d
bimap a -> b
f c -> d
g State a c
s =
        State a c
s{record :: Responses d
record = (c -> d) -> Responses c -> Responses d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (State a c -> Responses c
forall w e. State w e -> Responses e
record State a c
s), observableState :: b
observableState = a -> b
f (State a c -> a
forall w e. State w e -> w
observableState State a c
s)}

-- | A request sent to a contract instance. It contains the previous 'State' of
--   the instance, and a 'Response' to one of the requests of the instance.
data ContractRequest w s = ContractRequest
    { ContractRequest w s -> State w (CheckpointKey, s)
oldState :: State w (CheckpointKey, s)
    , ContractRequest w s -> Response s
event    :: Response s
    }
    deriving stock ((forall x. ContractRequest w s -> Rep (ContractRequest w s) x)
-> (forall x. Rep (ContractRequest w s) x -> ContractRequest w s)
-> Generic (ContractRequest w s)
forall x. Rep (ContractRequest w s) x -> ContractRequest w s
forall x. ContractRequest w s -> Rep (ContractRequest w s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w s x. Rep (ContractRequest w s) x -> ContractRequest w s
forall w s x. ContractRequest w s -> Rep (ContractRequest w s) x
$cto :: forall w s x. Rep (ContractRequest w s) x -> ContractRequest w s
$cfrom :: forall w s x. ContractRequest w s -> Rep (ContractRequest w s) x
Generic, ContractRequest w s -> ContractRequest w s -> Bool
(ContractRequest w s -> ContractRequest w s -> Bool)
-> (ContractRequest w s -> ContractRequest w s -> Bool)
-> Eq (ContractRequest w s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w s.
(Eq s, Eq w) =>
ContractRequest w s -> ContractRequest w s -> Bool
/= :: ContractRequest w s -> ContractRequest w s -> Bool
$c/= :: forall w s.
(Eq s, Eq w) =>
ContractRequest w s -> ContractRequest w s -> Bool
== :: ContractRequest w s -> ContractRequest w s -> Bool
$c== :: forall w s.
(Eq s, Eq w) =>
ContractRequest w s -> ContractRequest w s -> Bool
Eq, Int -> ContractRequest w s -> ShowS
[ContractRequest w s] -> ShowS
ContractRequest w s -> String
(Int -> ContractRequest w s -> ShowS)
-> (ContractRequest w s -> String)
-> ([ContractRequest w s] -> ShowS)
-> Show (ContractRequest w s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w s. (Show s, Show w) => Int -> ContractRequest w s -> ShowS
forall w s. (Show s, Show w) => [ContractRequest w s] -> ShowS
forall w s. (Show s, Show w) => ContractRequest w s -> String
showList :: [ContractRequest w s] -> ShowS
$cshowList :: forall w s. (Show s, Show w) => [ContractRequest w s] -> ShowS
show :: ContractRequest w s -> String
$cshow :: forall w s. (Show s, Show w) => ContractRequest w s -> String
showsPrec :: Int -> ContractRequest w s -> ShowS
$cshowsPrec :: forall w s. (Show s, Show w) => Int -> ContractRequest w s -> ShowS
Show, a -> ContractRequest w b -> ContractRequest w a
(a -> b) -> ContractRequest w a -> ContractRequest w b
(forall a b.
 (a -> b) -> ContractRequest w a -> ContractRequest w b)
-> (forall a b. a -> ContractRequest w b -> ContractRequest w a)
-> Functor (ContractRequest w)
forall a b. a -> ContractRequest w b -> ContractRequest w a
forall a b. (a -> b) -> ContractRequest w a -> ContractRequest w b
forall w a b. a -> ContractRequest w b -> ContractRequest w a
forall w a b.
(a -> b) -> ContractRequest w a -> ContractRequest w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ContractRequest w b -> ContractRequest w a
$c<$ :: forall w a b. a -> ContractRequest w b -> ContractRequest w a
fmap :: (a -> b) -> ContractRequest w a -> ContractRequest w b
$cfmap :: forall w a b.
(a -> b) -> ContractRequest w a -> ContractRequest w b
Functor, ContractRequest w a -> Bool
(a -> m) -> ContractRequest w a -> m
(a -> b -> b) -> b -> ContractRequest w a -> b
(forall m. Monoid m => ContractRequest w m -> m)
-> (forall m a. Monoid m => (a -> m) -> ContractRequest w a -> m)
-> (forall m a. Monoid m => (a -> m) -> ContractRequest w a -> m)
-> (forall a b. (a -> b -> b) -> b -> ContractRequest w a -> b)
-> (forall a b. (a -> b -> b) -> b -> ContractRequest w a -> b)
-> (forall b a. (b -> a -> b) -> b -> ContractRequest w a -> b)
-> (forall b a. (b -> a -> b) -> b -> ContractRequest w a -> b)
-> (forall a. (a -> a -> a) -> ContractRequest w a -> a)
-> (forall a. (a -> a -> a) -> ContractRequest w a -> a)
-> (forall a. ContractRequest w a -> [a])
-> (forall a. ContractRequest w a -> Bool)
-> (forall a. ContractRequest w a -> Int)
-> (forall a. Eq a => a -> ContractRequest w a -> Bool)
-> (forall a. Ord a => ContractRequest w a -> a)
-> (forall a. Ord a => ContractRequest w a -> a)
-> (forall a. Num a => ContractRequest w a -> a)
-> (forall a. Num a => ContractRequest w a -> a)
-> Foldable (ContractRequest w)
forall a. Eq a => a -> ContractRequest w a -> Bool
forall a. Num a => ContractRequest w a -> a
forall a. Ord a => ContractRequest w a -> a
forall m. Monoid m => ContractRequest w m -> m
forall a. ContractRequest w a -> Bool
forall a. ContractRequest w a -> Int
forall a. ContractRequest w a -> [a]
forall a. (a -> a -> a) -> ContractRequest w a -> a
forall w a. Eq a => a -> ContractRequest w a -> Bool
forall w a. Num a => ContractRequest w a -> a
forall w a. Ord a => ContractRequest w a -> a
forall m a. Monoid m => (a -> m) -> ContractRequest w a -> m
forall w m. Monoid m => ContractRequest w m -> m
forall w a. ContractRequest w a -> Bool
forall w a. ContractRequest w a -> Int
forall w a. ContractRequest w a -> [a]
forall b a. (b -> a -> b) -> b -> ContractRequest w a -> b
forall a b. (a -> b -> b) -> b -> ContractRequest w a -> b
forall w a. (a -> a -> a) -> ContractRequest w a -> a
forall w m a. Monoid m => (a -> m) -> ContractRequest w a -> m
forall w b a. (b -> a -> b) -> b -> ContractRequest w a -> b
forall w a b. (a -> b -> b) -> b -> ContractRequest w a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ContractRequest w a -> a
$cproduct :: forall w a. Num a => ContractRequest w a -> a
sum :: ContractRequest w a -> a
$csum :: forall w a. Num a => ContractRequest w a -> a
minimum :: ContractRequest w a -> a
$cminimum :: forall w a. Ord a => ContractRequest w a -> a
maximum :: ContractRequest w a -> a
$cmaximum :: forall w a. Ord a => ContractRequest w a -> a
elem :: a -> ContractRequest w a -> Bool
$celem :: forall w a. Eq a => a -> ContractRequest w a -> Bool
length :: ContractRequest w a -> Int
$clength :: forall w a. ContractRequest w a -> Int
null :: ContractRequest w a -> Bool
$cnull :: forall w a. ContractRequest w a -> Bool
toList :: ContractRequest w a -> [a]
$ctoList :: forall w a. ContractRequest w a -> [a]
foldl1 :: (a -> a -> a) -> ContractRequest w a -> a
$cfoldl1 :: forall w a. (a -> a -> a) -> ContractRequest w a -> a
foldr1 :: (a -> a -> a) -> ContractRequest w a -> a
$cfoldr1 :: forall w a. (a -> a -> a) -> ContractRequest w a -> a
foldl' :: (b -> a -> b) -> b -> ContractRequest w a -> b
$cfoldl' :: forall w b a. (b -> a -> b) -> b -> ContractRequest w a -> b
foldl :: (b -> a -> b) -> b -> ContractRequest w a -> b
$cfoldl :: forall w b a. (b -> a -> b) -> b -> ContractRequest w a -> b
foldr' :: (a -> b -> b) -> b -> ContractRequest w a -> b
$cfoldr' :: forall w a b. (a -> b -> b) -> b -> ContractRequest w a -> b
foldr :: (a -> b -> b) -> b -> ContractRequest w a -> b
$cfoldr :: forall w a b. (a -> b -> b) -> b -> ContractRequest w a -> b
foldMap' :: (a -> m) -> ContractRequest w a -> m
$cfoldMap' :: forall w m a. Monoid m => (a -> m) -> ContractRequest w a -> m
foldMap :: (a -> m) -> ContractRequest w a -> m
$cfoldMap :: forall w m a. Monoid m => (a -> m) -> ContractRequest w a -> m
fold :: ContractRequest w m -> m
$cfold :: forall w m. Monoid m => ContractRequest w m -> m
Foldable, Functor (ContractRequest w)
Foldable (ContractRequest w)
Functor (ContractRequest w)
-> Foldable (ContractRequest w)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ContractRequest w a -> f (ContractRequest w b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ContractRequest w (f a) -> f (ContractRequest w a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ContractRequest w a -> m (ContractRequest w b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ContractRequest w (m a) -> m (ContractRequest w a))
-> Traversable (ContractRequest w)
(a -> f b) -> ContractRequest w a -> f (ContractRequest w b)
forall w. Functor (ContractRequest w)
forall w. Foldable (ContractRequest w)
forall w (m :: * -> *) a.
Monad m =>
ContractRequest w (m a) -> m (ContractRequest w a)
forall w (f :: * -> *) a.
Applicative f =>
ContractRequest w (f a) -> f (ContractRequest w a)
forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ContractRequest w a -> m (ContractRequest w b)
forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ContractRequest w a -> f (ContractRequest w b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ContractRequest w (m a) -> m (ContractRequest w a)
forall (f :: * -> *) a.
Applicative f =>
ContractRequest w (f a) -> f (ContractRequest w a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ContractRequest w a -> m (ContractRequest w b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ContractRequest w a -> f (ContractRequest w b)
sequence :: ContractRequest w (m a) -> m (ContractRequest w a)
$csequence :: forall w (m :: * -> *) a.
Monad m =>
ContractRequest w (m a) -> m (ContractRequest w a)
mapM :: (a -> m b) -> ContractRequest w a -> m (ContractRequest w b)
$cmapM :: forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ContractRequest w a -> m (ContractRequest w b)
sequenceA :: ContractRequest w (f a) -> f (ContractRequest w a)
$csequenceA :: forall w (f :: * -> *) a.
Applicative f =>
ContractRequest w (f a) -> f (ContractRequest w a)
traverse :: (a -> f b) -> ContractRequest w a -> f (ContractRequest w b)
$ctraverse :: forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ContractRequest w a -> f (ContractRequest w b)
$cp2Traversable :: forall w. Foldable (ContractRequest w)
$cp1Traversable :: forall w. Functor (ContractRequest w)
Traversable)
    deriving anyclass ([ContractRequest w s] -> Encoding
[ContractRequest w s] -> Value
ContractRequest w s -> Encoding
ContractRequest w s -> Value
(ContractRequest w s -> Value)
-> (ContractRequest w s -> Encoding)
-> ([ContractRequest w s] -> Value)
-> ([ContractRequest w s] -> Encoding)
-> ToJSON (ContractRequest w s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall w s.
(ToJSON s, ToJSON w) =>
[ContractRequest w s] -> Encoding
forall w s. (ToJSON s, ToJSON w) => [ContractRequest w s] -> Value
forall w s. (ToJSON s, ToJSON w) => ContractRequest w s -> Encoding
forall w s. (ToJSON s, ToJSON w) => ContractRequest w s -> Value
toEncodingList :: [ContractRequest w s] -> Encoding
$ctoEncodingList :: forall w s.
(ToJSON s, ToJSON w) =>
[ContractRequest w s] -> Encoding
toJSONList :: [ContractRequest w s] -> Value
$ctoJSONList :: forall w s. (ToJSON s, ToJSON w) => [ContractRequest w s] -> Value
toEncoding :: ContractRequest w s -> Encoding
$ctoEncoding :: forall w s. (ToJSON s, ToJSON w) => ContractRequest w s -> Encoding
toJSON :: ContractRequest w s -> Value
$ctoJSON :: forall w s. (ToJSON s, ToJSON w) => ContractRequest w s -> Value
ToJSON, Value -> Parser [ContractRequest w s]
Value -> Parser (ContractRequest w s)
(Value -> Parser (ContractRequest w s))
-> (Value -> Parser [ContractRequest w s])
-> FromJSON (ContractRequest w s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall w s.
(FromJSON s, FromJSON w) =>
Value -> Parser [ContractRequest w s]
forall w s.
(FromJSON s, FromJSON w) =>
Value -> Parser (ContractRequest w s)
parseJSONList :: Value -> Parser [ContractRequest w s]
$cparseJSONList :: forall w s.
(FromJSON s, FromJSON w) =>
Value -> Parser [ContractRequest w s]
parseJSON :: Value -> Parser (ContractRequest w s)
$cparseJSON :: forall w s.
(FromJSON s, FromJSON w) =>
Value -> Parser (ContractRequest w s)
FromJSON)
    deriving [ContractRequest w s] -> Doc ann
ContractRequest w s -> Doc ann
(forall ann. ContractRequest w s -> Doc ann)
-> (forall ann. [ContractRequest w s] -> Doc ann)
-> Pretty (ContractRequest w s)
forall ann. [ContractRequest w s] -> Doc ann
forall ann. ContractRequest w s -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
forall w s ann.
(Show s, Show w) =>
[ContractRequest w s] -> Doc ann
forall w s ann. (Show s, Show w) => ContractRequest w s -> Doc ann
prettyList :: [ContractRequest w s] -> Doc ann
$cprettyList :: forall w s ann.
(Show s, Show w) =>
[ContractRequest w s] -> Doc ann
pretty :: ContractRequest w s -> Doc ann
$cpretty :: forall w s ann. (Show s, Show w) => ContractRequest w s -> Doc ann
Pretty via PrettyShow (ContractRequest w s)

-- | A response produced by a contract instance. It contains the new 'State',
--   the list of endpoints that can be called, logs produced by the contract,
--   possibly an error message, and the accumulated observable state.
data ContractResponse w e s h = ContractResponse
    { ContractResponse w e s h -> State w (CheckpointKey, s)
newState  :: State w (CheckpointKey, s) -- ^ Serialised state of the contract (internal)
    , ContractResponse w e s h -> [Request h]
hooks     :: [Request h] -- ^ Open requests that can be handled
    , ContractResponse w e s h -> [LogMessage Value]
logs      :: [LogMessage Value] -- ^ Logs produced by the contract
    , ContractResponse w e s h -> [LogMessage Value]
lastLogs  :: [LogMessage Value] -- ^ Logs produced in the last step
    , ContractResponse w e s h -> Maybe e
err       :: Maybe e -- ^ Error that happened during contract execution
    , ContractResponse w e s h -> w
lastState :: w -- ^ Observable state produced in the last step
    }
    deriving stock ((forall x.
 ContractResponse w e s h -> Rep (ContractResponse w e s h) x)
-> (forall x.
    Rep (ContractResponse w e s h) x -> ContractResponse w e s h)
-> Generic (ContractResponse w e s h)
forall x.
Rep (ContractResponse w e s h) x -> ContractResponse w e s h
forall x.
ContractResponse w e s h -> Rep (ContractResponse w e s h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w e s h x.
Rep (ContractResponse w e s h) x -> ContractResponse w e s h
forall w e s h x.
ContractResponse w e s h -> Rep (ContractResponse w e s h) x
$cto :: forall w e s h x.
Rep (ContractResponse w e s h) x -> ContractResponse w e s h
$cfrom :: forall w e s h x.
ContractResponse w e s h -> Rep (ContractResponse w e s h) x
Generic, ContractResponse w e s h -> ContractResponse w e s h -> Bool
(ContractResponse w e s h -> ContractResponse w e s h -> Bool)
-> (ContractResponse w e s h -> ContractResponse w e s h -> Bool)
-> Eq (ContractResponse w e s h)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w e s h.
(Eq s, Eq w, Eq h, Eq e) =>
ContractResponse w e s h -> ContractResponse w e s h -> Bool
/= :: ContractResponse w e s h -> ContractResponse w e s h -> Bool
$c/= :: forall w e s h.
(Eq s, Eq w, Eq h, Eq e) =>
ContractResponse w e s h -> ContractResponse w e s h -> Bool
== :: ContractResponse w e s h -> ContractResponse w e s h -> Bool
$c== :: forall w e s h.
(Eq s, Eq w, Eq h, Eq e) =>
ContractResponse w e s h -> ContractResponse w e s h -> Bool
Eq, Int -> ContractResponse w e s h -> ShowS
[ContractResponse w e s h] -> ShowS
ContractResponse w e s h -> String
(Int -> ContractResponse w e s h -> ShowS)
-> (ContractResponse w e s h -> String)
-> ([ContractResponse w e s h] -> ShowS)
-> Show (ContractResponse w e s h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w e s h.
(Show s, Show w, Show h, Show e) =>
Int -> ContractResponse w e s h -> ShowS
forall w e s h.
(Show s, Show w, Show h, Show e) =>
[ContractResponse w e s h] -> ShowS
forall w e s h.
(Show s, Show w, Show h, Show e) =>
ContractResponse w e s h -> String
showList :: [ContractResponse w e s h] -> ShowS
$cshowList :: forall w e s h.
(Show s, Show w, Show h, Show e) =>
[ContractResponse w e s h] -> ShowS
show :: ContractResponse w e s h -> String
$cshow :: forall w e s h.
(Show s, Show w, Show h, Show e) =>
ContractResponse w e s h -> String
showsPrec :: Int -> ContractResponse w e s h -> ShowS
$cshowsPrec :: forall w e s h.
(Show s, Show w, Show h, Show e) =>
Int -> ContractResponse w e s h -> ShowS
Show, a -> ContractResponse w e s b -> ContractResponse w e s a
(a -> b) -> ContractResponse w e s a -> ContractResponse w e s b
(forall a b.
 (a -> b) -> ContractResponse w e s a -> ContractResponse w e s b)
-> (forall a b.
    a -> ContractResponse w e s b -> ContractResponse w e s a)
-> Functor (ContractResponse w e s)
forall a b.
a -> ContractResponse w e s b -> ContractResponse w e s a
forall a b.
(a -> b) -> ContractResponse w e s a -> ContractResponse w e s b
forall w e s a b.
a -> ContractResponse w e s b -> ContractResponse w e s a
forall w e s a b.
(a -> b) -> ContractResponse w e s a -> ContractResponse w e s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ContractResponse w e s b -> ContractResponse w e s a
$c<$ :: forall w e s a b.
a -> ContractResponse w e s b -> ContractResponse w e s a
fmap :: (a -> b) -> ContractResponse w e s a -> ContractResponse w e s b
$cfmap :: forall w e s a b.
(a -> b) -> ContractResponse w e s a -> ContractResponse w e s b
Functor)
    deriving anyclass ([ContractResponse w e s h] -> Encoding
[ContractResponse w e s h] -> Value
ContractResponse w e s h -> Encoding
ContractResponse w e s h -> Value
(ContractResponse w e s h -> Value)
-> (ContractResponse w e s h -> Encoding)
-> ([ContractResponse w e s h] -> Value)
-> ([ContractResponse w e s h] -> Encoding)
-> ToJSON (ContractResponse w e s h)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
[ContractResponse w e s h] -> Encoding
forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
[ContractResponse w e s h] -> Value
forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
ContractResponse w e s h -> Encoding
forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
ContractResponse w e s h -> Value
toEncodingList :: [ContractResponse w e s h] -> Encoding
$ctoEncodingList :: forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
[ContractResponse w e s h] -> Encoding
toJSONList :: [ContractResponse w e s h] -> Value
$ctoJSONList :: forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
[ContractResponse w e s h] -> Value
toEncoding :: ContractResponse w e s h -> Encoding
$ctoEncoding :: forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
ContractResponse w e s h -> Encoding
toJSON :: ContractResponse w e s h -> Value
$ctoJSON :: forall w e s h.
(ToJSON e, ToJSON h, ToJSON s, ToJSON w) =>
ContractResponse w e s h -> Value
ToJSON, Value -> Parser [ContractResponse w e s h]
Value -> Parser (ContractResponse w e s h)
(Value -> Parser (ContractResponse w e s h))
-> (Value -> Parser [ContractResponse w e s h])
-> FromJSON (ContractResponse w e s h)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall w e s h.
(FromJSON s, FromJSON w, FromJSON h, FromJSON e) =>
Value -> Parser [ContractResponse w e s h]
forall w e s h.
(FromJSON s, FromJSON w, FromJSON h, FromJSON e) =>
Value -> Parser (ContractResponse w e s h)
parseJSONList :: Value -> Parser [ContractResponse w e s h]
$cparseJSONList :: forall w e s h.
(FromJSON s, FromJSON w, FromJSON h, FromJSON e) =>
Value -> Parser [ContractResponse w e s h]
parseJSON :: Value -> Parser (ContractResponse w e s h)
$cparseJSON :: forall w e s h.
(FromJSON s, FromJSON w, FromJSON h, FromJSON e) =>
Value -> Parser (ContractResponse w e s h)
FromJSON)

instance Bifunctor (ContractResponse w e) where
    bimap :: (a -> b)
-> (c -> d) -> ContractResponse w e a c -> ContractResponse w e b d
bimap a -> b
f c -> d
g c :: ContractResponse w e a c
c@ContractResponse{State w (CheckpointKey, a)
newState :: State w (CheckpointKey, a)
newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
newState} =
        (c -> d) -> ContractResponse w e b c -> ContractResponse w e b d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g ContractResponse w e a c
c{ newState :: State w (CheckpointKey, b)
newState = ((CheckpointKey, a) -> (CheckpointKey, b))
-> State w (CheckpointKey, a) -> State w (CheckpointKey, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (CheckpointKey, a) -> (CheckpointKey, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) State w (CheckpointKey, a)
newState }

mapE :: forall e f w s h. (e -> f) -> ContractResponse w e s h -> ContractResponse w f s h
mapE :: (e -> f) -> ContractResponse w e s h -> ContractResponse w f s h
mapE e -> f
f c :: ContractResponse w e s h
c@ContractResponse{Maybe e
err :: Maybe e
err :: forall w e s h. ContractResponse w e s h -> Maybe e
err} = ContractResponse w e s h
c{err :: Maybe f
err = (e -> f) -> Maybe e -> Maybe f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> f
f Maybe e
err}

mapW :: forall w q e s h. (w -> q) -> ContractResponse w e s h -> ContractResponse q e s h
mapW :: (w -> q) -> ContractResponse w e s h -> ContractResponse q e s h
mapW w -> q
f c :: ContractResponse w e s h
c@ContractResponse{w
lastState :: w
lastState :: forall w e s h. ContractResponse w e s h -> w
lastState, State w (CheckpointKey, s)
newState :: State w (CheckpointKey, s)
newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
newState} = ContractResponse w e s h
c{lastState :: q
lastState = w -> q
f w
lastState, newState :: State q (CheckpointKey, s)
newState = (w -> q)
-> State w (CheckpointKey, s) -> State q (CheckpointKey, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first w -> q
f State w (CheckpointKey, s)
newState}

-- | Run one step of the contract by restoring it to its previous state and
--   feeding it a single new 'Response' event.
insertAndUpdateContract ::
    forall w s e a.
    (Monoid w)
    => Contract w s e a -- ^ The 'Contract' with schema @s@ error type @e@.
    -> ContractRequest w PABResp -- ^  The 'ContractRequest' value with the previous state and the new event.
    -> ContractResponse w e PABResp PABReq
insertAndUpdateContract :: Contract w s e a
-> ContractRequest w PABResp -> ContractResponse w e PABResp PABReq
insertAndUpdateContract (Contract Eff (ContractEffs w e) a
con) ContractRequest{oldState :: forall w s. ContractRequest w s -> State w (CheckpointKey, s)
oldState=State Responses (CheckpointKey, PABResp)
record CheckpointStore
checkpoints w
oldW, Response PABResp
event :: Response PABResp
event :: forall w s. ContractRequest w s -> Response s
event} =
    w
-> ResumableResult w e PABResp PABReq a
-> ContractResponse w e PABResp PABReq
forall w e s h a.
Monoid w =>
w -> ResumableResult w e s h a -> ContractResponse w e s h
mkResponse
        w
oldW
        (ResumableResult w e PABResp PABReq a
 -> ContractResponse w e PABResp PABReq)
-> ResumableResult w e PABResp PABReq a
-> ContractResponse w e PABResp PABReq
forall a b. (a -> b) -> a -> b
$ ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
forall w e i o a.
ResumableResult w e i o a -> ResumableResult w e i o a
shrinkResumableResult
        (ResumableResult w e PABResp PABReq a
 -> ResumableResult w e PABResp PABReq a)
-> ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
forall a b. (a -> b) -> a -> b
$ Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses (CheckpointKey, PABResp)
-> Response PABResp
-> ResumableResult w e PABResp PABReq a
forall w e a.
Monoid w =>
Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses (CheckpointKey, PABResp)
-> Response PABResp
-> ResumableResult w e PABResp PABReq a
insertAndUpdate Eff (ContractEffs w e) a
con CheckpointStore
checkpoints Responses (CheckpointKey, PABResp)
record Response PABResp
event

mkResponse :: forall w e s h a.
    Monoid w
    => w
    -> ResumableResult w e s h a
    -> ContractResponse w e s h
mkResponse :: w -> ResumableResult w e s h a -> ContractResponse w e s h
mkResponse w
oldW ResumableResult{Responses (CheckpointKey, s)
_responses :: forall w e i o a.
ResumableResult w e i o a -> Responses (CheckpointKey, i)
_responses :: Responses (CheckpointKey, s)
_responses, _requests :: forall w e i o a. ResumableResult w e i o a -> Requests o
_requests=Requests{[Request h]
unRequests :: forall o. Requests o -> [Request o]
unRequests :: [Request h]
unRequests},CheckpointStore
_checkpointStore :: forall w e i o a. ResumableResult w e i o a -> CheckpointStore
_checkpointStore :: CheckpointStore
_checkpointStore, Seq (LogMessage Value)
_logs :: forall w e i o a.
ResumableResult w e i o a -> Seq (LogMessage Value)
_logs :: Seq (LogMessage Value)
_logs, Seq (LogMessage Value)
_lastLogs :: forall w e i o a.
ResumableResult w e i o a -> Seq (LogMessage Value)
_lastLogs :: Seq (LogMessage Value)
_lastLogs, Either e (Maybe a)
_finalState :: forall w e i o a. ResumableResult w e i o a -> Either e (Maybe a)
_finalState :: Either e (Maybe a)
_finalState, _lastState :: forall w e i o a. ResumableResult w e i o a -> w
_lastState=w
lastState} =
    ContractResponse :: forall w e s h.
State w (CheckpointKey, s)
-> [Request h]
-> [LogMessage Value]
-> [LogMessage Value]
-> Maybe e
-> w
-> ContractResponse w e s h
ContractResponse
        { hooks :: [Request h]
hooks = [Request h]
unRequests
        , newState :: State w (CheckpointKey, s)
newState = State :: forall w e. Responses e -> CheckpointStore -> w -> State w e
State { record :: Responses (CheckpointKey, s)
record = Responses (CheckpointKey, s)
_responses, checkpoints :: CheckpointStore
checkpoints=CheckpointStore
_checkpointStore, observableState :: w
observableState = w
oldW w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
lastState }
        , logs :: [LogMessage Value]
logs = Seq (LogMessage Value) -> [LogMessage Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (LogMessage Value)
_logs
        , lastLogs :: [LogMessage Value]
lastLogs = Seq (LogMessage Value) -> [LogMessage Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (LogMessage Value)
_lastLogs
        , err :: Maybe e
err = (e -> Maybe e)
-> (Maybe a -> Maybe e) -> Either e (Maybe a) -> Maybe e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Maybe e
forall a. a -> Maybe a
Just (Maybe e -> Maybe a -> Maybe e
forall a b. a -> b -> a
const Maybe e
forall a. Maybe a
Nothing) Either e (Maybe a)
_finalState
        , w
lastState :: w
lastState :: w
lastState
        }

-- | The 'ContractResponse' with the initial state of the contract.
initialiseContract ::
    forall w s e a.
    (Monoid w)
    => Contract w s e a
    -> ContractResponse w e PABResp PABReq
initialiseContract :: Contract w s e a -> ContractResponse w e PABResp PABReq
initialiseContract (Contract Eff (ContractEffs w e) a
c) = w
-> ResumableResult w e PABResp PABReq a
-> ContractResponse w e PABResp PABReq
forall w e s h a.
Monoid w =>
w -> ResumableResult w e s h a -> ContractResponse w e s h
mkResponse w
forall a. Monoid a => a
mempty (ResumableResult w e PABResp PABReq a
 -> ContractResponse w e PABResp PABReq)
-> ResumableResult w e PABResp PABReq a
-> ContractResponse w e PABResp PABReq
forall a b. (a -> b) -> a -> b
$ [Response PABResp]
-> CheckpointStore
-> Eff (ContractEffs w e) a
-> ResumableResult w e PABResp PABReq a
forall w e a.
Monoid w =>
[Response PABResp]
-> CheckpointStore
-> Eff (ContractEffs w e) a
-> ResumableResult w e PABResp PABReq a
runResumable [] CheckpointStore
forall a. Monoid a => a
mempty Eff (ContractEffs w e) a
c