{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Distributed.Process.ManagedProcess.Server.Restricted
-- Copyright   :  (c) Tim Watson 2012 - 2017
-- License     :  BSD3 (see the file LICENSE)
--
-- Maintainer  :  Tim Watson <watson.timothy@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires concurrency)
--
-- A /safe/ variant of the Server Portion of the /Managed Process/ API. Most
-- of these operations have the same names as similar operations in the impure
-- @Server@ module (re-exported by the primary API in @ManagedProcess@). To
-- remove the ambiguity, some combination of either qualification and/or the
-- @hiding@ clause will be required.
--
-- [Restricted Server Callbacks]
--
-- The idea behind this module is to provide /safe/ callbacks, i.e., server
-- code that is free from side effects. This safety is enforced by the type
-- system via the @RestrictedProcess@ monad. A StateT interface is provided
-- for code running in the @RestrictedProcess@ monad, so that server side
-- state can be managed safely without resorting to IO (or code running in
-- the @Process@ monad).
--
-----------------------------------------------------------------------------

module Control.Distributed.Process.ManagedProcess.Server.Restricted
  ( -- * Exported Types
    RestrictedProcess
  , Result(..)
  , RestrictedAction(..)
    -- * Creating call/cast protocol handlers
  , handleCall
  , handleCallIf
  , handleCast
  , handleCastIf
  , handleInfo
  , handleExit
  , handleTimeout
    -- * Handling Process State
  , putState
  , getState
  , modifyState
    -- * Handling responses/transitions
  , reply
  , noReply
  , haltNoReply
  , continue
  , timeoutAfter
  , hibernate
  , stop
    -- * Utilities
  , say
  ) where

import Control.Distributed.Process hiding (call, say)
import qualified Control.Distributed.Process as P (say)
import Control.Distributed.Process.Extras
  (ExitReason(..))
import Control.Distributed.Process.ManagedProcess.Internal.Types hiding (lift)
import qualified Control.Distributed.Process.ManagedProcess.Server as Server
import Control.Distributed.Process.Extras.Time
import Control.Distributed.Process.Serializable
import Prelude hiding (init)

import Control.Monad.IO.Class (MonadIO)
import qualified Control.Monad.State as ST
  ( MonadState
  , StateT
  , get
  , lift
  , modify
  , put
  , runStateT
  )

import Data.Typeable

