XMPP module now calls setResource "" on empty bind requests.

2 files changed, 23 insertions, 18 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index d35e5617..c4e4d7f6 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -242,24 +242,28 @@ tagName _                       = ""
 
 handleIQSetBind session cmdChan stanza_id = do
     mchild <- nextElement
-    case mchild of
-     Just child -> do
-        let unhandledBind = liftIO $ putStrLn $ "unhandled-bind: "++show child
-        case tagName child of
-            "{urn:ietf:params:xml:ns:xmpp-bind}resource"
-              -> do
-                rsc <- lift content
-                liftIO $ do
-                    putStrLn $ "iq-set-bind-resource " ++ show rsc
-                    setResource session (L.fromChunks [S.encodeUtf8 rsc])
-                    jid <- getJID session
-                    atomically $ writeTChan cmdChan (Send $ iq_bind_reply stanza_id (toStrict $ L.decodeUtf8 $ L.show jid) )
-                    forCachedPresence session $ \presence -> do
-                        xs <- xmlifyPresenceForClient presence
-                        atomically . writeTChan cmdChan . Send $ xs
-            _ -> unhandledBind
-     Nothing -> do
-        liftIO $ putStrLn $ "empty bind request!"
+    rsc <- case mchild of
+             Just child -> do
+                let unhandledBind = do
+                        liftIO $ putStrLn $ "unhandled-bind: "++show child
+                        return ""
+                case tagName child of
+                    "{urn:ietf:params:xml:ns:xmpp-bind}resource"
+                      -> do
+                        rsc <- lift content
+                        return $ L.fromChunks [S.encodeUtf8 rsc]
+                    _ -> unhandledBind
+             Nothing -> do
+                liftIO $ putStrLn $ "empty bind request!"
+                return ""
+    liftIO $ do
+        L.putStrLn $ "iq-set-bind-resource " <++> rsc
+        setResource session rsc
+        jid <- getJID session
+        atomically $ writeTChan cmdChan (Send $ iq_bind_reply stanza_id (toStrict $ L.decodeUtf8 $ L.show jid) )
+        forCachedPresence session $ \presence -> do
+            xs <- xmlifyPresenceForClient presence
+            atomically . writeTChan cmdChan . Send $ xs
 
 
 iq_session_reply host stanza_id =
diff --git a/Presence/main.hs b/Presence/main.hs
index 6721db86..e8c07788 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -113,6 +113,7 @@ instance JabberClientSession ClientSession where
         return $ ClientSession (hostname state) uid_ref res_ref state
 
     setResource  s  resource    = do
+        -- TODO: handle resource = empty string 
         writeIORef (unix_resource s) (Just resource)
         L.putStrLn $ "CLIENT SESSION: resource " <++> resource