-- |
-- 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 Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe UTCTime
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"])] ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ [Node]
-> (MUCHistoryReq -> [Node]) -> Maybe MUCHistoryReq -> [Node]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\MUCHistoryReq
hr -> [
		Element -> Node
NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> [(Name, [Content])] -> [Node] -> Element
Element Name
"history" (
			([Char]
-> (Integer -> [Char]) -> Maybe Integer -> [(Name, [Content])]
forall a p t.
IsString a =>
p -> (t -> [Char]) -> Maybe t -> [(a, [Content])]
elementify [Char]
"maxchars" Integer -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Integer -> [(Name, [Content])])
-> Maybe Integer -> [(Name, [Content])]
forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrMaxChars MUCHistoryReq
hr) [(Name, [Content])] -> [(Name, [Content])] -> [(Name, [Content])]
forall a. [a] -> [a] -> [a]
++
			([Char]
-> (Integer -> [Char]) -> Maybe Integer -> [(Name, [Content])]
forall a p t.
IsString a =>
p -> (t -> [Char]) -> Maybe t -> [(a, [Content])]
elementify [Char]
"maxstanzas" Integer -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Integer -> [(Name, [Content])])
-> Maybe Integer -> [(Name, [Content])]
forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrMaxStanzas MUCHistoryReq
hr) [(Name, [Content])] -> [(Name, [Content])] -> [(Name, [Content])]
forall a. [a] -> [a] -> [a]
++
			([Char]
-> (Integer -> [Char]) -> Maybe Integer -> [(Name, [Content])]
forall a p t.
IsString a =>
p -> (t -> [Char]) -> Maybe t -> [(a, [Content])]
elementify [Char]
"seconds" Integer -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Integer -> [(Name, [Content])])
-> Maybe Integer -> [(Name, [Content])]
forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe Integer
mhrSeconds MUCHistoryReq
hr) [(Name, [Content])] -> [(Name, [Content])] -> [(Name, [Content])]
forall a. [a] -> [a] -> [a]
++
			([Char]
-> (UTCTime -> [Char]) -> Maybe UTCTime -> [(Name, [Content])]
forall a p t.
IsString a =>
p -> (t -> [Char]) -> Maybe t -> [(a, [Content])]
elementify [Char]
"since" UTCTime -> [Char]
toDateTime (Maybe UTCTime -> [(Name, [Content])])
-> Maybe UTCTime -> [(Name, [Content])]
forall a b. (a -> b) -> a -> b
$ MUCHistoryReq -> Maybe UTCTime
mhrSince MUCHistoryReq
hr)
		) []]) Maybe MUCHistoryReq
mhr
	] } )
	where elementify :: p -> (t -> [Char]) -> Maybe t -> [(a, [Content])]
elementify p
name t -> [Char]
show Maybe t
content = (t -> (a, [Content])) -> [t] -> [(a, [Content])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
s -> (a
"seconds", [Text -> Content
ContentText (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ t -> [Char]
show t
s])) ([t] -> [(a, [Content])]) -> [t] -> [(a, [Content])]
forall a b. (a -> b) -> a -> b
$ Maybe t -> [t]
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 Maybe Jid -> Maybe Jid -> Bool
forall a. Eq a => a -> a -> Bool
== Jid -> Maybe Jid
forall a. a -> Maybe a
Just Jid
jid -> Either StanzaError PresenceType
-> IO (Either StanzaError PresenceType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StanzaError PresenceType
 -> IO (Either StanzaError PresenceType))
-> Either StanzaError PresenceType
-> IO (Either StanzaError PresenceType)
forall a b. (a -> b) -> a -> b
$ StanzaError -> Either StanzaError PresenceType
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 Maybe Jid -> Maybe Jid -> Bool
forall a. Eq a => a -> a -> Bool
== Jid -> Maybe Jid
forall a. a -> Maybe a
Just Jid
jid -> Either StanzaError PresenceType
-> IO (Either StanzaError PresenceType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StanzaError PresenceType
 -> IO (Either StanzaError PresenceType))
-> Either StanzaError PresenceType
-> IO (Either StanzaError PresenceType)
forall a b. (a -> b) -> a -> b
$ PresenceType -> Either StanzaError PresenceType
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 })