module Network.XMPP.MUC where
import Network.XMPP
matchesBare :: String -> StanzaPredicate
matchesBare bare = attributeMatches "from" ((==bare).getBareJid)
joinGroupchat :: String
-> String
-> Maybe String
-> XMPP ()
joinGroupchat nick room password = do
sendStanza $ XML "presence"
[("to",room++"/"++nick)]
[XML "x" [("xmlns","http://jabber.org/protocol/muc")]
passNode]
where
passNode = maybe [] (\pass -> [XML "password" [] [CData pass]]) password
leaveGroupchat :: String -> XMPP ()
leaveGroupchat room = sendStanza $ XML "presence"
[("to",room),("type","unavailable")] []
isGroupchatMessage :: StanzaPredicate
isGroupchatMessage = isMessage `conj` attributeMatches "type" (=="groupchat")
isGroupchatPrivmsg :: String -> StanzaPredicate
isGroupchatPrivmsg room = matchesBare room `conj` attributeMatches "type" (=="chat")
`conj` attributeMatches "from" ((/="") . getResource)
sendGroupchatMessage :: String
-> String
-> XMPP ()
sendGroupchatMessage room body =
sendStanza $ XML "message"
[("to",room),
("type","groupchat")]
[XML "body" [] [CData body]]
sendGroupchatPrivateMessage :: String
-> String
-> String
-> XMPP ()
sendGroupchatPrivateMessage nick room body =
sendStanza $ XML "message"
[("to",room++"/"++nick),
("type","chat")]
[XML "body" [] [CData body]]
getMessageSubject :: XMLElem -> Maybe String
getMessageSubject =
getCdata . maybe (XML [] [] []) id . xmlPath ["subject"]
data Occupant
= Occupant
{ occRole :: Role
, occAffiliation :: Affiliation
, occNick :: String
, occJid :: Maybe String
}
data Role = RModerator | RParticipant | RNone | RVisitor
data Affiliation = AOwner | AAdmin | AMember | ANone
doOccupant :: XMLElem -> Occupant
doOccupant stanza =
Occupant role aff nick jid
where
items = xmlPath' ["x", "item"] [stanza]
item | length items == 0 = XML [] [] []
| otherwise = head items
role = case getAttr "role" item of
Just "moderator" -> RModerator
Just "participant" -> RParticipant
Just "visitor" -> RVisitor
_ -> RNone
aff = case getAttr "affiliation" item of
Just "owner" -> AOwner
Just "admin" -> AAdmin
Just "member" -> AMember
_ -> ANone
nick = snd $ getJidRes stanza
jid = getAttr "jid" item
isGroupchatPresence :: StanzaPredicate
isGroupchatPresence stanza =
(isPresence stanza) && (not $ null xs')
where
xs = xmlPath' ["x"] [stanza]
xs' = filter
(attributeMatches "xmlns" (=="http://jabber.org/protocol/muc#user"))
xs