Browse Source

Remove the `StanzaID' type and the `IdGenerator' newtype

master
Jon Kristensen 12 years ago
parent
commit
e7a6c7cd07
  1. 2
      source/Network/Xmpp/Concurrent.hs
  2. 13
      source/Network/Xmpp/Concurrent/Types.hs
  3. 1
      source/Network/Xmpp/Internal.hs
  4. 24
      source/Network/Xmpp/Marshal.hs
  5. 2
      source/Network/Xmpp/Stream.hs
  6. 33
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp/Concurrent.hs

@ -284,5 +284,5 @@ doRetry sess@Session{reconnectWait = rw} = do @@ -284,5 +284,5 @@ doRetry sess@Session{reconnectWait = rw} = do
reconnectNow sess
newStanzaID :: Session -> IO StanzaID
newStanzaID :: Session -> IO Text
newStanzaID = idGenerator

13
source/Network/Xmpp/Concurrent/Types.hs

@ -26,7 +26,7 @@ data SessionConfiguration = SessionConfiguration @@ -26,7 +26,7 @@ data SessionConfiguration = SessionConfiguration
-- | Handler to be run when the session ends (for whatever reason).
, onConnectionClosed :: Session -> XmppFailure -> IO ()
-- | Function to generate the stream of stanza identifiers.
, sessionStanzaIDs :: IO (IO StanzaID)
, sessionStanzaIDs :: IO (IO Text)
, extraStanzaHandlers :: [StanzaHandler]
, enableRoster :: Bool
}
@ -39,7 +39,7 @@ instance Default SessionConfiguration where @@ -39,7 +39,7 @@ instance Default SessionConfiguration where
return . atomically $ do
curId <- readTVar idRef
writeTVar idRef (curId + 1 :: Integer)
return . StanzaID . Text.pack . show $ curId
return . Text.pack . show $ curId
, extraStanzaHandlers = []
, enableRoster = True
}
@ -67,7 +67,7 @@ data Session = Session @@ -67,7 +67,7 @@ data Session = Session
-- Fields below are from Context.
, writeSemaphore :: WriteSemaphore
, readerThread :: ThreadId
, idGenerator :: IO StanzaID
, idGenerator :: IO Text
-- | Lock (used by withStream) to make sure that a maximum of one
-- Stream action is executed at any given time.
, streamRef :: TMVar Stream
@ -80,10 +80,11 @@ data Session = Session @@ -80,10 +80,11 @@ data Session = Session
, reconnectWait :: TVar Int
}
-- | IQHandlers holds the registered channels for incomming IQ requests and
-- TMVars of and TMVars for expected IQ responses
-- | IQHandlers holds the registered channels for incoming IQ requests and
-- TMVars of and TMVars for expected IQ responses (the second Text represent a
-- stanza identifier.
type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
, Map.Map StanzaID (TMVar IQResponse)
, Map.Map Text (TMVar IQResponse)
)
-- | Contains whether or not a reply has been sent, and the IQ request body to

1
source/Network/Xmpp/Internal.hs

@ -30,7 +30,6 @@ module Network.Xmpp.Internal @@ -30,7 +30,6 @@ module Network.Xmpp.Internal
, pullStanza
, pushIQ
, SaslHandler
, StanzaID(..)
, Stanza(..)
, TlsBehaviour(..)
)

24
source/Network/Xmpp/Marshal.hs

