{-# LANGUAGE FlexibleInstances #-} module Stanza.Types where import Control.Concurrent.STM import Data.Int import Data.Text import Data.XML.Types as XML import Connection (PeerAddress(..)) import ConnectionKey (ClientAddress(..)) import LockedChan import Nesting (Lang) type Stanza = StanzaWrap (LockedChan XML.Event) data StanzaWrap a = Stanza { stanzaType :: StanzaType , stanzaId :: Maybe Text , stanzaTo :: Maybe Text , stanzaFrom :: Maybe Text , stanzaChan :: a , stanzaClosers :: TVar (Maybe [XML.Event]) , stanzaInterrupt :: TMVar () , stanzaOrigin :: StanzaOrigin } data StanzaOrigin = LocalPeer | PeerOrigin PeerAddress (TChan Stanza) | ClientOrigin ClientAddress (TChan Stanza) data StanzaType = Unrecognized | Ping | Pong | RequestResource (Maybe Text) (Maybe Text) -- ^ Client's name for this host followed by client's requested resource id. | SetResource | SessionRequest | UnrecognizedQuery Name | RequestRoster | Roster | RosterEvent { rosterEventType :: RosterEventType , rosterUser :: Text , rosterContact :: Text } | Error StanzaError XML.Event | PresenceStatus { presenceShow :: JabberShow , presencePriority :: Maybe Int8 , presenceStatus :: [(Lang,Text)] , presenceWhiteList :: [Text] } | PresenceInformError | PresenceInformSubscription Bool | PresenceRequestStatus | PresenceRequestSubscription Bool | Message { msgThread :: Maybe MessageThread , msgLangMap :: [(Lang,LangSpecificMessage)] } | NotifyClientVersion { versionName :: Text , versionVersion :: Text } | InternalEnableHack ClientHack | InternalCacheId Text deriving (Show,Eq) data RosterEventType = RequestedSubscription | NewBuddy -- preceded by PresenceInformSubscription True | RemovedBuddy -- preceded by PresenceInformSubscription False | PendingSubscriber -- same as PresenceRequestSubscription | NewSubscriber | RejectSubscriber deriving (Show,Read,Ord,Eq,Enum) data ClientHack = SimulatedChatErrors deriving (Show,Read,Ord,Eq,Enum) data LangSpecificMessage = LangSpecificMessage { msgBody :: Maybe Text , msgSubject :: Maybe Text } deriving (Show,Eq) data MessageThread = MessageThread { msgThreadParent :: Maybe Text, msgThreadContent :: Text } deriving (Show,Eq) data JabberShow = Offline | ExtendedAway | Away | DoNotDisturb | Available | Chatty deriving (Show,Enum,Ord,Eq,Read) class StanzaFirstTag a where stanzaFirstTag :: StanzaWrap a -> IO XML.Event instance StanzaFirstTag (TChan XML.Event) where stanzaFirstTag stanza = do e <-atomically $ peekTChan (stanzaChan stanza) return e instance StanzaFirstTag (LockedChan XML.Event) where stanzaFirstTag stanza = do e <-atomically $ peekLChan (stanzaChan stanza) return e instance StanzaFirstTag XML.Event where stanzaFirstTag stanza = return (stanzaChan stanza) data StanzaError = BadRequest | Conflict | FeatureNotImplemented | Forbidden | Gone | InternalServerError | ItemNotFound | JidMalformed | NotAcceptable | NotAllowed | NotAuthorized | PaymentRequired | RecipientUnavailable | Redirect | RegistrationRequired | RemoteServerNotFound | RemoteServerTimeout | ResourceConstraint | ServiceUnavailable | SubscriptionRequired | UndefinedCondition | UnexpectedRequest deriving (Show,Enum,Ord,Eq) xep0086 :: StanzaError -> (Text, Int) xep0086 e = case e of BadRequest -> ("modify", 400) Conflict -> ("cancel", 409) FeatureNotImplemented -> ("cancel", 501) Forbidden -> ("auth", 403) Gone -> ("modify", 302) InternalServerError -> ("wait", 500) ItemNotFound -> ("cancel", 404) JidMalformed -> ("modify", 400) NotAcceptable -> ("modify", 406) NotAllowed -> ("cancel", 405) NotAuthorized -> ("auth", 401) PaymentRequired -> ("auth", 402) RecipientUnavailable -> ("wait", 404) Redirect -> ("modify", 302) RegistrationRequired -> ("auth", 407) RemoteServerNotFound -> ("cancel", 404) RemoteServerTimeout -> ("wait", 504) ResourceConstraint -> ("wait", 500) ServiceUnavailable -> ("cancel", 503) SubscriptionRequired -> ("auth", 407) UndefinedCondition -> ("", 500) UnexpectedRequest -> ("wait", 400) errorText :: StanzaError -> Text errorText e = case e of BadRequest -> "Bad request" Conflict -> "Conflict" FeatureNotImplemented -> "This feature is not implemented" Forbidden -> "Forbidden" Gone -> "Recipient can no longer be contacted" InternalServerError -> "Internal server error" ItemNotFound -> "Item not found" JidMalformed -> "JID Malformed" NotAcceptable -> "Message was rejected" NotAllowed -> "Not allowed" NotAuthorized -> "Not authorized" PaymentRequired -> "Payment is required" RecipientUnavailable -> "Recipient is unavailable" Redirect -> "Redirect" RegistrationRequired -> "Registration required" RemoteServerNotFound -> "Recipient's server not found" RemoteServerTimeout -> "Remote server timeout" ResourceConstraint -> "The server is low on resources" ServiceUnavailable -> "The service is unavailable" SubscriptionRequired -> "A subscription is required" UndefinedCondition -> "Undefined condition" UnexpectedRequest -> "Unexpected request"