diff --git a/flake.lock b/flake.lock
index e26ce2f5fe7bf54e0624dc8ed6d3dfc58595adf1..cd0a41f5074db0a30850aeb2dce2da50cd10fcd9 100644
--- a/flake.lock
+++ b/flake.lock
@@ -2,11 +2,12 @@
   "nodes": {
     "nixpkgs": {
       "locked": {
-        "lastModified": 1630338749,
-        "narHash": "sha256-J1LsmwGtlYpqIMYEi/amMKkk0VfRrwHaEs/uylugGnE=",
-        "path": "/nix/store/y38w1iqhwlsa5aphd2kc1r1qii9al3aj-source",
-        "rev": "8a2ec31e224de9461390cdd03e5e0b0290cdad0b",
-        "type": "path"
+        "lastModified": 1635403963,
+        "narHash": "sha256-0actzfzBAXvvDJ/EvPSGbtCPXUwSObQrcq0RpsPWZgA=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "2deb07f3ac4eeb5de1c12c4ba2911a2eb1f6ed61",
+        "type": "github"
       },
       "original": {
         "id": "nixpkgs",
diff --git a/src/Quasar/Wayland/Protocol.hs b/src/Quasar/Wayland/Protocol.hs
index 93c8458c99e76b1679346133564489c277a19d07..d597e70e06bb0ccb24303486652b988aed650941 100644
--- a/src/Quasar/Wayland/Protocol.hs
+++ b/src/Quasar/Wayland/Protocol.hs
@@ -11,7 +11,8 @@ module Quasar.Wayland.Protocol (
   WlString(..),
 
   -- ** Classes for generated interfaces
-  IsInterface(InterfaceName, interfaceName),
+  IsInterface(InterfaceName),
+  interfaceName,
   Side(..),
   IsSide(WireUp, WireDown),
   IsInterfaceSide,
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index 51f7e33ae4f581df4397c098194d04d80a15b9ff..1b65d458c49826cb34cb27f6557c85725bf5c20e 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -13,9 +13,11 @@ module Quasar.Wayland.Protocol.Core (
   IsSide(..),
   Side(..),
   IsInterface(..),
+  interfaceName,
   IsInterfaceSide(..),
   IsInterfaceHandler(..),
   Object,
+  objectMessageHandler,
   IsObject,
   IsMessage(..),
   ProtocolHandle,
@@ -71,6 +73,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Data.Proxy
 import Data.String (IsString(..))
+import Data.Kind (Type)
 import Data.Void (absurd)
 import GHC.Conc (unsafeIOToSTM)
 import GHC.TypeLits
@@ -183,15 +186,18 @@ instance WireFormat Void where
 -- | Class for a proxy type (in the haskell sense) that describes a Wayland interface.
 class (
     IsMessage (WireRequest i),
-    IsMessage (WireEvent i)
+    IsMessage (WireEvent i),
+    KnownSymbol (InterfaceName i)
   )
   => IsInterface i where
-  type Requests i
-  type Events i
+  type Requests (s :: Side) i
+  type Events (s :: Side) i
   type WireRequest i
   type WireEvent i
   type InterfaceName i :: Symbol
-  interfaceName :: String
+
+interfaceName :: forall i. IsInterface i => String
+interfaceName = symbolVal @(InterfaceName i) Proxy
 
 class IsSide (s :: Side) where
   type Up s i
@@ -202,8 +208,8 @@ class IsSide (s :: Side) where
   maximumId :: Word32
 
 instance IsSide 'Client where
-  type Up 'Client i = Requests i
-  type Down 'Client i = Events i
+  type Up 'Client i = Requests 'Client i
+  type Down 'Client i = Events 'Client i
   type WireUp 'Client i = WireRequest i
   type WireDown 'Client i = WireEvent i
   -- Id #1 is reserved for wl_display
@@ -211,8 +217,8 @@ instance IsSide 'Client where
   maximumId = 0xfeffffff
 
 instance IsSide 'Server where
-  type Up 'Server i = Events i
-  type Down 'Server i = Requests i
+  type Up 'Server i = Events 'Server i
+  type Down 'Server i = Requests 'Server i
   type WireUp 'Server i = WireEvent i
   type WireDown 'Server i = WireRequest i
   initialId = 0xff000000
@@ -228,6 +234,7 @@ class (
   )
   => IsInterfaceSide (s :: Side) i where
   createProxy :: Object s i -> Up s i
+  handleMessage :: Object s i -> WireDown s i -> STM ()
 
 
 getWireDown :: forall s i. IsInterfaceSide s i => Object s i -> Opcode -> Get (ProtocolM s (WireDown s i))
@@ -238,13 +245,24 @@ putWireUp _ = putMessage @(WireUp s i)
 
 
 class IsInterfaceSide s i => IsInterfaceHandler s i a where
-  handleMessage :: a -> Object s i -> WireDown s i -> ProtocolM s ()
+  handlerHandleMessage :: a -> Object s i -> WireDown s i -> ProtocolM s ()
 
 
 -- | Data kind
 data Side = Client | Server
 
-data Object s i = IsInterfaceSide s i => Object (ProtocolHandle s) GenericObjectId (Up s i) (Down s i) (WireCallback s i)
+
+data Object s i = IsInterfaceSide s i => Object {
+  objectProtocol :: (ProtocolHandle s),
+  objectObjectId :: GenericObjectId,
+  objectUp :: (Up s i),
+  objectDown :: (Down s i),
+  objectWireCallback :: (WireCallback s i)
+}
+
+objectMessageHandler :: Object s i -> Down s i
+objectMessageHandler = (.objectDown)
+
 
 instance IsInterface i => Show (Object s i) where
   show = showObject
@@ -260,7 +278,7 @@ class IsObjectSide a where
   describeDownMessage :: a -> Opcode -> BSL.ByteString -> String
 
 instance forall s i. IsInterface i => IsObject (Object s i) where
-  objectId (Object _ oId _ _ _) = oId
+  objectId = objectObjectId
   objectInterfaceName _ = interfaceName @i
 
 instance forall s i. IsInterfaceSide s i => IsObjectSide (Object s i) where
@@ -317,13 +335,13 @@ showObjectMessage object message =
 data WireCallback s i = forall a. IsInterfaceHandler s i a => WireCallback a
 
 instance IsInterfaceSide s i => IsInterfaceHandler s i (WireCallback s i) where
-  handleMessage (WireCallback callback) = handleMessage callback
+  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
-  handleMessage (FnWireCallback fn) object msg = fn object msg
+  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
@@ -340,7 +358,7 @@ internalFnWireCallback = WireCallback . FnWireCallback
 traceWireCallback :: IsInterfaceSide 'Client i => WireCallback 'Client i -> WireCallback 'Client i
 traceWireCallback next = internalFnWireCallback \object message -> do
   traceM $ "<- " <> showObjectMessage object message
-  handleMessage next 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
@@ -553,6 +571,10 @@ newObjectFromId (NewId oId) callback = do
   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 ()
@@ -579,7 +601,7 @@ sendMessage object message = do
       putWord32host $ (fromIntegral msgSize `shiftL` 16) .|. fromIntegral opcode
 
 objectSendMessage :: forall s i. IsInterfaceSide s i => Object s i -> WireUp s i -> STM ()
-objectSendMessage object@(Object protocol _ _ _ _) message = runProtocolM protocol $ sendMessage object message
+objectSendMessage object message = runProtocolM (objectProtocol object) $ sendMessage object message
 
 
 receiveMessages :: IsSide s => ProtocolM s ()
@@ -613,7 +635,7 @@ getMessageAction
   -> Get (ProtocolM s ())
 getMessageAction object@(Object _ _ _ _ objectHandler) opcode = do
   verifyMessage <- getWireDown object opcode
-  pure $ handleMessage objectHandler object =<< verifyMessage
+  pure $ handlerHandleMessage objectHandler object =<< verifyMessage
 
 type RawMessage = (GenericObjectId, Opcode, BSL.ByteString)
 
diff --git a/src/Quasar/Wayland/Protocol/Generated.hs b/src/Quasar/Wayland/Protocol/Generated.hs
index f3d48c6e355352bfc6e0c53faca6c24e2861c9cb..62b271400f74581091ab2cbaee0e2d9bc5f8108c 100644
--- a/src/Quasar/Wayland/Protocol/Generated.hs
+++ b/src/Quasar/Wayland/Protocol/Generated.hs
@@ -9,6 +9,8 @@ module Quasar.Wayland.Protocol.Generated where
 import Control.Monad.Catch
 import Control.Monad.STM
 import Data.Binary
+import Data.Void
+import GHC.Records
 import Quasar.Prelude
 import Quasar.Wayland.Protocol.Core
 import Quasar.Wayland.Protocol.TH
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index ac71b06fb7d285fda4234429cad96f4c6726aff8..ec94960c88246df9348ad54688213fbc7448de28 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -6,6 +6,8 @@ import Control.Monad.STM
 import Control.Monad.Writer
 import Data.ByteString qualified as BS
 import Data.List (intersperse)
+import Data.Void (absurd)
+import GHC.Records (getField)
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (BangType, VarBangType, addDependentFile)
 import Prelude qualified
@@ -92,7 +94,7 @@ interfaceDecs interface = do
   public <- execWriterT do
     tellQ $ dataD (pure []) iName [] Nothing [] []
     tellQ $ instanceD (pure []) [t|IsInterface $iT|] instanceDecs
-    tellQs $ interfaceSideInstanceDs interface
+    tellQs interfaceSideInstanceDs
 
     when (length interface.requests > 0) do
       tellQ requestRecordD
@@ -111,13 +113,13 @@ interfaceDecs interface = do
   where
     iName = interfaceN interface
     iT = interfaceT interface
+    sT = sideTVar
     instanceDecs = [
-      tySynInstD (tySynEqn Nothing (appT (conT ''Requests) iT) (orUnit (requestsT interface))),
-      tySynInstD (tySynEqn Nothing (appT (conT ''Events) iT) (orUnit (eventsT interface))),
+      tySynInstD (tySynEqn Nothing [t|$(conT ''Requests) $sT $iT|] (orUnit (requestsT interface sT))),
+      tySynInstD (tySynEqn Nothing [t|$(conT ''Events) $sT $iT|] (orUnit (eventsT interface sT))),
       tySynInstD (tySynEqn Nothing (appT (conT ''WireRequest) iT) wireRequestT),
       tySynInstD (tySynEqn Nothing (appT (conT ''WireEvent) iT) eT),
-      tySynInstD (tySynEqn Nothing (appT (conT ''InterfaceName) iT) (litT (strTyLit interface.name))),
-      valD (varP 'interfaceName) (normalB (stringE interface.name)) []
+      tySynInstD (tySynEqn Nothing (appT (conT ''InterfaceName) iT) (litT (strTyLit interface.name)))
       ]
     wireRequestT :: Q Type
     wireRequestT = if length interface.requests > 0 then conT rTypeName else [t|Void|]
@@ -160,48 +162,73 @@ interfaceDecs interface = do
     objectP = varP objectName
     objectE = varE objectName
 
-    interfaceSideInstanceDs :: InterfaceSpec -> Q [Dec]
-    interfaceSideInstanceDs interface = execWriterT do
-      tellQ $ instanceD (pure []) ([t|IsInterfaceSide 'Client $iT|]) [createProxyD Client]
-      tellQ $ instanceD (pure []) ([t|IsInterfaceSide 'Server $iT|]) [createProxyD Server]
-      where
-        iT = interfaceT interface
-        createProxyD :: Side -> Q Dec
-        createProxyD Client = funD 'createProxy [clause [objectP] (normalB requestsProxyE) (sendMessageProxy <$> requestContexts)]
-        createProxyD Server = funD 'createProxy [clause [objectP] (normalB eventsProxyE) (sendMessageProxy <$> eventContexts)]
-        requestsProxyE :: Q Exp
-        requestsProxyE
-          | length interface.requests > 0 = recConE (requestsName interface) (sendMessageProxyField <$> requestContexts)
-          | otherwise = [|()|]
-        eventsProxyE :: Q Exp
-        eventsProxyE
-          | length interface.events > 0 = recConE (eventsName interface) (sendMessageProxyField <$> eventContexts)
-          | otherwise = [|()|]
+    interfaceSideInstanceDs :: Q [Dec]
+    interfaceSideInstanceDs = execWriterT do
+      tellQ $ instanceD (pure []) ([t|IsInterfaceSide 'Client $iT|]) [createProxyD Client, handleMessageD Client]
+      tellQ $ instanceD (pure []) ([t|IsInterfaceSide 'Server $iT|]) [createProxyD Server, handleMessageD Server]
+
+    createProxyD :: Side -> Q Dec
+    createProxyD Client = funD 'createProxy [clause [objectP] (normalB requestsProxyE) (sendMessageProxy <$> requestContexts)]
+    createProxyD Server = funD 'createProxy [clause [objectP] (normalB eventsProxyE) (sendMessageProxy <$> eventContexts)]
+    requestsProxyE :: Q Exp
+    requestsProxyE
+      | length interface.requests > 0 = recConE (requestsName interface) (sendMessageProxyField <$> requestContexts)
+      | otherwise = [|()|]
+    eventsProxyE :: Q Exp
+    eventsProxyE
+      | length interface.events > 0 = recConE (eventsName interface) (sendMessageProxyField <$> eventContexts)
+      | otherwise = [|()|]
 
     sendMessageProxyField :: MessageContext -> Q (Name, Exp)
-    sendMessageProxyField msg = (mkName msg.msgSpec.name,) <$> varE (sendMessageFunctionName msg)
+    sendMessageProxyField msg = (messageFieldName msg, ) <$> varE (sendMessageFunctionName msg)
 
     sendMessageFunctionName :: MessageContext -> Name
-    sendMessageFunctionName msg = mkName $ "send_" <> msg.msgSpec.name
+    sendMessageFunctionName msg = mkName $ "send_" <> messageFieldNameString msg
 
     sendMessageProxy :: MessageContext -> Q Dec
-    sendMessageProxy msg = funD (sendMessageFunctionName msg) [clause [] (normalB [|undefined|]) []]
+    sendMessageProxy msg = funD (sendMessageFunctionName msg) [clause (msgArgPats msg) (normalB [|objectSendMessage object $(msgE msg)|]) []]
+
+    handleMessageD :: Side -> Q Dec
+    handleMessageD Client = funD 'handleMessage (handleMessageClauses eventContexts)
+    handleMessageD Server = funD 'handleMessage (handleMessageClauses requestContexts)
+
+    handleMessageClauses :: [MessageContext] -> [Q Clause]
+    handleMessageClauses [] = [clause [wildP] (normalB [|absurd|]) []]
+    handleMessageClauses messageContexts = handleMessageClause <$> messageContexts
+
+    handleMessageClause :: MessageContext -> Q Clause
+    handleMessageClause msg = clause [objectP, msgConP msg] (normalB bodyE) []
+      where
+        fieldNameLitT :: Q Type
+        fieldNameLitT = litT (strTyLit (messageFieldNameString msg))
+        fieldE :: Q Exp
+        fieldE = [|$(appTypeE [|getField|] fieldNameLitT) (objectMessageHandler $objectE)|]
+        bodyE :: Q Exp
+        bodyE = applyMsgArgs msg fieldE
 
 
+messageFieldName :: MessageContext -> Name
+messageFieldName msg = mkName $ messageFieldNameString msg
+
+messageFieldNameString :: MessageContext -> String
+messageFieldNameString msg = msg.msgSpec.name
+
 messageRecordD :: Name -> [MessageContext] -> Q Dec
-messageRecordD name messageContexts = dataD (cxt []) name [] Nothing [con] []
+messageRecordD name messageContexts = dataD (cxt []) name [plainTV sideTVarName] Nothing [con] []
   where
     con = recC name (recField <$> messageContexts)
     recField :: MessageContext -> Q VarBangType
-    recField msg = varDefaultBangType (mkName msg.msgSpec.name) [t|$(applyArgTypes [t|STM $returnType|])|]
+    recField msg = varDefaultBangType (messageFieldName msg) [t|$(applyArgTypes [t|STM ()|])|]
       where
         applyArgTypes :: Q Type -> Q Type
         applyArgTypes xt = foldr (\x y -> [t|$x -> $y|]) xt (argumentType <$> msg.msgSpec.arguments)
-        returnType :: Q Type
-        returnType = buildTupleType $ sequence $ catMaybes $ argumentReturnType <$> msg.msgSpec.arguments
 
 
 
+sideTVarName :: Name
+sideTVarName = mkName "s"
+sideTVar :: Q Type
+sideTVar = varT sideTVarName
 
 interfaceN :: InterfaceSpec -> Name
 interfaceN interface = mkName $ "Interface_" <> interface.name
@@ -209,17 +236,20 @@ interfaceN interface = mkName $ "Interface_" <> interface.name
 interfaceT :: InterfaceSpec -> Q Type
 interfaceT interface = conT (interfaceN interface)
 
+interfaceTFromName :: String -> Q Type
+interfaceTFromName name = conT (mkName ("Interface_" <> name))
+
 requestsName :: InterfaceSpec -> Name
 requestsName interface = mkName $ "Requests_" <> interface.name
 
-requestsT :: InterfaceSpec -> Maybe (Q Type)
-requestsT interface = if (length interface.requests) > 0 then Just (conT (requestsName interface)) else Nothing
+requestsT :: InterfaceSpec -> Q Type -> Maybe (Q Type)
+requestsT interface sideT = if (length interface.requests) > 0 then Just [t|$(conT (requestsName interface)) $sideT|] else Nothing
 
 eventsName :: InterfaceSpec -> Name
 eventsName interface = mkName $ "Events_" <> interface.name
 
-eventsT :: InterfaceSpec -> Maybe (Q Type)
-eventsT interface = if (length interface.events) > 0 then Just (conT (eventsName interface)) else Nothing
+eventsT :: InterfaceSpec -> Q Type -> Maybe (Q Type)
+eventsT interface sideT = if (length interface.events) > 0 then Just [t|$(conT (eventsName interface)) $sideT|] else Nothing
 
 orVoid :: Maybe (Q Type) -> Q Type
 orVoid = fromMaybe [t|Void|]
@@ -239,7 +269,11 @@ data MessageContext = MessageContext {
 
 -- | Pattern to match a message. Arguments can then be accessed by using 'msgArgE'.
 msgConP :: MessageContext -> Q Pat
-msgConP msg = conP msg.msgConName (varP . msgArgTempName <$> msg.msgSpec.arguments)
+msgConP msg = conP msg.msgConName (msgArgPats msg)
+
+-- | Pattern to match all arguments of a message. Arguments can then be accessed by using e.g. 'msgArgE'.
+msgArgPats :: MessageContext -> [Q Pat]
+msgArgPats msg = varP . msgArgTempName <$> msg.msgSpec.arguments
 
 -- | Expression for accessing a message argument which has been matched from a request/event using 'msgArgConP'.
 msgArgE :: MessageContext -> ArgumentSpec -> Q Exp
@@ -247,8 +281,15 @@ msgArgE _msg arg = varE (msgArgTempName arg)
 
 -- | Helper for 'msgConP' and 'msgArgE'.
 msgArgTempName :: ArgumentSpec -> Name
--- Add an "_" to prevent name conflicts with everything
-msgArgTempName arg = mkName $ arg.name <> "_"
+-- Add a prefix to prevent name conflicts with exports from the Prelude
+msgArgTempName arg = mkName $ "arg_" <> arg.name
+
+applyMsgArgs :: MessageContext -> Q Exp -> Q Exp
+applyMsgArgs msg base = foldl appE base (msgArgE msg <$> msg.msgSpec.arguments)
+
+-- | Expression to construct a wire message with arguments which have been matched using 'msgConP'/'msgArgPats'.
+msgE :: MessageContext -> Q Exp
+msgE msg = applyMsgArgs msg (conE msg.msgConName)
 
 
 messageTypeDecs :: Name -> [MessageContext] -> Q [Dec]
@@ -323,28 +364,15 @@ derivingShow = derivClause (Just StockStrategy) [[t|Show|]]
 argumentType :: ArgumentSpec -> Q Type
 argumentType argSpec = liftArgumentType argSpec.argType
 
--- | Map an argument to its high-level return type, if required
-argumentReturnType :: ArgumentSpec -> Maybe (Q Type)
-argumentReturnType argSpec = liftArgumentReturnType argSpec.argType
+liftArgumentType :: ArgumentType -> Q Type
+--liftArgumentType (ObjectArgument iName) = [t|Object $sideTVar $(interfaceTFromName iName)|]
+liftArgumentType x = liftArgumentWireType x
+
 
 -- | Map an argument to its wire representation type
 argumentWireType :: ArgumentSpec -> Q Type
 argumentWireType argSpec = liftArgumentWireType argSpec.argType
 
-
-liftArgumentType :: ArgumentType -> Q Type
-liftArgumentType (ObjectArgument iName) = [t|ObjectId $(litT (strTyLit iName))|]
-liftArgumentType GenericObjectArgument = [t|GenericObjectId|]
-liftArgumentType (NewIdArgument iName) = [t|NewId $(litT (strTyLit iName))|]
-liftArgumentType GenericNewIdArgument = [t|GenericNewId|]
-liftArgumentType FdArgument = [t|Void|] -- TODO
-liftArgumentType x = liftArgumentWireType x
-
-liftArgumentReturnType :: ArgumentType -> Maybe (Q Type)
-liftArgumentReturnType (NewIdArgument iName) = Just [t|Void|]
-liftArgumentReturnType GenericNewIdArgument = Just [t|Void|]
-liftArgumentReturnType _ = Nothing
-
 liftArgumentWireType :: ArgumentType -> Q Type
 liftArgumentWireType IntArgument = [t|Int32|]
 liftArgumentWireType UIntArgument = [t|Word32|]