From 61c5f0dda920ce604a741781899d6a7f2a7cc866 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Wed, 23 Oct 2013 14:19:17 +0200
Subject: [PATCH] make stanza handler plugins more flexible

stanza handlers used to return a Boolean value to indicate whether stanza processing should continue. Now the return lists of stanzas instead. This facilitates plugins that transform stranzas (e.g. encryption)
---
 source/Network/Xmpp/Concurrent.hs | 17 +++++++----------
 source/Network/Xmpp/IM/Roster.hs  | 12 ++++++------
 source/Network/Xmpp/Types.hs      |  4 ++--
 3 files changed, 15 insertions(+), 18 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 4e4ca13..8bf20ba 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -52,24 +52,21 @@ runHandlers :: WriteSemaphore -> [StanzaHandler] -> Stanza -> IO ()
 runHandlers _    []        _   = return ()
 runHandlers  sem (h:hands) sta = do
     res <- h sem sta
-    case res of
-        True -> runHandlers sem hands sta
-        False -> return ()
+    forM_ res (runHandlers sem hands)
 
 toChan :: TChan Stanza -> StanzaHandler
 toChan stanzaC _ sta = do
     atomically $ writeTChan stanzaC sta
-    return True
-
+    return [sta]
 
 handleIQ :: TVar IQHandlers
          -> StanzaHandler
 handleIQ iqHands writeSem sta = do
         case sta of
-            IQRequestS     i -> handleIQRequest iqHands i >> return False
-            IQResultS      i -> handleIQResponse iqHands (Right i) >> return False
-            IQErrorS       i -> handleIQResponse iqHands (Left i) >> return False
-            _                -> return True
+            IQRequestS     i -> handleIQRequest iqHands i >> return []
+            IQResultS      i -> handleIQResponse iqHands (Right i) >> return []
+            IQErrorS       i -> handleIQResponse iqHands (Left i)  >> return []
+            _                -> return [sta]
   where
     -- If the IQ request has a namespace, send it through the appropriate channel.
     handleIQRequest :: TVar IQHandlers -> IQRequest -> IO ()
@@ -141,7 +138,7 @@ newSession stream config realm mbSasl = runErrorT $ do
     ros <- liftIO . newTVarIO $ Roster Nothing Map.empty
     rew <- lift $ newTVarIO 60
     let rosterH = if (enableRoster config) then handleRoster ros
-                                           else \ _ _ -> return True
+                                           else \ _ sta -> return [sta]
     let stanzaHandler = runHandlers writeSem
                         $ Prelude.concat [ [ toChan stanzaChan ]
                                          , extraStanzaHandlers
diff --git a/source/Network/Xmpp/IM/Roster.hs b/source/Network/Xmpp/IM/Roster.hs
index 358531b..f71ef91 100644
--- a/source/Network/Xmpp/IM/Roster.hs
+++ b/source/Network/Xmpp/IM/Roster.hs
@@ -81,26 +81,26 @@ initRoster session = do
                           "Server did not return a roster"
         Just roster -> atomically $ writeTVar (rosterRef session) roster
 
-handleRoster :: TVar Roster -> WriteSemaphore -> Stanza -> IO Bool
+handleRoster :: TVar Roster -> WriteSemaphore -> Stanza -> IO [Stanza]
 handleRoster ref sem sta = case sta of
     IQRequestS (iqr@IQRequest{iqRequestPayload =
                                    iqb@Element{elementName = en}})
         | nameNamespace en == Just "jabber:iq:roster" -> do
             case iqRequestFrom iqr of
-                Just _from -> return True -- Don't handle roster pushes from
-                                          -- unauthorized sources
+                Just _from -> return [sta] -- Don't handle roster pushes from
+                                           -- unauthorized sources
                 Nothing -> case unpickleElem xpQuery iqb of
                     Right Query{ queryVer = v
                                , queryItems = [update]
                                } -> do
                         handleUpdate v update
                         _ <- writeStanza sem $ result iqr
-                        return False
+                        return []
                     _ -> do
                         errorM "Pontarius.Xmpp" "Invalid roster query"
                         _ <- writeStanza sem $ badRequest iqr
-                        return False
-    _ -> return True
+                        return []
+    _ -> return [sta]
   where
     handleUpdate v' update = atomically $ modifyTVar ref $ \(Roster v is) ->
         Roster (v' `mplus` v) $ case qiSubscription update of
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index e342dd6..811dd4d 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -756,7 +756,7 @@ instance Read Jid where
 
 #if WITH_TEMPLATE_HASKELL
 -- | Constructs a @Jid@ value at compile time.
---  
+--
 -- Syntax:
 -- @
 --     [jidQ|localpart\@domainpart/resourcepart|]
@@ -1037,7 +1037,7 @@ instance Default StreamConfiguration where
 
 type StanzaHandler =  TMVar (BS.ByteString -> IO Bool) -- ^ outgoing stanza
                    -> Stanza       -- ^ stanza to handle
-                   -> IO Bool      -- ^ True when processing should continue
+                   -> IO [Stanza]  -- ^ modified stanzas (if any)
 
 -- | How the client should behave in regards to TLS.
 data TlsBehaviour = RequireTls -- ^ Require the use of TLS; disconnect if it's