module Network.XMPP.Types
( XmppMessage
, XmppStateT
, Stream(..)
, StreamType(..)
, Stanza(..)
, MessageType(..), PresenceType(..), IQType(..), ShowType(..)
, RosterItem(..)
, defaultStreamBlockSize
, isMessage, isPresence, isIQ
) where
import System.IO (Handle)
import Control.Monad.State (StateT)
import Text.XML.HaXml.Types (Content)
import Text.XML.HaXml.Posn (Posn)
import Text.XML.HaXml.Lex (Token)
import Text.PrettyPrint.HughesPJ (render)
import qualified Text.XML.HaXml.Pretty as P (content)
import Network.XMPP.JID
type XmppMessage = Content Posn
data Stream = Stream { handle::Handle
, idx :: !Int
, lexemes :: [Token]
}
defaultStreamBlockSize :: Int
defaultStreamBlockSize = 1500
type XmppStateT a = StateT Stream IO a
data StreamType = Client
| ComponentAccept
| ComponentConnect
instance Show StreamType where
show Client = "jabber:client"
show ComponentAccept = "jabber:component:accept"
show ComponentConnect = "jabber:component:connect"
data RosterItem = RosterItem { jid :: JID
, subscribtion :: SubscribtionType
, nickname :: Maybe String
, groups :: [String]
}
data SubscribtionType = None | To | From | Both deriving Eq
instance Show SubscribtionType where
show None = "none"
show To = "to"
show From = "from"
show Both = "both"
instance Read SubscribtionType where
readsPrec _ "none" = [(None, "")]
readsPrec _ "to" = [(To, "")]
readsPrec _ "from" = [(From, "")]
readsPrec _ "both" = [(Both, "")]
readsPrec _ "" = [(None, "")]
readsPrec _ _ = error "incorrect subscribtion type"
data Stanza = Message { mFrom :: Maybe JID
, mTo :: JID
, mId :: String
, mType :: MessageType
, mSubject :: String
, mBody :: String
, mThread :: String
, mExt :: [Content Posn]
}
| Presence { pFrom :: Maybe JID
, pTo :: Maybe JID
, pId :: String
, pType :: PresenceType
, pShowType :: ShowType
, pStatus :: String
, pPriority :: Maybe Integer
, pExt :: [Content Posn]
}
| IQ { iqFrom :: Maybe JID
, iqTo :: Maybe JID
, iqId :: String
, iqType :: IQType
, iqBody :: [Content Posn]
} deriving Show
data MessageType = Chat | GroupChat | Headline | Normal | MessageError deriving Eq
data PresenceType = Default | Unavailable | Subscribe | Subscribed | Unsubscribe | Unsubscribed | Probe | PresenceError deriving Eq
data IQType = Get | Result | Set | IQError deriving Eq
data ShowType = Available | Away | FreeChat | DND | XAway deriving Eq
instance Show (Content a) where
show = render . P.content
instance Show MessageType where
show Chat = "chat"
show GroupChat = "groupchat"
show Headline = "headline"
show Normal = "normal"
show MessageError = "error"
instance Show PresenceType where
show Default = ""
show Unavailable = "unavailable"
show Subscribe = "subscribe"
show Subscribed = "subscribed"
show Unsubscribe = "unsubscribe"
show Unsubscribed = "unsubscribed"
show Probe = "probe"
show PresenceError = "error"
instance Show IQType where
show Get = "get"
show Result = "result"
show Set = "set"
show IQError = "error"
instance Show ShowType where
show Available = ""
show Away = "away"
show FreeChat = "chat"
show DND = "dnd"
show XAway = "xa"
instance Read MessageType where
readsPrec _ "chat" = [(Chat, "")]
readsPrec _ "groupchat" = [(GroupChat, "")]
readsPrec _ "headline" = [(Headline, "")]
readsPrec _ "normal" = [(Normal, "")]
readsPrec _ "error" = [(MessageError, "")]
readsPrec _ "" = [(Chat, "")]
readsPrec _ _ = error "incorrect message type"
instance Read PresenceType where
readsPrec _ "" = [(Default, "")]
readsPrec _ "available" = [(Default, "")]
readsPrec _ "unavailable" = [(Unavailable, "")]
readsPrec _ "subscribe" = [(Subscribe, "")]
readsPrec _ "subscribed" = [(Subscribed, "")]
readsPrec _ "unsubscribe" = [(Unsubscribe, "")]
readsPrec _ "unsubscribed" = [(Unsubscribed, "")]
readsPrec _ "probe" = [(Probe, "")]
readsPrec _ "error" = [(PresenceError, "")]
readsPrec _ _ = error "incorrect presence type"
instance Read IQType where
readsPrec _ "get" = [(Get, "")]
readsPrec _ "result" = [(Result, "")]
readsPrec _ "set" = [(Set, "")]
readsPrec _ "error" = [(IQError, "")]
readsPrec _ "" = [(Get, "")]
readsPrec _ _ = error "incorrect iq type"
instance Read ShowType where
readsPrec _ "" = [(Available, "")]
readsPrec _ "available" = [(Available, "")]
readsPrec _ "away" = [(Away, "")]
readsPrec _ "chat" = [(FreeChat, "")]
readsPrec _ "dnd" = [(DND, "")]
readsPrec _ "xa" = [(XAway, "")]
readsPrec _ "invisible" = [(Available, "")]
readsPrec _ _ = error "incorrect <show> value"
isMessage :: Stanza -> Bool
isMessage Message{} = True
isMessage _ = False
isPresence :: Stanza -> Bool
isPresence Presence{} = True
isPresence _ = False
isIQ :: Stanza -> Bool
isIQ IQ{} = True
isIQ _ = False