{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE NamedFieldPuns         #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE RecordWildCards        #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-|
Module: Capnp.Rpc.Server
Description: handlers for incoming method calls.

The term server in this context refers to a thread that handles method calls for
a particular capability (The capnproto rpc protocol itself has no concept of
clients and servers).
-}
module Capnp.Rpc.Server
    ( Server(..)
    , ServerOps(..)
    , CallInfo(..)
    , runServer

    -- * Handling methods
    , MethodHandler
    -- ** Using high-level representations
    , pureHandler
    -- ** Using low-level representations
    , rawHandler
    , rawAsyncHandler
    -- ** Always throwing exceptions
    , methodThrow
    , methodUnimplemented
    -- ** Working with untyped data
    , untypedHandler
    , toUntypedHandler
    , fromUntypedHandler

    -- * Invoking methods
    , invoke
    ) where

import Control.Concurrent.STM
import Control.Monad.STM.Class
import Data.Word

import Control.Exception.Safe  (MonadCatch, try)
import Control.Monad.IO.Class  (MonadIO, liftIO)
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Typeable           (Typeable)

import Capnp.Classes
    ( Cerialize
    , Decerialize(Cerial, decerialize)
    , FromPtr(fromPtr)
    , ToStruct(toStruct)
    )
import Capnp.Convert        (valueToMsg)
import Capnp.Message        (Mutability(..))
import Capnp.Rpc.Errors     (eMethodUnimplemented, wrapException)
import Capnp.Rpc.Promise    (Fulfiller, breakPromise, fulfill, newCallback)
import Capnp.TraversalLimit (defaultLimit, evalLimitT)
import Capnp.Untyped        (Ptr)
import Data.Mutable         (freeze)

import qualified Capnp.Gen.Capnp.Rpc.Pure as RpcGen
import qualified Capnp.Message            as Message
import qualified Capnp.Untyped            as Untyped
import qualified Internal.TCloseQ         as TCloseQ

