Progress toward respecting client's requeseted presence state.

1 files changed, 25 insertions, 0 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index fb7d4204..756d300a 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -359,6 +359,28 @@ handleIQGet session cmdChan tag = do
         req -> unhandledGet req
     
 
+handleClientPresence session stanza = do
+    -- online (Available or Away)
+    let log  = liftIO . debugL . ("(C) " <++>)
+    withJust (lookupAttrib "from" (tagAttrs stanza)) $ \jid -> do
+    -- cjid <- liftIO $ parseAddressJID (textToByteString jid)
+    let parseChildren stat = do
+            child <- nextElement
+            case child of
+                Just tag | tagName tag=="{jabber:server}show"
+                                      -> fmap toStat (lift content)
+                Just tag | otherwise  -> parseChildren stat
+                Nothing -> return stat
+        toStat "away" = Away
+        toStat "xa"   = ExtendedAway
+        toStat "dnd"  = DoNotDisturb
+        toStat "chat" = Chatty
+
+    stat' <- parseChildren Available
+    liftIO $ setPresence session stat'
+    log $ "requesting presence: "<++>bshow stat'
+    return ()
+
 fromClient :: (MonadThrow m,MonadIO m, JabberClientSession session) => 
     session -> TChan ClientCommands -> Sink XML.Event m ()
 fromClient session cmdChan = doNestingXML $ do
@@ -395,6 +417,8 @@ fromClient session cmdChan = doNestingXML $ do
                                            -> clientApprovesSubscription session stanza
              _ | stanza `isClientPresenceOf` presenceTypeUnsubscribed
                                            -> clientRejectsSubscription session stanza
+             _ | stanza `isClientPresenceOf` presenceTypeOnline
+                                           -> handleClientPresence session stanza
              _ | otherwise                 -> unhandledStanza
 
             awaitCloser stanza_lvl
@@ -672,6 +696,7 @@ isClientPresenceOf (EventBeginElement name attrs) testType
     = True
 isClientPresenceOf _ _ = False
 
+
 handlePresenceProbe session stanza = do
     withJust (lookupAttrib "to" (tagAttrs stanza)) $ \to -> do
     -- withJust (lookupAttrib "from" (tagAttrs stanza)) $ \from -> do