{-# 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 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
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
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
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 })