diff --git a/quasar-wayland.cabal b/quasar-wayland.cabal
index ded85924646a8d8c43b6977ecf08cd14ba796150..fa2fb27c90c32f390ed7f48c9dde629c3aa66e42 100644
--- a/quasar-wayland.cabal
+++ b/quasar-wayland.cabal
@@ -84,6 +84,7 @@ library
   import: shared-properties
   exposed-modules:
     Quasar.Wayland.Client
+    Quasar.Wayland.Core
     Quasar.Wayland.Protocol
     Quasar.Wayland.TH
   build-depends:
diff --git a/src/Quasar/Wayland/Client.hs b/src/Quasar/Wayland/Client.hs
index ddb98413c206a6ed9010b0f5f40b6f1760e996e5..2851e28ff60c5caa2dfa783a1379c127800c1e56 100644
--- a/src/Quasar/Wayland/Client.hs
+++ b/src/Quasar/Wayland/Client.hs
@@ -11,6 +11,7 @@ import Network.Socket.ByteString qualified as Socket
 import Network.Socket.ByteString.Lazy qualified as SocketL
 import Quasar
 import Quasar.Prelude
+import Quasar.Wayland.Core
 import Quasar.Wayland.Protocol
 import System.Environment (getEnv, lookupEnv)
 import System.FilePath ((</>), isRelative)
