{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DeriveAnyClass         #-}
{-# LANGUAGE DerivingStrategies     #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE NamedFieldPuns         #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE TupleSections          #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeOperators          #-}
module Plutus.Contract.Types(
    ContractEffs
    , handleContractEffs
    , Contract(..)
    , IsContract(..)
    -- * Select
    , Promise(..)
    , promiseBind
    , promiseMap
    , select
    , selectEither
    , selectList
    , never
    -- * Error handling
    , Plutus.Contract.Error.ContractError(..)
    , Plutus.Contract.Error.AsContractError(..)
    , Plutus.Contract.Error.MatchingError(..)
    , mapError
    , throwError
    , runError
    , handleError
    -- * Checkpoints
    , AsCheckpointError(..)
    , CheckpointError(..)
    , checkpoint
    , checkpointLoop
    -- * Run and update
    , runResumable
    , insertAndUpdate
    , runWithRecord
    -- * State
    , ResumableResult(..)
    , responses
    , requests
    , finalState
    , logs
    , lastState
    , checkpointStore
    , observableState
    , shrinkResumableResult
    -- * Run with continuations
    , SuspendedContract(..)
    , resumableResult
    , continuations
    , checkpointKey
    , suspend
    , runStep
    , lastLogs
    ) where

import Control.Lens (Bifunctor (bimap), Iso', iso, makeLenses, over, set, to, unto, view, (&), (.~), (^.))
import Control.Monad.Except (MonadError (catchError, throwError))
import Control.Monad.Freer (Eff, Member, interpret, reinterpret, run, send, subsume, type (~>))
import Control.Monad.Freer.Error (Error)
import Control.Monad.Freer.Error qualified as E
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, handleLogIgnore, handleLogWriter)
import Control.Monad.Freer.Extras.Modify (raiseEnd, raiseUnder, writeIntoState)
import Control.Monad.Freer.State (State, get, put, runState)
import Control.Monad.Freer.Writer (Writer)
import Control.Monad.Freer.Writer qualified as W
import Data.Aeson (Value)
import Data.Aeson qualified as Aeson
import Data.Either (fromRight)
import Data.Foldable (foldl')
import Data.Functor.Apply (Apply, liftF2)
import Data.IntervalSet qualified as IS
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Row (Row)
import Data.Sequence (Seq)
import GHC.Generics (Generic)

import Plutus.Contract.Checkpoint (AsCheckpointError (_CheckpointError),
                                   Checkpoint (AllocateKey, DoCheckpoint, Retrieve, Store),
                                   CheckpointError (JSONDecodeError), CheckpointKey, CheckpointLogMsg, CheckpointStore,
                                   completedIntervals, handleCheckpoint, jsonCheckpoint, jsonCheckpointLoop)
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Error qualified
import Plutus.Contract.Resumable (IterationID, MultiRequestContStatus (AContinuation, AResult),
                                  MultiRequestContinuation (MultiRequestContinuation, ndcCont, ndcRequests), RequestID,
                                  Requests, Response, Responses, Resumable, _Responses, handleResumable, insertResponse,
                                  suspendNonDet)
import Plutus.Contract.Resumable qualified as Resumable
import PlutusTx.Applicative qualified as PlutusTx
import PlutusTx.Functor qualified as PlutusTx
import Prelude as Haskell

-- | Effects that are available to contracts.
type ContractEffs w e =
    '[ Error e
    ,  LogMsg Value
    ,  Writer w
    ,  Checkpoint
    ,  Resumable PABResp PABReq
    ]

type ContractEnv = (IterationID, RequestID)

newtype AccumState w = AccumState { AccumState w -> w
unAccumState :: w }
  deriving stock (AccumState w -> AccumState w -> Bool
(AccumState w -> AccumState w -> Bool)
-> (AccumState w -> AccumState w -> Bool) -> Eq (AccumState w)
forall w. Eq w => AccumState w -> AccumState w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccumState w -> AccumState w -> Bool
$c/= :: forall w. Eq w => AccumState w -> AccumState w -> Bool
== :: AccumState w -> AccumState w -> Bool
$c== :: forall w. Eq w => AccumState w -> AccumState w -> Bool
Eq, Eq (AccumState w)
Eq (AccumState w)
-> (AccumState w -> AccumState w -> Ordering)
-> (AccumState w -> AccumState w -> Bool)
-> (AccumState w -> AccumState w -> Bool)
-> (AccumState w -> AccumState w -> Bool)
-> (AccumState w -> AccumState w -> Bool)
-> (AccumState w -> AccumState w -> AccumState w)
-> (AccumState w -> AccumState w -> AccumState w)
-> Ord (AccumState w)
AccumState w -> AccumState w -> Bool
AccumState w -> AccumState w -> Ordering
AccumState w -> AccumState w -> AccumState w
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w. Ord w => Eq (AccumState w)
forall w. Ord w => AccumState w -> AccumState w -> Bool
forall w. Ord w => AccumState w -> AccumState w -> Ordering
forall w. Ord w => AccumState w -> AccumState w -> AccumState w
min :: AccumState w -> AccumState w -> AccumState w
$cmin :: forall w. Ord w => AccumState w -> AccumState w -> AccumState w
max :: AccumState w -> AccumState w -> AccumState w
$cmax :: forall w. Ord w => AccumState w -> AccumState w -> AccumState w
>= :: AccumState w -> AccumState w -> Bool
$c>= :: forall w. Ord w => AccumState w -> AccumState w -> Bool
> :: AccumState w -> AccumState w -> Bool
$c> :: forall w. Ord w => AccumState w -> AccumState w -> Bool
<= :: AccumState w -> AccumState w -> Bool
$c<= :: forall w. Ord w => AccumState w -> AccumState w -> Bool
< :: AccumState w -> AccumState w -> Bool
$c< :: forall w. Ord w => AccumState w -> AccumState w -> Bool
compare :: AccumState w -> AccumState w -> Ordering
$ccompare :: forall w. Ord w => AccumState w -> AccumState w -> Ordering
$cp1Ord :: forall w. Ord w => Eq (AccumState w)
Ord, Int -> AccumState w -> ShowS
[AccumState w] -> ShowS
AccumState w -> String
(Int -> AccumState w -> ShowS)
-> (AccumState w -> String)
-> ([AccumState w] -> ShowS)
-> Show (AccumState w)
forall w. Show w => Int -> AccumState w -> ShowS
forall w. Show w => [AccumState w] -> ShowS
forall w. Show w => AccumState w -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccumState w] -> ShowS
$cshowList :: forall w. Show w => [AccumState w] -> ShowS
show :: AccumState w -> String
$cshow :: forall w. Show w => AccumState w -> String
showsPrec :: Int -> AccumState w -> ShowS
$cshowsPrec :: forall w. Show w => Int -> AccumState w -> ShowS
Show)
  deriving newtype (b -> AccumState w -> AccumState w
NonEmpty (AccumState w) -> AccumState w
AccumState w -> AccumState w -> AccumState w
(AccumState w -> AccumState w -> AccumState w)
-> (NonEmpty (AccumState w) -> AccumState w)
-> (forall b. Integral b => b -> AccumState w -> AccumState w)
-> Semigroup (AccumState w)
forall b. Integral b => b -> AccumState w -> AccumState w
forall w. Semigroup w => NonEmpty (AccumState w) -> AccumState w
forall w.
Semigroup w =>
AccumState w -> AccumState w -> AccumState w
forall w b.
(Semigroup w, Integral b) =>
b -> AccumState w -> AccumState w
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> AccumState w -> AccumState w
$cstimes :: forall w b.
(Semigroup w, Integral b) =>
b -> AccumState w -> AccumState w
sconcat :: NonEmpty (AccumState w) -> AccumState w
$csconcat :: forall w. Semigroup w => NonEmpty (AccumState w) -> AccumState w
<> :: AccumState w -> AccumState w -> AccumState w
$c<> :: forall w.
Semigroup w =>
AccumState w -> AccumState w -> AccumState w
Semigroup, Semigroup (AccumState w)
AccumState w
Semigroup (AccumState w)
-> AccumState w
-> (AccumState w -> AccumState w -> AccumState w)
-> ([AccumState w] -> AccumState w)
-> Monoid (AccumState w)
[AccumState w] -> AccumState w
AccumState w -> AccumState w -> AccumState w
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall w. Monoid w => Semigroup (AccumState w)
forall w. Monoid w => AccumState w
forall w. Monoid w => [AccumState w] -> AccumState w
forall w. Monoid w => AccumState w -> AccumState w -> AccumState w
mconcat :: [AccumState w] -> AccumState w
$cmconcat :: forall w. Monoid w => [AccumState w] -> AccumState w
mappend :: AccumState w -> AccumState w -> AccumState w
$cmappend :: forall w. Monoid w => AccumState w -> AccumState w -> AccumState w
mempty :: AccumState w
$cmempty :: forall w. Monoid w => AccumState w
$cp1Monoid :: forall w. Monoid w => Semigroup (AccumState w)
Monoid, [AccumState w] -> Encoding
[AccumState w] -> Value
AccumState w -> Encoding
AccumState w -> Value
(AccumState w -> Value)
-> (AccumState w -> Encoding)
-> ([AccumState w] -> Value)
-> ([AccumState w] -> Encoding)
-> ToJSON (AccumState w)
forall w. ToJSON w => [AccumState w] -> Encoding
forall w. ToJSON w => [AccumState w] -> Value
forall w. ToJSON w => AccumState w -> Encoding
forall w. ToJSON w => AccumState w -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AccumState w] -> Encoding
$ctoEncodingList :: forall w. ToJSON w => [AccumState w] -> Encoding
toJSONList :: [AccumState w] -> Value
$ctoJSONList :: forall w. ToJSON w => [AccumState w] -> Value
toEncoding :: AccumState w -> Encoding
$ctoEncoding :: forall w. ToJSON w => AccumState w -> Encoding
toJSON :: AccumState w -> Value
$ctoJSON :: forall w. ToJSON w => AccumState w -> Value
Aeson.ToJSON, Value -> Parser [AccumState w]
Value -> Parser (AccumState w)
(Value -> Parser (AccumState w))
-> (Value -> Parser [AccumState w]) -> FromJSON (AccumState w)
forall w. FromJSON w => Value -> Parser [AccumState w]
forall w. FromJSON w => Value -> Parser (AccumState w)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AccumState w]
$cparseJSONList :: forall w. FromJSON w => Value -> Parser [AccumState w]
parseJSON :: Value -> Parser (AccumState w)
$cparseJSON :: forall w. FromJSON w => Value -> Parser (AccumState w)
Aeson.FromJSON)

