finish implementing wayland server api

7 files changed, 756 insertions, 239 deletions

diff --git a/wayland/Wayland/Server.hs b/wayland/Wayland/Server.hs
index 61486b0..07fc3d7 100644
--- a/wayland/Wayland/Server.hs
+++ b/wayland/Wayland/Server.hs
@@ -7,23 +7,40 @@ module Wayland.Server
     DisplayM
   , withDisplay
   , bindSocket
-  ,  -- * Processing Requests
-    Request(..)
-  , RequestHandler
-  , fromRequest
-  , processRequests
+  ,  -- * Handling Messages
+    MessageClass
+  , Message(..)
+  , MessageHandler
+  , fromMessage
+  , processMessages
   , requestTermination
-  , -- * Managing Objects
+  , -- * Objects
     Global
   , registerGlobal
+  , hideGlobal
   , unregisterGlobal
   , createObject
   , destroyObject
   , sendEvent
   , flushEvents
-  , -- * Event Sources
-    EventSource
-  , registerSignalEvent
+  , -- * Clients
+    Client
+  , ClientMessage(..)
+  , destroyClient
+  , flushClientEvents
+  , -- * Message Sources
+    SignalSource
+  , TimerSource
+  , FileSource
+  , FileEventMask(..)
+  , registerSignalSource
+  , unregisterSignalSource
+  , registerTimerSource
+  , setTimerSource
+  , unregisterTimerSource
+  , registerFileSource
+  , updateFileSourceMask
+  , unregisterFileSource
   , -- * Interface Descriptions
     InterfaceDesc(..)
   , MessageDesc(..)
@@ -42,3 +59,5 @@ module Wayland.Server
 import Wayland.Server.Interface
 import Wayland.Server.Object
 import Wayland.Server.Display
+import Wayland.Server.Client
+import Wayland.Server.Types
diff --git a/wayland/Wayland/Server/Client.hs b/wayland/Wayland/Server/Client.hs
index 99d11d6..e7325c9 100644
--- a/wayland/Wayland/Server/Client.hs
+++ b/wayland/Wayland/Server/Client.hs
@@ -1,18 +1,98 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- |
+-- Module     : Wayland.Server.Client
+-- Description: Low-level API for wrapping Wayland client handles.
+
 module Wayland.Server.Client
