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 =
cdata' . xmlPath ["subject"]
setGroupchatSubject :: String
-> String
-> XMPP ()
setGroupchatSubject room subject =
sendStanza $ XML "message"
[("to",room),("type","groupchat")]
[XML "subject" [] [CData subject]]
data Occupant
= Occupant
{ occRole :: Role
, occAffiliation :: Affiliation
, occNick :: String
, occJid :: Maybe String
, occStatus :: Status
}
data Role = RModerator | RParticipant | RNone | RVisitor
deriving (Eq, Show)
data Affiliation = AOwner | AAdmin | AMember | ANone | AOutcast
deriving (Eq, Show)
data GroupchatPresence
= Leave
| Kick (Maybe String)
| Ban (Maybe String)
| NickChange String
| RoleChange (Maybe String)
doGroupchatPresence :: XMLElem -> (GroupchatPresence, Occupant)
doGroupchatPresence stanza =
(presence, Occupant role aff nick jid status)
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
Just "outcast" -> AOutcast
_ -> ANone
presence = case getAttr "type" stanza of
Just "unavailable" -> off_presence
_ -> RoleChange reason
off_presence = case status_code of
Just "301" -> Ban reason
Just "303" -> NickChange new_nick
Just "307" -> Kick reason
_ -> Leave
reason = cdata' $ xmlPath ["reason"] item
status = doStatus stanza
nick = snd $ getJidRes stanza
new_nick = maybe "" id $ getAttr "nick" item
jid = getAttr "jid" item
status_node = xmlPath' ["x", "status"] [stanza]
status_code | length status_node == 0 = Nothing
| otherwise = getAttr "code"
$ head status_node
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
type Nick = String
type JID = String
adminGroupchat :: Either Nick JID
-> String
-> String
-> (Maybe String)
-> XMPP ()
adminGroupchat nickOrJid room arg mReason =
sendIq room "set"
[XML "query"
[("xmlns","http://jabber.org/protocol/muc#admin")]
[item]]
>> return ()
where
item = case nickOrJid of
Left nick -> XML "item" [("nick",nick),("role",arg)] reason
Right jid -> XML "item" [("jid",jid),("affiliation",arg)] reason
reason = maybe [] (\r -> [XML "reason" [] [CData r]]) mReason