_AccumState :: forall w. Iso' (AccumState w) w
_AccumState :: p w (f w) -> p (AccumState w) (f (AccumState w))
_AccumState = (AccumState w -> w)
-> (w -> AccumState w) -> Iso (AccumState w) (AccumState w) w w
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso AccumState w -> w
forall w. AccumState w -> w
unAccumState w -> AccumState w
forall w. w -> AccumState w
AccumState

handleContractEffs ::
  forall w e effs a.
  ( Member (Error e) effs
  , Member (State CheckpointStore) effs
  , Member (State CheckpointKey) effs
  , Member (State (AccumState w)) effs
  , Member (LogMsg CheckpointLogMsg) effs
  , Member (LogMsg Value) effs
  , Monoid w
  )
  => Eff (ContractEffs w e) a
  -> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a))
handleContractEffs :: Eff (ContractEffs w e) a
-> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a))
handleContractEffs =
  Eff (Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a) a
-> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a))
forall i o a (effs :: [* -> *]).
Eff (Yield o i : ResumableEffs i o effs a) a
-> Eff effs (Maybe (MultiRequestContStatus i o effs a))
suspendNonDet @PABResp @PABReq @a @effs
  (Eff (Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a) a
 -> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a)))
-> (Eff (ContractEffs w e) a
    -> Eff
         (Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a) a)
