diff --git a/src/Quasar/Wayland/Client.hs b/src/Quasar/Wayland/Client.hs
index d54ac10b12290f37d099209ec93f568c46cb8150..b08759c7bc0ba3c3c23310156236e284d6068818 100644
--- a/src/Quasar/Wayland/Client.hs
+++ b/src/Quasar/Wayland/Client.hs
@@ -33,10 +33,10 @@ instance IsDisposable WaylandClient where
 newWaylandClient :: MonadResourceManager m => Socket -> m WaylandClient
 newWaylandClient socket = WaylandClient <$> newWaylandConnection @I_wl_display @I_wl_registry clientCallback clientCallback socket
 
-clientCallback :: IsInterfaceSide 'Client i => ClientCallback STM i
-clientCallback = Callback {
+clientCallback :: IsInterfaceSide 'Client i => SimpleCallback 'Client STM i
+clientCallback = SimpleCallback {
   messageCallback = \object message ->
-    lift $ traceM $ showObjectMessage object message
+    traceM $ "<- " <> showObjectMessage object message
 }
 
 connectWaylandClient :: MonadResourceManager m => m WaylandClient
diff --git a/src/Quasar/Wayland/Connection.hs b/src/Quasar/Wayland/Connection.hs
index fb6a66a4edfdb07c818ecefb737e334860f3df98..f29c26e7d386981ddc66ae996dc6a67a91e7e979 100644
--- a/src/Quasar/Wayland/Connection.hs
+++ b/src/Quasar/Wayland/Connection.hs
@@ -36,8 +36,8 @@ data SocketClosed = SocketClosed
 
 newWaylandConnection
   :: forall wl_display wl_registry s m. (IsInterfaceSide s wl_display, IsInterfaceSide s wl_registry, MonadResourceManager m)
-  => Callback s STM wl_display
-  -> Callback s STM wl_registry
+  => SimpleCallback s STM wl_display
+  -> SimpleCallback s STM wl_registry
   -> Socket
   -> m (WaylandConnection s)
 newWaylandConnection wlDisplayCallback wlRegistryCallback socket = do
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index 7ec275ba822e436857e2271203c67f3bad674431..d95151b3bbf37e5b82d8ccfe466f0b1e2a837ac5 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -9,6 +9,7 @@ module Quasar.Wayland.Protocol.Core (
   Side(..),
   IsInterface(..),
   IsInterfaceSide(..),
+  IsInterfaceHandler(..),
   Object,
   IsObject(..),
   IsObject,
@@ -16,9 +17,7 @@ module Quasar.Wayland.Protocol.Core (
   ProtocolState,
   ClientProtocolState,
   ServerProtocolState,
-  ClientCallback,
-  ServerCallback,
-  Callback(..),
+  SimpleCallback(..),
   ProtocolStep,
   initialProtocolState,
   sendMessage,
@@ -157,9 +156,8 @@ instance WireFormat 'FdArgument where
   showArgument = undefined
 
 
--- | A proxy type (in the haskell sense) for a Wayland interface.
-class
-  (
+-- | Class for a proxy type (in the haskell sense) that describes a Wayland interface.
+class (
     IsMessage (Request i),
     IsMessage (Event i)
   )
@@ -186,14 +184,24 @@ instance IsSide 'Server where
   getDown = getMessage @(Down 'Server i)
 
 
--- | Empty class, only required to combine constraints
-class (IsSide s, IsInterface i, IsMessage (Up s i), IsMessage (Down s i)) => IsInterfaceSide (s :: Side) i
+--- | Empty class, used to combine constraints
+class (
+    IsSide s,
+    IsInterface i,
+    IsMessage (Up s i),
+    IsMessage (Down s i)
+  )
+  => IsInterfaceSide (s :: Side) i
+
+
+class IsInterfaceSide s i => IsInterfaceHandler s m i a where
+  handleMessage :: a -> Object s m i -> Down s i -> m ()
 
 
 -- | Data kind
 data Side = Client | Server
 
-data Object s m i = IsInterfaceSide s i => Object ObjectId (Callback s m i)
+data Object s m i = forall a. IsInterfaceHandler s m i a => Object ObjectId a
 
 class IsObject a where
   objectId :: a -> ObjectId
@@ -297,13 +305,13 @@ data ProtocolState (s :: Side) m = ProtocolState {
 }
 
 
-type ClientCallback m i = Callback 'Client m i
-type ServerCallback m i = Callback 'Server m i
-
-data Callback s m i = Callback {
-  messageCallback :: Object s m i -> Down s i -> StateT (ProtocolState s m) m ()
+data SimpleCallback s m i = SimpleCallback {
+  messageCallback :: Object s m i -> Down s i -> m ()
 }
 
+instance IsInterfaceSide s i => IsInterfaceHandler s m i (SimpleCallback s m i) where
+  handleMessage cb object msg = cb.messageCallback object msg
+
 -- * Exceptions
 
 data CallbackFailed = CallbackFailed SomeException
@@ -342,8 +350,8 @@ protocolStep action inState = do
 
 initialProtocolState
   :: forall wl_display wl_registry s m. (IsInterfaceSide s wl_display, IsInterfaceSide s wl_registry)
-  => Callback s m wl_display
-  -> Callback s m wl_registry
+  => SimpleCallback s m wl_display
+  -> SimpleCallback s m wl_registry
   -> ProtocolState s m
 initialProtocolState wlDisplayCallback wlRegistryCallback = sendInitialMessage initialState
   where
@@ -398,11 +406,11 @@ runCallbacks :: (IsSide s, MonadCatch m) => StateT (ProtocolState s m) m ()
 runCallbacks = receiveRawMessage >>= \case
   Nothing -> pure ()
   Just rawMessage -> do
-    handleMessage rawMessage
+    handleRawMessage rawMessage
     runCallbacks
 
-handleMessage :: forall s m. (IsSide s, MonadCatch m) => RawMessage -> StateT (ProtocolState s m) m ()
-handleMessage rawMessage@(oId, opcode, body) = do
+handleRawMessage :: forall s m. (IsSide s, MonadCatch m) => RawMessage -> StateT (ProtocolState s m) m ()
+handleRawMessage rawMessage@(oId, opcode, body) = do
   st <- State.get
   case HM.lookup oId st.objects of
     Nothing -> throwM $ ProtocolException $ "Received message with invalid object id " <> show oId
@@ -424,10 +432,11 @@ getMessageAction
   -> Object s m i
   -> RawMessage
   -> Get (ProtocolAction s m ())
-getMessageAction objects object@(Object _ callback) (oId, opcode, body) = do
+getMessageAction objects object@(Object _ objectHandler) (oId, opcode, body) = do
   message <- getDown object opcode
-  -- TODO apply message to object
-  pure $ traceM $ "<- " <> showObjectMessage object message
+  pure do
+    --traceM $ "<- " <> showObjectMessage object message
+    lift $ handleMessage objectHandler object message
 
 type ProtocolAction s m a = StateT (ProtocolState s m) m a