-  ( Client
+  ( -- * Handles
+    Client
+  , ClientMessage(..)
+  , createClient
   , unwrapClient
   , wrapClient
+  , -- * Data
+    ClientData
+  , ClientDataReader
+  , newClientData
+  , destroyClientData
   ) where
 
+import Data.Hashable (Hashable)
+import Control.Monad.Trans (MonadIO(..))
+import Control.Monad.Reader (ReaderT, asks)
+import Foreign (newStablePtr, castStablePtrToPtr, FunPtr, freeHaskellFunPtr, Ptr, castPtrToStablePtr, deRefStablePtr, freeStablePtr)
+import Wayland.Server.Types (Handle, createHandle, Message(..), invalidateHandle, MessageClass, resolveHandle)
 import Wayland.Server.System
 
-data Client = Client WLClient
+-- | A handle to a Wayland client.
+--
+-- The handle remains valid and can be used for equality checks even after the underlying libwayland client was
+-- destroyed. However, actions accessing the client will fail.
+newtype Client = Client (Handle WLClient)
+  deriving (Show, Eq, Ord, Hashable)
+
+-- | Messages informing the server that a client has been created/connected to the server or destroyed.
+data ClientMessage
+  = ClientCreated   Client
+  | ClientDestroyed Client
   deriving (Show, Eq)
 
+-- | Client-related data.
+newtype ClientData = ClientData { dataDestroyFunc :: FunPtr WLUserDataDestroyFunc }
+
+-- | A reader monad providing an instance of 'ClientData'.
+type ClientDataReader = ReaderT ClientData IO
+
+instance MessageClass ClientMessage
+
+-- | Initialize client-related data.
+newClientData
+  :: (Message -> IO ()) -- ^ Message handler used to dispatch messages when clients were destroyed.
+  -> IO ClientData      -- ^ Action creating the data.
+newClientData handler = do
+  destroyFunc <- wrapWLUserDataDestroyFunc (destroyClient handler)
+  pure $ ClientData { dataDestroyFunc = destroyFunc }
+
+-- | Destroy client-related data, freeing all acquired resources.
+--
+-- This should only be done after no wl_client instances are alive as it will free memory used by them.
+destroyClientData :: ClientData -> IO ()
+destroyClientData c = do
+  freeHaskellFunPtr (dataDestroyFunc c)
+
+-- | Create a wrapper for a native wl_client instance.
+--
+-- This will associate user data with the client and register a destroy function which dispatches a message.
+createClient :: WLClient -> ClientDataReader Client
+createClient c = do
+  destroyFunc <- asks dataDestroyFunc
+  liftIO $ do
+    handle <- createHandle c
+    let client = Client handle
+    clientPtr <- newStablePtr client
+    wlClientSetUserData c (castStablePtrToPtr clientPtr) destroyFunc
+    pure client
+
+-- | Callback used when a client was destroyed, disassociating any data and dispatching a message to the message loop.
+destroyClient :: (Message -> IO ()) -> Ptr () -> IO ()
+destroyClient handler c = do
+  let clientPtr = castPtrToStablePtr c
+  client@(Client handle) <- deRefStablePtr clientPtr
+  invalidateHandle handle
+  freeStablePtr clientPtr
+  handler $ Message $ ClientDestroyed client
+
+-- | Get the underlying Wayland client wrapped by a 'Client'.
+--
+-- This function may raise an error if the underlying client is no longer alive.
 unwrapClient :: Client -> IO WLClient
-unwrapClient (Client c) = pure c
+unwrapClient (Client handle) = resolveHandle handle
 
+-- | Get the existing wrapper for a Wayland client.
+--
+-- The client wrapper is stored as a StablePtr in the client's userdata.
 wrapClient :: WLClient -> IO Client
-wrapClient c = pure $ Client c
-
--- TODO: Lifecycle
+wrapClient c = do
+  clientPtr <- castPtrToStablePtr <$> wlClientGetUserData c
+  deRefStablePtr clientPtr
diff --git a/wayland/Wayland/Server/Display.hs b/wayland/Wayland/Server/Display.hs
index 2a30323..527d9da 100644
--- a/wayland/Wayland/Server/Display.hs
+++ b/wayland/Wayland/Server/Display.hs
@@ -8,91 +8,147 @@
 
 -- |
 -- Module     : Wayland.Server.Display
--- Description: Entrypoint for the server, managing the request loop and server state.
+-- Description: Entrypoint for the server, managing the message loop and server state.
 --
--- A wayland server provides a "display" that can be controlled using a UNIX socket. The server runs an event loop
--- handling requests. These requests may be events, requests to create objects, or requests for a particular object
--- instance.
+-- A wayland server provides a "display" that can be controlled using a UNIX socket. The server runs a message loop
+-- handling messages. These messages may be timers, UNIX signals, requests to create objects, or requests for a
+-- particular object instance.
 
 module Wayland.Server.Display
   ( -- * The Display Monad
     DisplayM
   , withDisplay
   , bindSocket
-  ,  -- * Processing Requests
-    RequestHandler
-  , processRequests
+  ,  -- * Processing Messages
+    MessageHandler
+  , processMessages
   , requestTermination
+  , -- * Managing Clients
+    destroyClient
+  , flushClientEvents
   , -- * Managing Objects
     Global
   , registerGlobal
+  , hideGlobal
   , unregisterGlobal
   , createObject
   , destroyObject
   , sendEvent
   , flushEvents
-  , -- * Event Sources
-    EventSource
-  , registerSignalEvent
+  , -- * Message Sources
+    SignalSource
+  , TimerSource
+  , FileSource
+  , FileEventMask(..)
+  , registerSignalSource
+  , unregisterSignalSource
+  , registerTimerSource
+  , setTimerSource
+  , unregisterTimerSource
+  , registerFileSource
+  , updateFileSourceMask
+  , unregisterFileSource
   ) where
 
 import Data.Maybe (isJust)
 import Data.Functor (($>))
 import Data.Typeable (Proxy(..))
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Foreign (Ptr, FunPtr, Word32, nullPtr)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
+import Data.Hashable (Hashable(..))
+import Data.Time.Clock (DiffTime, diffTimeToPicoseconds)
+import Data.Bits ((.&.), (.|.))
+import Foreign (Ptr, FunPtr, Word32, nullPtr, freeHaskellFunPtr, free, new, castPtr)
 import Foreign.C (peekCString, CInt)
 import Lens.Micro.TH (makeLenses)
 import Lens.Micro.Mtl.Internal (Zoom(..), Zoomed)
 import Control.Monad.State.Strict (StateT(..), MonadState(..))
 import Control.Monad.Reader (ReaderT(..), ask, asks)
 import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
-import Control.Exception (bracket)
-import Control.Monad (when)
+import Control.Exception (bracket, bracket_)
+import Control.Monad (when, void)
 import Wayland.Server.System
-import Wayland.Server.Object (ObjectCache, Request(..), newObjectCache, destroyObjectCache, createResource, RequestClass, Object(..), unwrapResource, resolveTypeInterface, sendResourceEvent, NewObject, createNewObject)
-import Wayland.Server.Client (wrapClient)
+import Wayland.Server.Object
+import Wayland.Server.Client (wrapClient, ClientData, newClientData, destroyClientData, ClientMessage(..), createClient, Client, unwrapClient)
+import Wayland.Server.Types (Message(..), MessageClass, Handle, createHandle, resolveHandle, invalidateHandle)
+import Wayland.Server.Interface (InterfaceDesc(..))
+import System.Posix.Types (Fd (..))
 
 -- | The display monad.
 --
--- All server-related logic runs in this monad, including the initial set-up and all request handlers. The monad
+-- All server-related logic runs in this monad, including the initial set-up and all message handlers. The monad
 -- provides custom state and support for IO operations.
 newtype DisplayM s a = DisplayM { runDisplayM :: StateT s (ReaderT Display (StateT DisplayState IO)) a }
   deriving (Functor, Applicative, Monad, MonadIO, MonadState s)
 
--- | A function handling a type-erased request.
+-- | A function handling a type-erased message.
 --
--- This handler is executed as part of the event loop.
-type RequestHandler s = Request -> DisplayM s ()
+-- This handler is executed as part of the message loop.
+type MessageHandler s = Message -> DisplayM s ()
 
 -- | Read-only data related to the display.
 data Display
-  = Display { display         :: !WLDisplay                 -- ^ The underlying wl_display instance.
-            , activeEventLoop :: !(IORef (Maybe EventLoop)) -- ^ Mutable reference to the active request handler.
+  = Display { dispDisplay           :: !WLDisplay                   -- ^ The underlying wl_display instance.
+            , dispActiveMessageLoop :: !(IORef (Maybe MessageLoop)) -- ^ Mutable reference to the active message handler.
+            , dispClientData        :: !ClientData
             }
 
 -- | Mutable state for the display.
 newtype DisplayState = DisplayState { _stateObjectCache :: ObjectCache }
 
--- | A function handling a request in the IO monad.
+-- | A function handling a message in the IO monad.
 --
--- The event loop callback needs to retrieve the current state, run the request handler in a Display monad, and update
+-- The message loop callback needs to retrieve the current state, run the message handler in a Display monad, and update
 -- the state.
-newtype EventLoop = EventLoop { handleEvent :: Request -> IO () }
+newtype MessageLoop = MessageLoop (Message -> IO ())
 
--- | Handle to an event source that dispatches requests to the event loop.
+-- | Handle to a message source that dispatches messages when a UNIX signal was raised.
 --
--- This may be a signal event source, timer event source, etc. The event source handle remains valid even after it has
--- expired or after it was unregistered.
-data EventSource = EventSource (FunPtr WLEventLoopSignalFunc) (IORef WLEventSource)
-  deriving (Eq)
+-- The message source handle remains valid even after it is unregistered. However, actions using the source (like
+-- unregistering it) will fail.
+data SignalSource
+  = SignalSource { signalHandle :: !(Handle WLEventSource)
+                 , signalFunc   :: !(FunPtr WLEventLoopSignalFunc)
+                 }
+
+-- | Handle to a message source that dispatches messages after a timeout has passed.
+--
+-- The timer can be reused and/or reset multiple times before it is unregistered.
+--
+-- The message source handle remains valid even after it is unregistered. However, actions using the source (like
+-- unregistering it) will fail.
+data TimerSource
+  = TimerSource { timerHandle :: !(Handle WLEventSource)
+                , timerFunc   :: !(FunPtr WLEventLoopTimerFunc)
+                }
+
+-- | Handle to a message source that dispatches messages for file descriptor events.
+--
+-- The message source handle remains valid even after it is unregistered. However, actions using the source (like
+-- unregistering it) will fail.
+data FileSource
+  = FileSource { fileHandle :: !(Handle WLEventSource)
+               , fileFunc   :: !(FunPtr WLEventLoopFdFunc)
+               }
+
+-- | The file events listened for by a 'FileSource' on a UNIX file descriptor.
+data FileEventMask
+  = FileEventMask { fileEventReadable :: Bool
+                  , fileEventWritable :: Bool
+                  , fileEventHangup   :: Bool
+                  , fileEventError    :: Bool
+                  }
+  deriving (Show, Eq, Ord)
 
 -- | Handle to a global object shared between all clients.
 --
--- For each client, the global can be "bound" to a specific object. The global handle remains valid even after it was
--- unregistered.
-data Global = Global (FunPtr WLGlobalBindFunc) (IORef WLGlobal)
-  deriving (Eq)
+-- For each client, the global can be "bound" to a specific object.
+--
+-- The global handle remains valid even after it is destroyed. However, actions using the global (like unregistering it)
+-- will fail.
+data Global
+  = Global { glbHandle   :: Handle WLGlobal
+           , glbBindFunc :: FunPtr WLGlobalBindFunc
+           }
 
 makeLenses ''DisplayState
 
@@ -101,6 +157,54 @@ type instance Zoomed (DisplayM s) = Zoomed (StateT s (ReaderT Display (StateT Di
 instance Zoom (DisplayM s) (DisplayM t) s t where
   zoom l (DisplayM m) = DisplayM (zoom l m)
 
+instance Eq SignalSource where
+  a == b = signalHandle a == signalHandle b
+
+instance Ord SignalSource where
+  a <= b = signalHandle a <= signalHandle b
+
+instance Hashable SignalSource where
+  hashWithSalt s o = hashWithSalt s (signalHandle o)
+
+instance Show SignalSource where
+  show o = "SignalSource " ++ show (signalHandle o)
+
+instance Eq TimerSource where
+  a == b = timerHandle a == timerHandle b
+
+instance Ord TimerSource where
+  a <= b = timerHandle a <= timerHandle b
+
+instance Hashable TimerSource where
+  hashWithSalt s o = hashWithSalt s (timerHandle o)
+
+instance Show TimerSource where
+  show o = "TimerSource " ++ show (timerHandle o)
+
+instance Eq FileSource where
+  a == b = fileHandle a == fileHandle b
+
+instance Ord FileSource where
+  a <= b = fileHandle a <= fileHandle b
+
+instance Hashable FileSource where
+  hashWithSalt s o = hashWithSalt s (fileHandle o)
+
+instance Show FileSource where
+  show o = "FileSource " ++ show (fileHandle o)
+
+instance Eq Global where
+  a == b = glbHandle a == glbHandle b
+
+instance Ord Global where
+  a <= b = glbHandle a <= glbHandle b
+
+instance Hashable Global where
+  hashWithSalt s o = hashWithSalt s (glbHandle o)
+
+instance Show Global where
+  show o = "Global " ++ show (glbHandle o)
+
 -- | Lift a 'Display' reader operation into the display monad.
 liftDisplay :: ReaderT Display (StateT DisplayState IO) a -> DisplayM s a
 liftDisplay = DisplayM . lift
@@ -111,20 +215,25 @@ liftDisplayState = DisplayM . lift . lift
 
 -- | Get a reference to the underlying wl_display instance.
 getDisplay :: DisplayM s WLDisplay
-getDisplay = liftDisplay $ asks display
+getDisplay = liftDisplay $ asks dispDisplay
 
--- | Get a function which can be used to handle a request.
+-- | Get a function which can be used to handle a message.
 --
--- This function can be used even before the event loop is started as it will use the mutable "activeEventLoop"
--- reference which gets updated when the event loop is started.
-getRequestHandler :: DisplayM s (Request -> IO ())
-getRequestHandler = do
-  loopRef <- liftDisplay $ asks activeEventLoop
-  pure $ \req -> do
-    loop <- readIORef loopRef
-    case loop of
-      Just handler -> handleEvent handler req
-      Nothing      -> putStrLn $ "Lost request because no event loop is active: " ++ show req
+-- This function can be used even before the message loop is started as it will use the mutable "activeMessageLoop"
+-- reference which gets updated when the message loop is started.
+getMessageHandler :: DisplayM s (Message -> IO ())
+getMessageHandler = liftDisplay $ asks (handleMessage . dispActiveMessageLoop)
+
+-- | Handle a message within a display's message loop.
+--
+-- The message loop supports reentrant calls. In this case, dispatching the message is delayed until after the current
+-- message has been processed.
+handleMessage :: IORef (Maybe MessageLoop) -> Message -> IO ()
+handleMessage loopRef msg = do
+  loop <- readIORef loopRef
+  case loop of
+    Just (MessageLoop handler) -> handler msg
+    Nothing                    -> putStrLn $ "Lost message because no message loop is active: " ++ show msg
 
 -- | Create a new display and execute the given action on it.
 --
@@ -134,16 +243,31 @@ withDisplay
   -> DisplayM s a -- ^ The display action to execute.
   -> IO (a, s)    -- ^ IO monad returning the result and the resulting state.
 withDisplay initialState f = bracket wlDisplayCreate wlDisplayDestroy $ \sysDisp -> do
-  eventLoop <- newIORef Nothing
-  let disp = Display { display         = sysDisp
-                     , activeEventLoop = eventLoop
-                     }
+  messageLoop <- newIORef Nothing
+  clientData  <- newClientData (handleMessage messageLoop)
   objectCache <- newObjectCache
+  let disp = Display { dispDisplay           = sysDisp
+                     , dispActiveMessageLoop = messageLoop
+                     , dispClientData        = clientData
+                     }
   let dispState = DisplayState { _stateObjectCache = objectCache }
-  (res, dispState') <- runStateT (runReaderT (runStateT (runDisplayM f) initialState) disp) dispState
+  (res, dispState') <- handleClientCreated disp $
+    runStateT (runReaderT (runStateT (runDisplayM f) initialState) disp) dispState
   destroyObjectCache (_stateObjectCache dispState')
+  destroyClientData clientData
   pure res
 
+-- | Handle the "client created" event, creating a wrapper and dispatching a message.
+handleClientCreated :: Display -> IO a -> IO a
+handleClientCreated disp action =
+  let clientCreated :: Ptr WLListener -> Ptr () -> IO ()
+      clientCreated _ c = do
+        client <- runReaderT (createClient (WLClient (castPtr c))) (dispClientData disp)
+        handleMessage (dispActiveMessageLoop disp) $ Message $ ClientCreated client
+  in bracket (wrapWLNotifyFunc clientCreated) freeHaskellFunPtr $ \clientCreatedFunc ->
+    bracket (new $ WLListener clientCreatedFunc) free $ \clientListener ->
+      bracket_ (wlDisplayAddClientCreatedListener (dispDisplay disp) clientListener) (wlListenerRemove clientListener) action
+
 -- | Bind the display to a UNIX socket so it is reachable from clients.
 --
 -- This will return the name of the Wayland display.
@@ -153,49 +277,117 @@ bindSocket = do
   name <- liftIO $ wlDisplayAddSocketAuto disp
   liftIO $ peekCString name
 
--- | Start the event loop for the display.
+-- | Start the message loop for the display.
 --
--- The display will then handle all requests using the provided handler until 'requestTermination' is called. The state
--- may be modified by the request handler.
-processRequests :: RequestHandler s -> DisplayM s ()
-processRequests h = do
+-- The display will then handle all messages using the provided handler until 'requestTermination' is called. The state
+-- may be modified by the message handler.
+processMessages :: MessageHandler s -> DisplayM s ()
+processMessages h = do
   disp <- liftDisplay ask
   stateBefore <- get
   displayStateBefore <- liftDisplayState get
-  stateRef <- liftIO $ newIORef (stateBefore, displayStateBefore)
-  let handler :: Request -> IO ()
+  stateRef <- liftIO $ newIORef $ Just (stateBefore, displayStateBefore)
+  queued   <- liftIO $ newIORef []
+  let snoc r (x:xs) = x : snoc r xs
+      snoc r []     = [r]
+  let runQueued :: MessageHandler s -> DisplayM s ()
+      runQueued h' = do
+        x <- liftIO $ readIORef queued
+        case x of
+          (r:rs) -> do liftIO $ writeIORef queued rs
+                       h' r
+                       runQueued h'
+          []    -> pure ()
+  let handler :: Message -> IO ()
       handler r = do
-        (s, ds) <- readIORef stateRef
-        ((_, s'), ds') <- runStateT (runReaderT (runStateT (runDisplayM (h r)) s) disp) ds
-        writeIORef stateRef (s', ds')
-  loop <- liftIO $ readIORef (activeEventLoop disp)
-  when (isJust loop) (error "Cannot start an event loop from within an event handler.")
-  liftIO $ writeIORef (activeEventLoop disp) (Just (EventLoop handler))
-  liftIO $ wlDisplayRun (display disp)
-  (stateAfter, displayStateAfter) <- liftIO $ readIORef stateRef
-  put stateAfter
-  liftDisplayState $ put displayStateAfter
+        stateVal <- readIORef stateRef
+        modifyIORef queued (snoc r) -- In most cases, queued is empty, so we don't really care about snoc's runtime.
+        case stateVal of
+          Just (s, ds) -> do writeIORef stateRef Nothing
+                             ((_, s'), ds') <- runStateT (runReaderT (runStateT (runDisplayM (runQueued h)) s) disp) ds
+                             writeIORef stateRef $ Just (s', ds')
+          Nothing      -> pure () -- Reentrant call, dispatch after completing the current message.
+  loop <- liftIO $ readIORef (dispActiveMessageLoop disp)
+  when (isJust loop) (error "Cannot start a message loop from within a message handler.")
+  liftIO $ writeIORef (dispActiveMessageLoop disp) (Just (MessageLoop handler))
+  liftIO $ wlDisplayRun (dispDisplay disp)
+  stateVal <- liftIO $ readIORef stateRef
+  case stateVal of
+    Just (stateAfter, displayStateAfter) -> do put stateAfter
+                                               liftDisplayState $ put displayStateAfter
+    Nothing                              -> pure ()
 
--- | Request the event loop to stop.
+-- | Request the message loop to stop.
 --
--- The 'processRequests' will return following this action.
+-- The 'processMessages' will return following this action.
 requestTermination :: DisplayM s ()
 requestTermination = do
   disp <- getDisplay
   liftIO $ wlDisplayTerminate disp
 
+-- | Destroy a client instance.
+destroyClient :: Client -> DisplayM s ()
+destroyClient c = liftIO (unwrapClient c >>= wlClientDestroy)
+
+-- | Ensure that all queued events are sent to a particular client.
+flushClientEvents :: Client -> DisplayM s ()
+flushClientEvents c = liftIO (unwrapClient c >>= wlClientFlush)
+
+-- | Register a global object which can be bound by clients.
+--
+-- The object is published through the global wl_registry instance. When a client wants to instantiate the global
+-- object, the given "bind" message will be dispatched in the message loop.
+registerGlobal
+  :: forall o bindMsg s. Object o
+  => MessageClass bindMsg
+  => (Global -> NewObject o -> bindMsg) -- ^ Function used to create a message to bind the global object for a client.
+  -> DisplayM s Global                  -- ^ Display monad wrapping a handle to the global which can be used to unregister it.
+registerGlobal mkBindMsg = do
+  disp    <- getDisplay
+  handler <- getMessageHandler
+  iface   <- liftDisplayState $ zoom stateObjectCache $ resolveTypeInterface (Proxy :: Proxy o) handler
+  liftIO $ do
+    ref <- newIORef Nothing
+    let version = Wayland.Server.Interface.ifVersion (describeInterface (Proxy :: Proxy o))
+    let bind :: WLClient -> Ptr () -> Word32 -> Word32 -> IO ()
+        bind client _ _ objID = do wrappedClient <- wrapClient client
+                                   Just global   <- readIORef ref
+                                   obj           <- createNewObject wrappedClient objID
+                                   handler $ Message (mkBindMsg global obj)
+    bindFunc <- wrapWLGlobalBindFunc bind
+    handle   <- wlGlobalCreate disp iface (fromIntegral version) nullPtr bindFunc >>= createHandle
+    let res = Global handle bindFunc
+    writeIORef ref (Just res)
+    pure res
+
+-- | Stop advertizing a global object to client.
+--
+-- The global will continue to exist until it is destroyed using 'destroyGlobal'. This is useful for waiting for a
+-- timeout to elapse before actually destroying the global.
+hideGlobal :: Global -> DisplayM s ()
+hideGlobal global = liftIO (resolveHandle (glbHandle global) >>= wlGlobalRemove)
+
+-- | Unregister a global once it is no longer available.
+--
+-- The global and all resources associated with it will be destroyed.
+unregisterGlobal :: Global -> DisplayM s ()
+unregisterGlobal global = liftIO $ do
+  resolveHandle (glbHandle global) >>= wlGlobalDestroy
+  invalidateHandle (glbHandle global)
+  freeHaskellFunPtr (glbBindFunc global)
+
 -- | Create a new object instance.
 --
--- If the NewObject instance has already been used to create an instance, the same instance is returned again.
+-- It is a programmer error to use a NewObject instance more than once.
 createObject
   :: Object o
-  => RequestClass destroyReq
+  => MessageClass destroyMsg
   => NewObject o        -- ^ Handle describing the object to be created
-  -> (o -> destroyReq)  -- ^ Function creating a request dispatched after the object was destroyed.
+  -> (o -> destroyMsg)  -- ^ Function creating a message dispatched after the object was destroyed.
   -> DisplayM s o       -- ^ Display monad wrapping the newly created object.
 createObject o destroyHook = do
-  handle <- getRequestHandler
-  liftDisplayState $ zoom stateObjectCache $ createResource handle o destroyHook
+  handler <- getMessageHandler
+  liftDisplayState $ zoom stateObjectCache $ createResource handler o destroyHook
 
 -- | Destroy an object instance.
 --
@@ -215,48 +407,119 @@ flushEvents = do
   disp <- getDisplay
   liftIO $ wlDisplayFlushClients disp
 
--- | Register a global object which can be bound by clients.
+-- | Register a message to be dispatched in the message loop when a UNIX signal is sent to the server process.
+registerSignalSource
+  :: MessageClass msg
+  => (SignalSource -> msg)   -- ^ Function used to create the message when the signal is received.
+  -> CInt                    -- ^ The code of the UNIX signal to listen for.
+  -> DisplayM s SignalSource -- ^ Display monad wrapping a handle to the newly registered message source.
+registerSignalSource mkMsg sig = do
+  disp    <- getDisplay
+  handler <- getMessageHandler
+  liftIO $ do
+    ref    <- newIORef Nothing
+    loop   <- wlDisplayGetEventLoop disp
+    func   <- wrapWLEventLoopSignalFunc $ \_ _ -> do
+      Just src <- readIORef ref
+      handler (Message (mkMsg src)) $> 0
+    handle <- wlEventLoopAddSignal loop sig func nullPtr >>= createHandle
+    let res = SignalSource handle func
+    writeIORef ref (Just res)
+    pure res
+
+-- | Unregister a signal message source and stop it from dispatching any more messages.
+unregisterSignalSource :: SignalSource -> DisplayM s ()
+unregisterSignalSource signal = liftIO $ do
+  _ <- resolveHandle (signalHandle signal) >>= wlEventSourceRemove
+  invalidateHandle (signalHandle signal)
+  freeHaskellFunPtr (signalFunc signal)
+
+-- | Register a message to be dispatched using a timer.
 --
--- The object is published through the global wl_registry instance. When a client wants to instantiate the global
--- object, the given "bind" request will be dispatched in the request loop.
-registerGlobal
-  :: forall o req s. Object o
-  => RequestClass req
-  => (NewObject o -> req) -- ^ Function used to create a request to bind the global object for a client.
-  -> Int                  -- ^ Version of the global published.
-  -> DisplayM s Global    -- ^ Display monad wrapping a handle to the global which can be used to unregister it.
-registerGlobal mkReq version = do
-  disp <- getDisplay
-  handle <- getRequestHandler
-  iface <- liftDisplayState $ zoom stateObjectCache $ resolveTypeInterface (Proxy :: Proxy o)
-  let bind :: WLClient -> Ptr () -> Word32 -> Word32 -> IO ()
-      bind client _ ver objID = do wrappedClient <- wrapClient client
-                                   obj <- createNewObject wrappedClient objID (fromIntegral ver)
-                                   handle $ Request (mkReq obj)
+-- Initially, the timer is not set. Use 'setTimerSource' to arm/disarm the timer later.
+registerTimerSource
+  :: MessageClass msg
+  => (TimerSource -> msg)   -- ^ Function used to create a message on timeout.
+  -> DisplayM s TimerSource -- ^ Display monad wrapping a handle to the newly registered message source.
+registerTimerSource mkMsg = do
+  disp    <- getDisplay
+  handler <- getMessageHandler
   liftIO $ do
-    bindFunc <- wrapWLGlobalBindFunc bind
-    global <- wlGlobalCreate disp iface (fromIntegral version) nullPtr bindFunc
-    globalRef <- newIORef global
-    -- TODO: Free func
-    pure $ Global bindFunc globalRef
+    ref    <- newIORef Nothing
+    loop   <- wlDisplayGetEventLoop disp
+    func   <- wrapWLEventLoopTimerFunc $ \_ -> do
+      Just src <- readIORef ref
+      handler (Message (mkMsg src)) $> 0
+    handle <- wlEventLoopAddTimer loop func nullPtr >>= createHandle
+    let res = TimerSource handle func
+    writeIORef ref (Just res)
+    pure res
 
--- | Unregister a global after it is no longer available.
-unregisterGlobal :: Global -> DisplayM s ()
-unregisterGlobal _ = pure ()
+-- | Arm/disarm a timer message source.
+--
+-- Any active timeout is stopped. If the specified timeout is not Nothing, a new timeout is started.
+setTimerSource :: TimerSource -> Maybe DiffTime -> DisplayM s ()
+setTimerSource timer timeout = liftIO $ do
+  src <- resolveHandle (timerHandle timer)
+  let msDelay = case timeout of
+                  Just diff -> fromIntegral $ max 1 (diffTimeToPicoseconds diff `div` 1000000000)
+                  Nothing   -> 0
+  void $ wlEventSourceTimerUpdate src msDelay
 
--- | Register an event to be dispatched in the request loop when a UNIX signal is sent to the server process.
-registerSignalEvent
-  :: RequestClass req
-  => req                    -- ^ The request dispatched when the signal is received.
-  -> CInt                   -- ^ The code of the UNIX signal to listen for.
-  -> DisplayM s EventSource -- ^ Display monad wrapping a handle to the event source which can be used to unregister it.
-registerSignalEvent r sig = do
-  disp <- getDisplay
-  handle <- getRequestHandler
+-- | Unregister a timer message source and stop it from dispatching any more messages.
+unregisterTimerSource :: TimerSource -> DisplayM s ()
+unregisterTimerSource timer = liftIO $ do
+  _ <- resolveHandle (timerHandle timer) >>= wlEventSourceRemove
+  invalidateHandle (timerHandle timer)
+  freeHaskellFunPtr (timerFunc timer)
+
+-- | Register a message to be dispatched for file events on a UNIX file descriptor.
+--
+-- Initially, file descriptors are usually writable so the event should only be listened for after a write fails.
+registerFileSource
+  :: MessageClass msg
+  => (FileSource -> FileEventMask -> msg) -- ^ Function used to create a message following one or more file events (as specified).
+  -> Fd                                   -- ^ The UNIX file descriptor to watch.
+  -> FileEventMask                        -- ^ Events to watch for.
+  -> DisplayM s FileSource                -- ^ Display monad wrapping a handle to the newly registered message source.
+registerFileSource mkMsg (Fd fd) events = do
+  disp    <- getDisplay
+  handler <- getMessageHandler
   liftIO $ do
-    loop <- wlDisplayGetEventLoop disp
-    func <- wrapWLEventLoopSignalFunc $ \_ _ -> handle (Request r) $> 0
-    src <- wlEventLoopAddSignal loop sig func nullPtr
-    srcRef <- newIORef src
-    -- TODO: Free func
-    pure $ EventSource func srcRef
+    ref    <- newIORef Nothing
+    loop   <- wlDisplayGetEventLoop disp
+    func   <- wrapWLEventLoopFdFunc $ \_ e _ -> do
+      Just src <- readIORef ref
+      handler (Message (mkMsg src (toFileEventMask e))) $> 0
+    handle <- wlEventLoopAddFd loop fd (fromFileEventMask events) func nullPtr >>= createHandle
+    let res = FileSource handle func
+    writeIORef ref (Just res)
+    pure res
+
+-- | Update the file events to watch for using an existing file message source.
+updateFileSourceMask :: FileSource -> FileEventMask -> DisplayM s ()
+updateFileSourceMask file events = liftIO $ do
+  src <- resolveHandle (fileHandle file)
+  void $ wlEventSourceFdUpdate src (fromFileEventMask events)
+
+-- | Unregister a file message source and stop it from dispatching any more messages.
+unregisterFileSource :: FileSource -> DisplayM s ()
+unregisterFileSource file = liftIO $ do
+  _ <- resolveHandle (fileHandle file) >>= wlEventSourceRemove
+  invalidateHandle (fileHandle file)
+  freeHaskellFunPtr (fileFunc file)
+
+fromFileEventMask :: FileEventMask -> Word32
+fromFileEventMask events = conditionalMask wlEventReadable (fileEventReadable events)
+                         $ conditionalMask wlEventWritable (fileEventWritable events)
+                         $ conditionalMask wlEventHangup   (fileEventHangup   events)
+                         $ conditionalMask wlEventError    (fileEventError    events) 0
+  where conditionalMask mask enabled x = if enabled then x .|. mask else x
+
+toFileEventMask :: Word32 -> FileEventMask
+toFileEventMask bits = FileEventMask { fileEventReadable = testMask wlEventReadable
+                                     , fileEventWritable = testMask wlEventWritable
+                                     , fileEventHangup   = testMask wlEventHangup
+                                     , fileEventError    = testMask wlEventError
+                                     }
+  where testMask mask = (bits .&. mask) /= 0
diff --git a/wayland/Wayland/Server/Object.hs b/wayland/Wayland/Server/Object.hs
index 1437cc9..b56bbaf 100644
--- a/wayland/Wayland/Server/Object.hs
+++ b/wayland/Wayland/Server/Object.hs
@@ -21,8 +21,6 @@ module Wayland.Server.Object
   , createNewObject
   , RequestClass
   , EventClass
-  , Request(..)
-  , fromRequest
   , ArgumentMarshaller(..)
   , ArgumentDemarshaller(..)
   , -- * State
@@ -38,23 +36,24 @@ module Wayland.Server.Object
   , sendResourceEvent
   ) where
 
-import System.Mem.StableName (makeStableName, StableName)
+import System.Posix.Types (Fd(..))
 import Data.Kind (Type)
 import Data.Hashable (Hashable(..))
-import Data.IORef (readIORef, newIORef, writeIORef, IORef)
-import Data.Typeable (Proxy(..), TypeRep, typeRep, Typeable, cast)
+import Data.IORef (readIORef, newIORef, IORef, writeIORef)
+import Data.Typeable (Proxy(..), TypeRep, typeRep, Typeable)
 import Foreign
 import Foreign.C (withCString, peekCString, CInt)
-import Lens.Micro.Mtl ((<<%=), use, (%=), zoom)
+import Lens.Micro.Mtl (use, (%=), zoom)
 import Lens.Micro.TH (makeLenses)
-import Control.Monad.State.Strict (StateT(..), MonadState)
+import Control.Monad.State.Strict (StateT(..), MonadState(..))
 import Control.Monad.Cont (ContT(..))
 import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
-import Control.Monad (when)
+import Control.Monad.Reader (ReaderT (..), MonadReader(..))
 import Wayland.Server.System
-import Wayland.Server.Interface (MessageDesc(..), InterfaceDesc, InterfaceCache, newInterfaceCache, destroyInterfaceCache, resolveInterface)
+import Wayland.Server.Interface (MessageDesc(..), InterfaceDesc(..), InterfaceCache, newInterfaceCache, destroyInterfaceCache, resolveInterface)
+import Wayland.Server.Client (Client, unwrapClient, wrapClient)
+import Wayland.Server.Types (Handle, invalidateHandle, resolveHandle, createHandle, MessageClass, Message(..))
 import qualified Data.Map as M
-import Wayland.Server.Client (Client, unwrapClient)
 
 -- | The primary data type for typed object handles.
 --
@@ -100,18 +99,14 @@ class (Typeable o, RequestClass (ObjectRequest o), EventClass (ObjectEvent o)) =
 
 -- | A request for an object sent by a client.
 --
--- The request usually includes the object it is referring to, as well as arguments provided by the client.
---
--- The request's type is erased and it is then processed by the display's event loop.
-class (Typeable r, Show r) => RequestClass r where
+-- The request usually includes the object it is referring to, as well as arguments provided by the client. It is
+-- processed as part of the server's message loop.
+class MessageClass r => RequestClass r where
 
 -- | An event that can be emitted on an object by the server.
 --
 -- The event stores the arguments passed to the client.
-class (Typeable e, Show e) => EventClass e where
-
--- | A type-erased request.
-data Request = forall r. RequestClass r => Request r
+class MessageClass e => EventClass e where
 
 -- | A monad providing an environment for marshalling a fixed number of arguments of various types.
 --
@@ -125,7 +120,7 @@ class Monad m => ArgumentMarshaller m where
   marshalObject :: Object o => o           -> m ()
   marshalNewID  :: Object o => NewObject o -> m ()
   marshalArray  :: Storable a => [a]       -> m ()
-  marshalFD     :: Int32                   -> m ()
+  marshalFD     :: Fd                      -> m ()
 
 -- | A monad providing an environment for reading a fixed number of arguments of various types.
 --
@@ -139,28 +134,25 @@ class Monad m => ArgumentDemarshaller m where
   demarshalObject :: Object o => m o
   demarshalNewID  :: Object o => m (NewObject o)
   demarshalArray  :: Storable a => m [a]
-  demarshalFD     :: m Int32
+  demarshalFD     :: m Fd
 
 -- | An opaque handle to a Wayland object.
 --
 -- The handle remains valid and can be used for equality checks even after the underlying libwayland resource was
--- destroyed. This is realized using an IORef which is set to nullPtr once the resource is destroyed. The IORef itself
--- is used for equality checks.
+-- destroyed. However, actions using the object (like sending events to it) will fail.
 --
 -- In addition, a custom type-erased cleanup action is stored which is invoked once the resource is destroyed.
 data AnyObject
-  = AnyObject { objName        :: StableName (IORef WLResource) -- ^ Name used for hashing and ordering.
-              , objResource    :: IORef WLResource              -- ^ Reference to the underlying resource.
-              , objDestroyHook :: AnyObject -> IO ()            -- ^ Function executed after the object was destroyed.
+  = AnyObject { objHandle      :: Handle WLResource  -- ^ The underlying resource.
+              , objDestroyHook :: AnyObject -> IO () -- ^ Function executed after the object was destroyed.
               }
 
 -- | Handle to an object which has not yet been created but has an ID assigned by the client.
 --
--- This handle can be used to create an object.
+-- This handle can be used to create an object. It is a programmer error to use it more than once.
 data NewObject o
   = NewObject { newClient  :: !Client            -- ^ The client this object is associated with.
               , newID      :: !Word32            -- ^ Object ID of the new object.
-              , newVersion :: !CInt              -- ^ Protocol version to use for the newly created object.
               , newObject  :: !(IORef (Maybe o)) -- ^ Reference to the object, assigned when it is created.
               }
 
@@ -180,51 +172,42 @@ data ObjectCache
 -- | A state monad providing an instance of 'ObjectCache'.
 type ObjectCacheState = StateT ObjectCache IO
 
--- | State used when iterating over a fixed number of wl_arguments.
-data ArgumentIterator
-  = ArgumentIterator { _argNext          :: !(Ptr WLArgument) -- ^ Pointer to the next argument to be processed.
-                     , _argRemaining     :: !Int              -- ^ Number of remaining arguments in the list.
-                     }
+-- | State used when iterating over a buffer of wl_arguments.
+newtype ArgumentIterator = ArgumentIterator (Ptr WLArgument)
 
--- | A state monad providing an instance of 'ArgumentIterator'.
+-- | Monad used for writing arguments into a wl_argument buffer.
 --
 -- The monad wraps a ContT monad to allow using alloca when wrapping arguments.
-newtype ArgumentIteratorState r a
-  = ArgumentIteratorState { runArgumentIteratorState :: StateT ArgumentIterator (ContT r IO) a }
+newtype ArgumentWriter r a = ArgumentWriter { runArgumentWriter :: StateT ArgumentIterator (ContT r IO) a }
   deriving (Functor, Applicative, Monad, MonadState ArgumentIterator, MonadIO)
 
-makeLenses ''ObjectCache
-makeLenses ''ArgumentIterator
+-- | Monad used for reading arguments from a wl_argument buffer.
+newtype ArgumentReader a = ArgumentReader { runArgumentReader :: StateT ArgumentIterator (ReaderT Client IO) a }
+  deriving (Functor, Applicative, Monad, MonadState ArgumentIterator, MonadIO, MonadReader Client)
 
-instance Show Request where
-  show (Request r) = show r
-
--- | Try to cast a type-erased request into a concrete 'RequestClass'.
-fromRequest :: RequestClass a => Request -> Maybe a
-fromRequest (Request x) = cast x
+makeLenses ''ObjectCache
 
 instance Eq AnyObject where
-  a == b = objResource a == objResource b
+  a == b = objHandle a == objHandle b
 
 instance Ord AnyObject where
-  a <= b = hash (objName a) <= hash (objName b)
+  a <= b = objHandle a <= objHandle b
 
 instance Hashable AnyObject where
-  hashWithSalt s o = hashWithSalt s (objName o)
+  hashWithSalt s o = hashWithSalt s (objHandle o)
 
 instance Show AnyObject where
-  show o = "AnyObject " ++ show (hash (objName o))
+  show o = show (objHandle o)
 
 instance Show (NewObject o) where
   show o = "NewObject " ++ show (newClient o) ++ " " ++ show (newID o)
 
 -- | Create a handle to an object that has yet to be created.
-createNewObject :: Client -> Word32 -> CInt -> IO (NewObject o)
-createNewObject client objID version = do
+createNewObject :: Client -> Word32 -> IO (NewObject o)
+createNewObject client objID = do
   obj <- newIORef Nothing
   pure $ NewObject { newClient  = client
                    , newID      = objID
-                   , newVersion = version
                    , newObject  = obj
                    }
 
@@ -251,10 +234,7 @@ destroyObjectCache c = do
 --
 -- This function may raise an error if the underlying resource is no longer alive.
 unwrapResource :: Object o => o -> IO WLResource
-unwrapResource o = fetch (toAny o)
-  where fetch obj = readIORef (objResource obj) >>= check
-        check res@(WLResource ptr) | ptr == nullPtr = error "Invalid object handle."
-                                   | otherwise      = pure res
+unwrapResource o = resolveHandle (objHandle (toAny o))
 
 -- | Get the typed object wrapping a Wayland resource.
 --
@@ -271,39 +251,38 @@ destroyResource :: WLResource -> IO ()
 destroyResource res = do
   objPtr <- castPtrToStablePtr <$> wlResourceGetUserData res
   obj <- deRefStablePtr objPtr
-  writeIORef (objResource obj) (WLResource nullPtr)
+  invalidateHandle (objHandle obj)
   freeStablePtr objPtr
-  -- TODO: Prevent destroy hook from being invoked while in the request handler.
   objDestroyHook obj obj
 
 -- | Create a new Wayland resource and associate it with a typed object wrapper.
 --
 -- This not only creates the object but also attaches a dispatch function to it and updates the destroy callback.
 createResource
-  :: forall o destroyReq. Object o
-  => RequestClass destroyReq
-  => (Request -> IO ()) -- ^ Request handler used for dispatching object requests and the destroy hook.
+  :: forall o destroyMsg. Object o
+  => MessageClass destroyMsg
+  => (Message -> IO ()) -- ^ Message handler used for dispatching object requests and the destroy hook.
   -> NewObject o        -- ^ Handle describing the object to be created
-  -> (o -> destroyReq)  -- ^ Function creating a request dispatched after the object was destroyed.
+  -> (o -> destroyMsg)  -- ^ Function creating a message dispatched after the object was destroyed.
   -> ObjectCacheState o -- ^ State monad returning the newly created object.
-createResource handle newObj destroyHook = do
+createResource handler newObj destroyHook = do
   existing <- liftIO $ readIORef (newObject newObj)
   case existing of
-    Just obj -> pure obj
-    Nothing  -> do typeInfo <- resolveTypeInfo (Proxy :: Proxy o)
-                   destroyFunc <- use cacheDestroyFunc
-                   liftIO $ do
-                     client <- unwrapClient (newClient newObj)
-                     res <- wlResourceCreate client (typeInterface typeInfo) (newVersion newObj) (newID newObj)
-                     resRef <- newIORef res
-                     name <- makeStableName resRef
-                     let obj = fromAny $ AnyObject { objName        = name
-                                                   , objResource    = resRef
-                                                   , objDestroyHook = handle . Request . destroyHook . fromAny
-                                                   }
-                     objPtr <- newStablePtr obj
-                     wlResourceSetDispatcher res (typeDispatchFunc typeInfo) nullPtr (castStablePtrToPtr objPtr) destroyFunc
-                     pure obj
+    Just _  -> error "The NewObject instance was already used to create an object."
+    Nothing -> do typeInfo <- resolveTypeInfo (Proxy :: Proxy o) handler
+                  destroyFunc <- use cacheDestroyFunc
+                  liftIO $ do
+                    let version = Wayland.Server.Interface.ifVersion (describeInterface (Proxy :: Proxy o))
+                    client <- unwrapClient (newClient newObj)
+                    res <- wlResourceCreate client (typeInterface typeInfo) (fromIntegral version) (newID newObj)
+                    handle <- createHandle res
+                    let obj = fromAny $ AnyObject { objHandle      = handle
+                                                  , objDestroyHook = handler . Message . destroyHook . fromAny
+                                                  }
+                    objPtr <- newStablePtr obj
+                    wlResourceSetDispatcher res (typeDispatchFunc typeInfo) nullPtr (castStablePtrToPtr objPtr) destroyFunc
+                    writeIORef (newObject newObj) (Just obj)
+                    pure obj
 
 -- | Send an event for a typed object.
 --
@@ -313,32 +292,36 @@ sendResourceEvent o e = do
   let paramCount = length $ msgArguments (eventSignature (Proxy :: Proxy o) e)
   res <- unwrapResource o
   allocaArray0 paramCount $ \buffer ->
-    let s = ArgumentIterator { _argNext      = buffer
-                             , _argRemaining = paramCount
-                             }
-        handler (opcode, _) = wlResourcePostEventArray res (fromIntegral opcode) buffer
-    in runContT (runStateT (runArgumentIteratorState (marshalEvent (Proxy :: Proxy o) e)) s) handler
+    runContT (runStateT (runArgumentWriter (marshalEvent (Proxy :: Proxy o) e)) (ArgumentIterator buffer)) $ \(opcode, _) ->
+      wlResourcePostEventArray res (fromIntegral opcode) buffer
 
 -- | Request handler for a typed object.
 --
 -- This provides a WLDispatcherFunc for an object type.
-dispatchResourceRequest :: forall o. Object o => Proxy o -> Ptr () -> WLResource -> Word32 -> Ptr WLMessage -> Ptr WLArgument -> IO CInt
-dispatchResourceRequest _ _ res _ _ _ = do
-  _ :: o <- wrapResource res
-  -- TODO: Handle request
+dispatchResourceRequest :: forall o. Object o => Proxy o -> (Message -> IO ()) -> Ptr () -> WLResource -> Word32 -> Ptr WLMessage -> Ptr WLArgument -> IO CInt
+dispatchResourceRequest _ handler _ res opcode _ args = do
+  obj :: o <- wrapResource res
+  client <- wlResourceGetClient res >>= wrapClient
+  (req, _) <- runReaderT (runStateT (runArgumentReader (demarshalRequest obj (fromIntegral opcode))) (ArgumentIterator args)) client
+  handler $ Message req
   pure 0
 
 -- | Resolve a type information for an object type.
 --
 -- This will first attempt to use an existing instance from the 'ObjectCache'. If there is none, it will create a new
 -- structure storing the wl_interface pointer and allocating a function pointer to the typed dispatcher function.
-resolveTypeInfo :: Object o => Proxy o -> ObjectCacheState TypeInfo
-resolveTypeInfo proxy = do
+resolveTypeInfo
+  :: Object o
+  => Proxy o                   -- ^ Proxy for the object type to resolve.
+  -> (Message -> IO ())        -- ^ Message handler used to dispatch requests in the type's dispatch func.
+  -> ObjectCacheState TypeInfo -- ^ State monad wrapping the type information.
+resolveTypeInfo proxy handler = do
   existing <- use cacheTypeInfo
   case M.lookup (typeRep proxy) existing of
     Just info -> pure info
-    Nothing   -> do interface    <- zoom cacheInterfaces $ resolveInterface (describeInterface proxy)
-                    dispatchFunc <- liftIO $ wrapWLDispatcherFunc (dispatchResourceRequest proxy)
+    Nothing   -> do let desc = describeInterface proxy
+                    interface    <- zoom cacheInterfaces $ resolveInterface desc
+                    dispatchFunc <- liftIO $ wrapWLDispatcherFunc (dispatchResourceRequest proxy handler)
                     let info = TypeInfo { typeInterface    = interface
                                         , typeDispatchFunc = dispatchFunc
                                         }
@@ -346,24 +329,27 @@ resolveTypeInfo proxy = do
                     pure info
 
 -- | Resolve the native interface for an object type.
-resolveTypeInterface :: Object o => Proxy o -> ObjectCacheState (Ptr WLInterface)
-resolveTypeInterface proxy = typeInterface <$> resolveTypeInfo proxy
+resolveTypeInterface
+  :: Object o
+  => Proxy o                            -- ^ Proxy for the object type to resolve.
+  -> (Message -> IO ())                 -- ^ Message handler used to dispatch requests in the type's dispatch func.
+  -> ObjectCacheState (Ptr WLInterface) -- ^ State monad wrapping the native interface.
+resolveTypeInterface proxy handler = typeInterface <$> resolveTypeInfo proxy handler
 
 -- | Get the next argument in an argument iterator.
 --
 -- This function may raise an error if there is no more argument remaining.
-advanceIterator :: ArgumentIteratorState r (Ptr WLArgument)
+advanceIterator :: MonadState ArgumentIterator m => m (Ptr WLArgument)
 advanceIterator = do
-  next      <- argNext      <<%= \p -> plusPtr p (sizeOf (undefined :: WLArgument))
-  remaining <- argRemaining <<%= (+(-1))
-  when (remaining == 0) (error "Out of range for argument")
-  pure next
+  ArgumentIterator arg <- get
+  put $ ArgumentIterator $ plusPtr arg (sizeOf (undefined :: WLArgument))
+  pure arg
 
--- | Create an 'ArgumentIteratorState' wrapping a continuation (like alloca).
-liftCont :: ((a -> IO r) -> IO r) -> ArgumentIteratorState r a
-liftCont = ArgumentIteratorState . lift . ContT
+-- | Create an 'ArgumentWriter' wrapping a continuation (like alloca).
+liftCont :: ((a -> IO r) -> IO r) -> ArgumentWriter r a
+liftCont = ArgumentWriter . lift . ContT
 
-instance ArgumentMarshaller (ArgumentIteratorState r) where
+instance ArgumentMarshaller (ArgumentWriter r) where
   marshalInt v = do
     arg <- advanceIterator
     liftIO $ wlArgumentPokeInt arg (fromIntegral v)
@@ -373,7 +359,7 @@ instance ArgumentMarshaller (ArgumentIteratorState r) where
   marshalFixed v = do
     arg <- advanceIterator
     liftIO $ wlArgumentPokeFixed arg (WLFixed (round (v * 256)))
-  marshalFD v = do
+  marshalFD (Fd v) = do
     arg <- advanceIterator
     liftIO $ wlArgumentPokeFD arg (fromIntegral v)
   marshalString v = do
@@ -385,8 +371,8 @@ instance ArgumentMarshaller (ArgumentIteratorState r) where
     obj <- liftIO $ unwrapResource v
     liftIO $ wlArgumentPokeObject arg obj
   marshalNewID v = do
-    -- TODO
-    undefined
+    arg <- advanceIterator
+    liftIO $ wlArgumentPokeNewID arg (newID v)
   marshalArray v = do
     arg <- advanceIterator
     let len = fromIntegral $ length v * sizeOf (head v)
@@ -397,7 +383,7 @@ instance ArgumentMarshaller (ArgumentIteratorState r) where
                                      }
     liftIO $ wlArgumentPokeArray arg arr
 
-instance ArgumentDemarshaller (ArgumentIteratorState r) where
+instance ArgumentDemarshaller ArgumentReader where
   demarshalInt    = fromIntegral   <$> (advanceIterator >>= liftIO . wlArgumentPeekInt)
   demarshalUInt   = fromIntegral   <$> (advanceIterator >>= liftIO . wlArgumentPeekUInt)
   demarshalFixed  = wlFixedToFloat <$> (advanceIterator >>= liftIO . wlArgumentPeekFixed)
@@ -408,10 +394,11 @@ instance ArgumentDemarshaller (ArgumentIteratorState r) where
     ptr <- advanceIterator >>= liftIO . wlArgumentPeekObject
     liftIO $ wrapResource ptr
   demarshalNewID = do
-    -- TODO
-    undefined
+    objID <- advanceIterator >>= liftIO . wlArgumentPeekNewID
+    client <- ask
+    liftIO $ createNewObject client objID
   demarshalArray = do
     ptr <- advanceIterator >>= liftIO . wlArgumentPeekArray
     arr <- liftIO $ peek ptr
     liftIO $ peekArray (fromIntegral (arrSize arr)) (castPtr (arrData arr))
-  demarshalFD = advanceIterator >>= liftIO . wlArgumentPeekFD
+  demarshalFD = Fd . fromIntegral <$> (advanceIterator >>= liftIO . wlArgumentPeekFD)
diff --git a/wayland/Wayland/Server/System.hsc b/wayland/Wayland/Server/System.hsc
index 8340efa..960caf4 100644
--- a/wayland/Wayland/Server/System.hsc
+++ b/wayland/Wayland/Server/System.hsc
@@ -18,17 +18,38 @@ import Foreign (FunPtr, Ptr, Int32, Storable(..), castPtr)
 import Foreign.C (CString, CSize, CInt(..))
 import Data.Word (Word32)
 
+-- * Constants
+
+wlEventReadable :: Word32
+wlEventReadable = #{const WL_EVENT_READABLE}
+wlEventWritable :: Word32
+wlEventWritable = #{const WL_EVENT_WRITABLE}
+wlEventHangup   :: Word32
+wlEventHangup   = #{const WL_EVENT_HANGUP}
+wlEventError    :: Word32
+wlEventError    = #{const WL_EVENT_ERROR}
+
 -- * Callback Types
 
 type WLEventLoopSignalFunc = CInt -> Ptr () -> IO CInt
+type WLEventLoopTimerFunc  = Ptr () -> IO CInt
+type WLEventLoopFdFunc     = CInt -> Word32 -> Ptr () -> IO CInt
 type WLGlobalBindFunc      = WLClient -> Ptr () -> Word32 -> Word32 -> IO ()
 type WLDispatcherFunc      = Ptr () -> WLResource -> Word32 -> Ptr WLMessage -> Ptr WLArgument -> IO CInt
 type WLResourceDestroyFunc = WLResource -> IO ()
+type WLNotifyFunc          = Ptr WLListener -> Ptr () -> IO ()
+type WLUserDataDestroyFunc = Ptr () -> IO ()
 
 foreign import ccall "wrapper"
   wrapWLEventLoopSignalFunc :: WLEventLoopSignalFunc -> IO (FunPtr WLEventLoopSignalFunc)
 
 foreign import ccall "wrapper"
+  wrapWLEventLoopTimerFunc :: WLEventLoopTimerFunc -> IO (FunPtr WLEventLoopTimerFunc)
+
+foreign import ccall "wrapper"
+  wrapWLEventLoopFdFunc :: WLEventLoopFdFunc -> IO (FunPtr WLEventLoopFdFunc)
+
+foreign import ccall "wrapper"
   wrapWLGlobalBindFunc :: WLGlobalBindFunc -> IO (FunPtr WLGlobalBindFunc)
 
 foreign import ccall "wrapper"
@@ -37,6 +58,12 @@ foreign import ccall "wrapper"
 foreign import ccall "wrapper"
   wrapWLResourceDestroyFunc :: WLResourceDestroyFunc -> IO (FunPtr WLResourceDestroyFunc)
 
+foreign import ccall "wrapper"
+  wrapWLNotifyFunc :: WLNotifyFunc -> IO (FunPtr WLNotifyFunc)
+
+foreign import ccall "wrapper"
+  wrapWLUserDataDestroyFunc :: WLUserDataDestroyFunc -> IO (FunPtr WLUserDataDestroyFunc)
+
 -- * Primitive Types
 
 -- ** wl_message
@@ -190,6 +217,24 @@ wlArgumentPokeArray  = #{poke union wl_argument, a}
 wlArgumentPokeFD     :: Ptr WLArgument -> Int32 -> IO ()
 wlArgumentPokeFD     = #{poke union wl_argument, h}
 
+-- ** wl_listener
+
+newtype WLListener = WLListener (FunPtr WLNotifyFunc)
+  deriving (Show)
+
+instance Storable WLListener where
+  sizeOf    _ = #{size struct wl_listener}
+  alignment _ = #{alignment struct wl_listener}
+  peek p = do
+    notify <- #{peek struct wl_listener, notify} p
+    return $ WLListener notify
+  poke p (WLListener notify) = do
+    #{poke struct wl_listener, notify} p notify
+    return ()
+
+foreign import ccall "wl_list_remove"
+  wlListenerRemove :: Ptr WLListener -> IO ()
+
 -- * Opaque Types
 
 -- ** wl_display
@@ -218,6 +263,9 @@ foreign import ccall "wl_display_terminate"
 foreign import ccall "wl_display_get_event_loop"
   wlDisplayGetEventLoop :: WLDisplay -> IO WLEventLoop
 
+foreign import ccall "wl_display_add_client_created_listener"
+  wlDisplayAddClientCreatedListener :: WLDisplay -> Ptr WLListener -> IO ()
+
 -- ** wl_event_loop
 
 newtype WLEventLoop = WLEventLoop (Ptr WLEventLoop)
@@ -226,11 +274,26 @@ newtype WLEventLoop = WLEventLoop (Ptr WLEventLoop)
 foreign import ccall "wl_event_loop_add_signal"
   wlEventLoopAddSignal :: WLEventLoop -> CInt -> FunPtr WLEventLoopSignalFunc -> Ptr () -> IO WLEventSource
 
+foreign import ccall "wl_event_loop_add_timer"
+  wlEventLoopAddTimer :: WLEventLoop -> FunPtr WLEventLoopTimerFunc -> Ptr () -> IO WLEventSource
+
+foreign import ccall "wl_event_loop_add_fd"
+  wlEventLoopAddFd :: WLEventLoop -> CInt -> Word32 -> FunPtr WLEventLoopFdFunc -> Ptr () -> IO WLEventSource
+
 -- ** wl_event_source
 
 newtype WLEventSource = WLEventSource (Ptr WLEventSource)
   deriving (Show, Eq, Storable)
 
+foreign import ccall "wl_event_source_remove"
+  wlEventSourceRemove :: WLEventSource -> IO CInt
+
+foreign import ccall "wl_event_source_fd_update"
+  wlEventSourceFdUpdate :: WLEventSource -> Word32 -> IO CInt
+
+foreign import ccall "wl_event_source_timer_update"
+  wlEventSourceTimerUpdate :: WLEventSource -> CInt -> IO CInt
+
 -- ** wl_global
 
 newtype WLGlobal = WLGlobal (Ptr WLGlobal)
@@ -239,11 +302,29 @@ newtype WLGlobal = WLGlobal (Ptr WLGlobal)
 foreign import ccall "wl_global_create"
   wlGlobalCreate :: WLDisplay -> Ptr WLInterface -> CInt -> Ptr () -> FunPtr WLGlobalBindFunc -> IO WLGlobal
 
+foreign import ccall "wl_global_remove"
+  wlGlobalRemove :: WLGlobal -> IO ()
+
+foreign import ccall "wl_global_destroy"
+  wlGlobalDestroy :: WLGlobal -> IO ()
+
 -- ** wl_client
 
 newtype WLClient = WLClient (Ptr WLClient)
   deriving (Show, Eq, Storable)
 
+foreign import ccall "wl_client_destroy"
+  wlClientDestroy :: WLClient -> IO ()
+
+foreign import ccall "wl_client_flush"
+  wlClientFlush :: WLClient -> IO ()
+
+foreign import ccall "wl_client_set_user_data"
+  wlClientSetUserData :: WLClient -> Ptr () -> FunPtr WLUserDataDestroyFunc -> IO ()
+
+foreign import ccall "wl_client_get_user_data"
+  wlClientGetUserData :: WLClient -> IO (Ptr ())
+
 -- ** wl_resource
 
 newtype WLResource = WLResource (Ptr WLResource)
@@ -263,3 +344,6 @@ foreign import ccall "wl_resource_post_event_array"
 
 foreign import ccall "wl_resource_destroy"
   wlResourceDestroy :: WLResource -> IO ()
+
+foreign import ccall "wl_resource_get_client"
+  wlResourceGetClient :: WLResource -> IO WLClient
diff --git a/wayland/Wayland/Server/Types.hs b/wayland/Wayland/Server/Types.hs
new file mode 100644
index 0000000..3167005
--- /dev/null
+++ b/wayland/Wayland/Server/Types.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+-- |
+-- Module     : Wayland.Server.Types
+-- Description: Primitive types shared among other modules.
+
+module Wayland.Server.Types
+  ( -- * Messages
+    MessageClass
+  , Message(..)
+  , fromMessage
+  , -- * Handles
+    Handle
+  , createHandle
+  , resolveHandle
+  , invalidateHandle
+  ) where
+
+import System.Mem.StableName (StableName, makeStableName)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Hashable (Hashable(..))
+import Data.Typeable (Typeable, cast)
+
+-- | A message that is dispatched on the display's message loop.
+class (Typeable m, Show m) => MessageClass m
+
+-- | A type-erased message processed on the display's message loop.
+data Message = forall m. MessageClass m => Message m
+
+-- | A handle to a native pointer.
+--
+-- The handle remains valid and can be used for equality checks even after the underlying pointer was destroyed. This is
+-- realized using an IORef which is set to nullPtr once the object is destroyed. The IORef itself is used for equality
+-- checks.
+data Handle ptr
+  = Handle { hndName    :: StableName (IORef (Maybe ptr)) -- ^ Name used for hashing and ordering.
+           , hndPointer :: IORef (Maybe ptr)              -- ^ Reference to the underlying pointer.
+           }
+
+instance Eq (Handle ptr) where
+  a == b = hndPointer a == hndPointer b
+
+instance Ord (Handle ptr) where
+  a <= b = hash (hndName a) <= hash (hndName b)
+
+instance Hashable (Handle ptr) where
+  hashWithSalt s o = hashWithSalt s (hndName o)
+
+instance Show (Handle ptr) where
+  show o = "Handle " ++ show (hash (hndName o))
+
+instance Show Message where
+  show (Message m) = show m
+
+-- | Try to cast a type-erased message into a concrete 'MessageClass'.
+fromMessage :: MessageClass m => Message -> Maybe m
+fromMessage (Message x) = cast x
+
+-- | Create a handle wrapping a pointer.
+--
+-- This should only be called once for the underlying resource to ensure equality.
+createHandle :: ptr -> IO (Handle ptr)
+createHandle p = do
+  ptrRef <- newIORef $ Just p
+  name <- makeStableName ptrRef
+  return $ Handle { hndName = name
+                  , hndPointer = ptrRef
+                  }
+
+-- | Get the underlying pointer for a handle.
+--
+-- This function may raise an error if the handle was invalidated.
+resolveHandle :: Handle ptr -> IO ptr
+resolveHandle h = check <$> readIORef (hndPointer h)
+  where check (Just p) = p
+        check Nothing  = error "Invalid object handle."
+
+-- | Invalidate the handle, making all further requests to 'resolveHandle' fail.
+--
+-- The handle itself will still remain valid and can be used to check for equality.
+invalidateHandle :: Handle ptr -> IO ()
+invalidateHandle h = writeIORef (hndPointer h) Nothing
diff --git a/wayland/wayland.cabal b/wayland/wayland.cabal
index 2708d50..9b08e2c 100644
--- a/wayland/wayland.cabal
+++ b/wayland/wayland.cabal
@@ -15,13 +15,15 @@ library
                        hashable,
                        microlens,
                        microlens-mtl,
-                       microlens-th
+                       microlens-th,
+                       time
     default-language:  Haskell2010
     exposed-modules:   Wayland.Server
     other-modules:     Wayland.Server.System,
                        Wayland.Server.Interface,
                        Wayland.Server.Display,
                        Wayland.Server.Client,
-                       Wayland.Server.Object
+                       Wayland.Server.Object,
+                       Wayland.Server.Types
     pkgconfig-depends: wayland-server >= 1.23.0
     cpp-options:       -D__attribute__(A)= -D_Nullable= -D_Nonnull= -D_Noreturn=