-- |Implementation of Multi-User Chat, according to XEP-0045.  This
-- API needs more thought and will change.
module Network.XMPP.MUC where

import Network.XMPP.XMPPMonad
import Network.XMPP.Stanzas
import Network.XMPP.XMLParse
import Network.XMPP.JID

-- |Return true if the stanza is from a JID whose \"username\@server\"
-- part matches the given string.
matchesBare :: String -> StanzaPredicate
matchesBare bare = attributeMatches "from" ((==bare).getBareJid)

-- |Join groupchat.
joinGroupchat :: String       -- ^Nickname to use
              -> String       -- ^JID of room
              -> String       -- ^Password of room. Use empty if no.
              -> XMPP Integer -- ^Error number. Zero if joining room succeeded.
joinGroupchat nick room password = do
    let joinStanza' = if null password then joinStanza
                                       else joinPassStanza
        joinStanza = XML "presence"
                       [("to",room++"/"++nick)]
                       [XML "x" [("xmlns","http://jabber.org/protocol/muc")] []]
        joinPassStanza = XML "presence"
                           [("to",room++"/"++nick)]
                           [XML "x" [("xmlns","http://jabber.org/protocol/muc")]
                             [XML "password" [] [CData password]]]
    sendStanza joinStanza'
    -- response <- waitForStanza $ isPresence `conj` matchesBare room
    -- FIXME: this presence go to first opened runXMPP
    return $ 0 --getErrorCode response

-- |Leave groupchat.
leaveGroupchat :: String -> XMPP ()
leaveGroupchat room = sendStanza $ XML "presence"
                                     [("to",room),("type","unavailable")] []

-- |Return true if the stanza is a message of type \"groupchat\".
isGroupchatMessage :: StanzaPredicate
isGroupchatMessage = isMessage `conj` attributeMatches "type" (=="groupchat")

-- |Return true if the stanza is a private message in the named room.
isGroupchatPrivmsg :: String -> StanzaPredicate
isGroupchatPrivmsg room = matchesBare room `conj` attributeMatches "type" (=="chat")
                          `conj` attributeMatches "from" ((/="") . getResource)

-- |Send a groupchat message.
sendGroupchatMessage :: String  -- ^JID of chat room
                     -> String  -- ^Text of message
                     -> XMPP ()
sendGroupchatMessage room body =
    sendStanza $ XML "message"
                   [("to",room),
                    ("type","groupchat")]
                   [XML "body" [] [CData body]]

-- |Send a private message in a chat room.
sendGroupchatPrivateMessage :: String -- ^Nick of recipient
                            -> String -- ^JID of chat room
                            -> String -- ^Text of message
                            -> XMPP ()
sendGroupchatPrivateMessage nick room body =
    sendStanza $ XML "message"
                   [("to",room++"/"++nick),
                    ("type","chat")]
                   [XML "body" [] [CData body]]