-- | Restricted (i.e., pure, free from side effects) execution
-- environment for call/cast/info handlers to execute in.
--
newtype RestrictedProcess s a = RestrictedProcess {
    forall s a. RestrictedProcess s a -> StateT s Process a
unRestricted :: ST.StateT s Process a
  }
  deriving ((forall a b.
 (a -> b) -> RestrictedProcess s a -> RestrictedProcess s b)
-> (forall a b.
    a -> RestrictedProcess s b -> RestrictedProcess s a)
-> Functor (RestrictedProcess s)
forall a b. a -> RestrictedProcess s b -> RestrictedProcess s a
forall a b.
(a -> b) -> RestrictedProcess s a -> RestrictedProcess s b
forall s a b. a -> RestrictedProcess s b -> RestrictedProcess s a
forall s a b.
(a -> b) -> RestrictedProcess s a -> RestrictedProcess s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b.
(a -> b) -> RestrictedProcess s a -> RestrictedProcess s b
fmap :: forall a b.
(a -> b) -> RestrictedProcess s a -> RestrictedProcess s b
$c<$ :: forall s a b. a -> RestrictedProcess s b -> RestrictedProcess s a
<$ :: forall a b. a -> RestrictedProcess s b -> RestrictedProcess s a
Functor, Applicative (RestrictedProcess s)
Applicative (RestrictedProcess s) =>
(forall a b.
 RestrictedProcess s a
 -> (a -> RestrictedProcess s b) -> RestrictedProcess s b)
-> (forall a b.
    RestrictedProcess s a
    -> RestrictedProcess s b -> RestrictedProcess s b)
-> (forall a. a -> RestrictedProcess s a)
-> Monad (RestrictedProcess s)
forall s. Applicative (RestrictedProcess s)
forall a. a -> RestrictedProcess s a
forall s a. a -> RestrictedProcess s a
forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
forall a b.
RestrictedProcess s a
-> (a -> RestrictedProcess s b) -> RestrictedProcess s b
forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
forall s a b.
RestrictedProcess s a
-> (a -> RestrictedProcess s b) -> RestrictedProcess s 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
$c>>= :: forall s a b.
RestrictedProcess s a
-> (a -> RestrictedProcess s b) -> RestrictedProcess s b
>>= :: forall a b.
RestrictedProcess s a
-> (a -> RestrictedProcess s b) -> RestrictedProcess s b
$c>> :: forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
>> :: forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
$creturn :: forall s a. a -> RestrictedProcess s a
return :: forall a. a -> RestrictedProcess s a
Monad, ST.MonadState s, Monad (RestrictedProcess s)
Monad (RestrictedProcess s) =>
(forall a. IO a -> RestrictedProcess s a)
-> MonadIO (RestrictedProcess s)
forall s. Monad (RestrictedProcess s)
forall a. IO a -> RestrictedProcess s a
forall s a. IO a -> RestrictedProcess s a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall s a. IO a -> RestrictedProcess s a
liftIO :: forall a. IO a -> RestrictedProcess s a
MonadIO, Typeable, Functor (RestrictedProcess s)
Functor (RestrictedProcess s) =>
(forall a. a -> RestrictedProcess s a)
-> (forall a b.
    RestrictedProcess s (a -> b)
    -> RestrictedProcess s a -> RestrictedProcess s b)
-> (forall a b c.
    (a -> b -> c)
    -> RestrictedProcess s a
    -> RestrictedProcess s b
    -> RestrictedProcess s c)
-> (forall a b.
    RestrictedProcess s a
    -> RestrictedProcess s b -> RestrictedProcess s b)
-> (forall a b.
    RestrictedProcess s a
    -> RestrictedProcess s b -> RestrictedProcess s a)
-> Applicative (RestrictedProcess s)
forall s. Functor (RestrictedProcess s)
forall a. a -> RestrictedProcess s a
forall s a. a -> RestrictedProcess s a
forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s a
forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
forall a b.
RestrictedProcess s (a -> b)
-> RestrictedProcess s a -> RestrictedProcess s b
forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s a
forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
forall s a b.
RestrictedProcess s (a -> b)
-> RestrictedProcess s a -> RestrictedProcess s b
forall a b c.
(a -> b -> c)
-> RestrictedProcess s a
-> RestrictedProcess s b
-> RestrictedProcess s c
forall s a b c.
(a -> b -> c)
-> RestrictedProcess s a
-> RestrictedProcess s b
-> RestrictedProcess s 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
$cpure :: forall s a. a -> RestrictedProcess s a
pure :: forall a. a -> RestrictedProcess s a
$c<*> :: forall s a b.
RestrictedProcess s (a -> b)
-> RestrictedProcess s a -> RestrictedProcess s b
<*> :: forall a b.
RestrictedProcess s (a -> b)
-> RestrictedProcess s a -> RestrictedProcess s b
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> RestrictedProcess s a
-> RestrictedProcess s b
-> RestrictedProcess s c
liftA2 :: forall a b c.
(a -> b -> c)
-> RestrictedProcess s a
-> RestrictedProcess s b
-> RestrictedProcess s c
$c*> :: forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
*> :: forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s b
$c<* :: forall s a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s a
<* :: forall a b.
RestrictedProcess s a
-> RestrictedProcess s b -> RestrictedProcess s a
Applicative)

-- | The result of a 'call' handler's execution.
data Result a =
    Reply     a              -- ^ reply with the given term
  | Timeout   Delay a        -- ^ reply with the given term and enter timeout
  | Hibernate TimeInterval a -- ^ reply with the given term and hibernate
  | Stop      ExitReason     -- ^ stop the process with the given reason
  deriving (Typeable)

-- | The result of a safe 'cast' handler's execution.
data RestrictedAction =
    RestrictedContinue               -- ^ continue executing
  | RestrictedTimeout   Delay        -- ^ timeout if no messages are received
  | RestrictedHibernate TimeInterval -- ^ hibernate (i.e., sleep)
  | RestrictedStop      ExitReason   -- ^ stop/terminate the server process