@ -48,7 +48,7 @@ xpMessage = ("xpMessage" , "") <?+> xpWrap @@ -48,7 +48,7 @@ xpMessage = ("xpMessage" , "") <?+> xpWrap
(xpElem "{jabber:client}message"
(xp5Tuple
(xpDefault Normal $ xpAttr "type" xpMessageType)
(xpAttrImplied "id" xpStanzaID)
(xpAttrImplied "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -63,7 +63,7 @@ xpPresence = ("xpPresence" , "") <?+> xpWrap @@ -63,7 +63,7 @@ xpPresence = ("xpPresence" , "") <?+> xpWrap
(\(Presence qid from to lang tp ext) -> ((qid, from, to, lang, tp), ext))
(xpElem "{jabber:client}presence"
(xp5Tuple
(xpAttrImplied "id" xpStanzaID)
(xpAttrImplied "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -78,7 +78,7 @@ xpIQRequest = ("xpIQRequest" , "") <?+> xpWrap @@ -78,7 +78,7 @@ xpIQRequest = ("xpIQRequest" , "") <?+> xpWrap
(\(IQRequest qid from to lang tp body) -> ((qid, from, to, lang, tp), body))
(xpElem "{jabber:client}iq"
(xp5Tuple
(xpAttr "id" xpStanzaID)
(xpAttr "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -93,7 +93,7 @@ xpIQResult = ("xpIQResult" , "") <?+> xpWrap @@ -93,7 +93,7 @@ xpIQResult = ("xpIQResult" , "") <?+> xpWrap
(\(IQResult qid from to lang body) -> ((qid, from, to, lang, ()), body))
(xpElem "{jabber:client}iq"
(xp5Tuple
(xpAttr "id" xpStanzaID)
(xpAttr "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -142,7 +142,7 @@ xpMessageError = ("xpMessageError" , "") <?+> xpWrap @@ -142,7 +142,7 @@ xpMessageError = ("xpMessageError" , "") <?+> xpWrap
(xpElem "{jabber:client}message"
(xp5Tuple
(xpAttrFixed "type" "error")
(xpAttrImplied "id" xpStanzaID)
(xpAttrImplied "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
(xpAttrImplied xmlLang xpLang)
@ -159,7 +159,7 @@ xpPresenceError = ("xpPresenceError" , "") <?+> xpWrap @@ -159,7 +159,7 @@ xpPresenceError = ("xpPresenceError" , "") <?+> xpWrap
((qid, from, to, lang, ()), (err, ext)))
(xpElem "{jabber:client}presence"
(xp5Tuple
(xpAttrImplied "id" xpStanzaID)
(xpAttrImplied "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -176,7 +176,7 @@ xpIQError = ("xpIQError" , "") <?+> xpWrap @@ -176,7 +176,7 @@ xpIQError = ("xpIQError" , "") <?+> xpWrap
((qid, from, to, lang, ()), (err, body)))
(xpElem "{jabber:client}iq"
(xp5Tuple
(xpAttr "id" xpStanzaID)
(xpAttr "id" xpId)
(xpAttrImplied "from" xpJid)
(xpAttrImplied "to" xpJid)
xpLangTag
@ -292,16 +292,6 @@ xpJid = ("xpJid", "") <?> @@ -292,16 +292,6 @@ xpJid = ("xpJid", "") <?>
Just j -> Right j)
jidToText
xpStanzaID :: PU Text StanzaID
xpStanzaID = ("xpStanzaID", "") <?>
xpPartial ( \input -> case stanzaIDFromText input of
Nothing -> Left "Could not parse StanzaID."
Just j -> Right j)
stanzaIDToText
where
stanzaIDFromText t = Just $ StanzaID t
stanzaIDToText (StanzaID s) = s
xpIQRequestType :: PU Text IQRequestType
xpIQRequestType = ("xpIQRequestType", "") <?>
xpPartial ( \input -> case iqRequestTypeFromText input of

2
source/Network/Xmpp/Stream.hs

@ -752,7 +752,7 @@ killStream = withStream $ do @@ -752,7 +752,7 @@ killStream = withStream $ do
-- Sends an IQ request and waits for the response. If the response ID does not
-- match the outgoing ID, an error is thrown.
pushIQ :: StanzaID
pushIQ :: Text
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag

33
source/Network/Xmpp/Types.hs

@ -18,7 +18,6 @@ module Network.Xmpp.Types @@ -18,7 +18,6 @@ module Network.Xmpp.Types
, IQRequestType(..)
, IQResponse(..)
, IQResult(..)
, IdGenerator(..)
, LangTag (..)
, langTagFromText
, langTagToText
@ -38,7 +37,6 @@ module Network.Xmpp.Types @@ -38,7 +37,6 @@ module Network.Xmpp.Types
, StanzaError(..)
, StanzaErrorCondition(..)
, StanzaErrorType(..)
, StanzaID(..)
, XmppFailure(..)
, StreamErrorCondition(..)
, Version(..)
@ -97,15 +95,6 @@ import Network.TLS.Extra @@ -97,15 +95,6 @@ import Network.TLS.Extra
import qualified Text.NamePrep as SP
import qualified Text.StringPrep as SP
-- |
-- Wraps a string of random characters that, when using an appropriate
-- @IdGenerator@, is guaranteed to be unique for the Xmpp session.
data StanzaID = StanzaID !Text deriving (Eq, Ord, Read, Show)
instance IsString StanzaID where
fromString = StanzaID . Text.pack
-- | The Xmpp communication primities (Message, Presence and Info/Query) are
-- called stanzas.
data Stanza = IQRequestS !IQRequest
@ -119,7 +108,7 @@ data Stanza = IQRequestS !IQRequest @@ -119,7 +108,7 @@ data Stanza = IQRequestS !IQRequest
-- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as
-- type. It always contains an xml payload.
data IQRequest = IQRequest { iqRequestID :: !StanzaID
data IQRequest = IQRequest { iqRequestID :: !Text
, iqRequestFrom :: !(Maybe Jid)
, iqRequestTo :: !(Maybe Jid)
, iqRequestLangTag :: !(Maybe LangTag)
@ -138,7 +127,7 @@ data IQResponse = IQResponseError IQError @@ -138,7 +127,7 @@ data IQResponse = IQResponseError IQError
deriving Show
-- | The (non-error) answer to an IQ request.
data IQResult = IQResult { iqResultID :: !StanzaID
data IQResult = IQResult { iqResultID :: !Text
, iqResultFrom :: !(Maybe Jid)
, iqResultTo :: !(Maybe Jid)
, iqResultLangTag :: !(Maybe LangTag)
@ -146,7 +135,7 @@ data IQResult = IQResult { iqResultID :: !StanzaID @@ -146,7 +135,7 @@ data IQResult = IQResult { iqResultID :: !StanzaID
} deriving Show
-- | The answer to an IQ request that generated an error.
data IQError = IQError { iqErrorID :: !StanzaID
data IQError = IQError { iqErrorID :: !Text
, iqErrorFrom :: !(Maybe Jid)
, iqErrorTo :: !(Maybe Jid)
, iqErrorLangTag :: !(Maybe LangTag)
@ -155,7 +144,7 @@ data IQError = IQError { iqErrorID :: !StanzaID @@ -155,7 +144,7 @@ data IQError = IQError { iqErrorID :: !StanzaID
} deriving Show
-- | The message stanza. Used for /push/ type communication.
data Message = Message { messageID :: !(Maybe StanzaID)
data Message = Message { messageID :: !(Maybe Text)
, messageFrom :: !(Maybe Jid)
, messageTo :: !(Maybe Jid)
, messageLangTag :: !(Maybe LangTag)
@ -179,7 +168,7 @@ instance Default Message where @@ -179,7 +168,7 @@ instance Default Message where
def = message
-- | An error stanza generated in response to a 'Message'.
data MessageError = MessageError { messageErrorID :: !(Maybe StanzaID)
data MessageError = MessageError { messageErrorID :: !(Maybe Text)
, messageErrorFrom :: !(Maybe Jid)
, messageErrorTo :: !(Maybe Jid)
, messageErrorLangTag :: !(Maybe LangTag)
@ -226,7 +215,7 @@ data MessageType = -- | The message is sent in the context of a one-to-one chat @@ -226,7 +215,7 @@ data MessageType = -- | The message is sent in the context of a one-to-one chat
deriving (Eq, Read, Show)
-- | The presence stanza. Used for communicating status updates.
data Presence = Presence { presenceID :: !(Maybe StanzaID)
data Presence = Presence { presenceID :: !(Maybe Text)
, presenceFrom :: !(Maybe Jid)
, presenceTo :: !(Maybe Jid)
, presenceLangTag :: !(Maybe LangTag)
@ -248,7 +237,7 @@ instance Default Presence where @@ -248,7 +237,7 @@ instance Default Presence where
def = presence
-- | An error stanza generated in response to a 'Presence'.
data PresenceError = PresenceError { presenceErrorID :: !(Maybe StanzaID)
data PresenceError = PresenceError { presenceErrorID :: !(Maybe Text)
, presenceErrorFrom :: !(Maybe Jid)
, presenceErrorTo :: !(Maybe Jid)
, presenceErrorLangTag :: !(Maybe LangTag)
@ -552,14 +541,6 @@ instance Error AuthFailure where @@ -552,14 +541,6 @@ instance Error AuthFailure where
-- XML TYPES
-- =============================================================================
-- | Wraps a function that MUST generate a stream of unique Ids. The
-- strings MUST be appropriate for use in the stanza id attirubte.
-- For a default implementation, see @idGenerator@.
newtype IdGenerator = IdGenerator (IO Text)
-- | XMPP version number. Displayed as "<major>.<minor>". 2.4 is lesser than
-- 2.13, which in turn is lesser than 12.3.

Loading…
Cancel
Save