1 files changed, 9 insertions, 1 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 218e60e0..a0d5a69b 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -305,6 +305,12 @@ swapit old new (EventEndElement n) | nameNamespace n==Just old =
     EventEndElement (n { nameNamespace = Just new })
 swapit old new x = x
 
+-- | This is invoked by sendModifiedStanzaTo* before swapping the namespace.
+--
+-- Optionally, when the namespace is jabber:server, this will set a "whitelist"
+-- attribute on a presence tag that indicates a list of users deliminated by
+-- spaces.  This is so that a server can communicate to another server which
+-- users are believed to be subscribed.
 fixHeaders :: Monad m => Stanza -> ConduitM Event Event m ()
 fixHeaders Stanza { stanzaType=typ, stanzaTo=mto, stanzaFrom=mfrom } = do
     x <- await
@@ -319,8 +325,10 @@ fixHeaders Stanza { stanzaType=typ, stanzaTo=mto, stanzaFrom=mfrom } = do
         as'' = maybe as' (setAttrib "from" as') mfrom
         as3 = case typ of
                 PresenceStatus {} | nameNamespace n == Just "jabber:client"
-                  -> delAttrib "whitelist" as''
+                  -> delAttrib "whitelist" as'' -- client-to-peer "whitelist" is filtered.
                 PresenceStatus {} | otherwise
+                  -- peer-to-client, we may have set a list of subscribed users
+                  -- to be communicated to the remote end.
                   -> case presenceWhiteList typ of
                         [] -> delAttrib "whitelist" as''
                         ws -> setAttrib "whitelist" as'' (Text.intercalate " " ws)