--------------------------------------------------------------------------------
-- Handling state in RestrictedProcess execution environments                 --
--------------------------------------------------------------------------------

-- | Log a trace message using the underlying Process's @say@
say :: String -> RestrictedProcess s ()
say :: forall s. String -> RestrictedProcess s ()
say = Process () -> RestrictedProcess s ()
forall a s. Process a -> RestrictedProcess s a
lift (Process () -> RestrictedProcess s ())
-> (String -> Process ()) -> String -> RestrictedProcess s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Process ()
P.say

-- | Get the current process state
getState :: RestrictedProcess s s
getState :: forall s. RestrictedProcess s s
getState = RestrictedProcess s s
forall s (m :: * -> *). MonadState s m => m s
ST.get

-- | Put a new process state state
putState :: s -> RestrictedProcess s ()
putState :: forall s. s -> RestrictedProcess s ()
putState = s -> RestrictedProcess s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put

-- | Apply the given expression to the current process state
modifyState :: (s -> s) -> RestrictedProcess s ()
modifyState :: forall s. (s -> s) -> RestrictedProcess s ()
modifyState = (s -> s) -> RestrictedProcess s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify

--------------------------------------------------------------------------------
-- Generating replies and state transitions inside RestrictedProcess          --
--------------------------------------------------------------------------------

-- | Instructs the process to send a reply and continue running.
reply :: forall s r . (Serializable r) => r -> RestrictedProcess s (Result r)
reply :: forall s r. Serializable r => r -> RestrictedProcess s (Result r)
reply = Result r -> RestrictedProcess s (Result r)
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result r -> RestrictedProcess s (Result r))
-> (r -> Result r) -> r -> RestrictedProcess s (Result r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Result r
forall a. a -> Result a
Reply

-- | Continue without giving a reply to the caller - equivalent to 'continue',
-- but usable in a callback passed to the 'handleCall' family of functions.
noReply :: forall s r . (Serializable r)
           => Result r
           -> RestrictedProcess s (Result r)
noReply :: forall s r.
Serializable r =>
Result r -> RestrictedProcess s (Result r)
noReply = Result r -> RestrictedProcess s (Result r)
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Halt process execution during a call handler, without paying any attention
-- to the expected return type.
haltNoReply :: forall s r . (Serializable r)
           => ExitReason
           -> RestrictedProcess s (Result r)
haltNoReply :: forall s r.
Serializable r =>
ExitReason -> RestrictedProcess s (Result r)
haltNoReply ExitReason
r = Result r -> RestrictedProcess s (Result r)
forall s r.
Serializable r =>
Result r -> RestrictedProcess s (Result r)
noReply (ExitReason -> Result r
forall a. ExitReason -> Result a
Stop ExitReason
r)

-- | Instructs the process to continue running and receiving messages.
continue :: forall s . RestrictedProcess s RestrictedAction
continue :: forall s. RestrictedProcess s RestrictedAction
continue = RestrictedAction -> RestrictedProcess s RestrictedAction
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return RestrictedAction
RestrictedContinue

-- | Instructs the process loop to wait for incoming messages until 'Delay'
-- is exceeded. If no messages are handled during this period, the /timeout/
-- handler will be called. Note that this alters the process timeout permanently
-- such that the given @Delay@ will remain in use until changed.
timeoutAfter :: forall s. Delay -> RestrictedProcess s RestrictedAction
timeoutAfter :: forall s. Delay -> RestrictedProcess s RestrictedAction
timeoutAfter Delay
d = RestrictedAction -> RestrictedProcess s RestrictedAction
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RestrictedAction -> RestrictedProcess s RestrictedAction)
-> RestrictedAction -> RestrictedProcess s RestrictedAction
forall a b. (a -> b) -> a -> b
$ Delay -> RestrictedAction
RestrictedTimeout Delay
d

-- | Instructs the process to /hibernate/ for the given 'TimeInterval'. Note
-- that no messages will be removed from the mailbox until after hibernation has
-- ceased. This is equivalent to evaluating @liftIO . threadDelay@.
--
hibernate :: forall s. TimeInterval -> RestrictedProcess s RestrictedAction
hibernate :: forall s. TimeInterval -> RestrictedProcess s RestrictedAction
hibernate TimeInterval
d = RestrictedAction -> RestrictedProcess s RestrictedAction
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RestrictedAction -> RestrictedProcess s RestrictedAction)
-> RestrictedAction -> RestrictedProcess s RestrictedAction
forall a b. (a -> b) -> a -> b
$ TimeInterval -> RestrictedAction
RestrictedHibernate TimeInterval
d

