From cf5c378256a59ba3b7c722a18279989281e276e5 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sun, 22 Nov 2015 15:51:37 -0500
Subject: [PATCH] Respond to all IQ with an error

---
 Main.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/Main.hs b/Main.hs
index 25aaccb..c52c033 100644
--- a/Main.hs
+++ b/Main.hs
@@ -72,14 +72,14 @@ componentMessage _ toVitelity _ _ existingRoom bareFrom resourceFrom tel body =
 		| fmap bareTxt existingRoom == Just bareFrom = fromMaybe (fromString "nonick") resourceFrom
 		| otherwise = bareFrom
 
-componentStanza db toVitelity (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
+componentStanza db toVitelity _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
 	| Just tel <- strNode <$> jidNode to,
 	  Just body <- getBody "jabber:component:accept" m = do
 		existingRoom <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ T.unpack tel)
 		componentMessage db toVitelity (messageType m) (fromMaybe mempty $ messageID m) existingRoom (bareTxt from) resourceFrom tel body
 	where
 	resourceFrom = strResource <$> jidResource from
-componentStanza db toVitelity (ReceivedPresence p@(Presence { presenceFrom = Just from, presenceTo = Just to }))
+componentStanza db toVitelity _ (ReceivedPresence p@(Presence { presenceFrom = Just from, presenceTo = Just to }))
 	| Just tel <- strNode <$> jidNode to,
 	  [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< presencePayloads p,
 	  [status] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x,
@@ -94,7 +94,17 @@ componentStanza db toVitelity (ReceivedPresence p@(Presence { presenceFrom = Jus
 	where
 	bareMUC = bareTxt from
 	roomNick = fromMaybe mempty (strResource <$> jidResource from)
-componentStanza _ _ _ = return ()
+componentStanza _ _ toComponent (ReceivedIQ (IQ { iqType = typ, iqFrom = Just from, iqTo = to, iqID = id }))
+	| typ `elem` [IQGet, IQSet] =
+		writeStanzaChan toComponent $ (emptyIQ IQError) {
+			iqTo = Just from,
+			iqFrom = to,
+			iqID = id,
+			iqPayload = Just $ Element (fromString "{jabber:component:accept}error")
+				[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]
+				[NodeElement $ Element (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}feature-not-implemented") [] []]
+		}
+componentStanza _ _ _ _ = return ()
 
 component db toVitelity toComponent = do
 	forkXMPP $ forever $ flip catchError (const $ return ()) $ do
@@ -104,7 +114,7 @@ component db toVitelity toComponent = do
 	--forever $ getStanza >>= liftIO . componentStanza db toVitelity
 	forever $ flip catchError (const $ return ()) $ do
 		s <- getStanza
-		liftIO $ componentStanza db toVitelity s
+		liftIO $ componentStanza db toVitelity toComponent s
 
 data Command = Join JID | Send Text
 	deriving (Show, Eq)
-- 
2.45.2