diff --git a/src/Quasar/Wayland/Core.hs b/src/Quasar/Wayland/Core.hs
new file mode 100644
index 0000000000000000000000000000000000000000..eac854f0a9bcf54d293d69ad1666611441e7311e
--- /dev/null
+++ b/src/Quasar/Wayland/Core.hs
@@ -0,0 +1,170 @@
+module Quasar.Wayland.Core (
+  ProtocolState,
+  ClientProtocolState,
+  initialClientProtocolState,
+  --ServerProtocolState,
+  --initialServerProtocolState,
+  Request,
+  Event,
+  initialProtocolState,
+  feedInput,
+  takeOutbox,
+) where
+
+import Control.Monad.State (State)
+import Control.Monad.State qualified as State
+import Data.Binary.Get
+import Data.Binary.Put
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.ByteString (ByteString)
+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 Quasar.Prelude
+
+
+type ObjectId = Word32
+type ObjectType = String
+type Opcode = Word16
+
+data Object = Object {
+  objectId :: ObjectId,
+  objectType :: ObjectType
+}
+
+
+data Argument
+  = IntArgument Int32
+  | UIntArgument Word32
+  -- TODO
+  | FixedArgument Void
+  | StringArgument String
+  | ObjectArgument ObjectId
+  | NewIdArgument ObjectId
+  | FdArgument ()
+
+argumentSize :: Argument -> Word16
+argumentSize (IntArgument _) = 4
+argumentSize (UIntArgument _) = 4
+argumentSize (ObjectArgument _) = 4
+argumentSize (NewIdArgument _) = 4
+argumentSize _ = undefined
+
+putArgument :: Argument -> Put
+putArgument (IntArgument x) = putInt32host x
+putArgument (UIntArgument x) = putWord32host x
+putArgument (ObjectArgument x) = putWord32host x
+putArgument (NewIdArgument x) = putWord32host x
+putArgument _ = undefined
+
+
+type ClientProtocolState = ProtocolState Request Event
+type ServerProtocolState = ProtocolState Event Request
+
+data ProtocolState up down = ProtocolState {
+  bytesReceived :: Word64,
+  bytesSent :: Word64,
+  parser :: Decoder down,
+  inboxDecoder :: Decoder down,
+  outbox :: Maybe Put,
+  objects :: HashMap ObjectId Object
+}
+
+data Request = Request ObjectId Opcode BSL.ByteString
+  deriving stock Show
+data Event = Event ObjectId Opcode (Either BSL.ByteString (Word32, BSL.ByteString, Word32))
+  deriving stock Show
+
+initialClientProtocolState :: ClientProtocolState
+initialClientProtocolState = initialProtocolState decodeEvent
+
+initialProtocolState :: Get down -> ProtocolState up down
+initialProtocolState downGet = sendInitialMessage ProtocolState {
+  bytesReceived = 0,
+  bytesSent = 0,
+  parser = runGetIncremental downGet,
+  inboxDecoder = runGetIncremental downGet,
+  outbox = Nothing,
+  objects = HM.singleton 1 (Object 1 "wl_display")
+}
+
+sendInitialMessage :: ProtocolState up down -> ProtocolState up down
+sendInitialMessage = sendMessage 1 1 [NewIdArgument 2]
+
+feedInput :: forall up down. ByteString -> ProtocolState up down -> ([down], ProtocolState up down)
+feedInput bytes = State.runState do
+  State.modify (receive bytes)
+  go
+  where
+    go :: State (ProtocolState up down) [down]
+    go = State.state takeDownMsg >>= \case
+      Nothing -> pure []
+      Just msg -> (msg :) <$> go
+
+
+receive :: forall up down. ByteString -> ProtocolState up down -> ProtocolState up down
+receive bytes state = state {
+  bytesReceived = state.bytesReceived + fromIntegral (BS.length bytes),
+  inboxDecoder = pushChunk state.inboxDecoder bytes
+}
+
+takeDownMsg :: forall up down. ProtocolState up down -> (Maybe down, ProtocolState up down)
+takeDownMsg state = (result, state{inboxDecoder = newDecoder})
+  where
+    result :: Maybe down
+    newDecoder :: Decoder down
+    (result, newDecoder) = checkDecoder state.inboxDecoder
+    checkDecoder :: Decoder down -> (Maybe down, Decoder down)
+    checkDecoder (Fail _ _ _) = undefined
+    checkDecoder x@(Partial _) = (Nothing, x)
+    checkDecoder (Done leftovers _ result) = (Just result, pushChunk state.parser leftovers)
+
+
+decodeEvent :: Get Event
+decodeEvent = do
+  objectId <- getWord32host
+  sizeAndOpcode <- getWord32host
+  let
+    size = fromIntegral (sizeAndOpcode `shiftR` 16) - 8
+    opcode = fromIntegral (sizeAndOpcode .&. 0xFFFF)
+  body <- if (objectId == 2 && opcode == 0)
+             then Right <$> parseGlobal
+             else Left <$> getLazyByteString size <* skipPadding
+  pure $ Event objectId opcode body
+  where
+    parseGlobal :: Get (Word32, BSL.ByteString, Word32)
+    parseGlobal = (,,) <$> getWord32host <*> getWaylandString <*> getWord32host
+    getWaylandString :: Get BSL.ByteString
+    getWaylandString = do
+      size <- getWord32host
+      Just (string, 0) <- BSL.unsnoc <$> getLazyByteString (fromIntegral size)
+      skipPadding
+      pure string
+
+skipPadding :: Get ()
+skipPadding = do
+  bytes <- bytesRead
+  skip $ fromIntegral ((4 - (bytes `mod` 4)) `mod` 4)
+
+
+sendMessage :: ObjectId -> Opcode -> [Argument] -> ProtocolState up down -> ProtocolState up down
+sendMessage objectId opcode args = sendRaw do
+  putWord32host objectId
+  putWord32host $ (fromIntegral msgSize `shiftL` 16) .|. fromIntegral opcode
+  mapM_ putArgument args
+  -- TODO padding
+  where
+    msgSize :: Word16
+    msgSize = if msgSizeInteger <= fromIntegral (maxBound :: Word16) then fromIntegral msgSizeInteger else undefined
+    msgSizeInteger :: Integer
+    msgSizeInteger = foldr ((+) . (fromIntegral . argumentSize)) 8 args :: Integer
+
+sendRaw :: Put -> ProtocolState up down -> ProtocolState up down
+sendRaw put oldState = oldState {
+  outbox = Just (maybe put (<> put) oldState.outbox)
+}
+
+takeOutbox :: ProtocolState up down -> (Maybe BSL.ByteString, ProtocolState up down)
+takeOutbox state = (runPut <$> state.outbox, state{outbox = Nothing})
+akeOutbox state = (runPut <$> state.outbox, state{outbox = Nothing})
diff --git a/src/Quasar/Wayland/Protocol.hs b/src/Quasar/Wayland/Protocol.hs
index aeb1398552bd535b35fd8e838d52187797ac2e1b..8500419f06be6922fab1d6598fa727cf0416e185 100644
--- a/src/Quasar/Wayland/Protocol.hs
+++ b/src/Quasar/Wayland/Protocol.hs
@@ -1,172 +1,6 @@
-module Quasar.Wayland.Protocol (
-  ProtocolState,
-  ClientProtocolState,
-  initialClientProtocolState,
-  --ServerProtocolState,
-  --initialServerProtocolState,
-  Request,
-  Event,
-  initialProtocolState,
-  feedInput,
-  takeOutbox,
-) where
+module Quasar.Wayland.Protocol where
 