-- | Instructs the process to terminate, giving the supplied reason. If a valid
-- 'shutdownHandler' is installed, it will be called with the 'ExitReason'
-- returned from this call, along with the process state.
stop :: forall s. ExitReason -> RestrictedProcess s RestrictedAction
stop :: forall s. ExitReason -> RestrictedProcess s RestrictedAction
stop ExitReason
r = RestrictedAction -> RestrictedProcess s RestrictedAction
forall a. a -> RestrictedProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RestrictedAction -> RestrictedProcess s RestrictedAction)
-> RestrictedAction -> RestrictedProcess s RestrictedAction
forall a b. (a -> b) -> a -> b
$ ExitReason -> RestrictedAction
RestrictedStop ExitReason
r

--------------------------------------------------------------------------------
-- Wrapping handler expressions in Dispatcher and DeferredDispatcher          --
--------------------------------------------------------------------------------

-- | A version of "Control.Distributed.Process.ManagedProcess.Server.handleCall"
-- that takes a handler which executes in 'RestrictedProcess'.
--
handleCall :: forall s a b . (Serializable a, Serializable b)
           => (a -> RestrictedProcess s (Result b))
           -> Dispatcher s
handleCall :: forall s a b.
(Serializable a, Serializable b) =>
(a -> RestrictedProcess s (Result b)) -> Dispatcher s
handleCall = Condition s a
-> (a -> RestrictedProcess s (Result b)) -> Dispatcher s
forall s a b.
(Serializable a, Serializable b) =>
Condition s a
-> (a -> RestrictedProcess s (Result b)) -> Dispatcher s
handleCallIf (Condition s a
 -> (a -> RestrictedProcess s (Result b)) -> Dispatcher s)
