From 332002c101682f9c796a973cf62a82bef2c4659e Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 30 Jun 2013 18:11:17 -0400
Subject: bug fixes

---
 Presence/XMPP.hs | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

(limited to 'Presence')

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 4c8beec4..36630bc7 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -130,8 +130,8 @@ greet host =
         ,("version",[ContentText "1.0"])
         ]
     , EventBeginElement (streamP "features") []
-    , EventBeginElement "bind" [("xmlns",[ContentText "urn:ietf:params:xml:ns:xmpp-bind"])]
-    , EventEndElement   "bind"
+    , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-bind}bind" []
+    , EventEndElement "{urn:ietf:params:xml:ns:xmpp-bind}bind"
 
     {-
     -- , "  <session xmlns='urn:ietf:params:xml:ns:xmpp-session'/>"
@@ -149,6 +149,7 @@ greet host =
 mawait :: Monad m => MaybeT (ConduitM i o m) i
 mawait = MaybeT await
 
+-- Note: This function ignores name space qualification
 elementAttrs expected (EventBeginElement name attrs)
     | nameLocalName name==expected 
     = return attrs
@@ -437,15 +438,16 @@ prettyPrint prefix xs =
 
 toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m [XML.Event]
 toClient pchan cmdChan = fix $ \loop -> do
+    let send xs = yield xs >> prettyPrint ">C: " xs
     event <- liftIO . atomically $ 
               orElse (fmap Left  $ readTChan pchan)
                      (fmap Right $ readTChan cmdChan)
     case event of
       Right QuitThread -> return ()
-      Right (Send xs)  -> yield xs >> prettyPrint ">C: " xs >> loop
+      Right (Send xs)  -> send xs >> loop
       Left  presence   -> do 
         xs <- liftIO $ xmlifyPresenceForClient presence
-        yield xs
+        send xs
         loop
 
 handleClient
@@ -580,11 +582,14 @@ matchAttribMaybe name (Just value) attrs =
 matchAttribMaybe name Nothing attrs  
     | find ( (==name) . fst) attrs==Nothing
     = True
+matchAttribMaybe name Nothing attrs  
+    | otherwise
+    = False
 
 presenceTypeOffline = Just "unavailable"
 presenceTypeOnline  = Nothing
 
-isPresence (EventBeginElement name attrs) testType
+isPresenceOf (EventBeginElement name attrs) testType
     | name=="{jabber:server}presence"
     && matchAttribMaybe "type" testType attrs
     = True
@@ -611,7 +616,7 @@ fromPeer session = doNestingXML $ do
                     withJust mb $ \xs -> prettyPrint "P: " (toList xs)
             case () of
               _ | stanza `isPresenceOf` presenceTypeOnline
-                    -> handlePeerPresence session stanza True
+                    -> log "peer online!" >> handlePeerPresence session stanza True
               _ | stanza `isPresenceOf` presenceTypeOffline
                     -> handlePeerPresence session stanza False
               _ -> unhandledStanza
@@ -681,34 +686,30 @@ greetPeer =
     [ EventBeginDocument
     , EventBeginElement (streamP "stream")
         [("xmlns",[ContentText "jabber:server"])
-        ,("xmlns:stream",[ContentText "http://etherx.jabber.org/streams"])
         ,("version",[ContentText "1.0"])
         ]
     ]
 
 goodbyePeer = 
-    [ EventEndElement "{jabber:server}stream"
+    [ EventEndElement (streamP "stream")
     , EventEndDocument
     ]
 
 toPeer sock cache chan = do
-    let log  = liftIO . L.putStrLn . ("(>P) " <++>)
-    yield greetPeer
-    log "<stream>"
+    let -- log     = liftIO . L.putStrLn . ("(>P) " <++>)
+        send xs = yield xs >> prettyPrint ">P: " xs
+    send greetPeer
     forM_ cache $ \(jid,st) -> do
         r <- lift $ xmlifyPresenceForPeer sock (Presence jid st)
-        yield r
-        log $ "(cache) \n" <++> bshow r
+        send r
     fix $ \loop -> do
         event <- lift . atomically $ readTChan chan
         case event of
           OutBoundPresence p -> do
             r <- lift $ xmlifyPresenceForPeer sock p
-            yield r
-            log (bshow r)
+            send r
         loop
-    yield goodbyePeer
-    log "</stream>"
+    send goodbyePeer
 
 handleOutgoingToPeer sock cache chan snk = do
 #ifdef RENDERFLUSH
-- 
cgit v1.2.3