-- | a @'MethodHandler' m p r@ handles a method call with parameters @p@
-- and return type @r@, in monad @m@.
--
-- The library represents method handlers via an abstract type
-- 'MethodHandler', parametrized over parameter (@p@) and return (@r@)
-- types, and the monadic context in which it runs (@m@). This allows us
-- to provide different strategies for actually handling methods; there
-- are various helper functions which construct these handlers.
--
-- At some point we will likely additionally provide handlers affording:
--
-- * Working directly with the low-level data types.
-- * Replying to the method call asynchronously, allowing later method
--   calls to be serviced before the current one is finished.
newtype MethodHandler m p r = MethodHandler
    { MethodHandler m p r
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod
        :: Maybe (Ptr 'Const)
        -> Fulfiller (Maybe (Ptr 'Const))
        -> m ()
    }

invoke
    :: MonadSTM m
    => MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
    -> Maybe (Ptr 'Const)
    -> Fulfiller (Maybe (Ptr 'Const))
    -> m ()
invoke :: MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
invoke = MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
forall (m :: * -> *) p r.
MethodHandler m p r
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod

-- | @'pureHandler' f cap@ is a 'MethodHandler' which calls a function @f@
-- that accepts the receiver and the parameter type as exposed by the
-- high-level API, and returns the high-level API representation of the
-- return type.
pureHandler ::
    ( MonadCatch m
    , MonadSTM m
    , PrimMonad m
    , s ~ PrimState m
    , Decerialize p
    , FromPtr 'Const (Cerial 'Const p)
    , Cerialize s r
    , ToStruct ('Mut s) (Cerial ('Mut s) r)
    ) =>
    (cap -> p -> m r)
    -> cap
    -> MethodHandler m p r
pureHandler :: (cap -> p -> m r) -> cap -> MethodHandler m p r
pureHandler cap -> p -> m r
f cap
cap = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler
    { handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod = \Maybe (Ptr 'Const)
ptr Fulfiller (Maybe (Ptr 'Const))
reply -> do
        p
param <- WordCount -> LimitT m p -> m p
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
defaultLimit (LimitT m p -> m p) -> LimitT m p -> m p
forall a b. (a -> b) -> a -> b
$
            Message 'Const -> Maybe (Ptr 'Const) -> LimitT m (Cerial 'Const p)
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
fromPtr Message 'Const
Message.empty Maybe (Ptr 'Const)
ptr LimitT m (Cerial 'Const p)
-> (Cerial 'Const p -> LimitT m p) -> LimitT m p
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial 'Const p -> LimitT m p
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
decerialize
        Either SomeException r
result <- m r -> m (Either SomeException r)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m r -> m (Either SomeException r))
-> m r -> m (Either SomeException r)
forall a b. (a -> b) -> a -> b
$ cap -> p -> m r
f cap
cap p
param
        case Either SomeException r
result of
            Right r
val -> do
                Struct 'Const
struct <- WordCount -> LimitT m (Struct 'Const) -> m (Struct 'Const)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
defaultLimit (LimitT m (Struct 'Const) -> m (Struct 'Const))
-> LimitT m (Struct 'Const) -> m (Struct 'Const)
forall a b. (a -> b) -> a -> b
$
                    r -> LimitT m (Message ('Mut s))
forall (m :: * -> *) s a.
(MonadLimit m, WriteCtx m s, Cerialize s a,
 ToStruct ('Mut s) (Cerial ('Mut s) a)) =>
a -> m (Message ('Mut s))
valueToMsg r
val LimitT m (Message ('Mut s))
-> (Message ('Mut s) -> LimitT m (Message 'Const))
-> LimitT m (Message 'Const)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message ('Mut s) -> LimitT m (Message 'Const)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze LimitT m (Message 'Const)
-> (Message 'Const -> LimitT m (Struct 'Const))
-> LimitT m (Struct 'Const)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message 'Const -> LimitT m (Struct 'Const)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m (Struct mut)
Untyped.rootPtr
                STM () -> m ()
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ Fulfiller (Maybe (Ptr 'Const)) -> Maybe (Ptr 'Const) -> STM ()
forall (m :: * -> *) a. MonadSTM m => Fulfiller a -> a -> m ()
fulfill Fulfiller (Maybe (Ptr 'Const))
reply (Ptr 'Const -> Maybe (Ptr 'Const)
forall a. a -> Maybe a
Just (Struct 'Const -> Ptr 'Const
forall (mut :: Mutability). Struct mut -> Ptr mut
Untyped.PtrStruct Struct 'Const
struct))
            Left SomeException
e ->
                -- TODO: find a way to get the connection config's debugMode
                -- option to be accessible from here, so we can use it.
                STM () -> m ()
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ Fulfiller (Maybe (Ptr 'Const)) -> Exception -> STM ()
forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Exception -> m ()
breakPromise Fulfiller (Maybe (Ptr 'Const))
reply (Bool -> SomeException -> Exception
wrapException Bool
False SomeException
e)
    }

-- | Like 'pureHandler', except that the parameter and return value use the
-- low-level representation.
rawHandler ::
    ( MonadCatch m
    , MonadSTM m
    , PrimMonad m
    , s ~ PrimState m
    , Decerialize p
    , FromPtr 'Const (Cerial 'Const p)
    , Decerialize r
    , ToStruct 'Const (Cerial 'Const r)
    ) =>
    (cap -> Cerial 'Const p -> m (Cerial 'Const r))
    -> cap
    -> MethodHandler m p r
rawHandler :: (cap -> Cerial 'Const p -> m (Cerial 'Const r))
-> cap -> MethodHandler m p r
rawHandler cap -> Cerial 'Const p -> m (Cerial 'Const r)
f cap
cap = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler
    { handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod = \Maybe (Ptr 'Const)
ptr Fulfiller (Maybe (Ptr 'Const))
reply -> do
        Cerial 'Const p
cerial <- WordCount -> LimitT m (Cerial 'Const p) -> m (Cerial 'Const p)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
defaultLimit (LimitT m (Cerial 'Const p) -> m (Cerial 'Const p))
-> LimitT m (Cerial 'Const p) -> m (Cerial 'Const p)
forall a b. (a -> b) -> a -> b
$ Message 'Const -> Maybe (Ptr 'Const) -> LimitT m (Cerial 'Const p)
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
fromPtr Message 'Const
Message.empty Maybe (Ptr 'Const)
ptr
        Either SomeException (Cerial 'Const r)
result <- m (Cerial 'Const r) -> m (Either SomeException (Cerial 'Const r))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m (Cerial 'Const r) -> m (Either SomeException (Cerial 'Const r)))
-> m (Cerial 'Const r)
-> m (Either SomeException (Cerial 'Const r))
forall a b. (a -> b) -> a -> b
$ cap -> Cerial 'Const p -> m (Cerial 'Const r)
f cap
cap Cerial 'Const p
cerial
        case Either SomeException (Cerial 'Const r)
result of
            Right Cerial 'Const r
val -> STM () -> m ()
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ Fulfiller (Maybe (Ptr 'Const)) -> Maybe (Ptr 'Const) -> STM ()
forall (m :: * -> *) a. MonadSTM m => Fulfiller a -> a -> m ()
fulfill Fulfiller (Maybe (Ptr 'Const))
reply (Ptr 'Const -> Maybe (Ptr 'Const)
forall a. a -> Maybe a
Just (Struct 'Const -> Ptr 'Const
forall (mut :: Mutability). Struct mut -> Ptr mut
Untyped.PtrStruct (Cerial 'Const r -> Struct 'Const
forall (mut :: Mutability) a. ToStruct mut a => a -> Struct mut
toStruct Cerial 'Const r
val)))
            Left SomeException
e -> STM () -> m ()
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ Fulfiller (Maybe (Ptr 'Const)) -> Exception -> STM ()
forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Exception -> m ()
breakPromise Fulfiller (Maybe (Ptr 'Const))
reply (Bool -> SomeException -> Exception
wrapException Bool
False SomeException
e)
    }

-- | Like 'rawHandler', except that it takes a fulfiller for the result,
-- instead of returning it. This allows the result to be supplied some time
-- after the method returns, making it possible to service other method
-- calls before the result is available.
rawAsyncHandler ::
    ( MonadCatch m
    , MonadSTM m
    , PrimMonad m
    , s ~ PrimState m
    , Decerialize p
    , FromPtr 'Const (Cerial 'Const p)
    , Decerialize r
    , ToStruct 'Const (Cerial 'Const r)
    ) =>
    (cap -> Cerial 'Const p -> Fulfiller (Cerial 'Const r) -> m ())
    -> cap
    -> MethodHandler m p r
rawAsyncHandler :: (cap -> Cerial 'Const p -> Fulfiller (Cerial 'Const r) -> m ())
-> cap -> MethodHandler m p r
rawAsyncHandler cap -> Cerial 'Const p -> Fulfiller (Cerial 'Const r) -> m ()
f cap
cap = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler
    { handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod = \Maybe (Ptr 'Const)
ptr Fulfiller (Maybe (Ptr 'Const))
reply -> do
        Fulfiller (Cerial 'Const r)
fulfiller <- (Either Exception (Cerial 'Const r) -> STM ())
-> m (Fulfiller (Cerial 'Const r))
forall (m :: * -> *) a.
MonadSTM m =>
(Either Exception a -> STM ()) -> m (Fulfiller a)
newCallback ((Either Exception (Cerial 'Const r) -> STM ())
 -> m (Fulfiller (Cerial 'Const r)))
-> (Either Exception (Cerial 'Const r) -> STM ())
-> m (Fulfiller (Cerial 'Const r))
forall a b. (a -> b) -> a -> b
$ \case
            Left Exception
e  -> Fulfiller (Maybe (Ptr 'Const)) -> Exception -> STM ()
forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Exception -> m ()
breakPromise Fulfiller (Maybe (Ptr 'Const))
reply Exception
e
            Right Cerial 'Const r
v -> Fulfiller (Maybe (Ptr 'Const)) -> Maybe (Ptr 'Const) -> STM ()
forall (m :: * -> *) a. MonadSTM m => Fulfiller a -> a -> m ()
fulfill Fulfiller (Maybe (Ptr 'Const))
reply (Maybe (Ptr 'Const) -> STM ()) -> Maybe (Ptr 'Const) -> STM ()
forall a b. (a -> b) -> a -> b
$ Ptr 'Const -> Maybe (Ptr 'Const)
forall a. a -> Maybe a
Just (Struct 'Const -> Ptr 'Const
forall (mut :: Mutability). Struct mut -> Ptr mut
Untyped.PtrStruct (Cerial 'Const r -> Struct 'Const
forall (mut :: Mutability) a. ToStruct mut a => a -> Struct mut
toStruct Cerial 'Const r
v))
        Cerial 'Const p
cerial <- WordCount -> LimitT m (Cerial 'Const p) -> m (Cerial 'Const p)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
defaultLimit (LimitT m (Cerial 'Const p) -> m (Cerial 'Const p))
-> LimitT m (Cerial 'Const p) -> m (Cerial 'Const p)
forall a b. (a -> b) -> a -> b
$ Message 'Const -> Maybe (Ptr 'Const) -> LimitT m (Cerial 'Const p)
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
fromPtr Message 'Const
Message.empty Maybe (Ptr 'Const)
ptr
        cap -> Cerial 'Const p -> Fulfiller (Cerial 'Const r) -> m ()
f cap
cap Cerial 'Const p
cerial Fulfiller (Cerial 'Const r)
fulfiller
    }

-- | Convert a 'MethodHandler' for any parameter and return types into
-- one that deals with untyped pointers.
toUntypedHandler
    :: MethodHandler m p r
    -> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
toUntypedHandler :: MethodHandler m p r
-> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
toUntypedHandler MethodHandler{Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: forall (m :: * -> *) p r.
MethodHandler m p r
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
..} = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler{Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
..}

-- | Inverse of 'toUntypedHandler'
fromUntypedHandler
    :: MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
    -> MethodHandler m p r
fromUntypedHandler :: MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
-> MethodHandler m p r
fromUntypedHandler MethodHandler{Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: forall (m :: * -> *) p r.
MethodHandler m p r
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
..} = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler{Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
..}

-- | Construct a method handler from a function accepting an untyped
-- pointer for the method's parameter, and a 'Fulfiller' which accepts
-- an untyped pointer for the method's return value.
untypedHandler
    :: (Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
    -> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
untypedHandler :: (Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
untypedHandler = (Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler

-- | @'methodThrow' exn@ is a 'MethodHandler' which always throws @exn@.
methodThrow :: MonadIO m => RpcGen.Exception -> MethodHandler m p r
methodThrow :: Exception -> MethodHandler m p r
methodThrow Exception
exn = MethodHandler :: forall (m :: * -> *) p r.
(Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ())
-> MethodHandler m p r
MethodHandler
    { handleMethod :: Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod = \Maybe (Ptr 'Const)
_ Fulfiller (Maybe (Ptr 'Const))
fulfiller -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Fulfiller (Maybe (Ptr 'Const)) -> Exception -> IO ()
forall (m :: * -> *) a.
MonadSTM m =>
Fulfiller a -> Exception -> m ()
breakPromise Fulfiller (Maybe (Ptr 'Const))
fulfiller Exception
exn
    }

-- | A 'MethodHandler' which always throws an @unimplemented@ exception.
methodUnimplemented :: MonadIO m => MethodHandler m p r
methodUnimplemented :: MethodHandler m p r
methodUnimplemented = Exception -> MethodHandler m p r
forall (m :: * -> *) p r.
MonadIO m =>
Exception -> MethodHandler m p r
methodThrow Exception
eMethodUnimplemented

-- | Base class for things that can act as capnproto servers.
class Monad m => Server m a | a -> m where
    -- | Called when the last live reference to a server is dropped.
    shutdown :: a -> m ()
    shutdown a
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- | Try to extract a value of a given type. The default implementation
    -- always fails (returns 'Nothing'). If an instance chooses to implement
    -- this, it will be possible to use "reflection" on clients that point
    -- at local servers to dynamically unwrap the server value. A typical
    -- implementation will just call Typeable's @cast@ method, but this
    -- needn't be the case -- a server may wish to allow local peers to
    -- unwrap some value that is not exactly the data the server has access
    -- to.
    unwrap :: Typeable b => a -> Maybe b
    unwrap a
_ = Maybe b
forall a. Maybe a
Nothing

-- | The operations necessary to receive and handle method calls, i.e.
-- to implement an object. It is parametrized over the monadic context
-- in which methods are serviced.
data ServerOps m = ServerOps
    { ServerOps m
-> Word64
-> Word16
-> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
handleCall
        :: Word64
        -> Word16
        -> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
    -- ^ Handle a method call; takes the interface and method id and returns
    -- a handler for the specific method.
    , ServerOps m -> m ()
handleStop :: m ()
    -- ^ Handle shutting-down the receiver; this is called when the last
    -- reference to the capability is dropped.
    , ServerOps m -> forall a. Typeable a => Maybe a
handleCast :: forall a. Typeable a => Maybe a
    -- ^ used to unwrap the server when reflecting on a local client.
    }

-- | A 'CallInfo' contains information about a method call.
data CallInfo = CallInfo
    { CallInfo -> Word64
interfaceId :: !Word64
    -- ^ The id of the interface whose method is being called.
    , CallInfo -> Word16
methodId    :: !Word16
    -- ^ The method id of the method being called.
    , CallInfo -> Maybe (Ptr 'Const)
arguments   :: Maybe (Ptr 'Const)
    -- ^ The arguments to the method call.
    , CallInfo -> Fulfiller (Maybe (Ptr 'Const))
response    :: Fulfiller (Maybe (Ptr 'Const))
    -- ^ A 'Fulfiller' which accepts the method's return value.
    }

-- | Handle incoming messages for a given object.
--
-- Accepts a queue of messages to handle, and 'ServerOps' used to handle them.
-- returns when it receives a 'Stop' message.
runServer :: TCloseQ.Q CallInfo -> ServerOps IO -> IO ()
runServer :: Q CallInfo -> ServerOps IO -> IO ()
runServer Q CallInfo
q ServerOps IO
ops = IO ()
go
  where
    go :: IO ()
go = STM (Maybe CallInfo) -> IO (Maybe CallInfo)
forall a. STM a -> IO a
atomically (Q CallInfo -> STM (Maybe CallInfo)
forall a. Q a -> STM (Maybe a)
TCloseQ.read Q CallInfo
q) IO (Maybe CallInfo) -> (Maybe CallInfo -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe CallInfo
Nothing ->
            () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just CallInfo{Word64
interfaceId :: Word64
interfaceId :: CallInfo -> Word64
interfaceId, Word16
methodId :: Word16
methodId :: CallInfo -> Word16
methodId, Maybe (Ptr 'Const)
arguments :: Maybe (Ptr 'Const)
arguments :: CallInfo -> Maybe (Ptr 'Const)
arguments, Fulfiller (Maybe (Ptr 'Const))
response :: Fulfiller (Maybe (Ptr 'Const))
response :: CallInfo -> Fulfiller (Maybe (Ptr 'Const))
response} -> do
            MethodHandler IO (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> IO ()
forall (m :: * -> *) p r.
MethodHandler m p r
-> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> m ()
handleMethod
                (ServerOps IO
-> Word64
-> Word16
-> MethodHandler IO (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
forall (m :: * -> *).
ServerOps m
-> Word64
-> Word16
-> MethodHandler m (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))
handleCall ServerOps IO
ops Word64
interfaceId Word16
methodId)
                Maybe (Ptr 'Const)
arguments
                Fulfiller (Maybe (Ptr 'Const))
response
            IO ()
go