From 06385ab79ef4b40d378088f20e8d8bc426a4f7bb Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 15 Sep 2021 23:24:44 +0200
Subject: [PATCH] Limit 'object'-attributes without interface to
wl_display.error
---
src/Quasar/Wayland/Protocol/TH.hs | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs
index cb94e96..7a1e636 100644
--- a/src/Quasar/Wayland/Protocol/TH.hs
+++ b/src/Quasar/Wayland/Protocol/TH.hs
@@ -342,10 +342,13 @@ parseMessage interfaceName (opcode, element) = do
name <- getAttr "name" element
since <- read <<$>> peekAttr "since" element
arguments <- mapM parseArgument $ zip [0..] $ findChildren (qname "arg") element
- forM_ arguments \arg ->
+ forM_ arguments \arg -> do
when
- do arg.argType == GenericNewIdArgument && interfaceName /= "wl_registry"
- do fail $ "Invalid GenericNewIdArgument encountered on " <> interfaceName <> "." <> name <> " (only valid on wl_registry)"
+ do arg.argType == GenericNewIdArgument && (interfaceName /= "wl_registry" || name /= "bind")
+ do fail $ "Invalid 'new_id' argument without 'interface' attribute encountered on " <> interfaceName <> "." <> name <> " (only valid on wl_registry.bind)"
+ when
+ do arg.argType == GenericObjectArgument && (interfaceName /= "wl_display" || name /= "error")
+ do fail $ "Invalid 'object' argument without 'interface' attribute encountered on " <> interfaceName <> "." <> name <> " (only valid on wl_display.error)"
pure MessageSpec {
name,
since,
--
GitLab