Browse Source

stream id now stored in connection state

master
Jon Kristensen 14 years ago
parent
commit
f53abf0176
  1. 2
      source/Network/Xmpp/Monad.hs
  2. 24
      source/Network/Xmpp/Stream.hs
  3. 2
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp/Monad.hs

@ -117,6 +117,7 @@ xmppNoConnection = XmppConnection @@ -117,6 +117,7 @@ xmppNoConnection = XmppConnection
, sJid = Nothing
, sCloseConnection = return ()
, sStreamLang = Nothing
, sStreamId = Nothing
, sPreferredLang = Nothing
, sToJid = Nothing
, sJidWhenPlain = False
@ -148,6 +149,7 @@ xmppRawConnect host hostname = do @@ -148,6 +149,7 @@ xmppRawConnect host hostname = do
, sCloseConnection = (hClose con)
, sPreferredLang = Nothing -- TODO: Allow user to set
, sStreamLang = Nothing
, sStreamId = Nothing
, sToJid = Nothing -- TODO: Allow user to set
, sJidWhenPlain = False -- TODO: Allow user to set
, sFrom = Nothing

24
source/Network/Xmpp/Stream.hs

@ -75,8 +75,13 @@ xmppStartStream = runErrorT $ do @@ -75,8 +75,13 @@ xmppStartStream = runErrorT $ do
, Just hostname
, sPreferredLang state
)
(lt, from, features) <- ErrorT . pullToSink $ runErrorT $ xmppStream to
modify (\s -> s {sFeatures = features, sStreamLang = Just lt, sFrom = from})
(lt, from, id, features) <- ErrorT . pullToSink $ runErrorT $ xmppStream to
modify (\s -> s { sFeatures = features
, sStreamLang = Just lt
, sStreamId = id
, sFrom = from
}
)
return ()
-- Creates a new connection source (of Events) using the raw source (of bytes)
@ -91,13 +96,17 @@ xmppRestartStream = do @@ -91,13 +96,17 @@ xmppRestartStream = do
-- Reads the (partial) stream:stream and the server features from the stream.
-- Also validates the stream element's attributes and throws an error if
-- appropriate.
xmppStream :: Maybe Jid -> StreamSink (LangTag, Maybe Text, ServerFeatures)
-- TODO: from.
xmppStream :: Maybe Jid -> StreamSink ( LangTag
, Maybe Text
, Maybe Text
, ServerFeatures)
xmppStream expectedTo = do
(langTag, from) <- xmppStreamHeader
(langTag, from, id) <- xmppStreamHeader
features <- xmppStreamFeatures
return (langTag, from, features)
return (langTag, from, id, features)
where
xmppStreamHeader :: StreamSink (LangTag, Maybe Text)
xmppStreamHeader :: StreamSink (LangTag, Maybe Text, Maybe Text)
xmppStreamHeader = do
lift throwOutJunk
-- Get the stream:stream element (or whatever it is) from the server,
@ -109,10 +118,9 @@ xmppStream expectedTo = do @@ -109,10 +118,9 @@ xmppStream expectedTo = do
unless (prefix == Just "stream") $ throwError $ StreamInvalidStreamPrefix prefix
unless (isNothing to || (fromText $ fromJust to) == expectedTo) $ throwError $ StreamWrongTo to
unless (ver == Just "1.0") $ throwError $ StreamWrongVersion ver
-- TODO: Verify id and from.
let lang_ = maybe Nothing langTag lang
when (isNothing lang_) $ throwError $ StreamWrongLangTag lang
return (fromJust lang_, from)
return (fromJust lang_, from, id)
xmppStreamFeatures :: StreamSink ServerFeatures
xmppStreamFeatures = do
e <- lift $ elements =$ CL.head

2
source/Network/Xmpp/Types.hs

@ -749,6 +749,8 @@ data XmppConnection = XmppConnection @@ -749,6 +749,8 @@ data XmppConnection = XmppConnection
, sStreamLang :: Maybe LangTag -- Will be a `Just' value
-- once connected to the
-- server.
, sStreamId :: Maybe Text -- Stream ID as specified by the
-- server.
, sToJid :: Maybe Jid -- JID to include in the stream
-- element's `to' attribute when
-- the connection is secured. See

Loading…
Cancel
Save