diff --git a/quasar-wayland.cabal b/quasar-wayland.cabal
index 0553b541fe2c3d2fdb3c260c228d040a01c5233f..8f15c5c6351686c5a71806596529832310b540bd 100644
--- a/quasar-wayland.cabal
+++ b/quasar-wayland.cabal
@@ -98,7 +98,6 @@ library
     network,
     quasar,
     template-haskell,
-    --unix,
     unordered-containers,
     stm,
     xml,
@@ -126,13 +125,8 @@ test-suite quasar-wayland-test
   build-depends:
     base >=4.7 && <5,
     --QuickCheck,
-    --binary,
-    --bytestring,
     hspec,
-    --network,
-    --quasar,
-    quasar-wayland,
-    --stm,
+    --quasar-wayland,
     -- required for record-dot-preprocessor
     record-dot-preprocessor,
     record-hasfield,
diff --git a/src/Quasar/Wayland/Connection.hs b/src/Quasar/Wayland/Connection.hs
index 359022359719dcdd9fe80e38ceb129aeec5e64b3..45eccaa2506c215c49c81eecd7c8faae0b688380 100644
--- a/src/Quasar/Wayland/Connection.hs
+++ b/src/Quasar/Wayland/Connection.hs
@@ -34,7 +34,7 @@ data SocketClosed = SocketClosed
   deriving stock Show
   deriving anyclass Exception
 
-newWaylandConnection :: forall s m. MonadResourceManager m => Callback s STM I_wl_display -> Callback s STM I_wl_registry -> Socket -> m (WaylandConnection s)
+newWaylandConnection :: forall s m. (IsSide s, MonadResourceManager m) => Callback s STM I_wl_display -> Callback s STM I_wl_registry -> Socket -> m (WaylandConnection s)
 newWaylandConnection wlDisplayCallback wlRegistryCallback socket = do
   protocolStateVar <- liftIO $ newTVarIO $ initialProtocolState wlDisplayCallback wlRegistryCallback
   outboxVar <- liftIO newEmptyTMVarIO
@@ -86,7 +86,7 @@ sendThread connection = forever do
   SocketL.sendAll connection.socket bytes
 
 
-receiveThread :: WaylandConnection s -> IO ()
+receiveThread :: IsSide s => WaylandConnection s -> IO ()
 receiveThread connection = forever do
   bytes <- Socket.recv connection.socket 4096
 
