diff --git a/src/Quasar/Wayland/Server/Shm.hs b/src/Quasar/Wayland/Server/Shm.hs
index 65234b9fd1e6b8e8f3cdca07881a389e8a764cf8..0a077e5af28e55593e7d045a97bc520d538ca831 100644
--- a/src/Quasar/Wayland/Server/Shm.hs
+++ b/src/Quasar/Wayland/Server/Shm.hs
@@ -38,5 +38,5 @@ initializeWlShmPool wlShmPool fd size = do
 
 initializeWlShmBuffer :: ShmPool -> NewObject 'Server Interface_wl_buffer -> Int32 -> Int32 -> Int32 -> Int32 -> Word32 -> STM ()
 initializeWlShmBuffer pool wlBuffer offset width height stride format = do
-  let initializeBufferFn = newShmBuffer pool offset width height stride format
-  initializeWlBuffer @ShmBufferBackend wlBuffer initializeBufferFn
+  buffer <- newShmBuffer pool offset width height stride format
+  initializeWlBuffer @ShmBufferBackend wlBuffer buffer
diff --git a/src/Quasar/Wayland/Server/Surface.hs b/src/Quasar/Wayland/Server/Surface.hs
index 8144428bc0e311d2b995b4bb72b2135f6bb67208..9d9093c3ac28c9e801b0a554562e3682912e1a95 100644
--- a/src/Quasar/Wayland/Server/Surface.hs
+++ b/src/Quasar/Wayland/Server/Surface.hs
@@ -24,7 +24,7 @@ data ServerSurface b = ServerSurface {
 
 data ServerBuffer b = ServerBuffer {
   buffer :: Buffer b,
-  attachedCount :: TVar Int
+  wlBuffer :: Object 'Server Interface_wl_buffer
 }
 
 newServerSurface :: forall b. STM (ServerSurface b)
@@ -57,15 +57,16 @@ commitServerSurface surface = do
         _ -> DamageAll
     combinedDamage = bufferDamage <> convertedSurfaceDamage
 
+  -- Attach callback for wl_buffer.release
+  forM_ serverBuffer \sb ->
+    addBufferReleaseCallback sb.buffer sb.wlBuffer.release
+
   commitSurface surface.surface SurfaceCommit {
     buffer = (.buffer) <$> serverBuffer,
     offset,
     bufferDamage = combinedDamage
   }
 
-  case serverBuffer of
-    Just sb -> modifyTVar sb.attachedCount (+ 1)
-    Nothing -> pure ()
 
 attachToSurface :: forall b. BufferBackend b => ServerSurface b -> Maybe (Object 'Server Interface_wl_buffer) -> Int32 -> Int32 -> STM ()
 attachToSurface surface wlBuffer x y = do
@@ -103,27 +104,17 @@ initializeServerSurface wlSurface = do
   setInterfaceData wlSurface surface
   traceM "wl_surface not implemented"
 
-initializeWlBuffer :: forall b. BufferBackend b => NewObject 'Server Interface_wl_buffer -> (STM () -> STM (Buffer b)) -> STM ()
-initializeWlBuffer wlBuffer initializeBufferFn = do
-  attachedCount <- newTVar 0
-  buffer <- initializeBufferFn (releaseServerBuffer attachedCount)
-
+initializeWlBuffer :: forall b. BufferBackend b => NewObject 'Server Interface_wl_buffer -> Buffer b -> STM ()
+initializeWlBuffer wlBuffer buffer = do
   let serverBuffer = ServerBuffer {
     buffer,
-    attachedCount
+    wlBuffer
   }
   setInterfaceData wlBuffer serverBuffer
   setRequestHandler wlBuffer RequestHandler_wl_buffer {
     -- TODO propagate buffer destruction
     destroy = destroyBuffer buffer
   }
-  where
-    releaseServerBuffer :: TVar Int -> STM ()
-    releaseServerBuffer attachedCountVar = do
-      attachedCount <- swapTVar attachedCountVar 0
-        -- TODO handle other exceptions (e.g. disconnects)
-      unlessM (isDestroyed wlBuffer) $
-        sequence_ $ replicate attachedCount $ wlBuffer.release
 
 
 getServerBuffer :: forall b. BufferBackend b => Object 'Server Interface_wl_buffer -> STM (ServerBuffer b)
diff --git a/src/Quasar/Wayland/Shm.hs b/src/Quasar/Wayland/Shm.hs
index 7114f22ee0ac713cd52a760f3bf79e8837970ade..954a0c44d4fb73013eca7e3e1039d068ca620e4c 100644
--- a/src/Quasar/Wayland/Shm.hs
+++ b/src/Quasar/Wayland/Shm.hs
@@ -83,12 +83,12 @@ tryFinalizeShmPool pool = do
 
 
 -- | Create a new buffer for an externally managed pool
-newShmBuffer :: ShmPool -> Int32 -> Int32 -> Int32 -> Int32 -> Word32 -> STM () -> STM (Buffer ShmBufferBackend)
-newShmBuffer pool offset width height stride format releaseBuffer = do
+newShmBuffer :: ShmPool -> Int32 -> Int32 -> Int32 -> Int32 -> Word32 -> STM (Buffer ShmBufferBackend)
+newShmBuffer pool offset width height stride format = do
   -- TODO check arguments
   modifyTVar pool.bufferCount succ
   let shmBuffer = ShmBuffer pool offset width height stride format
-  newBuffer @ShmBufferBackend shmBuffer releaseBuffer
+  newBuffer @ShmBufferBackend shmBuffer
 
 data DownstreamShmPool = DownstreamShmPool
 
diff --git a/src/Quasar/Wayland/Surface.hs b/src/Quasar/Wayland/Surface.hs
index d779193a4061b6f8d07aec58d7981c3c5c7d92f1..0902461e97f43f78709ecc0942f43c5424b36879 100644
--- a/src/Quasar/Wayland/Surface.hs
+++ b/src/Quasar/Wayland/Surface.hs
@@ -5,6 +5,7 @@ module Quasar.Wayland.Surface (
   newBuffer,
   lockBuffer,
   destroyBuffer,
+  addBufferReleaseCallback,
 
   -- * Surface
   Damage(..),
@@ -31,14 +32,15 @@ class Typeable b => BufferBackend b where
 data Buffer b = Buffer {
   content :: BufferContent b,
   -- | Buffer has been released by all current users and can be reused by the owner.
-  releaseBuffer :: STM (),
+  releaseBuffer :: TVar (STM ()),
   -- | Refcount that tracks how many times the buffer is locked by consumers.
   lockCount :: TVar Int,
   destroyed :: TVar Bool
 }
 
-newBuffer :: forall b. BufferContent b -> STM () -> STM (Buffer b)
-newBuffer content releaseBuffer = do
+newBuffer :: forall b. BufferContent b -> STM (Buffer b)
+newBuffer content = do
+  releaseBuffer <- newTVar (pure ())
   lockCount <- newTVar 0
   destroyed <- newTVar False
   pure Buffer {
@@ -48,6 +50,12 @@ newBuffer content releaseBuffer = do
     destroyed
   }
 
+
+addBufferReleaseCallback :: Buffer b -> STM () -> STM ()
+addBufferReleaseCallback buffer releaseFn =
+  modifyTVar buffer.releaseBuffer (>> releaseFn)
+
+
 -- | Prevents the buffer from being released. Returns an unlock action.
 lockBuffer :: forall b. BufferBackend b => Buffer b -> STM (STM ())
 lockBuffer buffer = do
@@ -58,7 +66,7 @@ lockBuffer buffer = do
     unlockBuffer = do
       lockCount <- stateTVar buffer.lockCount (dup . pred)
       when (lockCount == 0) do
-        buffer.releaseBuffer
+        join $ swapTVar buffer.releaseBuffer (pure ())
         tryFinalizeBuffer @b buffer
 
 -- | Request destruction of the buffer. Since the buffer might still be in use downstream, the backing storage must not be changed until all downstreams release the buffer (signalled by `releaseBufferStorage`).