diff --git a/src/Quasar/Wayland/Display.hs b/src/Quasar/Wayland/Display.hs
index 36af738af8470b6920ab637d513c874192393de6..3d8491236e98e10426ec7e9be8f49233675fa734 100644
--- a/src/Quasar/Wayland/Display.hs
+++ b/src/Quasar/Wayland/Display.hs
@@ -19,7 +19,7 @@ newClientDisplay
   :: (IsInterfaceSide 'Client Interface_wl_display)
   => STM (ClientDisplay, ProtocolHandle 'Client)
 newClientDisplay =
-  initializeProtocol clientWlDisplayWireCallback \wlDisplay -> do
+  initializeProtocol wlDisplayEventHandler \wlDisplay -> do
     registry <- createClientRegistry wlDisplay
     pure ClientDisplay {
       wlDisplay,
diff --git a/src/Quasar/Wayland/Protocol.hs b/src/Quasar/Wayland/Protocol.hs
index d597e70e06bb0ccb24303486652b988aed650941..94d761282b6c47d4a597a4c44e263622ca5eaf39 100644
--- a/src/Quasar/Wayland/Protocol.hs
+++ b/src/Quasar/Wayland/Protocol.hs
@@ -24,7 +24,7 @@ module Quasar.Wayland.Protocol (
   takeOutbox,
   setException,
 
-  -- ** Low-level protocol interaction
+  -- ** Low-level protocol interaction (TODO should no longer be required after cleanup)
   ProtocolM,
   runProtocolTransaction,
   runProtocolM,
@@ -32,11 +32,6 @@ module Quasar.Wayland.Protocol (
   newObject,
   sendMessage,
 
-  WireCallback(..),
-  internalFnWireCallback,
-  traceWireCallback,
-  ignoreMessage,
-
   -- * Protocol exceptions
   WireCallbackFailed(..),
   ParserFailed(..),
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index b5202bcf3ff6ebd9f9acba4a5bd8b2291e038eb8..754cc1f6edc07497bc26c9aa4b6837989e7b5a64 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -34,12 +34,7 @@ module Quasar.Wayland.Protocol.Core (
   sendMessage,
   objectSendMessage,
   newObject,
-
-  -- ** WireCallbacks
-  WireCallback(..),
-  internalFnWireCallback,
-  traceWireCallback,
-  ignoreMessage,
+  newObjectFromId,
 
   -- * Protocol exceptions
   WireCallbackFailed(..),
@@ -249,8 +244,7 @@ data Side = Client | Server
 data Object s i = IsInterfaceSide s i => Object {
   objectProtocol :: (ProtocolHandle s),
   objectObjectId :: GenericObjectId,
-  messageHandler :: (MessageHandler s i),
-  objectWireCallback :: (WireCallback s i)
+  messageHandler :: (MessageHandler s i)
 }
 
 instance IsInterface i => Show (Object s i) where
@@ -321,39 +315,6 @@ showObjectMessage object message =
   showObject object <> "." <> show message
 
 
-data WireCallback s i = forall a. IsInterfaceHandler s i a => WireCallback a
-
-instance IsInterfaceSide s i => IsInterfaceHandler s i (WireCallback s i) where
-  handlerHandleMessage (WireCallback callback) = handlerHandleMessage callback
-
-
-data LowLevelWireCallback s i = IsInterfaceSide s i => FnWireCallback (Object s i -> WireDown s i -> ProtocolM s ())
-
-instance IsInterfaceSide s i => IsInterfaceHandler s i (LowLevelWireCallback s i) where
-  handlerHandleMessage (FnWireCallback fn) object msg = fn object msg
-
-internalFnWireCallback :: IsInterfaceSide s i => (Object s i -> WireDown s i -> ProtocolM s ()) -> WireCallback s i
-internalFnWireCallback = WireCallback . FnWireCallback
-
-
--- | The 'traceWireCallback' callback outputs a trace for every received message, before passing the message to the
--- callback argument.
---
--- The 'trace' function should /only/ be used for debugging, or for monitoring execution. The function is not
--- referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the
--- trace message.
---
--- Uses `traceM` internally.
-traceWireCallback :: IsInterfaceSide 'Client i => WireCallback 'Client i -> WireCallback 'Client i
-traceWireCallback next = internalFnWireCallback \object message -> do
-  traceM $ "<- " <> showObjectMessage object message
-  handlerHandleMessage next object message
-
--- | A `WireCallback` that ignores all messages. Intended for development purposes, e.g. together with
--- `traceWireCallback`.
-ignoreMessage :: IsInterfaceSide 'Client i => WireCallback 'Client i
-ignoreMessage = internalFnWireCallback \_ _ -> pure ()
-
 -- * Exceptions
 
 data WireCallbackFailed = WireCallbackFailed SomeException
@@ -431,10 +392,10 @@ stateProtocolVar fn x = do
 
 initializeProtocol
   :: forall s wl_display a. (IsInterfaceSide s wl_display)
-  => WireCallback s wl_display
+  => MessageHandler s wl_display
   -> (Object s wl_display -> ProtocolM s a)
   -> STM (a, ProtocolHandle s)
-initializeProtocol wlDisplayWireCallback initializationAction = do
+initializeProtocol wlDisplayMessageHandler initializationAction = do
   bytesReceivedVar <- newTVar 0
   bytesSentVar <- newTVar 0
   inboxDecoderVar <- newTVar $ runGetIncremental getRawMessage
@@ -462,7 +423,7 @@ initializeProtocol wlDisplayWireCallback initializationAction = do
   }
   writeTVar stateVar (Right state)
 
-  let wlDisplay = Object protocol wlDisplayId undefined wlDisplayWireCallback
+  let wlDisplay = Object protocol wlDisplayId wlDisplayMessageHandler
   modifyTVar' objectsVar (HM.insert wlDisplayId (SomeObject wlDisplay))
 
   result <- runReaderT (initializationAction wlDisplay) state
@@ -528,14 +489,16 @@ takeOutbox protocol = runProtocolTransaction protocol do
 
 -- | Create an object. The caller is responsible for sending the 'NewId' immediately (exactly once; in the same STM
 -- transaction; before using the object).
+--
+-- Exported for use in TH generated code.
 newObject
   :: forall s i. IsInterfaceSide s i
-  => WireCallback s i
+  => MessageHandler s i
   -> ProtocolM s (Object s i, NewId (InterfaceName i))
-newObject callback = do
+newObject messageHandler = do
   oId <- allocateObjectId
   let newId = NewId @(InterfaceName i) oId
-  object <- newObjectFromId newId callback
+  object <- newObjectFromId newId messageHandler
   pure (object, newId)
   where
     allocateObjectId :: ProtocolM s (ObjectId (InterfaceName i))
@@ -548,24 +511,24 @@ newObject callback = do
       writeProtocolVar (.nextIdVar) nextId'
       pure $ ObjectId id'
 
+-- | Create an object from a received id. The caller is responsible for using a 'NewId' exactly once while handling an
+-- incoming message
+--
+-- Exported for use in TH generated code.
 newObjectFromId
   :: forall s i. IsInterfaceSide s i
   => NewId (InterfaceName i)
-  -> WireCallback s i
+  -> MessageHandler s i
   -> ProtocolM s (Object s i)
-newObjectFromId (NewId oId) callback = do
+newObjectFromId (NewId oId) messageHandler = do
   protocol <- askProtocol
   let
     genericObjectId = toGenericObjectId oId
-    object = Object protocol genericObjectId undefined callback
+    object = Object protocol genericObjectId messageHandler
     someObject = SomeObject object
   modifyProtocolVar (.objectsVar) (HM.insert genericObjectId someObject)
   pure object
 
--- TODO
--- createObject :: Callback -> STM (Object, NewId)
--- registerObject :: NewId -> Callback -> STM (Object)
-
 
 -- | Sends a message without checking any ids or creating proxy objects objects. (TODO)
 sendMessage :: forall s i. IsInterfaceSide s i => Object s i -> WireUp s i -> ProtocolM s ()
@@ -624,12 +587,12 @@ handleRawMessage (oId, opcode, body) = do
       => Object s i
       -> Opcode
       -> Get (ProtocolM s ())
-    getMessageAction object@(Object _ _ _ objectHandler) opcode = do
+    getMessageAction object opcode = do
       verifyMessage <- getWireDown object opcode
       pure do
         message <- verifyMessage
         traceM $ "<- " <> showObjectMessage object message
-        handlerHandleMessage objectHandler object message
+        lift $ objectHandleMessage object message
 
 type RawMessage = (GenericObjectId, Opcode, BSL.ByteString)
 
diff --git a/src/Quasar/Wayland/Protocol/Display.hs b/src/Quasar/Wayland/Protocol/Display.hs
index 5e81ea994ff78b36b6496d258a8102ae7a8681d8..6f9bb63e0ab9df25116dad3561ba09dce0afc10a 100644
--- a/src/Quasar/Wayland/Protocol/Display.hs
+++ b/src/Quasar/Wayland/Protocol/Display.hs
@@ -1,5 +1,5 @@
 module Quasar.Wayland.Protocol.Display (
-  clientWlDisplayWireCallback,
+  wlDisplayEventHandler,
 ) where
 
 import Control.Monad.Catch
@@ -8,15 +8,13 @@ import Quasar.Wayland.Protocol.Core
 import Quasar.Wayland.Protocol.Generated
 
 
+
 -- | Default implementation for @wl_display@ that handles errors and confirms deleted object ids.
 --
 -- This is only required when manually managing the @wl_display@ interface (usually it's applied by
 -- 'Quasar.Wayland.Display.newClientDisplay').
-clientWlDisplayWireCallback :: IsInterfaceSide 'Client Interface_wl_display => WireCallback 'Client Interface_wl_display
-clientWlDisplayWireCallback = internalFnWireCallback handler
+wlDisplayEventHandler :: EventHandler_wl_display
+wlDisplayEventHandler = EventHandler_wl_display { error = waylandError, delete_id }
   where
-    -- | wl_display is specified to never change, so manually specifying the callback is safe
-    handler :: Object 'Client Interface_wl_display -> WireEvent_wl_display -> ProtocolM 'Client ()
-    -- TODO parse oId
-    handler _ (WireEvent_wl_display__error oId code message) = throwM $ ServerError code (toString message)
-    handler _ (WireEvent_wl_display__delete_id deletedId) = pure () -- TODO confirm delete
+    waylandError oId code message = throwM $ ServerError code (toString message)
+    delete_id deletedId = pure () -- TODO confirm delete
diff --git a/src/Quasar/Wayland/Registry.hs b/src/Quasar/Wayland/Registry.hs
index 89b7ef5032ab527b9ff063c66bff899764b7cf11..846e447b64643adac5fcee2c694a7df5d39b3a05 100644
--- a/src/Quasar/Wayland/Registry.hs
+++ b/src/Quasar/Wayland/Registry.hs
@@ -22,7 +22,7 @@ createClientRegistry :: Object 'Client Interface_wl_display -> ProtocolM 'Client
 createClientRegistry wlDisplay = mfix \clientRegistry -> do
   globalsVar <- lift $ newTVar HM.empty
 
-  (wlRegistry, newId) <- newObject @'Client @Interface_wl_registry (callback clientRegistry)
+  (wlRegistry, newId) <- newObject @'Client @Interface_wl_registry (messageHandler clientRegistry)
   sendMessage wlDisplay $ WireRequest_wl_display__get_registry newId
 
   pure ClientRegistry {
@@ -30,15 +30,16 @@ createClientRegistry wlDisplay = mfix \clientRegistry -> do
     globalsVar
   }
   where
-    callback :: ClientRegistry -> IsInterfaceSide 'Client Interface_wl_registry => WireCallback 'Client Interface_wl_registry
-    callback clientRegistry = internalFnWireCallback handler
+    messageHandler :: ClientRegistry -> EventHandler_wl_registry
+    messageHandler clientRegistry = EventHandler_wl_registry { global, global_remove }
       where
-        -- | wl_registry is specified to never change, so manually specifying the callback is safe
-        handler :: Object 'Client Interface_wl_registry -> WireEvent_wl_registry -> ProtocolM 'Client ()
-        handler _ (WireEvent_wl_registry__global name interface version) = do
-          lift $ modifyTVar clientRegistry.globalsVar (HM.insert name (interface, version))
-        handler _ (WireEvent_wl_registry__global_remove name) = do
-          result <- lift $ stateTVar clientRegistry.globalsVar (swap . lookupDelete name)
+        global :: Word32 -> WlString -> Word32 -> STM ()
+        global name interface version = do
+          modifyTVar clientRegistry.globalsVar (HM.insert name (interface, version))
+
+        global_remove :: Word32 -> STM ()
+        global_remove name = do
+          result <- stateTVar clientRegistry.globalsVar (swap . lookupDelete name)
           case result of
             Nothing -> traceM $ "Invalid global removed by server: " <> show name
             Just (interface, version) -> pure ()