diff --git a/src/Network/XMPP/Types.hs b/src/Network/XMPP/Types.hs index b77fd99..7706f0d 100644 --- a/src/Network/XMPP/Types.hs +++ b/src/Network/XMPP/Types.hs @@ -1,15 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TupleSections #-} --- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the --- Pontarius distribution for more details. - -{-# OPTIONS_HADDOCK hide #-} - {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} - +{-# OPTIONS_HADDOCK hide #-} module Network.XMPP.Types ( IQError(..) @@ -27,7 +22,6 @@ module Network.XMPP.Types , PresenceType(..) , SaslError(..) , SaslFailure(..) - , ServerAddress(..) , ServerFeatures(..) , Stanza(..) , StanzaError(..) @@ -46,8 +40,6 @@ module Network.XMPP.Types ) where --- import Network.XMPP.Utilities (idGenerator) - import Control.Applicative((<$>)) import Control.Exception import Control.Monad.IO.Class @@ -69,24 +61,9 @@ import Network.XMPP.JID import System.IO --- ============================================================================= --- STANZA TYPES --- ============================================================================= - - --- TODO: Would a Stanza class such as the one below be useful sometimes? --- --- class Stanza a where --- stanzaID :: a -> Maybe StanzaID --- stanzaFrom :: a -> Maybe From --- stanzaTo :: a -> Maybe To --- stanzaXMLLang :: a -> Maybe XMLLang - - -- | -- Wraps a string of random characters that, when using an appropriate -- @IDGenerator@, is guaranteed to be unique for the XMPP session. --- Stanza identifiers are generated by Pontarius. data StanzaId = SI !Text deriving (Eq, Ord) @@ -99,13 +76,8 @@ instance Read StanzaId where instance IsString StanzaId where fromString = SI . Text.pack --- An Info/Query (IQ) stanza is either of the type "request" ("get" or --- "set") or "response" ("result" or "error"). The @IQ@ type wraps --- these two sub-types. --- --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - +-- | The XMPP communication primities (Message, Presence and Info/Query) are +-- called stanzas. data Stanza = IQRequestS IQRequest | IQResultS IQResult | IQErrorS IQError @@ -115,19 +87,17 @@ data Stanza = IQRequestS IQRequest | PresenceErrorS PresenceError deriving Show --- | --- A "request" Info/Query (IQ) stanza is one with either "get" or --- "set" as type. They are guaranteed to always contain a payload. +-- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as +-- type. They are guaranteed to always contain a payload. data IQRequest = IQRequest { iqRequestID :: StanzaId , iqRequestFrom :: Maybe JID , iqRequestTo :: Maybe JID , iqRequestLangTag :: Maybe LangTag , iqRequestType :: IQRequestType , iqRequestPayload :: Element - } - deriving (Show) + } deriving Show --- | The type of request that is made +-- | The type of IQ request that is made. data IQRequestType = Get | Set deriving (Eq, Ord) instance Show IQRequestType where @@ -139,93 +109,82 @@ instance Read IQRequestType where readsPrec _ "set" = [(Set, "")] readsPrec _ _ = [] --- | A "response" Info/Query (IQ) stanza is eitheran 'IQError' or an IQ stanza --- with the type "result" ('IQResult') - +-- | A "response" Info/Query (IQ) stanza is either an 'IQError' or an IQ stanza +-- with the type "result" ('IQResult'). type IQResponse = Either IQError IQResult --- | The answer to an IQ request +-- | The (non-error) answer to an IQ request. data IQResult = IQResult { iqResultID :: StanzaId , iqResultFrom :: Maybe JID , iqResultTo :: Maybe JID , iqResultLangTag :: Maybe LangTag - , iqResultPayload :: Maybe Element } - deriving (Show) + , iqResultPayload :: Maybe Element + } deriving Show --- | The answer to an IQ request that generated an error +-- | The answer to an IQ request that generated an error. data IQError = IQError { iqErrorID :: StanzaId , iqErrorFrom :: Maybe JID , iqErrorTo :: Maybe JID , iqErrorLangTag :: Maybe LangTag , iqErrorStanzaError :: StanzaError , iqErrorPayload :: Maybe Element -- should this be []? - } - deriving (Show) + } deriving Show --- | The message stanza. Used for /push/ type communication +-- | The message stanza. Used for /push/ type communication. data Message = Message { messageID :: Maybe StanzaId , messageFrom :: Maybe JID , messageTo :: Maybe JID , messageLangTag :: Maybe LangTag , messageType :: MessageType , messagePayload :: [Element] - } - deriving (Show) + } deriving Show --- | An error stanza generated in response to a 'Message' +-- | An error stanza generated in response to a 'Message'. data MessageError = MessageError { messageErrorID :: Maybe StanzaId , messageErrorFrom :: Maybe JID , messageErrorTo :: Maybe JID , messageErrorLangTag :: Maybe LangTag , messageErrorStanzaError :: StanzaError , messageErrorPayload :: [Element] - } - deriving (Show) + } deriving (Show) -- | The type of a Message being sent -- () -data MessageType = -- | The message is sent in the context of a one-to-one chat - -- session. Typically an interactive client will present a - -- message of type /chat/ in an interface that enables - -- one-to-one chat between the two parties, including an - -- appropriate conversation history. +data MessageType = -- | The message is sent in the context of a one-to-one chat + -- session. Typically an interactive client will present a + -- message of type /chat/ in an interface that enables + -- one-to-one chat between the two parties, including an + -- appropriate conversation history. Chat - -- | The message is sent in the context of a - -- multi-user chat environment (similar to that of - -- @IRC@). Typically a receiving client will - -- present a message of type /groupchat/ in an - -- interface that enables many-to-many chat - -- between the parties, including a roster of - -- parties in the chatroom and an appropriate - -- conversation history. + -- | The message is sent in the context of a multi-user chat + -- environment (similar to that of @IRC@). Typically a + -- receiving client will present a message of type + -- /groupchat/ in an interface that enables many-to-many + -- chat between the parties, including a roster of parties + -- in the chatroom and an appropriate conversation history. | GroupChat - -- | The message provides an alert, a - -- notification, or other transient information to - -- which no reply is expected (e.g., news - -- headlines, sports updates, near-real-time - -- market data, or syndicated content). Because no - -- reply to the message is expected, typically a - -- receiving client will present a message of type - -- /headline/ in an interface that appropriately - -- differentiates the message from standalone - -- messages, chat messages, and groupchat messages - -- (e.g., by not providing the recipient with the - -- ability to reply). + -- | The message provides an alert, a notification, or other + -- transient information to which no reply is expected + -- (e.g., news headlines, sports updates, near-real-time + -- market data, or syndicated content). Because no reply to + -- the message is expected, typically a receiving client + -- will present a message of type /headline/ in an interface + -- that appropriately differentiates the message from + -- standalone messages, chat messages, and groupchat + -- messages (e.g., by not providing the recipient with the + -- ability to reply). | Headline - -- | The message is a standalone message that is - -- sent outside the context of a one-to-one - -- conversation or groupchat, and to which it is - -- expected that the recipient will - -- reply. Typically a receiving client will - -- present a message of type /normal/ in an - -- interface that enables the recipient to reply, - -- but without a conversation history. - -- - -- This is the /default/ value + -- | The message is a standalone message that is sent outside + -- the context of a one-to-one conversation or groupchat, and + -- to which it is expected that the recipient will reply. + -- Typically a receiving client will present a message of + -- type /normal/ in an interface that enables the recipient + -- to reply, but without a conversation history. + -- + -- This is the /default/ value. | Normal - deriving (Eq) - + deriving (Eq) instance Show MessageType where show Chat = "chat" @@ -234,43 +193,33 @@ instance Show MessageType where show Normal = "normal" instance Read MessageType where - readsPrec _ "chat" = [( Chat ,"")] - readsPrec _ "groupchat" = [( GroupChat ,"")] - readsPrec _ "headline" = [( Headline ,"")] - readsPrec _ "normal" = [( Normal ,"")] - readsPrec _ _ = [( Normal ,"")] - --- | --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - -data Presence = Presence { presenceID :: Maybe StanzaId - , presenceFrom :: Maybe JID - , presenceTo :: Maybe JID - , presenceLangTag :: Maybe LangTag - , presenceType :: Maybe PresenceType - , presencePayload :: [Element] - } - deriving (Show) - - --- | --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - -data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaId - , presenceErrorFrom :: Maybe JID - , presenceErrorTo :: Maybe JID - , presenceErrorLangTag :: Maybe LangTag + readsPrec _ "chat" = [(Chat, "")] + readsPrec _ "groupchat" = [(GroupChat, "")] + readsPrec _ "headline" = [(Headline, "")] + readsPrec _ "normal" = [(Normal, "")] + readsPrec _ _ = [(Normal, "")] + +-- | The presence stanza. Used for communicating status updates. +data Presence = Presence { presenceID :: Maybe StanzaId + , presenceFrom :: Maybe JID + , presenceTo :: Maybe JID + , presenceLangTag :: Maybe LangTag + , presenceType :: Maybe PresenceType + , presencePayload :: [Element] + } deriving Show + + +-- | An error stanza generated in response to a 'Presence'. +data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaId + , presenceErrorFrom :: Maybe JID + , presenceErrorTo :: Maybe JID + , presenceErrorLangTag :: Maybe LangTag , presenceErrorStanzaError :: StanzaError - , presenceErrorPayload :: [Element] - } - deriving (Show) - --- | --- @PresenceType@ holds XMPP presence types. The "error" message type --- is left out as errors are using @PresenceError@. + , presenceErrorPayload :: [Element] + } deriving Show +-- | @PresenceType@ holds XMPP presence types. The "error" message type is left +-- out as errors are using @PresenceError@. data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence Subscribed | -- ^ Sender has approved the subscription Unsubscribe | -- ^ Sender is unsubscribing from presence @@ -281,7 +230,6 @@ data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence Default | Unavailable deriving (Eq) - instance Show PresenceType where show Subscribe = "subscribe" show Subscribed = "subscribed" @@ -292,15 +240,15 @@ instance Show PresenceType where show Unavailable = "unavailable" 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 _ _ = [] + readsPrec _ "" = [(Default, "")] + readsPrec _ "available" = [(Default, "")] + readsPrec _ "unavailable" = [(Unavailable, "")] + readsPrec _ "subscribe" = [(Subscribe, "")] + readsPrec _ "subscribed" = [(Subscribed, "")] + readsPrec _ "unsubscribe" = [(Unsubscribe, "")] + readsPrec _ "unsubscribed" = [(Unsubscribed, "")] + readsPrec _ "probe" = [(Probe, "")] + readsPrec _ _ = [] --data ShowType = Available -- | Away @@ -327,22 +275,18 @@ instance Read PresenceType where -- readsPrec _ _ = [] --- | --- All stanzas (IQ, message, presence) can cause errors, which in the XMPP +-- | All stanzas (IQ, message, presence) can cause errors, which in the XMPP -- stream looks like . These errors are -- wrapped in the @StanzaError@ type. - --- TODO: Sender XML is (optional and is) not included. -data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType - , stanzaErrorCondition :: StanzaErrorCondition - , stanzaErrorText :: Maybe (Maybe LangTag, Text) - , stanzaErrorApplicationSpecificCondition :: - Maybe Element } deriving (Eq, Show) - - --- | --- @StanzaError@s always have one of these types. - +-- TODO: Sender XML is (optional and is) not yet included. +data StanzaError = StanzaError + { stanzaErrorType :: StanzaErrorType + , stanzaErrorCondition :: StanzaErrorCondition + , stanzaErrorText :: Maybe (Maybe LangTag, Text) + , stanzaErrorApplicationSpecificCondition :: Maybe Element + } deriving (Eq, Show) + +-- | @StanzaError@s always have one of these types. data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry Continue | -- ^ Conditition was a warning - proceed Modify | -- ^ Change the data and retry @@ -350,7 +294,6 @@ data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry Wait -- ^ Error is temporary - wait and retry deriving (Eq) - instance Show StanzaErrorType where show Cancel = "cancel" show Continue = "continue" @@ -366,48 +309,42 @@ instance Read StanzaErrorType where readsPrec _ "wait" = [( Wait , "")] readsPrec _ _ = [] - --- | --- Stanza errors are accommodated with one of the error conditions listed below. - -data StanzaErrorCondition = BadRequest | -- ^ Malformed XML - Conflict | -- ^ Resource or session - -- with name already - -- exists - FeatureNotImplemented | - Forbidden | -- ^ Insufficient - -- permissions - Gone | -- ^ Entity can no longer - -- be contacted at this - -- address - InternalServerError | - ItemNotFound | - JIDMalformed | - NotAcceptable | -- ^ Does not meet policy - -- criteria - NotAllowed | -- ^ No entity may perform - -- this action - NotAuthorized | -- ^ Must provide proper - -- credentials - PaymentRequired | - RecipientUnavailable | -- ^ Temporarily - -- unavailable - Redirect | -- ^ Redirecting to other - -- entity, usually - -- temporarily - RegistrationRequired | - RemoteServerNotFound | - RemoteServerTimeout | - ResourceConstraint | -- ^ Entity lacks the - -- necessary system - -- resources - ServiceUnavailable | - SubscriptionRequired | - UndefinedCondition | -- ^ Application-specific - -- condition - UnexpectedRequest -- ^ Badly timed request - deriving (Eq) - +-- | Stanza errors are accommodated with one of the error conditions listed +-- below. +data StanzaErrorCondition = BadRequest -- ^ Malformed XML. + | Conflict -- ^ Resource or session with + -- name already exists. + | FeatureNotImplemented + | Forbidden -- ^ Insufficient permissions. + | Gone -- ^ Entity can no longer be + -- contacted at this + -- address. + | InternalServerError + | ItemNotFound + | JIDMalformed + | NotAcceptable -- ^ Does not meet policy + -- criteria. + | NotAllowed -- ^ No entity may perform + -- this action. + | NotAuthorized -- ^ Must provide proper + -- credentials. + | PaymentRequired + | RecipientUnavailable -- ^ Temporarily unavailable. + | Redirect -- ^ Redirecting to other + -- entity, usually + -- temporarily. + | RegistrationRequired + | RemoteServerNotFound + | RemoteServerTimeout + | ResourceConstraint -- ^ Entity lacks the + -- necessary system + -- resources. + | ServiceUnavailable + | SubscriptionRequired + | UndefinedCondition -- ^ Application-specific + -- condition. + | UnexpectedRequest -- ^ Badly timed request. + deriving Eq instance Show StanzaErrorCondition where show BadRequest = "bad-request" @@ -468,35 +405,33 @@ data SaslFailure = SaslFailure { saslFailureCondition :: SaslError ) } deriving Show - -data SaslError = SaslAborted -- ^ Client aborted +data SaslError = SaslAborted -- ^ Client aborted. | SaslAccountDisabled -- ^ The account has been temporarily - -- disabled + -- disabled. | SaslCredentialsExpired -- ^ The authentication failed because - -- the credentials have expired + -- the credentials have expired. | SaslEncryptionRequired -- ^ The mechanism requested cannot be -- used the confidentiality and -- integrity of the underlying -- stream is protected (typically - -- with TLS) - | SaslIncorrectEncoding -- ^ The base64 encoding is incorrect + -- with TLS). + | SaslIncorrectEncoding -- ^ The base64 encoding is incorrect. | SaslInvalidAuthzid -- ^ The authzid has an incorrect - -- format or the initiating entity does - -- not have the appropriate permissions - -- to authorize that ID + -- format or the initiating entity + -- does not have the appropriate + -- permissions to authorize that ID. | SaslInvalidMechanism -- ^ The mechanism is not supported by - -- the receiving entity - | SaslMalformedRequest -- ^ Invalid syntax + -- the receiving entity. + | SaslMalformedRequest -- ^ Invalid syntax. | SaslMechanismTooWeak -- ^ The receiving entity policy - -- requires a stronger mechanism - | SaslNotAuthorized -- ^ Invalid credentials - -- provided, or some - -- generic authentication - -- failure has occurred + -- requires a stronger mechanism. + | SaslNotAuthorized -- ^ Invalid credentials provided, or + -- some generic authentication + -- failure has occurred. | SaslTemporaryAuthFailure -- ^ There receiving entity reported a -- temporary error condition; the -- initiating entity is recommended - -- to try again later + -- to try again later. instance Show SaslError where show SaslAborted = "aborted" @@ -525,39 +460,36 @@ instance Read SaslError where readsPrec _ "temporary-auth-failure" = [(SaslTemporaryAuthFailure , "")] readsPrec _ _ = [] --- | Readability type for host name Texts. - --- type HostName = Text -- This is defined in Network as well - -data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq) +-- data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq) -- TODO: document the error cases -data StreamErrorCondition = StreamBadFormat - | StreamBadNamespacePrefix - | StreamConflict - | StreamConnectionTimeout - | StreamHostGone - | StreamHostUnknown - | StreamImproperAddressing - | StreamInternalServerError - | StreamInvalidFrom - | StreamInvalidNamespace - | StreamInvalidXml - | StreamNotAuthorized - | StreamNotWellFormed - | StreamPolicyViolation - | StreamRemoteConnectionFailed - | StreamReset - | StreamResourceConstraint - | StreamRestrictedXml - | StreamSeeOtherHost - | StreamSystemShutdown - | StreamUndefinedCondition - | StreamUnsupportedEncoding - | StreamUnsupportedFeature - | StreamUnsupportedStanzaType - | StreamUnsupportedVersion - deriving Eq +data StreamErrorCondition + = StreamBadFormat + | StreamBadNamespacePrefix + | StreamConflict + | StreamConnectionTimeout + | StreamHostGone + | StreamHostUnknown + | StreamImproperAddressing + | StreamInternalServerError + | StreamInvalidFrom + | StreamInvalidNamespace + | StreamInvalidXml + | StreamNotAuthorized + | StreamNotWellFormed + | StreamPolicyViolation + | StreamRemoteConnectionFailed + | StreamReset + | StreamResourceConstraint + | StreamRestrictedXml + | StreamSeeOtherHost + | StreamSystemShutdown + | StreamUndefinedCondition + | StreamUnsupportedEncoding + | StreamUnsupportedFeature + | StreamUnsupportedStanzaType + | StreamUnsupportedVersion + deriving Eq instance Show StreamErrorCondition where show StreamBadFormat = "bad-format" @@ -587,45 +519,46 @@ instance Show StreamErrorCondition where show StreamUnsupportedVersion = "unsupported-version" instance Read StreamErrorCondition where - readsPrec _ "bad-format" = [(StreamBadFormat , "")] - readsPrec _ "bad-namespace-prefix" = [(StreamBadNamespacePrefix , "")] - readsPrec _ "conflict" = [(StreamConflict , "")] - readsPrec _ "connection-timeout" = [(StreamConnectionTimeout , "")] - readsPrec _ "host-gone" = [(StreamHostGone , "")] - readsPrec _ "host-unknown" = [(StreamHostUnknown , "")] - readsPrec _ "improper-addressing" = [(StreamImproperAddressing , "")] - readsPrec _ "internal-server-error" = [(StreamInternalServerError , "")] - readsPrec _ "invalid-from" = [(StreamInvalidFrom , "")] - readsPrec _ "invalid-namespace" = [(StreamInvalidNamespace , "")] - readsPrec _ "invalid-xml" = [(StreamInvalidXml , "")] - readsPrec _ "not-authorized" = [(StreamNotAuthorized , "")] - readsPrec _ "not-well-formed" = [(StreamNotWellFormed , "")] - readsPrec _ "policy-violation" = [(StreamPolicyViolation , "")] - readsPrec _ "remote-connection-failed" = [(StreamRemoteConnectionFailed , "")] - readsPrec _ "reset" = [(StreamReset , "")] - readsPrec _ "resource-constraint" = [(StreamResourceConstraint , "")] - readsPrec _ "restricted-xml" = [(StreamRestrictedXml , "")] - readsPrec _ "see-other-host" = [(StreamSeeOtherHost , "")] - readsPrec _ "system-shutdown" = [(StreamSystemShutdown , "")] - readsPrec _ "undefined-condition" = [(StreamUndefinedCondition , "")] - readsPrec _ "unsupported-encoding" = [(StreamUnsupportedEncoding , "")] - readsPrec _ "unsupported-feature" = [(StreamUnsupportedFeature , "")] - readsPrec _ "unsupported-stanza-type" = [(StreamUnsupportedStanzaType , "")] - readsPrec _ "unsupported-version" = [(StreamUnsupportedVersion , "")] - readsPrec _ _ = [(StreamUndefinedCondition , "")] + readsPrec _ "bad-format" = [(StreamBadFormat , "")] + readsPrec _ "bad-namespace-prefix" = [(StreamBadNamespacePrefix , "")] + readsPrec _ "conflict" = [(StreamConflict , "")] + readsPrec _ "connection-timeout" = [(StreamConnectionTimeout , "")] + readsPrec _ "host-gone" = [(StreamHostGone , "")] + readsPrec _ "host-unknown" = [(StreamHostUnknown , "")] + readsPrec _ "improper-addressing" = [(StreamImproperAddressing , "")] + readsPrec _ "internal-server-error" = [(StreamInternalServerError , "")] + readsPrec _ "invalid-from" = [(StreamInvalidFrom , "")] + readsPrec _ "invalid-namespace" = [(StreamInvalidNamespace , "")] + readsPrec _ "invalid-xml" = [(StreamInvalidXml , "")] + readsPrec _ "not-authorized" = [(StreamNotAuthorized , "")] + readsPrec _ "not-well-formed" = [(StreamNotWellFormed , "")] + readsPrec _ "policy-violation" = [(StreamPolicyViolation , "")] + readsPrec _ "remote-connection-failed" = + [(StreamRemoteConnectionFailed, "")] + readsPrec _ "reset" = [(StreamReset , "")] + readsPrec _ "resource-constraint" = [(StreamResourceConstraint , "")] + readsPrec _ "restricted-xml" = [(StreamRestrictedXml , "")] + readsPrec _ "see-other-host" = [(StreamSeeOtherHost , "")] + readsPrec _ "system-shutdown" = [(StreamSystemShutdown , "")] + readsPrec _ "undefined-condition" = [(StreamUndefinedCondition , "")] + readsPrec _ "unsupported-encoding" = [(StreamUnsupportedEncoding , "")] + readsPrec _ "unsupported-feature" = [(StreamUnsupportedFeature , "")] + readsPrec _ "unsupported-stanza-type" = [(StreamUnsupportedStanzaType, "")] + readsPrec _ "unsupported-version" = [(StreamUnsupportedVersion , "")] + readsPrec _ _ = [(StreamUndefinedCondition , "")] data XmppStreamError = XmppStreamError - { errorCondition :: StreamErrorCondition - , errorText :: Maybe (Maybe LangTag, Text) - , errorXML :: Maybe Element - } deriving (Show, Eq) - + { errorCondition :: StreamErrorCondition + , errorText :: Maybe (Maybe LangTag, Text) + , errorXML :: Maybe Element + } deriving (Show, Eq) data StreamError = StreamError XmppStreamError | StreamWrongVersion Text - | StreamXMLError String + | StreamXMLError String -- If stream pickling goes wrong. | StreamConnectionError deriving (Show, Eq, Typeable) + instance Exception StreamError instance Error StreamError where noMsg = StreamConnectionError @@ -641,39 +574,33 @@ instance Error StreamError where noMsg = StreamConnectionError newtype IdGenerator = IdGenerator (IO Text) ---- other stuff +-- Version numbers are displayed as ".". data Version = Version { majorVersion :: Integer , minorVersion :: Integer } deriving (Eq) - --- Version numbers are displayed as ".". - instance Show Version where show (Version major minor) = (show major) ++ "." ++ (show minor) - -- If the major version numbers are not equal, compare them. Otherwise, compare -- the minor version numbers. - instance Ord Version where compare (Version amajor aminor) (Version bmajor bminor) | amajor /= bmajor = compare amajor bmajor | otherwise = compare aminor bminor - +-- The language tag in the form of "en-US". It has a primary tag, followed by a +-- number of subtags. data LangTag = LangTag { primaryTag :: Text , subtags :: [Text] } deriving (Eq) -- TODO: remove - --- Displays the language tag in the form of "en-US". - instance Show LangTag where show (LangTag p []) = Text.unpack p show (LangTag p s) = Text.unpack . Text.concat $ [p, "-", Text.intercalate "-" s] -- TODO: clean up +-- Parses a Text string to a list of LangTag objects. TODO: Why? parseLangTag :: Text -> [LangTag] parseLangTag txt = case Text.splitOn "-" txt of [] -> [] @@ -682,9 +609,8 @@ parseLangTag txt = case Text.splitOn "-" txt of instance Read LangTag where readsPrec _ txt = (,"") <$> (parseLangTag $ Text.pack txt) --- Two language tags are considered equal of they contain the same tags (case-insensitive). - --- TODO: port +-- Two language tags are considered equal of they contain the same tags +-- (case-insensitive). -- instance Eq LangTag where -- (LangTag ap as) == (LangTag bp bs) @@ -693,20 +619,17 @@ instance Read LangTag where -- | otherwise = False data ServerFeatures = SF - { stls :: Maybe Bool - , saslMechanisms :: [Text.Text] - , other :: [Element] - } deriving Show - -data XmppConnectionState = XmppConnectionClosed -- ^ No connection at - -- this point - | XmppConnectionPlain -- ^ Connection - -- established, but - -- not secured - | XmppConnectionSecured -- ^ Connection - -- established and - -- secured via TLS - deriving (Show, Eq, Typeable) + { stls :: Maybe Bool + , saslMechanisms :: [Text.Text] + , other :: [Element] + } deriving Show + +data XmppConnectionState + = XmppConnectionClosed -- ^ No connection at this point. + | XmppConnectionPlain -- ^ Connection established, but not secured. + | XmppConnectionSecured -- ^ Connection established and secured via TLS. + deriving (Show, Eq, Typeable) + data XmppConnection = XmppConnection { sConSrc :: Source IO Event , sRawSrc :: Source IO BS.ByteString @@ -725,12 +648,11 @@ data XmppConnection = XmppConnection -- The XMPP monad transformer. Contains internal state in order to -- work with Pontarius. Pontarius clients needs to operate in this -- context. - newtype XMPPT m a = XMPPT { runXMPPT :: StateT XmppConnection m a } deriving (Monad, MonadIO) +-- | Low-level and single-threaded XMPP monad. See @XMPP@ for a concurrent +-- implementation. type XMPPConMonad a = StateT XmppConnection IO a -- Make XMPPT derive the Monad and MonadIO instances. - -deriving instance (Monad m, MonadIO m) => MonadState (XmppConnection) (XMPPT m) - +deriving instance (Monad m, MonadIO m) => MonadState (XmppConnection) (XMPPT m) \ No newline at end of file