asakul
/
pontarius-xmpp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

make datatype fields strict

master
Philipp Balzarek 13 years ago
parent
6e504c3135
commit
828ca56cc3
1 changed files with 91 additions and 89 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 180
      source/Network/Xmpp/Types.hs

180
source/Network/Xmpp/Types.hs
Unescape View File

@ -80,23 +80,23 @@ instance IsString StanzaId where
-- | The Xmpp communication primities (Message, Presence and Info/Query) are -- | The Xmpp communication primities (Message, Presence and Info/Query) are
-- called stanzas. -- called stanzas.
data Stanza = IQRequestS IQRequest data Stanza = IQRequestS !IQRequest
| IQResultS IQResult | IQResultS !IQResult
| IQErrorS IQError | IQErrorS !IQError
| MessageS Message | MessageS !Message
| MessageErrorS MessageError | MessageErrorS !MessageError
| PresenceS Presence | PresenceS !Presence
| PresenceErrorS PresenceError | PresenceErrorS !PresenceError
deriving Show deriving Show
-- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as -- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as
-- type. It always contains an xml payload. -- type. It always contains an xml payload.
data IQRequest = IQRequest { iqRequestID :: StanzaId data IQRequest = IQRequest { iqRequestID :: !StanzaId
, iqRequestFrom :: Maybe Jid , iqRequestFrom :: !(Maybe Jid)
, iqRequestTo :: Maybe Jid , iqRequestTo :: !(Maybe Jid)
, iqRequestLangTag :: Maybe LangTag , iqRequestLangTag :: !(Maybe LangTag)
, iqRequestType :: IQRequestType , iqRequestType :: !IQRequestType
, iqRequestPayload :: Element , iqRequestPayload :: !Element
} deriving Show } deriving Show
-- | The type of IQ request that is made. -- | The type of IQ request that is made.
@ -119,38 +119,38 @@ data IQResponse = IQResponseError IQError
deriving Show deriving Show
-- | The (non-error) answer to an IQ request. -- | The (non-error) answer to an IQ request.
data IQResult = IQResult { iqResultID :: StanzaId data IQResult = IQResult { iqResultID :: !StanzaId
, iqResultFrom :: Maybe Jid , iqResultFrom :: !(Maybe Jid)
, iqResultTo :: Maybe Jid , iqResultTo :: !(Maybe Jid)
, iqResultLangTag :: Maybe LangTag , iqResultLangTag :: !(Maybe LangTag)
, iqResultPayload :: Maybe Element , iqResultPayload :: !(Maybe Element)
} deriving Show } 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 data IQError = IQError { iqErrorID :: !StanzaId
, iqErrorFrom :: Maybe Jid , iqErrorFrom :: !(Maybe Jid)
, iqErrorTo :: Maybe Jid , iqErrorTo :: !(Maybe Jid)
, iqErrorLangTag :: Maybe LangTag , iqErrorLangTag :: !(Maybe LangTag)
, iqErrorStanzaError :: StanzaError , iqErrorStanzaError :: !StanzaError
, iqErrorPayload :: Maybe Element -- should this be []? , 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 data Message = Message { messageID :: !(Maybe StanzaId)
, messageFrom :: Maybe Jid , messageFrom :: !(Maybe Jid)
, messageTo :: Maybe Jid , messageTo :: !(Maybe Jid)
, messageLangTag :: Maybe LangTag , messageLangTag :: !(Maybe LangTag)
, messageType :: MessageType , messageType :: !MessageType
, messagePayload :: [Element] , 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 data MessageError = MessageError { messageErrorID :: !(Maybe StanzaId)
, messageErrorFrom :: Maybe Jid , messageErrorFrom :: !(Maybe Jid)
, messageErrorTo :: Maybe Jid , messageErrorTo :: !(Maybe Jid)
, messageErrorLangTag :: Maybe LangTag , messageErrorLangTag :: !(Maybe LangTag)
, messageErrorStanzaError :: StanzaError , messageErrorStanzaError :: !StanzaError
, messageErrorPayload :: [Element] , messageErrorPayload :: ![Element]
} deriving (Show) } deriving (Show)
@ -192,10 +192,10 @@ data MessageType = -- | The message is sent in the context of a one-to-one chat
deriving (Eq) deriving (Eq)
instance Show MessageType where instance Show MessageType where
show Chat = "chat" show Chat = "chat"
show GroupChat = "groupchat" show GroupChat = "groupchat"
show Headline = "headline" show Headline = "headline"
show Normal = "normal" show Normal = "normal"
instance Read MessageType where instance Read MessageType where
readsPrec _ "chat" = [(Chat, "")] readsPrec _ "chat" = [(Chat, "")]
@ -205,22 +205,22 @@ instance Read MessageType where
readsPrec _ _ = [(Normal, "")] readsPrec _ _ = [(Normal, "")]
-- | The presence stanza. Used for communicating status updates. -- | The presence stanza. Used for communicating status updates.
data Presence = Presence { presenceID :: Maybe StanzaId data Presence = Presence { presenceID :: !(Maybe StanzaId)
, presenceFrom :: Maybe Jid , presenceFrom :: !(Maybe Jid)
, presenceTo :: Maybe Jid , presenceTo :: !(Maybe Jid)
, presenceLangTag :: Maybe LangTag , presenceLangTag :: !(Maybe LangTag)
, presenceType :: Maybe PresenceType , presenceType :: !(Maybe PresenceType)
, presencePayload :: [Element] , presencePayload :: ![Element]
} deriving Show } deriving Show
-- | An error stanza generated in response to a 'Presence'. -- | An error stanza generated in response to a 'Presence'.
data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaId data PresenceError = PresenceError { presenceErrorID :: !(Maybe StanzaId)
, presenceErrorFrom :: Maybe Jid , presenceErrorFrom :: !(Maybe Jid)
, presenceErrorTo :: Maybe Jid , presenceErrorTo :: !(Maybe Jid)
, presenceErrorLangTag :: Maybe LangTag , presenceErrorLangTag :: !(Maybe LangTag)
, presenceErrorStanzaError :: StanzaError , presenceErrorStanzaError :: !StanzaError
, presenceErrorPayload :: [Element] , presenceErrorPayload :: ![Element]
} deriving Show } deriving Show
-- | @PresenceType@ holds Xmpp presence types. The "error" message type is left -- | @PresenceType@ holds Xmpp presence types. The "error" message type is left
@ -275,11 +275,11 @@ data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry
deriving (Eq) deriving (Eq)
instance Show StanzaErrorType where instance Show StanzaErrorType where
show Cancel = "cancel" show Cancel = "cancel"
show Continue = "continue" show Continue = "continue"
show Modify = "modify" show Modify = "modify"
show Auth = "auth" show Auth = "auth"
show Wait = "wait" show Wait = "wait"
instance Read StanzaErrorType where instance Read StanzaErrorType where
readsPrec _ "auth" = [( Auth , "")] readsPrec _ "auth" = [( Auth , "")]
@ -614,9 +614,9 @@ instance Read StreamErrorCondition where
readsPrec _ _ = [(StreamUndefinedCondition , "")] readsPrec _ _ = [(StreamUndefinedCondition , "")]
data XmppStreamError = XmppStreamError data XmppStreamError = XmppStreamError
{ errorCondition :: StreamErrorCondition { errorCondition :: !StreamErrorCondition
, errorText :: Maybe (Maybe LangTag, Text) , errorText :: !(Maybe (Maybe LangTag, Text))
, errorXML :: Maybe Element , errorXML :: !(Maybe Element)
} deriving (Show, Eq) } deriving (Show, Eq)
data StreamError = StreamError XmppStreamError data StreamError = StreamError XmppStreamError
@ -651,8 +651,8 @@ newtype IdGenerator = IdGenerator (IO Text)
-- | XMPP version number. Displayed as "<major>.<minor>". 2.4 is lesser than -- | XMPP version number. Displayed as "<major>.<minor>". 2.4 is lesser than
-- 2.13, which in turn is lesser than 12.3. -- 2.13, which in turn is lesser than 12.3.
data Version = Version { majorVersion :: Integer data Version = Version { majorVersion :: !Integer
, minorVersion :: Integer } deriving (Eq) , minorVersion :: !Integer } deriving (Eq)
-- If the major version numbers are not equal, compare them. Otherwise, compare -- If the major version numbers are not equal, compare them. Otherwise, compare
-- the minor version numbers. -- the minor version numbers.
@ -685,8 +685,8 @@ versionParser = do
-- | The language tag in accordance with RFC 5646 (in the form of "en-US"). It -- | The language tag in accordance with RFC 5646 (in the form of "en-US"). It
-- has a primary tag and a number of subtags. Two language tags are considered -- has a primary tag and a number of subtags. Two language tags are considered
-- equal if and only if they contain the same tags (case-insensitive). -- equal if and only if they contain the same tags (case-insensitive).
data LangTag = LangTag { primaryTag :: Text data LangTag = LangTag { primaryTag :: !Text
, subtags :: [Text] } , subtags :: ![Text] }
instance Eq LangTag where instance Eq LangTag where
LangTag p s == LangTag q t = Text.toLower p == Text.toLower q && LangTag p s == LangTag q t = Text.toLower p == Text.toLower q &&
@ -729,9 +729,9 @@ langTagParser = do
tagChars = ['a'..'z'] ++ ['A'..'Z'] tagChars = ['a'..'z'] ++ ['A'..'Z']
data ServerFeatures = SF data ServerFeatures = SF
{ stls :: Maybe Bool { stls :: !(Maybe Bool)
, saslMechanisms :: [Text.Text] , saslMechanisms :: ![Text.Text]
, other :: [Element] , other :: ![Element]
} deriving Show } deriving Show
data XmppConnectionState data XmppConnectionState
@ -741,30 +741,32 @@ data XmppConnectionState
deriving (Show, Eq, Typeable) deriving (Show, Eq, Typeable)
data XmppConnection = XmppConnection data XmppConnection = XmppConnection
{ sConSrc :: Source IO Event { sConSrc :: !(Source IO Event)
, sRawSrc :: Source IO BS.ByteString , sRawSrc :: !(Source IO BS.ByteString)
, sConPushBS :: BS.ByteString -> IO Bool , sConPushBS :: !(BS.ByteString -> IO Bool)
, sConHandle :: Maybe Handle , sConHandle :: !(Maybe Handle)
, sFeatures :: ServerFeatures , sFeatures :: !ServerFeatures
, sConnectionState :: XmppConnectionState , sConnectionState :: !XmppConnectionState
, sHostname :: Maybe Text , sHostname :: !(Maybe Text)
, sJid :: Maybe Jid , sJid :: !(Maybe Jid)
, sCloseConnection :: IO () , sCloseConnection :: !(IO ())
, sPreferredLang :: Maybe LangTag , sPreferredLang :: !(Maybe LangTag)
, sStreamLang :: Maybe LangTag -- Will be a `Just' value , sStreamLang :: !(Maybe LangTag) -- Will be a `Just' value
-- once connected to the -- once connected to the
-- server. -- server.
, sStreamId :: Maybe Text -- Stream ID as specified by the , sStreamId :: !(Maybe Text) -- Stream ID as specified by
-- server. -- the server.
, sToJid :: Maybe Jid -- JID to include in the stream , sToJid :: !(Maybe Jid) -- JID to include in the
-- element's `to' attribute when -- stream element's `to'
-- the connection is secured. See -- attribute when the
-- also below. -- connection is secured. See
, sJidWhenPlain :: Bool -- Whether or not to also include the -- also below.
-- Jid when the connection is plain. , sJidWhenPlain :: !Bool -- Whether or not to also include the
, sFrom :: Maybe Jid -- From as specified by the -- Jid when the connection is plain.
-- server in the stream , sFrom :: !(Maybe Jid) -- From as specified by the
-- element's `from' attribute. -- server in the stream
-- element's `from'
-- attribute.
} }
-- | -- |

Write Preview
Loading…
Cancel
Save