-> Condition s a
-> (a -> RestrictedProcess s (Result b))
-> Dispatcher s
forall a b. (a -> b) -> a -> b
$ (s -> Bool) -> Condition s a
forall s m. Serializable m => (s -> Bool) -> Condition s m
Server.state (Bool -> s -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | A version of "Control.Distributed.Process.ManagedProcess.Server.handleCallIf"
-- that takes a handler which executes in 'RestrictedProcess'.
--
handleCallIf :: forall s a b . (Serializable a, Serializable b)
             => Condition s a
             -> (a -> RestrictedProcess s (Result b))
             -> Dispatcher s
handleCallIf :: forall s a b.
(Serializable a, Serializable b) =>
Condition s a
-> (a -> RestrictedProcess s (Result b)) -> Dispatcher s
handleCallIf Condition s a
cond a -> RestrictedProcess s (Result b)
h = Condition s a -> CallHandler s a b -> Dispatcher s
forall s a b.
(Serializable a, Serializable b) =>
Condition s a -> CallHandler s a b -> Dispatcher s
Server.handleCallIf Condition s a
cond ((a -> RestrictedProcess s (Result b)) -> CallHandler s a b
forall s a b.
(Serializable a, Serializable b) =>
(a -> RestrictedProcess s (Result b)) -> CallHandler s a b
wrapCall a -> RestrictedProcess s (Result b)
h)

-- | A version of "Control.Distributed.Process.ManagedProcess.Server.handleCast"
-- that takes a handler which executes in 'RestrictedProcess'.
--
handleCast :: forall s a . (Serializable a)
           => (a -> RestrictedProcess s RestrictedAction)
           -> Dispatcher s
handleCast :: forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> Dispatcher s
handleCast = Condition s a
-> (a -> RestrictedProcess s RestrictedAction) -> Dispatcher s
forall s a.
Serializable a =>
Condition s a
-> (a -> RestrictedProcess s RestrictedAction) -> Dispatcher s
handleCastIf ((s -> Bool) -> Condition s a
forall s m. Serializable m => (s -> Bool) -> Condition s m
Server.state (Bool -> s -> Bool
forall a b. a -> b -> a
const Bool
True))

-- | A version of "Control.Distributed.Process.ManagedProcess.Server.handleCastIf"
-- that takes a handler which executes in 'RestrictedProcess'.
--
handleCastIf :: forall s a . (Serializable a)
                => Condition s a -- ^ predicate that must be satisfied for the handler to run
                -> (a -> RestrictedProcess s RestrictedAction)
                -- ^ an action yielding function over the process state and input message
                -> Dispatcher s
handleCastIf :: forall s a.
Serializable a =>
Condition s a
-> (a -> RestrictedProcess s RestrictedAction) -> Dispatcher s
handleCastIf Condition s a
cond a -> RestrictedProcess s RestrictedAction
h = Condition s a -> CastHandler s a -> Dispatcher s
forall s a.
Serializable a =>
Condition s a -> CastHandler s a -> Dispatcher s
Server.handleCastIf Condition s a
cond ((a -> RestrictedProcess s RestrictedAction) -> CastHandler s a
forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
wrapHandler a -> RestrictedProcess s RestrictedAction
h)

-- | A version of "Control.Distributed.Process.ManagedProcess.Server.handleInfo"
-- that takes a handler which executes in 'RestrictedProcess'.
--
handleInfo :: forall s a. (Serializable a)
           => (a -> RestrictedProcess s RestrictedAction)
           -> DeferredDispatcher s
-- cast and info look the same to a restricted process
handleInfo :: forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> DeferredDispatcher s
handleInfo a -> RestrictedProcess s RestrictedAction
h = ActionHandler s a -> DeferredDispatcher s
forall s a.
Serializable a =>
ActionHandler s a -> DeferredDispatcher s
Server.handleInfo ((a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
wrapHandler a -> RestrictedProcess s RestrictedAction
h)

-- | Handle exit signals
handleExit :: forall s a. (Serializable a)
           => (a -> RestrictedProcess s RestrictedAction)
           -> ExitSignalDispatcher s
handleExit :: forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction)
-> ExitSignalDispatcher s
handleExit a -> RestrictedProcess s RestrictedAction
h = (ProcessId -> ActionHandler s a) -> ExitSignalDispatcher s
forall s a.
Serializable a =>
(ProcessId -> ActionHandler s a) -> ExitSignalDispatcher s
Server.handleExit ((ProcessId -> ActionHandler s a) -> ExitSignalDispatcher s)
-> (ProcessId -> ActionHandler s a) -> ExitSignalDispatcher s
forall a b. (a -> b) -> a -> b
$ \ProcessId
_ s
s a
a -> (a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
wrapHandler a -> RestrictedProcess s RestrictedAction
h s
s a
a

-- | Handle timeouts
handleTimeout :: forall s . (Delay -> RestrictedProcess s RestrictedAction)
                         -> TimeoutHandler s
handleTimeout :: forall s.
(Delay -> RestrictedProcess s RestrictedAction) -> TimeoutHandler s
handleTimeout Delay -> RestrictedProcess s RestrictedAction
h = \s
s Delay
d -> do
  (RestrictedAction
r, s
s') <- s
-> RestrictedProcess s RestrictedAction
-> Process (RestrictedAction, s)
forall s a. s -> RestrictedProcess s a -> Process (a, s)
runRestricted s
s (Delay -> RestrictedProcess s RestrictedAction
h Delay
d)
  case RestrictedAction
r of
    RestrictedAction
RestrictedContinue       -> s -> Action s
forall s. s -> Action s
Server.continue s
s'
    (RestrictedTimeout   Delay
i)  -> Delay -> s -> Action s
forall s. Delay -> s -> Action s
Server.timeoutAfter Delay
i s
s'
    (RestrictedHibernate TimeInterval
i)  -> TimeInterval -> s -> Action s
forall s. TimeInterval -> s -> Process (ProcessAction s)
Server.hibernate    TimeInterval
i s
s'
    (RestrictedStop      ExitReason
r') -> ExitReason -> Action s
forall s. ExitReason -> Action s
Server.stop ExitReason
r'

--------------------------------------------------------------------------------
-- Implementation                                                             --
--------------------------------------------------------------------------------

wrapHandler :: forall s a . (Serializable a)
            => (a -> RestrictedProcess s RestrictedAction)
            -> ActionHandler s a
wrapHandler :: forall s a.
Serializable a =>
(a -> RestrictedProcess s RestrictedAction) -> ActionHandler s a
wrapHandler a -> RestrictedProcess s RestrictedAction
h s
s a
a = do
  (RestrictedAction
r, s
s') <- s
-> RestrictedProcess s RestrictedAction
-> Process (RestrictedAction, s)
forall s a. s -> RestrictedProcess s a -> Process (a, s)
runRestricted s
s (a -> RestrictedProcess s RestrictedAction
h a
a)
  case RestrictedAction
r of
    RestrictedAction
RestrictedContinue       -> s -> Action s
forall s. s -> Action s
Server.continue s
s'
    (RestrictedTimeout   Delay
i)  -> Delay -> s -> Action s
forall s. Delay -> s -> Action s
Server.timeoutAfter Delay
i s
s'
    (RestrictedHibernate TimeInterval
i)  -> TimeInterval -> s -> Action s
forall s. TimeInterval -> s -> Process (ProcessAction s)
Server.hibernate    TimeInterval
i s
s'
    (RestrictedStop      ExitReason
r') -> ExitReason -> Action s
forall s. ExitReason -> Action s
Server.stop ExitReason
r'

wrapCall :: forall s a b . (Serializable a, Serializable b)
            => (a -> RestrictedProcess s (Result b))
            -> CallHandler s a b
wrapCall :: forall s a b.
(Serializable a, Serializable b) =>
(a -> RestrictedProcess s (Result b)) -> CallHandler s a b
wrapCall a -> RestrictedProcess s (Result b)
h s
s a
a = do
  (Result b
r, s
s') <- s -> RestrictedProcess s (Result b) -> Process (Result b, s)
forall s a. s -> RestrictedProcess s a -> Process (a, s)
runRestricted s
s (a -> RestrictedProcess s (Result b)
h a
a)
  case Result b
r of
    (Reply       b
r') -> b -> s -> Reply b s
forall r s. Serializable r => r -> s -> Reply r s
Server.reply b
r' s
s'
    (Timeout   Delay
i b
r') -> Delay -> s -> Action s
forall s. Delay -> s -> Action s
Server.timeoutAfter Delay
i s
s' Action s -> (ProcessAction s -> Reply b s) -> Reply b s
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProcessAction s -> Reply b s
forall r s. Serializable r => r -> ProcessAction s -> Reply r s
Server.replyWith b
r'
    (Hibernate TimeInterval
i b
r') -> TimeInterval -> s -> Action s
forall s. TimeInterval -> s -> Process (ProcessAction s)
Server.hibernate    TimeInterval
i s
s' Action s -> (ProcessAction s -> Reply b s) -> Reply b s
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProcessAction s -> Reply b s
forall r s. Serializable r => r -> ProcessAction s -> Reply r s
Server.replyWith b
r'
    (Stop      ExitReason
r'' ) -> ExitReason -> Action s
forall s. ExitReason -> Action s
Server.stop ExitReason
r''          Action s -> (ProcessAction s -> Reply b s) -> Reply b s
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessAction s -> Reply b s
forall r s. Serializable r => ProcessAction s -> Reply r s
Server.noReply

runRestricted :: s -> RestrictedProcess s a -> Process (a, s)
runRestricted :: forall s a. s -> RestrictedProcess s a -> Process (a, s)
runRestricted s
state RestrictedProcess s a
proc = StateT s Process a -> s -> Process (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
ST.runStateT (RestrictedProcess s a -> StateT s Process a
forall s a. RestrictedProcess s a -> StateT s Process a
unRestricted RestrictedProcess s a
proc) s
state

-- | TODO MonadTrans instance? lift :: (Monad m) => m a -> t m a
lift :: Process a -> RestrictedProcess s a
lift :: forall a s. Process a -> RestrictedProcess s a
lift Process a
p = StateT s Process a -> RestrictedProcess s a
forall s a. StateT s Process a -> RestrictedProcess s a
RestrictedProcess (StateT s Process a -> RestrictedProcess s a)
-> StateT s Process a -> RestrictedProcess s a
forall a b. (a -> b) -> a -> b
$ Process a -> StateT s Process a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift Process a
p