offline notifications

1 files changed, 28 insertions, 0 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index af392f27..4dda1f70 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -22,6 +22,8 @@ module XMPPServer
     , sendModifiedStanzaToClient
     , presenceProbe
     , presenceSolicitation
+    , makePresenceStanza
+    , JabberShow(..)
     ) where
 
 import Debug.Trace
@@ -746,6 +748,32 @@ grokStanza "jabber:client" stanzaTag =
 mkname :: Text -> Text -> XML.Name
 mkname namespace name = (Name name (Just namespace) Nothing)
 
+makePresenceStanza namespace mjid pstat = do
+    stanzaFromList PresenceStatus { presenceShow = pstat
+                                  , presencePriority = Nothing
+                                  , presenceStatus = []
+                                  }
+      $ [ EventBeginElement (mkname namespace "presence")
+            (setFrom $ typ pstat) ]
+        ++ (shw pstat >>= jabberShow) ++
+        [ EventEndElement (mkname namespace "presence")]
+ where
+    setFrom = maybe id
+                    (\jid -> (attr "from" jid :) )
+                    mjid
+    typ Offline = [attr "type" "unavailable"]
+    typ _       = []
+    shw ExtendedAway = ["xa"]
+    shw Chatty       = ["chat"]
+    shw Away         = ["away"]
+    shw DoNotDisturb = ["dnd"]
+    shw _            = []
+    jabberShow stat = 
+      [ EventBeginElement "{jabber:client}show" []
+      , EventContent (ContentText stat)
+      , EventEndElement "{jabber:client}show" ]
+    
+
 makePong :: Text -> Maybe Text -> Text -> Text -> [XML.Event]
 makePong namespace mid to from =
        -- Note: similar to session reply