diff --git a/src/Quasar/Wayland/Core.hs b/src/Quasar/Wayland/Core.hs
index e144c2e2a7c5e9abe12f01544a23059dacb96b15..071015cf91f61d4cffc3d4985af611383ac6ec43 100644
--- a/src/Quasar/Wayland/Core.hs
+++ b/src/Quasar/Wayland/Core.hs
@@ -1,8 +1,10 @@
 module Quasar.Wayland.Core (
   ObjectId,
   Opcode,
+  Fixed,
   IsInterface(..),
   Side(..),
+  IsSide,
   Object,
   IsSomeObject(..),
   IsSomeObject,
@@ -18,13 +20,18 @@ module Quasar.Wayland.Core (
   sendMessage,
   feedInput,
   setException,
+
+  -- Message decoder operations
+  WireGet,
+  WireFormat(..),
+  dropRemaining,
 ) where
 
 import Control.Monad (replicateM_)
 import Control.Monad.Catch
 import Control.Monad.Catch.Pure
 import Control.Monad.Reader (ReaderT, runReaderT)
-import Control.Monad.Writer (WriterT, runWriterT)
+import Control.Monad.Writer (WriterT, runWriterT, execWriterT, tell)
 import Control.Monad.State (StateT, runStateT, lift)
 import Control.Monad.State qualified as State
 import Data.Binary
@@ -36,6 +43,7 @@ import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
+import Data.Kind
 import Data.Maybe (isJust)
 import Data.Void (absurd)
 import GHC.TypeLits
@@ -49,6 +57,39 @@ type Opcode = Word16
 newtype Fixed = Fixed Word32
   deriving Eq
 
+
+
+type WireGet s m a =
+  ReaderT (HashMap ObjectId (SomeObject s m))
+    (WriterT [ProtocolAction s m ()]
+      (CatchT
+        Get
+      )
+    )
+    a
+
+runWireGet
+  :: MonadCatch m
+  => HashMap ObjectId (SomeObject s m)
+  -> WireGet s m ()
+  -> Get (ProtocolAction s m ())
+runWireGet objects action = do
+  result <- runCatchT $ execWriterT $ runReaderT action objects
+  case result of
+    Left ex -> pure $ throwM ex
+    Right actions -> pure $ sequence_ actions
+
+wireQueueAction :: ProtocolAction s m () -> WireGet s m ()
+wireQueueAction action = tell [action]
+
+
+liftGet :: Get a -> WireGet s m a
+liftGet = lift . lift . lift
+
+dropRemaining :: WireGet s m ()
+dropRemaining = liftGet $ void getRemainingLazyByteString
+
+
 class WireFormat a where
   type Argument a
   putArgument :: Argument a -> StateT (ProtocolState s m) PutM ()
@@ -96,18 +137,40 @@ instance WireFormat "fd" where
 
 
 -- | A wayland interface
-class (IsMessage (Request i), Binary (Request i), IsMessage (Event i), Binary (Event i)) => IsInterface i where
+class
+  (
+    Binary (Request i),
+    Binary (Event i),
+    IsMessage (Request i),
+    IsMessage (Event i),
+    IsMessage (Up 'Client i),
+    IsMessage (Up 'Server i),
+    IsMessage (Down 'Client i),
+    IsMessage (Down 'Server i)
+  )
+  => IsInterface i where
   type Request i
   type Event i
   interfaceName :: String
 
-type family Up (s :: Side) i where
-  Up 'Client i = Request i
-  Up 'Server i = Event i
+class IsSide (s :: Side) where
+  type Up s i
+  type Down s i
+  getDown :: forall m i. IsInterface i => Object s m i -> Opcode -> WireGet s m (Down s i)
+
+instance IsSide 'Client where
+  type Up 'Client i = Request i
+  type Down 'Client i = Event i
+  getDown :: forall m i. IsInterface i => Object 'Client m i -> Opcode -> WireGet 'Client m (Down 'Client i)
+  getDown = getMessage @(Down 'Client i)
+
+instance IsSide 'Server where
+  type Up 'Server i = Event i
+  type Down 'Server i = Request i
+  getDown :: forall m i. IsInterface i => Object 'Server m i -> Opcode -> WireGet 'Server m (Down 'Server i)
+  getDown = getMessage @(Down 'Server i)
+
 
-type family Down (s :: Side) i where
-  Down 'Client i = Event i
-  Down 'Server i = Request i
 
 -- | Data kind
 data Side = Client | Server
@@ -241,10 +304,6 @@ protocolStep action inState = do
         then st
         else st{protocolException = Just (toException ex)}
 
-type WireGet s m a = ReaderT (HashMap ObjectId (SomeObject s m)) (WriterT [StateT (ProtocolState s m) m ()] (CatchT Get)) a
-
-liftGet :: Get a -> WireGet s m a
-liftGet = lift . lift . lift
 
 -- * Exported functions
 
@@ -270,7 +329,7 @@ initialProtocolState wlDisplayCallback wlRegistryCallback = sendInitialMessage i
     }
 
 -- | Feed the protocol newly received data
-feedInput :: MonadCatch m => ByteString -> ProtocolStep s m ()
+feedInput :: (IsSide s, MonadCatch m) => ByteString -> ProtocolStep s m ()
 feedInput bytes = protocolStep do
   feed
   runCallbacks
@@ -280,7 +339,7 @@ feedInput bytes = protocolStep do
       inboxDecoder = pushChunk st.inboxDecoder bytes
     }
 
-sendMessage :: MonadCatch m => Object s m i -> Up s i -> ProtocolStep s m ()
+sendMessage :: (IsSide s, MonadCatch m) => Object s m i -> Up s i -> ProtocolStep s m ()
 sendMessage object message = protocolStep do
   undefined message
   runCallbacks
@@ -301,14 +360,14 @@ takeOutbox st = (outboxBytes, st{outbox = Nothing})
 sendInitialMessage :: ProtocolState s m -> ProtocolState s m
 sendInitialMessage = sendMessageInternal 1 1 [NewIdArgument 2]
 
-runCallbacks :: MonadCatch m => StateT (ProtocolState s m) m ()
+runCallbacks :: (IsSide s, MonadCatch m) => StateT (ProtocolState s m) m ()
 runCallbacks = receiveRawMessage >>= \case
   Nothing -> pure ()
   Just rawMessage -> do
     handleMessage rawMessage
     runCallbacks
 
-handleMessage :: forall s m. MonadCatch m => RawMessage -> StateT (ProtocolState s m) m ()
+handleMessage :: forall s m. (IsSide s, MonadCatch m) => RawMessage -> StateT (ProtocolState s m) m ()
 handleMessage rawMessage@(oId, opcode, body) = do
   st <- State.get
   case HM.lookup oId st.objects of
@@ -323,14 +382,15 @@ handleMessage rawMessage@(oId, opcode, body) = do
           throwM $ ParserFailed (describeMessage object opcode body) (show (BSL.length leftovers) <> "B not parsed")
 
 getMessageAction
-  :: MonadCatch m
+  :: (IsSide s, IsInterface i, MonadCatch m)
   => HashMap ObjectId (SomeObject s m)
   -> Object s m i
   -> RawMessage
   -> Get (ProtocolAction s m ())
-getMessageAction objects object@(Object _ callback) (oId, opcode, body) = do
-  pure $ traceM $ "Received message " <> objectInterfaceName object <> "@" <> show oId <> ".msg#" <> show opcode <> " (" <> show (BSL.length body) <> "B)"
-
+getMessageAction objects object@(Object _ callback) (oId, opcode, body) =
+  runWireGet objects do
+    message <- getDown object opcode
+    wireQueueAction $ traceM $ "Received message " <> describeMessage object opcode body
 
 type ProtocolAction s m a = StateT (ProtocolState s m) m a
 
diff --git a/src/Quasar/Wayland/Protocol.hs b/src/Quasar/Wayland/Protocol.hs
index e0c91f7aa610b732495d8f30bd0e32f75c2ed502..c21e9d88144f97c712c23383c0fbae03b336efeb 100644
--- a/src/Quasar/Wayland/Protocol.hs
+++ b/src/Quasar/Wayland/Protocol.hs
@@ -3,6 +3,8 @@
 
 module Quasar.Wayland.Protocol where
 
+import Data.Binary
+import Quasar.Wayland.Core
 import Quasar.Wayland.TH
 
 $(generateWaylandProcol "protocols/wayland.xml")
diff --git a/src/Quasar/Wayland/TH.hs b/src/Quasar/Wayland/TH.hs
index 1ebeaec95abaf1a04a9b1fa708c99cdc6598926f..2657bb642d0552b6936aee78524478a2d4c977b7 100644
--- a/src/Quasar/Wayland/TH.hs
+++ b/src/Quasar/Wayland/TH.hs
@@ -14,26 +14,26 @@ import Text.XML.Light
 
 
 data ProtocolSpec = ProtocolSpec {interfaces :: [InterfaceSpec]}
-  deriving stock (Show)
+  deriving stock Show
 
 data InterfaceSpec = InterfaceSpec {
   name :: String,
   requests :: [RequestSpec],
   events :: [EventSpec]
 }
-  deriving stock (Show)
+  deriving stock Show
 
 newtype RequestSpec = RequestSpec MessageSpec
-  deriving stock (Show)
+  deriving stock Show
 
 newtype EventSpec = EventSpec MessageSpec
-  deriving stock (Show)
+  deriving stock Show
 
 data MessageSpec = MessageSpec {
   name :: String,
   opcode :: Opcode
 }
-  deriving stock (Show)
+  deriving stock Show
 
 
 generateWaylandProcol :: FilePath -> Q [Dec]
@@ -100,11 +100,13 @@ interfaceDec interface = execWriterT do
     messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] [messageNameD, getMessageD, putMessageD]
       where
         messageNameD :: Q Dec
-        messageNameD = funD 'messageName (messageNameInstanceClauseD <$> messages)
-        messageNameInstanceClauseD :: (MessageSpec, Name) -> Q Clause
-        messageNameInstanceClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) []
+        messageNameD = funD 'messageName (messageNameClauseD <$> messages)
+        messageNameClauseD :: (MessageSpec, Name) -> Q Clause
+        messageNameClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) []
         getMessageD :: Q Dec
-        getMessageD = funD 'getMessage [clause [] (normalB [|undefined|]) []]
+        getMessageD = funD 'getMessage (getMessageClauseD <$> messages)
+        getMessageClauseD :: (MessageSpec, Name) -> Q Clause
+        getMessageClauseD (msg, conName) = clause [[p|_object|], litP (integerL (fromIntegral msg.opcode))] (normalB ([|$(conE conName) <$ dropRemaining|])) []
         putMessageD :: Q Dec
         putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []]
     binaryInstanceD :: Q Type -> Q [Dec]