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