module Network.XMPP.Roster (
RosterItem(..),
Subscription(..),
getRoster,
Presence(..),
Status(..),
StatusType(..),
doPresence
) where
import Network.XMPP.XMPPMonad
import Network.XMPP.XMLParse
import Network.XMPP.Stanzas
data RosterItem = RosterItem
{ itemName :: String
, itemJid :: String
, itemSubscription :: Subscription
, itemGroups :: [String]
} deriving Show
data Subscription = SBoth | SFrom | STo | SNone | SUnknown
deriving Show
getRoster :: XMPP [RosterItem]
getRoster = do
stanza <- sendIqWait "" "get" [XML "query" [("xmlns", "jabber:iq:roster")] []]
let items = xmlPath' ["query", "item"] [stanza]
return $ map getItem items
where
getItem item =
let getAttr' attr = maybe "" id $ getAttr attr item
name = getAttr' "name"
jid = getAttr' "jid"
groups = map cdata $ xmlPath' ["group"] [item]
subs = case getAttr' "subscription" of
"to" -> STo
"from" -> SFrom
"both" -> SBoth
"none" -> SNone
_ -> SUnknown
in RosterItem name jid subs groups
data Presence = Available Status
| Unavailable Status
| Subscribe
| Subscribed
| Unsubscribe
| Unsubscribed
| Probe
| Error
data Status = Status StatusType [String]
data StatusType = StatusOnline
| StatusAway
| StatusChat
| StatusDND
| StatusXA
| StatusOffline
doPresence :: XMLElem -> Presence
doPresence stanza =
let stanzaType = getAttr "type" stanza
statuses = map cdata $ xmlPath' ["status"] [stanza]
statusType = case cdata' $ xmlPath ["show"] stanza of
Just "away" -> StatusAway
Just "chat" -> StatusChat
Just "dnd" -> StatusDND
Just "xa" -> StatusXA
_ -> StatusOnline
in case stanzaType of
Nothing -> Available (Status statusType statuses)
Just "unavailable" -> Unavailable (Status StatusOffline statuses)
Just "subscribe" -> Subscribe
Just "subscribed" -> Subscribed
Just "unsubscribe" -> Unsubscribe
Just "unsubscribed" -> Unsubscribed
Just "probe" -> Probe
Just "error" -> Error
_ -> Error
cdata' = getCdata . maybe (XML "" [] []) id