-import Control.Monad.State (State)
-import Control.Monad.State qualified as State
-import Data.Binary.Get
-import Data.Binary.Put
-import Data.Bits ((.&.), (.|.), shiftL, shiftR)
-import Data.ByteString (ByteString)
-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 Quasar.Prelude
+import Quasar.Wayland.Core
 import Quasar.Wayland.TH
 
 $(generateWaylandProcol "protocols/wayland.xml")
-
-
-type ObjectId = Word32
-type ObjectType = String
-type Opcode = Word16
-
-data Object = Object {
-  objectId :: ObjectId,
-  objectType :: ObjectType
-}
-
-
-data Argument
-  = IntArgument Int32
-  | UIntArgument Word32
-  -- TODO
-  | FixedArgument Void
-  | StringArgument String
-  | ObjectArgument ObjectId
-  | NewIdArgument ObjectId
-  | FdArgument ()
-
-argumentSize :: Argument -> Word16
-argumentSize (IntArgument _) = 4
-argumentSize (UIntArgument _) = 4
-argumentSize (ObjectArgument _) = 4
-argumentSize (NewIdArgument _) = 4
-argumentSize _ = undefined
-
-putArgument :: Argument -> Put
-putArgument (IntArgument x) = putInt32host x
-putArgument (UIntArgument x) = putWord32host x
-putArgument (ObjectArgument x) = putWord32host x
-putArgument (NewIdArgument x) = putWord32host x
-putArgument _ = undefined
-
-
-type ClientProtocolState = ProtocolState Request Event
-type ServerProtocolState = ProtocolState Event Request
-
-data ProtocolState up down = ProtocolState {
-  bytesReceived :: Word64,
-  bytesSent :: Word64,
-  parser :: Decoder down,
-  inboxDecoder :: Decoder down,
-  outbox :: Maybe Put,
-  objects :: HashMap ObjectId Object
-}
-
-data Request = Request ObjectId Opcode BSL.ByteString
-  deriving stock Show
-data Event = Event ObjectId Opcode (Either BSL.ByteString (Word32, BSL.ByteString, Word32))
-  deriving stock Show
-
-initialClientProtocolState :: ClientProtocolState
-initialClientProtocolState = initialProtocolState decodeEvent
-
-initialProtocolState :: Get down -> ProtocolState up down
-initialProtocolState downGet = sendInitialMessage ProtocolState {
-  bytesReceived = 0,
-  bytesSent = 0,
-  parser = runGetIncremental downGet,
-  inboxDecoder = runGetIncremental downGet,
-  outbox = Nothing,
-  objects = HM.singleton 1 (Object 1 "wl_display")
-}
-
-sendInitialMessage :: ProtocolState up down -> ProtocolState up down
-sendInitialMessage = sendMessage 1 1 [NewIdArgument 2]
-
-feedInput :: forall up down. ByteString -> ProtocolState up down -> ([down], ProtocolState up down)
-feedInput bytes = State.runState do
-  State.modify (receive bytes)
-  go
-  where
-    go :: State (ProtocolState up down) [down]
-    go = State.state takeDownMsg >>= \case
-      Nothing -> pure []
-      Just msg -> (msg :) <$> go
-
-
-receive :: forall up down. ByteString -> ProtocolState up down -> ProtocolState up down
-receive bytes state = state {
-  bytesReceived = state.bytesReceived + fromIntegral (BS.length bytes),
-  inboxDecoder = pushChunk state.inboxDecoder bytes
-}
-
-takeDownMsg :: forall up down. ProtocolState up down -> (Maybe down, ProtocolState up down)
-takeDownMsg state = (result, state{inboxDecoder = newDecoder})
-  where
-    result :: Maybe down
-    newDecoder :: Decoder down
-    (result, newDecoder) = checkDecoder state.inboxDecoder
-    checkDecoder :: Decoder down -> (Maybe down, Decoder down)
-    checkDecoder (Fail _ _ _) = undefined
-    checkDecoder x@(Partial _) = (Nothing, x)
-    checkDecoder (Done leftovers _ result) = (Just result, pushChunk state.parser leftovers)
-
-
-decodeEvent :: Get Event
-decodeEvent = do
-  objectId <- getWord32host
-  sizeAndOpcode <- getWord32host
-  let
-    size = fromIntegral (sizeAndOpcode `shiftR` 16) - 8
-    opcode = fromIntegral (sizeAndOpcode .&. 0xFFFF)
-  body <- if (objectId == 2 && opcode == 0)
-             then Right <$> parseGlobal
-             else Left <$> getLazyByteString size <* skipPadding
-  pure $ Event objectId opcode body
-  where
-    parseGlobal :: Get (Word32, BSL.ByteString, Word32)
-    parseGlobal = (,,) <$> getWord32host <*> getWaylandString <*> getWord32host
-    getWaylandString :: Get BSL.ByteString
-    getWaylandString = do
-      size <- getWord32host
-      Just (string, 0) <- BSL.unsnoc <$> getLazyByteString (fromIntegral size)
-      skipPadding
-      pure string
-
-skipPadding :: Get ()
-skipPadding = do
-  bytes <- bytesRead
-  skip $ fromIntegral ((4 - (bytes `mod` 4)) `mod` 4)
-
-
-sendMessage :: ObjectId -> Opcode -> [Argument] -> ProtocolState up down -> ProtocolState up down
-sendMessage objectId opcode args = sendRaw do
-  putWord32host objectId
-  putWord32host $ (fromIntegral msgSize `shiftL` 16) .|. fromIntegral opcode
-  mapM_ putArgument args
-  -- TODO padding
-  where
-    msgSize :: Word16
-    msgSize = if msgSizeInteger <= fromIntegral (maxBound :: Word16) then fromIntegral msgSizeInteger else undefined
-    msgSizeInteger :: Integer
-    msgSizeInteger = foldr ((+) . (fromIntegral . argumentSize)) 8 args :: Integer
-
-sendRaw :: Put -> ProtocolState up down -> ProtocolState up down
-sendRaw put oldState = oldState {
-  outbox = Just (maybe put (<> put) oldState.outbox)
-}
-
-takeOutbox :: ProtocolState up down -> (Maybe BSL.ByteString, ProtocolState up down)
-takeOutbox state = (runPut <$> state.outbox, state{outbox = Nothing})
diff --git a/src/Quasar/Wayland/TH.hs b/src/Quasar/Wayland/TH.hs
index c76b8d6c1db9b2c4e434ca3fbc2a3cfe0a43bfb6..f1c7375f0185d045d949312b48701d05b331d4c0 100644
--- a/src/Quasar/Wayland/TH.hs
+++ b/src/Quasar/Wayland/TH.hs
@@ -9,6 +9,7 @@ import Data.ByteString qualified as BS
 import Language.Haskell.TH
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax (addDependentFile)
+--import Quasar.Wayland.Core