-> Eff (ContractEffs w e) a
-> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
(Member (Yield PABReq PABResp) effs, Member NonDet effs) =>
Eff (Resumable PABResp PABReq : effs) ~> Eff effs
forall i o (effs :: [* -> *]).
(Member (Yield o i) effs, Member NonDet effs) =>
Eff (Resumable i o : effs) ~> Eff effs
handleResumable @PABResp @PABReq
  (Eff
   (Resumable PABResp PABReq
      : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a) a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (Resumable PABResp PABReq
            : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  (Checkpoint
     : Resumable PABResp PABReq : Yield PABReq PABResp
     : ResumableEffs PABResp PABReq effs a)
  a
-> Eff
     (Resumable PABResp PABReq
        : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
     a
forall (effs :: [* -> *]).
(Member (State CheckpointStore) effs,
 Member (State CheckpointKey) effs,
 Member (LogMsg CheckpointLogMsg) effs) =>
Eff (Checkpoint : effs) ~> Eff effs
handleCheckpoint
  (Eff
   (Checkpoint
      : Resumable PABResp PABReq : Yield PABReq PABResp
      : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (Resumable PABResp PABReq
         : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
      a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (Checkpoint
            : Resumable PABResp PABReq : Yield PABReq PABResp
            : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (Resumable PABResp PABReq
        : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  (Checkpoint
     : Resumable PABResp PABReq : Yield PABReq PABResp
     : ResumableEffs PABResp PABReq effs a)
  a
-> Eff
     (Checkpoint
        : Resumable PABResp PABReq : Yield PABReq PABResp
        : ResumableEffs PABResp PABReq effs a)
     a
forall (effs :: [* -> *]).
(Member (State RequestID) effs, Member (State IterationID) effs) =>
Eff (Checkpoint : effs) ~> Eff (Checkpoint : effs)
addEnvToCheckpoint
  (Eff
   (Checkpoint
      : Resumable PABResp PABReq : Yield PABReq PABResp
      : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (Checkpoint
         : Resumable PABResp PABReq : Yield PABReq PABResp
         : ResumableEffs PABResp PABReq effs a)
      a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (Checkpoint
            : Resumable PABResp PABReq : Yield PABReq PABResp
            : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (Checkpoint
        : Resumable PABResp PABReq : Yield PABReq PABResp
        : ResumableEffs PABResp PABReq effs a)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Writer w
 ~> Eff
      (Checkpoint
         : Resumable PABResp PABReq : Yield PABReq PABResp
         : ResumableEffs PABResp PABReq effs a))
-> Eff
     (Writer w
        : Checkpoint : Resumable PABResp PABReq : Yield PABReq PABResp
        : ResumableEffs PABResp PABReq effs a)
   ~> Eff
        (Checkpoint
           : Resumable PABResp PABReq : Yield PABReq PABResp
           : ResumableEffs PABResp PABReq effs a)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret @(Writer w) (Setter' (AccumState w) w
-> Writer w
   ~> Eff
        (Checkpoint
           : Resumable PABResp PABReq : Yield PABReq PABResp
           : ResumableEffs PABResp PABReq effs a)
forall s1 s2 (effs :: [* -> *]).
(Monoid s1, Member (State s2) effs) =>
Setter' s2 s1 -> Writer s1 ~> Eff effs
writeIntoState forall w. Iso' (AccumState w) w
Setter' (AccumState w) w
_AccumState)
  (Eff
   (Writer w
      : Checkpoint : Resumable PABResp PABReq : Yield PABReq PABResp
      : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (Checkpoint
         : Resumable PABResp PABReq : Yield PABReq PABResp
         : ResumableEffs PABResp PABReq effs a)
      a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (Writer w
            : Checkpoint : Resumable PABResp PABReq : Yield PABReq PABResp
            : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (Checkpoint
        : Resumable PABResp PABReq : Yield PABReq PABResp
        : ResumableEffs PABResp PABReq effs a)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
Member (LogMsg Value) effs =>
Eff (LogMsg Value : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume @(LogMsg Value)
  (Eff
   (LogMsg Value
      : Writer w : Checkpoint : Resumable PABResp PABReq
      : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (Writer w
         : Checkpoint : Resumable PABResp PABReq : Yield PABReq PABResp
         : ResumableEffs PABResp PABReq effs a)
      a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (LogMsg Value
            : Writer w : Checkpoint : Resumable PABResp PABReq
            : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (Writer w
        : Checkpoint : Resumable PABResp PABReq : Yield PABReq PABResp
        : ResumableEffs PABResp PABReq effs a)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
Member (Error e) effs =>
Eff (Error e : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume @(Error e)
  (Eff
   (Error e
      : LogMsg Value : Writer w : Checkpoint : Resumable PABResp PABReq
      : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
   a
 -> Eff
      (LogMsg Value
         : Writer w : Checkpoint : Resumable PABResp PABReq
         : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
      a)
-> (Eff (ContractEffs w e) a
    -> Eff
         (Error e
            : LogMsg Value : Writer w : Checkpoint : Resumable PABResp PABReq
            : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
         a)
-> Eff (ContractEffs w e) a
-> Eff
     (LogMsg Value
        : Writer w : Checkpoint : Resumable PABResp PABReq
        : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (ContractEffs w e) a
-> Eff
     (Error e
        : LogMsg Value : Writer w : Checkpoint : Resumable PABResp PABReq
        : Yield PABReq PABResp : ResumableEffs PABResp PABReq effs a)
     a
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd

getContractEnv ::
  forall effs.
  ( Member (State RequestID) effs
  , Member (State IterationID) effs
  )
  => Eff effs ContractEnv
getContractEnv :: Eff effs ContractEnv
getContractEnv = (,) (IterationID -> RequestID -> ContractEnv)
-> Eff effs IterationID -> Eff effs (RequestID -> ContractEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff effs IterationID
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get Eff effs (RequestID -> ContractEnv)
-> Eff effs RequestID -> Eff effs ContractEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff effs RequestID
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get

putContractEnv ::
  forall effs.
  ( Member (State RequestID) effs
  , Member (State IterationID) effs
  )
  => ContractEnv
  -> Eff effs ()
putContractEnv :: ContractEnv -> Eff effs ()
putContractEnv (IterationID
it, RequestID
req) = IterationID -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put IterationID
it Eff effs () -> Eff effs () -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RequestID -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put RequestID
req

addEnvToCheckpoint ::
  forall effs.
  ( Member (State RequestID) effs
  , Member (State IterationID) effs
  )
  => Eff (Checkpoint ': effs)
  ~> Eff (Checkpoint ': effs)
addEnvToCheckpoint :: Eff (Checkpoint : effs) ~> Eff (Checkpoint : effs)
addEnvToCheckpoint = (Checkpoint ~> Eff (Checkpoint : effs))
-> Eff (Checkpoint : effs) ~> Eff (Checkpoint : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret @Checkpoint @Checkpoint @effs ((Checkpoint ~> Eff (Checkpoint : effs))
 -> Eff (Checkpoint : effs) ~> Eff (Checkpoint : effs))
-> (Checkpoint ~> Eff (Checkpoint : effs))
-> Eff (Checkpoint : effs) ~> Eff (Checkpoint : effs)
forall a b. (a -> b) -> a -> b
$ \case
  Checkpoint x
DoCheckpoint -> Checkpoint () -> Eff (Checkpoint : effs) ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send Checkpoint ()
DoCheckpoint
  Checkpoint x
AllocateKey -> Checkpoint CheckpointKey -> Eff (Checkpoint : effs) CheckpointKey
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send Checkpoint CheckpointKey
AllocateKey
  Store CheckpointKey
k CheckpointKey
k' a
a -> do
    ContractEnv
env <- Eff (Checkpoint : effs) ContractEnv
forall (effs :: [* -> *]).
(Member (State RequestID) effs, Member (State IterationID) effs) =>
Eff effs ContractEnv
getContractEnv
    Checkpoint () -> Eff (Checkpoint : effs) ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (Checkpoint () -> Eff (Checkpoint : effs) ())
-> Checkpoint () -> Eff (Checkpoint : effs) ()
forall a b. (a -> b) -> a -> b
$ CheckpointKey -> CheckpointKey -> (ContractEnv, a) -> Checkpoint ()
forall a.
ToJSON a =>
CheckpointKey -> CheckpointKey -> a -> Checkpoint ()
Store CheckpointKey
k CheckpointKey
k' (ContractEnv
env, a
a)
  Retrieve CheckpointKey
k -> do
    Either CheckpointError (Maybe (ContractEnv, a))
result <- Checkpoint (Either CheckpointError (Maybe (ContractEnv, a)))
-> Eff
     (Checkpoint : effs)
     (Either CheckpointError (Maybe (ContractEnv, a)))
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (Checkpoint (Either CheckpointError (Maybe (ContractEnv, a)))
 -> Eff
      (Checkpoint : effs)
      (Either CheckpointError (Maybe (ContractEnv, a))))
-> Checkpoint (Either CheckpointError (Maybe (ContractEnv, a)))
-> Eff
     (Checkpoint : effs)
     (Either CheckpointError (Maybe (ContractEnv, a)))
forall a b. (a -> b) -> a -> b
$ CheckpointKey
-> Checkpoint (Either CheckpointError (Maybe (ContractEnv, a)))
forall a.
FromJSON a =>
CheckpointKey -> Checkpoint (Either CheckpointError (Maybe a))
Retrieve @(ContractEnv, _) CheckpointKey
k
    case Either CheckpointError (Maybe (ContractEnv, a))
result of
      Right (Just (ContractEnv
env, a
a)) -> do
        ContractEnv -> Eff (Checkpoint : effs) ()
forall (effs :: [* -> *]).
(Member (State RequestID) effs, Member (State IterationID) effs) =>
ContractEnv -> Eff effs ()
putContractEnv ContractEnv
env
        Either CheckpointError (Maybe a)
-> Eff (Checkpoint : effs) (Either CheckpointError (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Either CheckpointError (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
      Left CheckpointError
err -> do
        Either CheckpointError (Maybe a)
-> Eff (Checkpoint : effs) (Either CheckpointError (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckpointError -> Either CheckpointError (Maybe a)
forall a b. a -> Either a b
Left CheckpointError
err)
      Right Maybe (ContractEnv, a)
Nothing -> do
        Either CheckpointError (Maybe a)
-> Eff (Checkpoint : effs) (Either CheckpointError (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Either CheckpointError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)

-- | @Contract w s e a@ is a contract with schema 's', producing a value of
--  type 'a' or an error 'e'. See note [Contract Schema].
--
newtype Contract w (s :: Row *) e a = Contract { Contract w s e a -> Eff (ContractEffs w e) a
unContract :: Eff (ContractEffs w e) a }
  deriving newtype (a -> Contract w s e b -> Contract w s e a
(a -> b) -> Contract w s e a -> Contract w s e b
(forall a b. (a -> b) -> Contract w s e a -> Contract w s e b)
-> (forall a b. a -> Contract w s e b -> Contract w s e a)
-> Functor (Contract w s e)
forall a b. a -> Contract w s e b -> Contract w s e a
forall a b. (a -> b) -> Contract w s e a -> Contract w s e b
forall w (s :: Row *) e a b.
a -> Contract w s e b -> Contract w s e a
forall w (s :: Row *) e a b.
(a -> b) -> Contract w s e a -> Contract w s e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Contract w s e b -> Contract w s e a
$c<$ :: forall w (s :: Row *) e a b.
a -> Contract w s e b -> Contract w s e a
fmap :: (a -> b) -> Contract w s e a -> Contract w s e b
$cfmap :: forall w (s :: Row *) e a b.
(a -> b) -> Contract w s e a -> Contract w s e b
Functor, Functor (Contract w s e)
a -> Contract w s e a
Functor (Contract w s e)
-> (forall a. a -> Contract w s e a)
-> (forall a b.
    Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b)
-> (forall a b c.
    (a -> b -> c)
    -> Contract w s e a -> Contract w s e b -> Contract w s e c)
-> (forall a b.
    Contract w s e a -> Contract w s e b -> Contract w s e b)
-> (forall a b.
    Contract w s e a -> Contract w s e b -> Contract w s e a)
-> Applicative (Contract w s e)
Contract w s e a -> Contract w s e b -> Contract w s e b
Contract w s e a -> Contract w s e b -> Contract w s e a
Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
(a -> b -> c)
-> Contract w s e a -> Contract w s e b -> Contract w s e c
forall a. a -> Contract w s e a
forall a b.
Contract w s e a -> Contract w s e b -> Contract w s e a
forall a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
forall a b.
Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
forall a b c.
(a -> b -> c)
-> Contract w s e a -> Contract w s e b -> Contract w s e c
forall w (s :: Row *) e. Functor (Contract w s e)
forall w (s :: Row *) e a. a -> Contract w s e a
forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e a
forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
forall w (s :: Row *) e a b.
Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
forall w (s :: Row *) e a b c.
(a -> b -> c)
-> Contract w s e a -> Contract w s e b -> Contract w s e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Contract w s e a -> Contract w s e b -> Contract w s e a
$c<* :: forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e a
*> :: Contract w s e a -> Contract w s e b -> Contract w s e b
$c*> :: forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
liftA2 :: (a -> b -> c)
-> Contract w s e a -> Contract w s e b -> Contract w s e c
$cliftA2 :: forall w (s :: Row *) e a b c.
(a -> b -> c)
-> Contract w s e a -> Contract w s e b -> Contract w s e c
<*> :: Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
$c<*> :: forall w (s :: Row *) e a b.
Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
pure :: a -> Contract w s e a
$cpure :: forall w (s :: Row *) e a. a -> Contract w s e a
$cp1Applicative :: forall w (s :: Row *) e. Functor (Contract w s e)
Applicative, Applicative (Contract w s e)
a -> Contract w s e a
Applicative (Contract w s e)
-> (forall a b.
    Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b)
-> (forall a b.
    Contract w s e a -> Contract w s e b -> Contract w s e b)
-> (forall a. a -> Contract w s e a)
-> Monad (Contract w s e)
Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
Contract w s e a -> Contract w s e b -> Contract w s e b
forall a. a -> Contract w s e a
forall a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
forall a b.
Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
forall w (s :: Row *) e. Applicative (Contract w s e)
forall w (s :: Row *) e a. a -> Contract w s e a
forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
forall w (s :: Row *) e a b.
Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Contract w s e a
$creturn :: forall w (s :: Row *) e a. a -> Contract w s e a
>> :: Contract w s e a -> Contract w s e b -> Contract w s e b
$c>> :: forall w (s :: Row *) e a b.
Contract w s e a -> Contract w s e b -> Contract w s e b
>>= :: Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
$c>>= :: forall w (s :: Row *) e a b.
Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
$cp1Monad :: forall w (s :: Row *) e. Applicative (Contract w s e)
Monad)

instance MonadError e (Contract w s e) where
    throwError :: e -> Contract w s e a
throwError = Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a -> Contract w s e a)
-> (e -> Eff (ContractEffs w e) a) -> e -> Contract w s e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Eff (ContractEffs w e) a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
E.throwError
    catchError :: Contract w s e a -> (e -> Contract w s e a) -> Contract w s e a
catchError (Contract Eff (ContractEffs w e) a
f) e -> Contract w s e a
handler =
      Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract
      (Eff (ContractEffs w e) a -> Contract w s e a)
-> Eff (ContractEffs w e) a -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ Eff (ContractEffs w e) a
-> (e -> Eff (ContractEffs w e) a) -> Eff (ContractEffs w e) a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
Eff effs a -> (e -> Eff effs a) -> Eff effs a
E.catchError Eff (ContractEffs w e) a
f
      ((e -> Eff (ContractEffs w e) a) -> Eff (ContractEffs w e) a)
-> (e -> Eff (ContractEffs w e) a) -> Eff (ContractEffs w e) a
forall a b. (a -> b) -> a -> b
$ Contract w s e a -> Eff (ContractEffs w e) a
forall w (s :: Row *) e a.
Contract w s e a -> Eff (ContractEffs w e) a
unContract (Contract w s e a -> Eff (ContractEffs w e) a)
-> (e -> Contract w s e a) -> e -> Eff (ContractEffs w e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Contract w s e a
handler

instance PlutusTx.Functor (Contract w s e) where
  fmap :: (a -> b) -> Contract w s e a -> Contract w s e b
fmap = (a -> b) -> Contract w s e a -> Contract w s e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Haskell.fmap

instance PlutusTx.Applicative (Contract w s e) where
  <*> :: Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
(<*>) = Contract w s e (a -> b) -> Contract w s e a -> Contract w s e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(Haskell.<*>)
  pure :: a -> Contract w s e a
pure  = a -> Contract w s e a
forall (f :: * -> *) a. Applicative f => a -> f a
Haskell.pure

instance Bifunctor (Contract w s) where
  bimap :: (a -> b) -> (c -> d) -> Contract w s a c -> Contract w s b d
bimap a -> b
l c -> d
r = (a -> b) -> Contract w s a d -> Contract w s b d
forall w (s :: Row *) a b c.
(a -> b) -> Contract w s a c -> Contract w s b c
mapError a -> b
l (Contract w s a d -> Contract w s b d)
-> (Contract w s a c -> Contract w s a d)
-> Contract w s a c
-> Contract w s b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> Contract w s a c -> Contract w s a d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r

instance Semigroup a => Semigroup (Contract w s e a) where
  Contract Eff (ContractEffs w e) a
ma <> :: Contract w s e a -> Contract w s e a -> Contract w s e a
<> Contract Eff (ContractEffs w e) a
ma' = Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a -> Contract w s e a)
-> Eff (ContractEffs w e) a -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a)
-> Eff (ContractEffs w e) a -> Eff (ContractEffs w e) (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (ContractEffs w e) a
ma Eff (ContractEffs w e) (a -> a)
-> Eff (ContractEffs w e) a -> Eff (ContractEffs w e) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (ContractEffs w e) a
ma'

-- | A wrapper indicating that this contract starts with a waiting action. For use with @select@.
newtype Promise w (s :: Row *) e a = Promise { Promise w s e a -> Contract w s e a
awaitPromise :: Contract w s e a }
  deriving newtype (a -> Promise w s e b -> Promise w s e a
(a -> b) -> Promise w s e a -> Promise w s e b
(forall a b. (a -> b) -> Promise w s e a -> Promise w s e b)
-> (forall a b. a -> Promise w s e b -> Promise w s e a)
-> Functor (Promise w s e)
forall a b. a -> Promise w s e b -> Promise w s e a
forall a b. (a -> b) -> Promise w s e a -> Promise w s e b
forall w (s :: Row *) e a b.
a -> Promise w s e b -> Promise w s e a
forall w (s :: Row *) e a b.
(a -> b) -> Promise w s e a -> Promise w s e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Promise w s e b -> Promise w s e a
$c<$ :: forall w (s :: Row *) e a b.
a -> Promise w s e b -> Promise w s e a
fmap :: (a -> b) -> Promise w s e a -> Promise w s e b
$cfmap :: forall w (s :: Row *) e a b.
(a -> b) -> Promise w s e a -> Promise w s e b
Functor, (a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d
(a -> b) -> Promise w s a c -> Promise w s b c
(b -> c) -> Promise w s a b -> Promise w s a c
(forall a b c d.
 (a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d)
-> (forall a b c. (a -> b) -> Promise w s a c -> Promise w s b c)
-> (forall b c a. (b -> c) -> Promise w s a b -> Promise w s a c)
-> Bifunctor (Promise w s)
forall a b c. (a -> b) -> Promise w s a c -> Promise w s b c
forall b c a. (b -> c) -> Promise w s a b -> Promise w s a c
forall a b c d.
(a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d
forall w (s :: Row *) a b c.
(a -> b) -> Promise w s a c -> Promise w s b c
forall w (s :: Row *) b c a.
(b -> c) -> Promise w s a b -> Promise w s a c
forall w (s :: Row *) a b c d.
(a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d)
-> (forall a b c. (a -> b) -> p a c -> p b c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> Bifunctor p
second :: (b -> c) -> Promise w s a b -> Promise w s a c
$csecond :: forall w (s :: Row *) b c a.
(b -> c) -> Promise w s a b -> Promise w s a c
first :: (a -> b) -> Promise w s a c -> Promise w s b c
$cfirst :: forall w (s :: Row *) a b c.
(a -> b) -> Promise w s a c -> Promise w s b c
bimap :: (a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d
$cbimap :: forall w (s :: Row *) a b c d.
(a -> b) -> (c -> d) -> Promise w s a c -> Promise w s b d
Bifunctor, b -> Promise w s e a -> Promise w s e a
NonEmpty (Promise w s e a) -> Promise w s e a
Promise w s e a -> Promise w s e a -> Promise w s e a
(Promise w s e a -> Promise w s e a -> Promise w s e a)
-> (NonEmpty (Promise w s e a) -> Promise w s e a)
-> (forall b.
    Integral b =>
    b -> Promise w s e a -> Promise w s e a)
-> Semigroup (Promise w s e a)
forall b. Integral b => b -> Promise w s e a -> Promise w s e a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall w (s :: Row *) e a.
Semigroup a =>
NonEmpty (Promise w s e a) -> Promise w s e a
forall w (s :: Row *) e a.
Semigroup a =>
Promise w s e a -> Promise w s e a -> Promise w s e a
forall w (s :: Row *) e a b.
(Semigroup a, Integral b) =>
b -> Promise w s e a -> Promise w s e a
stimes :: b -> Promise w s e a -> Promise w s e a
$cstimes :: forall w (s :: Row *) e a b.
(Semigroup a, Integral b) =>
b -> Promise w s e a -> Promise w s e a
sconcat :: NonEmpty (Promise w s e a) -> Promise w s e a
$csconcat :: forall w (s :: Row *) e a.
Semigroup a =>
NonEmpty (Promise w s e a) -> Promise w s e a
<> :: Promise w s e a -> Promise w s e a -> Promise w s e a
$c<> :: forall w (s :: Row *) e a.
Semigroup a =>
Promise w s e a -> Promise w s e a -> Promise w s e a
Semigroup)

instance Apply (Promise w s e) where
  liftF2 :: (a -> b -> c)
-> Promise w s e a -> Promise w s e b -> Promise w s e c
liftF2 a -> b -> c
f (Promise Contract w s e a
a) (Promise Contract w s e b
b) = Contract w s e c -> Promise w s e c
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (a -> b -> c
f (a -> b -> c) -> Contract w s e a -> Contract w s e (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract w s e a
a Contract w s e (b -> c) -> Contract w s e b -> Contract w s e c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Contract w s e b
b)

-- | A `Promise` that is never fulfilled. This is the identity of `select`.
never :: Promise w s e a
never :: Promise w s e a
never = Contract w s e a -> Promise w s e a
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a -> Contract w s e a)
-> Eff (ContractEffs w e) a -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Member (Resumable PABResp PABReq) effs =>
Eff effs a
forall i o (effs :: [* -> *]) a.
Member (Resumable i o) effs =>
Eff effs a
Resumable.never @PABResp @PABReq)

-- | Run more `Contract` code after the `Promise`.
promiseBind :: Promise w s e a -> (a -> Contract w s e b) -> Promise w s e b
promiseBind :: Promise w s e a -> (a -> Contract w s e b) -> Promise w s e b
promiseBind (Promise Contract w s e a
ma) a -> Contract w s e b
f = Contract w s e b -> Promise w s e b
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e a
ma Contract w s e a -> (a -> Contract w s e b) -> Contract w s e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Contract w s e b
f)

-- | Lift a mapping function for `Contract` to a mapping function for `Promise`.
promiseMap :: (Contract w1 s1 e1 a1 -> Contract w2 s2 e2 a2) -> Promise w1 s1 e1 a1 -> Promise w2 s2 e2 a2
promiseMap :: (Contract w1 s1 e1 a1 -> Contract w2 s2 e2 a2)
-> Promise w1 s1 e1 a1 -> Promise w2 s2 e2 a2
promiseMap Contract w1 s1 e1 a1 -> Contract w2 s2 e2 a2
f (Promise Contract w1 s1 e1 a1
ma) = Contract w2 s2 e2 a2 -> Promise w2 s2 e2 a2
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w1 s1 e1 a1 -> Contract w2 s2 e2 a2
f Contract w1 s1 e1 a1
ma)

-- | Class of types that can be trivially converted to a `Contract`.
-- For use with functions where it is convenient to accept both `Contract` and `Promise` types.
class IsContract c where
  toContract :: c w s e a -> Contract w s e a

instance IsContract Contract where
  toContract :: Contract w s e a -> Contract w s e a
toContract = Contract w s e a -> Contract w s e a
forall a. a -> a
id

instance IsContract Promise where
  toContract :: Promise w s e a -> Contract w s e a
toContract = Promise w s e a -> Contract w s e a
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise

-- | @select@ returns the contract that makes progress first, discarding the
--   other one.
--
-- However, note that if multiples promises are chained together like
-- @P1 `select` P2 `select` P3@ and all three can make progress at the same
-- moment, then @select@ will prioritize the promises starting from the right
-- (first @P3@ then @P2@ then @P1@).
select :: forall w s e a. Promise w s e a -> Promise w s e a -> Promise w s e a
select :: Promise w s e a -> Promise w s e a -> Promise w s e a
select (Promise (Contract Eff (ContractEffs w e) a
l)) (Promise (Contract Eff (ContractEffs w e) a
r)) = Contract w s e a -> Promise w s e a
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a
-> Eff (ContractEffs w e) a -> Eff (ContractEffs w e) a
forall i o (effs :: [* -> *]) a.
Member (Resumable i o) effs =>
Eff effs a -> Eff effs a -> Eff effs a
Resumable.select @PABResp @PABReq @(ContractEffs w e) Eff (ContractEffs w e) a
l Eff (ContractEffs w e) a
r))

-- | A variant of @select@ for contracts with different return types.
selectEither :: forall w s e a b. Promise w s e a -> Promise w s e b -> Promise w s e (Either a b)
selectEither :: Promise w s e a -> Promise w s e b -> Promise w s e (Either a b)
selectEither Promise w s e a
l Promise w s e b
r = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Promise w s e a -> Promise w s e (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Promise w s e a
l) Promise w s e (Either a b)
-> Promise w s e (Either a b) -> Promise w s e (Either a b)
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select` (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Promise w s e b -> Promise w s e (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Promise w s e b
r)

-- | 'selectList' returns the contract that makes progress first, discarding the
-- other ones.
--
-- However, if multiple contracts can make progress, 'selectList' prioritizes
-- the ones appearing first in the input list. Therefore, the order of the
-- list of promises is important.
selectList :: [Promise w s e a] -> Contract w s e a
selectList :: [Promise w s e a] -> Contract w s e a
selectList = Promise w s e a -> Contract w s e a
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise w s e a -> Contract w s e a)
-> ([Promise w s e a] -> Promise w s e a)
-> [Promise w s e a]
-> Contract w s e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Promise w s e a -> Promise w s e a -> Promise w s e a)
-> [Promise w s e a] -> Promise w s e a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Promise w s e a -> Promise w s e a -> Promise w s e a
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
select ([Promise w s e a] -> Promise w s e a)
-> ([Promise w s e a] -> [Promise w s e a])
-> [Promise w s e a]
-> Promise w s e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Promise w s e a] -> [Promise w s e a]
forall a. [a] -> [a]
reverse

-- | Write the current state of the contract to a checkpoint.
checkpoint :: forall w s e a. (AsCheckpointError e, Aeson.FromJSON a, Aeson.ToJSON a) => Contract w s e a -> Contract w s e a
checkpoint :: Contract w s e a -> Contract w s e a
checkpoint = Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a -> Contract w s e a)
-> (Contract w s e a -> Eff (ContractEffs w e) a)
-> Contract w s e a
-> Contract w s e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (effs :: [* -> *]).
(Member Checkpoint effs, Member (Error e) effs, ToJSON a,
 FromJSON a, AsCheckpointError e) =>
Eff effs a -> Eff effs a
forall err a (effs :: [* -> *]).
(Member Checkpoint effs, Member (Error err) effs, ToJSON a,
 FromJSON a, AsCheckpointError err) =>
Eff effs a -> Eff effs a
jsonCheckpoint @e (Eff (ContractEffs w e) a -> Eff (ContractEffs w e) a)
-> (Contract w s e a -> Eff (ContractEffs w e) a)
-> Contract w s e a
-> Eff (ContractEffs w e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a -> Eff (ContractEffs w e) a
forall w (s :: Row *) e a.
Contract w s e a -> Eff (ContractEffs w e) a
unContract

checkpointLoop :: forall w s e a b. (AsCheckpointError e, Aeson.FromJSON a, Aeson.ToJSON a, Aeson.ToJSON b, Aeson.FromJSON b) => (a -> Contract w s e (Either b a)) -> a -> Contract w s e b
checkpointLoop :: (a -> Contract w s e (Either b a)) -> a -> Contract w s e b
checkpointLoop a -> Contract w s e (Either b a)
f a
initial = Eff (ContractEffs w e) b -> Contract w s e b
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) b -> Contract w s e b)
-> Eff (ContractEffs w e) b -> Contract w s e b
forall a b. (a -> b) -> a -> b
$ (a -> Eff (ContractEffs w e) (Either b a))
-> a -> Eff (ContractEffs w e) b
forall err a b (effs :: [* -> *]).
(Member Checkpoint effs, Member (Error err) effs, ToJSON a,
 FromJSON a, ToJSON b, FromJSON b, AsCheckpointError err) =>
(a -> Eff effs (Either b a)) -> a -> Eff effs b
jsonCheckpointLoop @e ((Contract w s e (Either b a)
 -> Eff (ContractEffs w e) (Either b a))
-> (a -> Contract w s e (Either b a))
-> a
-> Eff (ContractEffs w e) (Either b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Contract w s e (Either b a) -> Eff (ContractEffs w e) (Either b a)
forall w (s :: Row *) e a.
Contract w s e a -> Eff (ContractEffs w e) a
unContract a -> Contract w s e (Either b a)
f) a
initial

-- | Transform any exceptions thrown by the 'Contract' using the given function.
mapError ::
  forall w s e e' a.
  (e -> e')
  -> Contract w s e a
  -> Contract w s e' a
mapError :: (e -> e') -> Contract w s e a -> Contract w s e' a
mapError e -> e'
f = (e -> Contract w s e' a) -> Contract w s e a -> Contract w s e' a
forall w (s :: Row *) e e' a.
(e -> Contract w s e' a) -> Contract w s e a -> Contract w s e' a
handleError (e' -> Contract w s e' a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e' -> Contract w s e' a) -> (e -> e') -> e -> Contract w s e' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e'
f)

-- | Turn a contract with error type 'e' and return type 'a' into one with
--   any error type (ie. throwing no errors) that returns 'Either e a'
runError ::
  forall w s e e0 a.
  Contract w s e a
  -> Contract w s e0 (Either e a)
runError :: Contract w s e a -> Contract w s e0 (Either e a)
runError (Contract Eff (ContractEffs w e) a
r) = Eff (ContractEffs w e0) (Either e a)
-> Contract w s e0 (Either e a)
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (Error e : ContractEffs w e0) a
-> Eff (ContractEffs w e0) (Either e a)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
E.runError (Eff (Error e : ContractEffs w e0) a
 -> Eff (ContractEffs w e0) (Either e a))
-> Eff (Error e : ContractEffs w e0) a
-> Eff (ContractEffs w e0) (Either e a)
forall a b. (a -> b) -> a -> b
$ Eff (ContractEffs w e) a -> Eff (Error e : ContractEffs w e0) a
forall (effs :: [* -> *]) (a :: * -> *) (b :: * -> *).
Eff (a : effs) ~> Eff (a : b : effs)
raiseUnder Eff (ContractEffs w e) a
r)

-- | Handle errors, potentially throwing new errors.
handleError ::
  forall w s e e' a.
  (e -> Contract w s e' a)
  -> Contract w s e a
  -> Contract w s e' a
handleError :: (e -> Contract w s e' a) -> Contract w s e a -> Contract w s e' a
handleError e -> Contract w s e' a
f (Contract Eff (ContractEffs w e) a
c) = Eff (ContractEffs w e') a -> Contract w s e' a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract Eff (ContractEffs w e') a
c' where
  c' :: Eff (ContractEffs w e') a
c' = Eff (Error e : ContractEffs w e') a
-> (e -> Eff (ContractEffs w e') a) -> Eff (ContractEffs w e') a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
E.handleError @e (Eff (ContractEffs w e) a -> Eff (Error e : ContractEffs w e') a
forall (effs :: [* -> *]) (a :: * -> *) (b :: * -> *).
Eff (a : effs) ~> Eff (a : b : effs)
raiseUnder Eff (ContractEffs w e) a
c) ((Contract w s e' a -> Eff (ContractEffs w e') a)
-> (e -> Contract w s e' a) -> e -> Eff (ContractEffs w e') a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Contract w s e' a -> Eff (ContractEffs w e') a
forall w (s :: Row *) e a.
Contract w s e a -> Eff (ContractEffs w e) a
unContract e -> Contract w s e' a
f)

type SuspendedContractEffects w e =
  Error e
  ': State CheckpointKey
  ': State CheckpointStore
  ': LogMsg CheckpointLogMsg
  ': State (AccumState w)
  ': LogMsg Value
  ': Writer (Seq (LogMessage Value))
  ': '[]

-- | The result of running a 'Resumable'
data ResumableResult w e i o a =
    ResumableResult
        { ResumableResult w e i o a -> Responses (CheckpointKey, i)
_responses       :: Responses (CheckpointKey, i) -- The record with the resumable's execution history
        , ResumableResult w e i o a -> Requests o
_requests        :: Requests o -- Handlers that the 'Resumable' has registered
        , ResumableResult w e i o a -> Either e (Maybe a)
_finalState      :: Either e (Maybe a) -- Error or final state of the 'Resumable' (if it has finished)
        , ResumableResult w e i o a -> Seq (LogMessage Value)
_logs            :: Seq (LogMessage Value) -- All log messages that have been produced by this instance.
        , ResumableResult w e i o a -> Seq (LogMessage Value)
_lastLogs        :: Seq (LogMessage Value) -- Log messages produced in the last step
        , ResumableResult w e i o a -> CheckpointStore
_checkpointStore :: CheckpointStore
        , ResumableResult w e i o a -> w
_observableState :: w -- ^ Accumulated, observable state of the contract
        , ResumableResult w e i o a -> w
_lastState       :: w -- ^ Last accumulated state
        }
        deriving stock ((forall x.
 ResumableResult w e i o a -> Rep (ResumableResult w e i o a) x)
-> (forall x.
    Rep (ResumableResult w e i o a) x -> ResumableResult w e i o a)
-> Generic (ResumableResult w e i o a)
forall x.
Rep (ResumableResult w e i o a) x -> ResumableResult w e i o a
forall x.
ResumableResult w e i o a -> Rep (ResumableResult w e i o a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w e i o a x.
Rep (ResumableResult w e i o a) x -> ResumableResult w e i o a
forall w e i o a x.
ResumableResult w e i o a -> Rep (ResumableResult w e i o a) x
$cto :: forall w e i o a x.
Rep (ResumableResult w e i o a) x -> ResumableResult w e i o a
$cfrom :: forall w e i o a x.
ResumableResult w e i o a -> Rep (ResumableResult w e i o a) x
Generic, Int -> ResumableResult w e i o a -> ShowS
[ResumableResult w e i o a] -> ShowS
ResumableResult w e i o a -> String
(Int -> ResumableResult w e i o a -> ShowS)
-> (ResumableResult w e i o a -> String)
-> ([ResumableResult w e i o a] -> ShowS)
-> Show (ResumableResult w e i o a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
Int -> ResumableResult w e i o a -> ShowS
forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
[ResumableResult w e i o a] -> ShowS
forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
ResumableResult w e i o a -> String
showList :: [ResumableResult w e i o a] -> ShowS
$cshowList :: forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
[ResumableResult w e i o a] -> ShowS
show :: ResumableResult w e i o a -> String
$cshow :: forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
ResumableResult w e i o a -> String
showsPrec :: Int -> ResumableResult w e i o a -> ShowS
$cshowsPrec :: forall w e i o a.
(Show i, Show o, Show e, Show a, Show w) =>
Int -> ResumableResult w e i o a -> ShowS
Show)
        deriving anyclass ([ResumableResult w e i o a] -> Encoding
[ResumableResult w e i o a] -> Value
ResumableResult w e i o a -> Encoding
ResumableResult w e i o a -> Value
(ResumableResult w e i o a -> Value)
-> (ResumableResult w e i o a -> Encoding)
-> ([ResumableResult w e i o a] -> Value)
-> ([ResumableResult w e i o a] -> Encoding)
-> ToJSON (ResumableResult w e i o a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
[ResumableResult w e i o a] -> Encoding
forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
[ResumableResult w e i o a] -> Value
forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
ResumableResult w e i o a -> Encoding
forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
ResumableResult w e i o a -> Value
toEncodingList :: [ResumableResult w e i o a] -> Encoding
$ctoEncodingList :: forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
[ResumableResult w e i o a] -> Encoding
toJSONList :: [ResumableResult w e i o a] -> Value
$ctoJSONList :: forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
[ResumableResult w e i o a] -> Value
toEncoding :: ResumableResult w e i o a -> Encoding
$ctoEncoding :: forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
ResumableResult w e i o a -> Encoding
toJSON :: ResumableResult w e i o a -> Value
$ctoJSON :: forall w e i o a.
(ToJSON w, ToJSON a, ToJSON e, ToJSON o, ToJSON i) =>
ResumableResult w e i o a -> Value
Aeson.ToJSON, Value -> Parser [ResumableResult w e i o a]
Value -> Parser (ResumableResult w e i o a)
(Value -> Parser (ResumableResult w e i o a))
-> (Value -> Parser [ResumableResult w e i o a])
-> FromJSON (ResumableResult w e i o a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall w e i o a.
(FromJSON i, FromJSON o, FromJSON e, FromJSON a, FromJSON w) =>
Value -> Parser [ResumableResult w e i o a]
forall w e i o a.
(FromJSON i, FromJSON o, FromJSON e, FromJSON a, FromJSON w) =>
Value -> Parser (ResumableResult w e i o a)
parseJSONList :: Value -> Parser [ResumableResult w e i o a]
$cparseJSONList :: forall w e i o a.
(FromJSON i, FromJSON o, FromJSON e, FromJSON a, FromJSON w) =>
Value -> Parser [ResumableResult w e i o a]
parseJSON :: Value -> Parser (ResumableResult w e i o a)
$cparseJSON :: forall w e i o a.
(FromJSON i, FromJSON o, FromJSON e, FromJSON a, FromJSON w) =>
Value -> Parser (ResumableResult w e i o a)
Aeson.FromJSON)

makeLenses ''ResumableResult

-- | Shrink the 'ResumableResult' by deleting everything that's not needed to restore the
--   state of the contract instance.
shrinkResumableResult :: ResumableResult w e i o a -> ResumableResult w e i o a
shrinkResumableResult :: ResumableResult w e i o a -> ResumableResult w e i o a
shrinkResumableResult ResumableResult w e i o a
rs =
  let comp :: IntervalSet (Interval CheckpointKey)
comp = ResumableResult w e i o a
rs ResumableResult w e i o a
-> Getting
     (IntervalSet (Interval CheckpointKey))
     (ResumableResult w e i o a)
     (IntervalSet (Interval CheckpointKey))
-> IntervalSet (Interval CheckpointKey)
forall s a. s -> Getting a s a -> a
^. (CheckpointStore
 -> Const (IntervalSet (Interval CheckpointKey)) CheckpointStore)
-> ResumableResult w e i o a
-> Const
     (IntervalSet (Interval CheckpointKey)) (ResumableResult w e i o a)
forall w e i o a. Lens' (ResumableResult w e i o a) CheckpointStore
checkpointStore ((CheckpointStore
  -> Const (IntervalSet (Interval CheckpointKey)) CheckpointStore)
 -> ResumableResult w e i o a
 -> Const
      (IntervalSet (Interval CheckpointKey)) (ResumableResult w e i o a))
-> ((IntervalSet (Interval CheckpointKey)
     -> Const
          (IntervalSet (Interval CheckpointKey))
          (IntervalSet (Interval CheckpointKey)))
    -> CheckpointStore
    -> Const (IntervalSet (Interval CheckpointKey)) CheckpointStore)
-> Getting
     (IntervalSet (Interval CheckpointKey))
     (ResumableResult w e i o a)
     (IntervalSet (Interval CheckpointKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CheckpointStore -> IntervalSet (Interval CheckpointKey))
-> (IntervalSet (Interval CheckpointKey)
    -> Const
         (IntervalSet (Interval CheckpointKey))
         (IntervalSet (Interval CheckpointKey)))
-> CheckpointStore
-> Const (IntervalSet (Interval CheckpointKey)) CheckpointStore
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CheckpointStore -> IntervalSet (Interval CheckpointKey)
completedIntervals
      isCovered :: CheckpointKey -> Bool
      isCovered :: CheckpointKey -> Bool
isCovered CheckpointKey
k = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntervalSet (Interval CheckpointKey) -> Bool
forall k. IntervalSet k -> Bool
IS.null (IntervalSet (Interval CheckpointKey) -> Bool)
-> IntervalSet (Interval CheckpointKey) -> Bool
forall a b. (a -> b) -> a -> b
$ IntervalSet (Interval CheckpointKey)
-> CheckpointKey -> IntervalSet (Interval CheckpointKey)
forall k e. Interval k e => IntervalSet k -> e -> IntervalSet k
IS.containing IntervalSet (Interval CheckpointKey)
comp CheckpointKey
k
  in ResumableResult w e i o a
rs ResumableResult w e i o a
-> (ResumableResult w e i o a -> ResumableResult w e i o a)
-> ResumableResult w e i o a
forall a b. a -> (a -> b) -> b
& (Seq (LogMessage Value) -> Identity (Seq (LogMessage Value)))
-> ResumableResult w e i o a
-> Identity (ResumableResult w e i o a)
forall w e i o a.
Lens' (ResumableResult w e i o a) (Seq (LogMessage Value))
logs ((Seq (LogMessage Value) -> Identity (Seq (LogMessage Value)))
 -> ResumableResult w e i o a
 -> Identity (ResumableResult w e i o a))
-> Seq (LogMessage Value)
-> ResumableResult w e i o a
-> ResumableResult w e i o a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (LogMessage Value)
forall a. Monoid a => a
mempty
        ResumableResult w e i o a
-> (ResumableResult w e i o a -> ResumableResult w e i o a)
-> ResumableResult w e i o a
forall a b. a -> (a -> b) -> b
& ASetter
  (ResumableResult w e i o a)
  (ResumableResult w e i o a)
  (Map ContractEnv (CheckpointKey, i))
  (Map ContractEnv (CheckpointKey, i))
-> (Map ContractEnv (CheckpointKey, i)
    -> Map ContractEnv (CheckpointKey, i))
-> ResumableResult w e i o a
-> ResumableResult w e i o a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Responses (CheckpointKey, i)
 -> Identity (Responses (CheckpointKey, i)))
-> ResumableResult w e i o a
-> Identity (ResumableResult w e i o a)
forall w e i o a i.
Lens
  (ResumableResult w e i o a)
  (ResumableResult w e i o a)
  (Responses (CheckpointKey, i))
  (Responses (CheckpointKey, i))
responses ((Responses (CheckpointKey, i)
  -> Identity (Responses (CheckpointKey, i)))
 -> ResumableResult w e i o a
 -> Identity (ResumableResult w e i o a))
-> ((Map ContractEnv (CheckpointKey, i)
     -> Identity (Map ContractEnv (CheckpointKey, i)))
    -> Responses (CheckpointKey, i)
    -> Identity (Responses (CheckpointKey, i)))
-> ASetter
     (ResumableResult w e i o a)
     (ResumableResult w e i o a)
     (Map ContractEnv (CheckpointKey, i))
     (Map ContractEnv (CheckpointKey, i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractEnv (CheckpointKey, i)
 -> Identity (Map ContractEnv (CheckpointKey, i)))
-> Responses (CheckpointKey, i)
-> Identity (Responses (CheckpointKey, i))
forall i. Iso' (Responses i) (Map ContractEnv i)
_Responses) (((CheckpointKey, i) -> Bool)
-> Map ContractEnv (CheckpointKey, i)
-> Map ContractEnv (CheckpointKey, i)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> ((CheckpointKey, i) -> Bool) -> (CheckpointKey, i) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckpointKey -> Bool
isCovered (CheckpointKey -> Bool)
-> ((CheckpointKey, i) -> CheckpointKey)
-> (CheckpointKey, i)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CheckpointKey, i) -> CheckpointKey
forall a b. (a, b) -> a
fst))

data SuspendedContract w e i o a =
  SuspendedContract
    { SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult :: ResumableResult w e i o a
    , SuspendedContract w e i o a
-> Maybe
     (MultiRequestContStatus i o (SuspendedContractEffects w e) a)
_continuations   :: Maybe (MultiRequestContStatus i o (SuspendedContractEffects w e) a)
    , SuspendedContract w e i o a -> CheckpointKey
_checkpointKey   :: CheckpointKey
    }

makeLenses ''SuspendedContract

runResumable ::
  Monoid w
  => [Response PABResp]
  -> CheckpointStore
  -> Eff (ContractEffs w e) a
  -> ResumableResult w e PABResp PABReq a
runResumable :: [Response PABResp]
-> CheckpointStore
-> Eff (ContractEffs w e) a
-> ResumableResult w e PABResp PABReq a
runResumable [Response PABResp]
events CheckpointStore
store Eff (ContractEffs w e) a
action =
  let initial :: SuspendedContract w e PABResp PABReq a
initial = CheckpointStore
-> Eff (ContractEffs w e) a
-> SuspendedContract w e PABResp PABReq a
forall w e a.
Monoid w =>
CheckpointStore
-> Eff (ContractEffs w e) a
-> SuspendedContract w e PABResp PABReq a
suspend CheckpointStore
store Eff (ContractEffs w e) a
action
      runStep' :: SuspendedContract w e PABResp PABReq a
-> Response PABResp -> SuspendedContract w e PABResp PABReq a
runStep' SuspendedContract w e PABResp PABReq a
con Response PABResp
rsp = SuspendedContract w e PABResp PABReq a
-> Maybe (SuspendedContract w e PABResp PABReq a)
-> SuspendedContract w e PABResp PABReq a
forall a. a -> Maybe a -> a
fromMaybe SuspendedContract w e PABResp PABReq a
con (SuspendedContract w e PABResp PABReq a
-> Response PABResp
-> Maybe (SuspendedContract w e PABResp PABReq a)
forall w e a.
Monoid w =>
SuspendedContract w e PABResp PABReq a
-> Response PABResp
-> Maybe (SuspendedContract w e PABResp PABReq a)
runStep SuspendedContract w e PABResp PABReq a
con Response PABResp
rsp)
      result :: ResumableResult w e PABResp PABReq a
result = (SuspendedContract w e PABResp PABReq a
 -> Response PABResp -> SuspendedContract w e PABResp PABReq a)
-> SuspendedContract w e PABResp PABReq a
-> [Response PABResp]
-> SuspendedContract w e PABResp PABReq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SuspendedContract w e PABResp PABReq a
-> Response PABResp -> SuspendedContract w e PABResp PABReq a
forall w e a.
Monoid w =>
SuspendedContract w e PABResp PABReq a
-> Response PABResp -> SuspendedContract w e PABResp PABReq a
runStep' SuspendedContract w e PABResp PABReq a
initial [Response PABResp]
events SuspendedContract w e PABResp PABReq a
-> (SuspendedContract w e PABResp PABReq a
    -> ResumableResult w e PABResp PABReq a)
-> ResumableResult w e PABResp PABReq a
forall a b. a -> (a -> b) -> b
& Getting
  (ResumableResult w e PABResp PABReq a)
  (SuspendedContract w e PABResp PABReq a)
  (ResumableResult w e PABResp PABReq a)
-> SuspendedContract w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (ResumableResult w e PABResp PABReq a)
  (SuspendedContract w e PABResp PABReq a)
  (ResumableResult w e PABResp PABReq a)
forall w e i o a.
Lens' (SuspendedContract w e i o a) (ResumableResult w e i o a)
resumableResult
  in ResumableResult w e PABResp PABReq a
result

runWithRecord ::
  forall w e a.
  Monoid w
  => Eff (ContractEffs w e) a
  -> CheckpointStore
  -> Responses PABResp
  -> ResumableResult w e PABResp PABReq a
runWithRecord :: Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses PABResp
-> ResumableResult w e PABResp PABReq a
runWithRecord Eff (ContractEffs w e) a
action CheckpointStore
store Responses PABResp
events =
  [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 (Responses PABResp -> [Response PABResp]
forall i. Responses i -> [Response i]
Resumable.responses Responses PABResp
events) CheckpointStore
store Eff (ContractEffs w e) a
action

mkResult ::
  forall w e a.
  Monoid w
  => w
  -> Seq (LogMessage Value) -- ^ Old logs
  -> ( Either e (Maybe (MultiRequestContStatus PABResp PABReq (SuspendedContractEffects w e) a))
     , CheckpointKey
     , CheckpointStore
     , AccumState w
     , Seq (LogMessage Value)
     )
  -> SuspendedContract w e PABResp PABReq a
mkResult :: w
-> Seq (LogMessage Value)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
mkResult w
oldW Seq (LogMessage Value)
oldLogs (Either
  e
  (Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a))
initialRes, CheckpointKey
cpKey, CheckpointStore
cpStore, AccumState w
newW, Seq (LogMessage Value)
newLogs) =
  SuspendedContract :: forall w e i o a.
ResumableResult w e i o a
-> Maybe
     (MultiRequestContStatus i o (SuspendedContractEffects w e) a)
-> CheckpointKey
-> SuspendedContract w e i o a
SuspendedContract
      { _resumableResult :: ResumableResult w e PABResp PABReq a
_resumableResult =
          ResumableResult :: forall w e i o a.
Responses (CheckpointKey, i)
-> Requests o
-> Either e (Maybe a)
-> Seq (LogMessage Value)
-> Seq (LogMessage Value)
-> CheckpointStore
-> w
-> w
-> ResumableResult w e i o a
ResumableResult
            { _responses :: Responses (CheckpointKey, PABResp)
_responses = Responses (CheckpointKey, PABResp)
forall a. Monoid a => a
mempty
            , _requests :: Requests PABReq
_requests =
                let getRequests :: MultiRequestContStatus i o effs a -> Maybe (Requests o)
getRequests = \case { AContinuation MultiRequestContinuation{Requests o
ndcRequests :: Requests o
ndcRequests :: forall i o (effs :: [* -> *]) a.
MultiRequestContinuation i o effs a -> Requests o
ndcRequests} -> Requests o -> Maybe (Requests o)
forall a. a -> Maybe a
Just Requests o
ndcRequests; MultiRequestContStatus i o effs a
_ -> Maybe (Requests o)
forall a. Maybe a
Nothing }
                in (e -> Requests PABReq)
-> (Maybe
      (MultiRequestContStatus
         PABResp PABReq (SuspendedContractEffects w e) a)
    -> Requests PABReq)
-> Either
     e
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> Requests PABReq
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Requests PABReq
forall a. Monoid a => a
mempty (Requests PABReq -> Maybe (Requests PABReq) -> Requests PABReq
forall a. a -> Maybe a -> a
fromMaybe Requests PABReq
forall a. Monoid a => a
mempty (Maybe (Requests PABReq) -> Requests PABReq)
-> (Maybe
      (MultiRequestContStatus
         PABResp PABReq (SuspendedContractEffects w e) a)
    -> Maybe (Requests PABReq))
-> Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a)
-> Requests PABReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe
  (MultiRequestContStatus
     PABResp PABReq (SuspendedContractEffects w e) a)
-> (MultiRequestContStatus
      PABResp PABReq (SuspendedContractEffects w e) a
    -> Maybe (Requests PABReq))
-> Maybe (Requests PABReq)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MultiRequestContStatus
  PABResp PABReq (SuspendedContractEffects w e) a
-> Maybe (Requests PABReq)
forall i o (effs :: [* -> *]) a.
MultiRequestContStatus i o effs a -> Maybe (Requests o)
getRequests)) Either
  e
  (Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a))
initialRes
            , _finalState :: Either e (Maybe a)
_finalState =
                let getResult :: MultiRequestContStatus i o effs a -> Maybe a
getResult = \case { AResult a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a; MultiRequestContStatus i o effs a
_ -> Maybe a
forall a. Maybe a
Nothing } in
                (Maybe
   (MultiRequestContStatus
      PABResp PABReq (SuspendedContractEffects w e) a)
 -> Maybe a)
-> Either
     e
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> Either e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe
  (MultiRequestContStatus
     PABResp PABReq (SuspendedContractEffects w e) a)
-> (MultiRequestContStatus
      PABResp PABReq (SuspendedContractEffects w e) a
    -> Maybe a)
-> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MultiRequestContStatus
  PABResp PABReq (SuspendedContractEffects w e) a
-> Maybe a
forall i o (effs :: [* -> *]) a.
MultiRequestContStatus i o effs a -> Maybe a
getResult) Either
  e
  (Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a))
initialRes
            , _logs :: Seq (LogMessage Value)
_logs = Seq (LogMessage Value)
oldLogs Seq (LogMessage Value)
-> Seq (LogMessage Value) -> Seq (LogMessage Value)
forall a. Semigroup a => a -> a -> a
<> Seq (LogMessage Value)
newLogs
            , _lastLogs :: Seq (LogMessage Value)
_lastLogs = Seq (LogMessage Value)
newLogs
            , _checkpointStore :: CheckpointStore
_checkpointStore = CheckpointStore
cpStore
            , _observableState :: w
_observableState = w
oldW w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
newW
            , _lastState :: w
_lastState = w
newW
            }
      , _continuations :: Maybe
  (MultiRequestContStatus
     PABResp PABReq (SuspendedContractEffects w e) a)
_continuations = Maybe
  (MultiRequestContStatus
     PABResp PABReq (SuspendedContractEffects w e) a)
-> Either
     e
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a)
forall b a. b -> Either a b -> b
fromRight Maybe
  (MultiRequestContStatus
     PABResp PABReq (SuspendedContractEffects w e) a)
forall a. Maybe a
Nothing Either
  e
  (Maybe
     (MultiRequestContStatus
        PABResp PABReq (SuspendedContractEffects w e) a))
initialRes
      , _checkpointKey :: CheckpointKey
_checkpointKey = CheckpointKey
cpKey
      }

runSuspContractEffects ::
  forall w e a.
  Monoid w
  => CheckpointKey
  -> CheckpointStore
  -> Eff (SuspendedContractEffects w e) a
  -> (Either e a, CheckpointKey, CheckpointStore, AccumState w, Seq (LogMessage Value))
runSuspContractEffects :: CheckpointKey
-> CheckpointStore
-> Eff (SuspendedContractEffects w e) a
-> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
runSuspContractEffects CheckpointKey
cpKey CheckpointStore
cpStore =
  ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
 Seq (LogMessage Value))
-> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
forall a b c d e. ((((a, b), c), d), e) -> (a, b, c, d, e)
flatten
    (((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
  Seq (LogMessage Value))
 -> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
     Seq (LogMessage Value)))
-> (Eff (SuspendedContractEffects w e) a
    -> ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
        Seq (LogMessage Value)))
-> Eff (SuspendedContractEffects w e) a
-> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[]
  ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
   Seq (LogMessage Value))
-> ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
    Seq (LogMessage Value))
forall a. Eff '[] a -> a
run
    (Eff
   '[]
   ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
    Seq (LogMessage Value))
 -> ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
     Seq (LogMessage Value)))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[]
         ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
          Seq (LogMessage Value)))
-> Eff (SuspendedContractEffects w e) a
-> ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
    Seq (LogMessage Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]) a.
Monoid (Seq (LogMessage Value)) =>
Eff (Writer (Seq (LogMessage Value)) : effs) a
-> Eff effs (a, Seq (LogMessage Value))
forall w (effs :: [* -> *]) a.
Monoid w =>
Eff (Writer w : effs) a -> Eff effs (a, w)
W.runWriter @(Seq (LogMessage Value))
    (Eff
   '[Writer (Seq (LogMessage Value))]
   (((Either e a, CheckpointKey), CheckpointStore), AccumState w)
 -> Eff
      '[]
      ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
       Seq (LogMessage Value)))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[Writer (Seq (LogMessage Value))]
         (((Either e a, CheckpointKey), CheckpointStore), AccumState w))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[]
     ((((Either e a, CheckpointKey), CheckpointStore), AccumState w),
      Seq (LogMessage Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg Value ~> Eff '[Writer (Seq (LogMessage Value))])
-> Eff '[LogMsg Value, Writer (Seq (LogMessage Value))]
   ~> Eff '[Writer (Seq (LogMessage Value))]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Writer (Seq (LogMessage Value))) effs =>
AReview (Seq (LogMessage Value)) (LogMessage Value)
-> LogMsg Value ~> Eff effs
forall a w (effs :: [* -> *]).
Member (Writer w) effs =>
AReview w (LogMessage a) -> LogMsg a ~> Eff effs
handleLogWriter @Value @(Seq (LogMessage Value)) (AReview (Seq (LogMessage Value)) (LogMessage Value)
 -> LogMsg Value ~> Eff '[Writer (Seq (LogMessage Value))])
-> AReview (Seq (LogMessage Value)) (LogMessage Value)
-> LogMsg Value ~> Eff '[Writer (Seq (LogMessage Value))]
forall a b. (a -> b) -> a -> b
$ (LogMessage Value -> Seq (LogMessage Value))
-> AReview (Seq (LogMessage Value)) (LogMessage Value)
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto LogMessage Value -> Seq (LogMessage Value)
forall (m :: * -> *) a. Monad m => a -> m a
return)
    (Eff
   '[LogMsg Value, Writer (Seq (LogMessage Value))]
   (((Either e a, CheckpointKey), CheckpointStore), AccumState w)
 -> Eff
      '[Writer (Seq (LogMessage Value))]
      (((Either e a, CheckpointKey), CheckpointStore), AccumState w))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[LogMsg Value, Writer (Seq (LogMessage Value))]
         (((Either e a, CheckpointKey), CheckpointStore), AccumState w))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[Writer (Seq (LogMessage Value))]
     (((Either e a, CheckpointKey), CheckpointStore), AccumState w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccumState w
-> Eff
     '[State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     ((Either e a, CheckpointKey), CheckpointStore)
-> Eff
     '[LogMsg Value, Writer (Seq (LogMessage Value))]
     (((Either e a, CheckpointKey), CheckpointStore), AccumState w)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState @(AccumState w) AccumState w
forall a. Monoid a => a
mempty
    (Eff
   '[State (AccumState w), LogMsg Value,
     Writer (Seq (LogMessage Value))]
   ((Either e a, CheckpointKey), CheckpointStore)
 -> Eff
      '[LogMsg Value, Writer (Seq (LogMessage Value))]
      (((Either e a, CheckpointKey), CheckpointStore), AccumState w))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[State (AccumState w), LogMsg Value,
           Writer (Seq (LogMessage Value))]
         ((Either e a, CheckpointKey), CheckpointStore))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[LogMsg Value, Writer (Seq (LogMessage Value))]
     (((Either e a, CheckpointKey), CheckpointStore), AccumState w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
Eff (LogMsg CheckpointLogMsg : effs) ~> Eff effs
forall a (effs :: [* -> *]). Eff (LogMsg a : effs) ~> Eff effs
handleLogIgnore @CheckpointLogMsg
    (Eff
   '[LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
     Writer (Seq (LogMessage Value))]
   ((Either e a, CheckpointKey), CheckpointStore)
 -> Eff
      '[State (AccumState w), LogMsg Value,
        Writer (Seq (LogMessage Value))]
      ((Either e a, CheckpointKey), CheckpointStore))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
           Writer (Seq (LogMessage Value))]
         ((Either e a, CheckpointKey), CheckpointStore))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     ((Either e a, CheckpointKey), CheckpointStore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckpointStore
-> Eff
     '[State CheckpointStore, LogMsg CheckpointLogMsg,
       State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     (Either e a, CheckpointKey)
-> Eff
     '[LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     ((Either e a, CheckpointKey), CheckpointStore)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState CheckpointStore
cpStore
    (Eff
   '[State CheckpointStore, LogMsg CheckpointLogMsg,
     State (AccumState w), LogMsg Value,
     Writer (Seq (LogMessage Value))]
   (Either e a, CheckpointKey)
 -> Eff
      '[LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
        Writer (Seq (LogMessage Value))]
      ((Either e a, CheckpointKey), CheckpointStore))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[State CheckpointStore, LogMsg CheckpointLogMsg,
           State (AccumState w), LogMsg Value,
           Writer (Seq (LogMessage Value))]
         (Either e a, CheckpointKey))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     ((Either e a, CheckpointKey), CheckpointStore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckpointKey
-> Eff
     '[State CheckpointKey, State CheckpointStore,
       LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     (Either e a)
-> Eff
     '[State CheckpointStore, LogMsg CheckpointLogMsg,
       State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     (Either e a, CheckpointKey)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState CheckpointKey
cpKey
    (Eff
   '[State CheckpointKey, State CheckpointStore,
     LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
     Writer (Seq (LogMessage Value))]
   (Either e a)
 -> Eff
      '[State CheckpointStore, LogMsg CheckpointLogMsg,
        State (AccumState w), LogMsg Value,
        Writer (Seq (LogMessage Value))]
      (Either e a, CheckpointKey))
-> (Eff (SuspendedContractEffects w e) a
    -> Eff
         '[State CheckpointKey, State CheckpointStore,
           LogMsg CheckpointLogMsg, State (AccumState w), LogMsg Value,
           Writer (Seq (LogMessage Value))]
         (Either e a))
-> Eff (SuspendedContractEffects w e) a
-> Eff
     '[State CheckpointStore, LogMsg CheckpointLogMsg,
       State (AccumState w), LogMsg Value,
       Writer (Seq (LogMessage Value))]
     (Either e a, CheckpointKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
E.runError @e where
      flatten :: ((((a, b), c), d), e) -> (a, b, c, d, e)
flatten ((((a
e, b
k), c
s), d
w), e
l) = (a
e, b
k, c
s, d
w, e
l)

-- | Run an action of @ContractEffs@ until it requests input for the first
--   time, returning the 'SuspendedContract'
suspend ::
  forall w e a.
  Monoid w
  => CheckpointStore
  -> Eff (ContractEffs w e) a -- ^ The contract
  -> SuspendedContract w e PABResp PABReq a
suspend :: CheckpointStore
-> Eff (ContractEffs w e) a
-> SuspendedContract w e PABResp PABReq a
suspend CheckpointStore
store Eff (ContractEffs w e) a
action =
  let initialKey :: CheckpointKey
initialKey = CheckpointKey
0 in
  w
-> Seq (LogMessage Value)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
forall w e a.
Monoid w =>
w
-> Seq (LogMessage Value)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
mkResult w
forall a. Monoid a => a
mempty Seq (LogMessage Value)
forall a. Monoid a => a
mempty
    ((Either
    e
    (Maybe
       (MultiRequestContStatus
          PABResp PABReq (SuspendedContractEffects w e) a)),
  CheckpointKey, CheckpointStore, AccumState w,
  Seq (LogMessage Value))
 -> SuspendedContract w e PABResp PABReq a)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
forall a b. (a -> b) -> a -> b
$ CheckpointKey
-> CheckpointStore
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
forall w e a.
Monoid w =>
CheckpointKey
-> CheckpointStore
-> Eff (SuspendedContractEffects w e) a
-> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
runSuspContractEffects @w @e
      CheckpointKey
initialKey
      CheckpointStore
store
      (Eff (ContractEffs w e) a
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
forall w e (effs :: [* -> *]) a.
(Member (Error e) effs, Member (State CheckpointStore) effs,
 Member (State CheckpointKey) effs,
 Member (State (AccumState w)) effs,
 Member (LogMsg CheckpointLogMsg) effs, Member (LogMsg Value) effs,
 Monoid w) =>
Eff (ContractEffs w e) a
-> Eff effs (Maybe (MultiRequestContStatus PABResp PABReq effs a))
handleContractEffs @w @e @(SuspendedContractEffects w e) Eff (ContractEffs w e) a
action)

-- | Feed a 'Response' to a 'SuspendedContract'.
runStep ::
  forall w e a.
  Monoid w
  => SuspendedContract w e PABResp PABReq a
  -> Response PABResp
  -> Maybe (SuspendedContract w e PABResp PABReq a)
runStep :: SuspendedContract w e PABResp PABReq a
-> Response PABResp
-> Maybe (SuspendedContract w e PABResp PABReq a)
runStep SuspendedContract{_continuations :: forall w e i o a.
SuspendedContract w e i o a
-> Maybe
     (MultiRequestContStatus i o (SuspendedContractEffects w e) a)
_continuations=Just (AContinuation MultiRequestContinuation{Response PABResp
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
ndcCont :: Response PABResp
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
ndcCont :: forall i o (effs :: [* -> *]) a.
MultiRequestContinuation i o effs a
-> Response i
-> Eff effs (Maybe (MultiRequestContStatus i o effs a))
ndcCont}), CheckpointKey
_checkpointKey :: CheckpointKey
_checkpointKey :: forall w e i o a. SuspendedContract w e i o a -> CheckpointKey
_checkpointKey, _resumableResult :: forall w e i o a.
SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult=ResumableResult{Responses (CheckpointKey, PABResp)
_responses :: Responses (CheckpointKey, PABResp)
_responses :: forall w e i o a.
ResumableResult w e i o a -> Responses (CheckpointKey, i)
_responses, CheckpointStore
_checkpointStore :: CheckpointStore
_checkpointStore :: forall w e i o a. ResumableResult w e i o a -> CheckpointStore
_checkpointStore, _observableState :: forall w e i o a. ResumableResult w e i o a -> w
_observableState=w
oldW, _logs :: forall w e i o a.
ResumableResult w e i o a -> Seq (LogMessage Value)
_logs=Seq (LogMessage Value)
oldLogs}} Response PABResp
event =
  SuspendedContract w e PABResp PABReq a
-> Maybe (SuspendedContract w e PABResp PABReq a)
forall a. a -> Maybe a
Just
    (SuspendedContract w e PABResp PABReq a
 -> Maybe (SuspendedContract w e PABResp PABReq a))
-> SuspendedContract w e PABResp PABReq a
-> Maybe (SuspendedContract w e PABResp PABReq a)
forall a b. (a -> b) -> a -> b
$ ASetter
  (SuspendedContract w e PABResp PABReq a)
  (SuspendedContract w e PABResp PABReq a)
  (Responses (CheckpointKey, PABResp))
  (Responses (CheckpointKey, PABResp))
-> Responses (CheckpointKey, PABResp)
-> SuspendedContract w e PABResp PABReq a
-> SuspendedContract w e PABResp PABReq a
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ResumableResult w e PABResp PABReq a
 -> Identity (ResumableResult w e PABResp PABReq a))
-> SuspendedContract w e PABResp PABReq a
-> Identity (SuspendedContract w e PABResp PABReq a)
forall w e i o a.
Lens' (SuspendedContract w e i o a) (ResumableResult w e i o a)
resumableResult ((ResumableResult w e PABResp PABReq a
  -> Identity (ResumableResult w e PABResp PABReq a))
 -> SuspendedContract w e PABResp PABReq a
 -> Identity (SuspendedContract w e PABResp PABReq a))
-> ((Responses (CheckpointKey, PABResp)
     -> Identity (Responses (CheckpointKey, PABResp)))
    -> ResumableResult w e PABResp PABReq a
    -> Identity (ResumableResult w e PABResp PABReq a))
-> ASetter
     (SuspendedContract w e PABResp PABReq a)
     (SuspendedContract w e PABResp PABReq a)
     (Responses (CheckpointKey, PABResp))
     (Responses (CheckpointKey, PABResp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Responses (CheckpointKey, PABResp)
 -> Identity (Responses (CheckpointKey, PABResp)))
-> ResumableResult w e PABResp PABReq a
-> Identity (ResumableResult w e PABResp PABReq a)
forall w e i o a i.
Lens
  (ResumableResult w e i o a)
  (ResumableResult w e i o a)
  (Responses (CheckpointKey, i))
  (Responses (CheckpointKey, i))
responses) (Response (CheckpointKey, PABResp)
-> Responses (CheckpointKey, PABResp)
-> Responses (CheckpointKey, PABResp)
forall i. Response i -> Responses i -> Responses i
insertResponse ((PABResp -> (CheckpointKey, PABResp))
-> Response PABResp -> Response (CheckpointKey, PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CheckpointKey
_checkpointKey,) Response PABResp
event) Responses (CheckpointKey, PABResp)
_responses)
    (SuspendedContract w e PABResp PABReq a
 -> SuspendedContract w e PABResp PABReq a)
-> SuspendedContract w e PABResp PABReq a
-> SuspendedContract w e PABResp PABReq a
forall a b. (a -> b) -> a -> b
$ w
-> Seq (LogMessage Value)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
forall w e a.
Monoid w =>
w
-> Seq (LogMessage Value)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
mkResult w
oldW Seq (LogMessage Value)
oldLogs
    ((Either
    e
    (Maybe
       (MultiRequestContStatus
          PABResp PABReq (SuspendedContractEffects w e) a)),
  CheckpointKey, CheckpointStore, AccumState w,
  Seq (LogMessage Value))
 -> SuspendedContract w e PABResp PABReq a)
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
-> SuspendedContract w e PABResp PABReq a
forall a b. (a -> b) -> a -> b
$ CheckpointKey
-> CheckpointStore
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
forall w e a.
Monoid w =>
CheckpointKey
-> CheckpointStore
-> Eff (SuspendedContractEffects w e) a
-> (Either e a, CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
runSuspContractEffects
        CheckpointKey
_checkpointKey
        CheckpointStore
_checkpointStore
        (Eff
   (SuspendedContractEffects w e)
   (Maybe
      (MultiRequestContStatus
         PABResp PABReq (SuspendedContractEffects w e) a))
 -> (Either
       e
       (Maybe
          (MultiRequestContStatus
             PABResp PABReq (SuspendedContractEffects w e) a)),
     CheckpointKey, CheckpointStore, AccumState w,
     Seq (LogMessage Value)))
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
-> (Either
      e
      (Maybe
         (MultiRequestContStatus
            PABResp PABReq (SuspendedContractEffects w e) a)),
    CheckpointKey, CheckpointStore, AccumState w,
    Seq (LogMessage Value))
forall a b. (a -> b) -> a -> b
$ Response PABResp
-> Eff
     (SuspendedContractEffects w e)
     (Maybe
        (MultiRequestContStatus
           PABResp PABReq (SuspendedContractEffects w e) a))
ndcCont Response PABResp
event
runStep SuspendedContract w e PABResp PABReq a
_ Response PABResp
_ = Maybe (SuspendedContract w e PABResp PABReq a)
forall a. Maybe a
Nothing

insertAndUpdate ::
  forall w e a.
  Monoid w
  => Eff (ContractEffs w e) a
  -> CheckpointStore -- ^ Checkpoint store
  -> Responses (CheckpointKey, PABResp)  -- ^ Previous responses
  -> Response PABResp
  -> ResumableResult w e PABResp PABReq a
insertAndUpdate :: Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses (CheckpointKey, PABResp)
-> Response PABResp
-> ResumableResult w e PABResp PABReq a
insertAndUpdate Eff (ContractEffs w e) a
action CheckpointStore
store Responses (CheckpointKey, PABResp)
record Response PABResp
newResponse =
  Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses PABResp
-> ResumableResult w e PABResp PABReq a
forall w e a.
Monoid w =>
Eff (ContractEffs w e) a
-> CheckpointStore
-> Responses PABResp
-> ResumableResult w e PABResp PABReq a
runWithRecord Eff (ContractEffs w e) a
action CheckpointStore
store (Response PABResp -> Responses PABResp -> Responses PABResp
forall i. Response i -> Responses i -> Responses i
insertResponse Response PABResp
newResponse (Responses PABResp -> Responses PABResp)
-> Responses PABResp -> Responses PABResp
forall a b. (a -> b) -> a -> b
$ ((CheckpointKey, PABResp) -> PABResp)
-> Responses (CheckpointKey, PABResp) -> Responses PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CheckpointKey, PABResp) -> PABResp
forall a b. (a, b) -> b
snd Responses (CheckpointKey, PABResp)
record)