diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index e983781add53f78a2f1b1a3d06f9149a33ddf4ed..da5c8f24f82924a32e2d5063128a1315bb52137c 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -196,8 +196,8 @@ class (
 getDown :: forall s m i. IsInterfaceSide s i => Object s m i -> Opcode -> Get (Down s i)
 getDown = getMessage @(Down s i)
 
-putUp :: forall s i. IsInterfaceSide s i => Up s i -> Put
-putUp = putMessage @(Up s i)
+putUp :: forall s m i. IsInterfaceSide s i => Object s m i -> Up s i -> PutM Opcode
+putUp _ = putMessage @(Up s i)
 
 
 class IsInterfaceSide s i => IsInterfaceHandler s m i a where
@@ -256,7 +256,7 @@ instance IsObjectSide (SomeObject s m) where
 class (Eq a, Show a) => IsMessage a where
   opcodeName :: Opcode -> Maybe String
   getMessage :: IsInterface i => Object s m i -> Opcode -> Get a
-  putMessage :: a -> PutM ()
+  putMessage :: a -> PutM Opcode
 
 instance IsMessage Void where
   opcodeName _ = Nothing
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index dab855ad3539063629ed11c35ab287a22a066bb8..8be2a10518d660321ab446b032a29b5185e4fa03 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -247,9 +247,10 @@ isMessageInstanceD t msgs = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD,
     putMessageClauseD msg = clause [msgConP msg] (normalB (putMessageE msg.msgSpec.arguments)) []
       where
         putMessageE :: [ArgumentSpec] -> Q Exp
-        putMessageE [] = [|pure ()|]
-        putMessageE args = doE ((\arg -> noBindS [|putArgument @($(argumentSpecType arg)) $(msgArgE msg arg)|]) <$> args)
-
+        putMessageE [] = opcodeE
+        putMessageE args = doE (((\arg -> noBindS [|putArgument @($(argumentSpecType arg)) $(msgArgE msg arg)|]) <$> args) <> [noBindS opcodeE])
+        opcodeE :: Q Exp
+        opcodeE = [|pure $(litE $ integerL $ fromIntegral msg.msgSpec.opcode)|]
 
 
 derivingEq :: Q DerivClause