-- |
-- Stability   :  Ultra-Violence
-- Portability :  I'm too young to die
-- XEP-0045: Multi-User Chat

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}

module Network.Xmpp.Extras.MUC
	( MUCHistoryReq(..)
	, joinMUC
	, joinMUCResult
	, sendMUC
	) where

import Data.Default
import Data.Maybe
import Data.Text as T
import Data.Time
import Data.XML.Types
import Network.Xmpp.Extras.DateTime
import Network.Xmpp.Internal hiding (priority, status)

--data MUCJID = MUCJID
--	{ mjService :: Text
--	, mjRoom :: Text
--	} deriving Show
--
--mUCJIDToJid (MUCJID s r) = jidFromTexts (Just s) r

data MUCHistoryReq = MUCHistoryReq
	{ MUCHistoryReq -> Maybe Integer
mhrMaxChars :: Maybe Integer
	, MUCHistoryReq -> Maybe Integer
mhrMaxStanzas :: Maybe Integer
	, MUCHistoryReq -> Maybe Integer
mhrSeconds :: Maybe Integer
	, MUCHistoryReq -> Maybe UTCTime
mhrSince :: Maybe UTCTime
	}

instance Default MUCHistoryReq where
	def :: MUCHistoryReq
def = Maybe Integer
-> Maybe Integer -> Maybe Integer -> Maybe UTCTime -> MUCHistoryReq
MUCHistoryReq forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- |Join the specified MUC or change your nickname in the already joined one. The resource part of the `Jid` sets the desired nickname.
joinMUC :: Jid -> Maybe MUCHistoryReq -> Session -> IO (Either XmppFailure ())
joinMUC :: Jid -> Maybe MUCHistoryReq -> Session -> IO (Either XmppFailure ())
joinMUC Jid
jid Maybe MUCHistoryReq
mhr = Presence -> Session -> IO (Either XmppFailure ())
sendPresence ((Presence -> Jid -> Presence
presTo Presence
presence Jid
jid) { presencePayload :: [Element]
presencePayload = [Name -> [(Name, [Content])] -> [Node] -> Element
Element Name
"x" [(Name
"xmlns", [Text -> Content
ContentText Text
"http://jabber.org/protocol/muc"])] forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\MUCHistoryReq
hr -> [
		Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$ Name -> [(Name, [Content])] -> [Node] -> Element
Element Name
"history" (
			(forall {a} {p} {t}.
IsString a =>
p -> (t -> String) -> Maybe t -> [(a, [Content])]
elementify String
"maxchars" forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrMaxChars MUCHistoryReq
hr) forall a. [a] -> [a] -> [a]
++
			(forall {a} {p} {t}.
IsString a =>
p -> (t -> String) -> Maybe t -> [(a, [Content])]
elementify String
"maxstanzas" forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrMaxStanzas MUCHistoryReq
hr) forall a. [a] -> [a] -> [a]
++
			(forall {a} {p} {t}.
IsString a =>
p -> (t -> String) -> Maybe t -> [(a, [Content])]
elementify String
"seconds" forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrSeconds MUCHistoryReq
hr) forall a. [a] -> [a] -> [a]
++
			(forall {a} {p} {t}.
IsString a =>
p -> (t -> String) -> Maybe t -> [(a, [Content])]
elementify String
"since" UTCTime -> String
toDateTime forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe UTCTime
mhrSince MUCHistoryReq
hr)
		) []]) Maybe MUCHistoryReq
mhr
	] } )
	where elementify :: p -> (t -> String) -> Maybe t -> [(a, [Content])]
elementify p
name t -> String
show Maybe t
content = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
s -> (a
"seconds", [Text -> Content
ContentText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ t -> String
show t
s])) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe t
content

-- |Like `joinMUC`, but waits for the server reply.
joinMUCResult :: Jid -> Maybe MUCHistoryReq -> Session -> IO (Either StanzaError PresenceType)
joinMUCResult :: Jid
-> Maybe MUCHistoryReq
-> Session
-> IO (Either StanzaError PresenceType)
joinMUCResult Jid
jid Maybe MUCHistoryReq
mhr Session
sess = do
	Jid -> Maybe MUCHistoryReq -> Session -> IO (Either XmppFailure ())
joinMUC Jid
jid Maybe MUCHistoryReq
mhr Session
sess
	Jid -> Session -> IO (Either StanzaError PresenceType)
waitForResult Jid
jid Session
sess

waitForResult :: Jid -> Session -> IO (Either StanzaError PresenceType)
waitForResult :: Jid -> Session -> IO (Either StanzaError PresenceType)
waitForResult Jid
jid Session
sess = do
	Either PresenceError Presence
pres <- Session -> IO (Either PresenceError Presence)
pullPresence Session
sess
	case Either PresenceError Presence
pres of
		Left p :: PresenceError
p@(PresenceError {[ExtendedAttribute]
[Element]
Maybe Text
Maybe LangTag
Maybe Jid
StanzaError
presenceErrorID :: PresenceError -> Maybe Text
presenceErrorFrom :: PresenceError -> Maybe Jid
presenceErrorTo :: PresenceError -> Maybe Jid
presenceErrorLangTag :: PresenceError -> Maybe LangTag
presenceErrorStanzaError :: PresenceError -> StanzaError
presenceErrorPayload :: PresenceError -> [Element]
presenceErrorAttributes :: PresenceError -> [ExtendedAttribute]
presenceErrorAttributes :: [ExtendedAttribute]
presenceErrorPayload :: [Element]
presenceErrorStanzaError :: StanzaError
presenceErrorLangTag :: Maybe LangTag
presenceErrorTo :: Maybe Jid
presenceErrorFrom :: Maybe Jid
presenceErrorID :: Maybe Text
..})	| Maybe Jid
presenceErrorFrom forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Jid
jid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left StanzaError
presenceErrorStanzaError
						| Bool
otherwise -> Jid -> Session -> IO (Either StanzaError PresenceType)
waitForResult Jid
jid Session
sess
		Right p :: Presence
p@(Presence{[ExtendedAttribute]
[Element]
Maybe Text
Maybe LangTag
Maybe Jid
PresenceType
presenceID :: Presence -> Maybe Text
presenceFrom :: Presence -> Maybe Jid
presenceTo :: Presence -> Maybe Jid
presenceLangTag :: Presence -> Maybe LangTag
presenceType :: Presence -> PresenceType
presenceAttributes :: Presence -> [ExtendedAttribute]
presenceAttributes :: [ExtendedAttribute]
presencePayload :: [Element]
presenceType :: PresenceType
presenceLangTag :: Maybe LangTag
presenceTo :: Maybe Jid
presenceFrom :: Maybe Jid
presenceID :: Maybe Text
presencePayload :: Presence -> [Element]
..})		| Maybe Jid
presenceFrom forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Jid
jid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right PresenceType
presenceType
						| Bool
otherwise -> Jid -> Session -> IO (Either StanzaError PresenceType)
waitForResult Jid
jid Session
sess

-- |Send a broadcast message. `Jid` must be bare.
sendMUC :: Jid -> Text -> Session -> IO (Either XmppFailure ())
sendMUC :: Jid -> Text -> Session -> IO (Either XmppFailure ())
sendMUC Jid
jid Text
text = Message -> Session -> IO (Either XmppFailure ())
sendMessage ((Jid -> Text -> Message
simpleIM Jid
jid Text
text) { messageType :: MessageType
messageType = MessageType
GroupChat })