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

@@ -52,24 +52,21 @@ runHandlers :: WriteSemaphore -> [StanzaHandler] -> Stanza -> IO ()
 runHandlers _    []        _   = return ()
 runHandlers  sem (h:hands) sta = do
     res <- h sem sta
-    case res of
+    forM_ res (runHandlers sem hands)
-        True -> runHandlers sem hands sta
-        False -> return ()
 
 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
+            IQRequestS     i -> handleIQRequest iqHands i >> return []
-            IQResultS      i -> handleIQResponse iqHands (Right i) >> return False
+            IQResultS      i -> handleIQResponse iqHands (Right i) >> return []
-            IQErrorS       i -> handleIQResponse iqHands (Left i) >> return False
+            IQErrorS       i -> handleIQResponse iqHands (Left i)  >> return []
-            _                -> return True
+            _                -> 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

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
+                Just _from -> return [sta] -- Don't handle roster pushes from
-                                          -- unauthorized sources
+                                           -- 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 []
-    _ -> return True
+    _ -> return [sta]
   where
     handleUpdate v' update = atomically $ modifyTVar ref $ \(Roster v is) ->
         Roster (v' `mplus` v) $ case qiSubscription update of

source/Network/Xmpp/Types.hs

@@ -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