change handling returned annotations: Annotations are appended to the list

source/Network/Xmpp/Concurrent.hs

@@ -58,12 +58,12 @@ runHandlers hs sta = go hs sta []
   where go []        _  _   = return ()
         go (h:hands) sta' as = do
             res <- h sta' as
-            forM_ res $ uncurry (go hands)
+            forM_ res $ \(sta, as') -> go hands sta (as ++ as')
 
 toChan :: TChan (Annotated Stanza) -> StanzaHandler
 toChan stanzaC _ sta as = do
     atomically $ writeTChan stanzaC (sta, as)
-    return [(sta, as)]
+    return [(sta, [])]
 
 handleIQ :: TVar IQHandlers
          -> StanzaHandler
@@ -72,7 +72,7 @@ handleIQ iqHands out sta as = do
             IQRequestS     i -> handleIQRequest iqHands i >> return []
             IQResultS      i -> handleIQResponse iqHands (Right i) >> return []
             IQErrorS       i -> handleIQResponse iqHands (Left i)  >> return []
-            _                -> return [(sta, as)]
+            _                -> return [(sta, [])]
   where
     -- If the IQ request has a namespace, send it through the appropriate channel.
     handleIQRequest :: TVar IQHandlers -> IQRequest -> IO ()

source/Network/Xmpp/Concurrent/Types.hs

@@ -22,8 +22,9 @@ import           Network.Xmpp.Types
 
 type StanzaHandler =  (Stanza -> IO Bool) -- ^ outgoing stanza
                    -> Stanza       -- ^ stanza to handle
-                   -> [Annotation]
+                   -> [Annotation] -- ^ annotations added by previous handlers
-                   -> IO [(Stanza, [Annotation])]  -- ^ modified stanzas (if any)
+                   -> IO [(Stanza, [Annotation])]  -- ^ modified stanzas and
+                                                   -- /additional/ annotations
 
 data Annotation = forall f. (Typeable f, Show f) => Annotation f
 

source/Network/Xmpp/IM/Roster.hs

@@ -86,12 +86,12 @@ initRoster session = do
         Just roster -> atomically $ writeTVar (rosterRef session) roster
 
 handleRoster :: TVar Roster -> StanzaHandler
-handleRoster ref out sta as = case sta of
+handleRoster ref out 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 [(sta, as)] -- Don't handle roster pushes
+                Just _from -> return [(sta, [])] -- Don't handle roster pushes
                                                  -- from unauthorized sources
                 Nothing -> case unpickleElem xpQuery iqb of
                     Right Query{ queryVer = v
@@ -104,7 +104,7 @@ handleRoster ref out sta as = case sta of
                         errorM "Pontarius.Xmpp" "Invalid roster query"
                         _ <- out $ badRequest iqr
                         return []
-    _ -> return [(sta, as)]
+    _ -> return [(sta, [])]
   where
     handleUpdate v' update = atomically $ modifyTVar ref $ \(Roster v is) ->
         Roster (v' `mplus` v) $ case qiSubscription update of