diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index 5b55c3d..f9b9ef9 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -107,7 +107,13 @@ auth :: [SaslHandler] auth mechanisms resource con = runErrorT $ do ErrorT $ xmppSasl mechanisms con jid <- ErrorT $ xmppBind resource con - _ <- lift $ startSession con + ErrorT $ flip withStream con $ do + s <- get + case establishSession $ streamConfiguration s of + False -> return $ Right Nothing + True -> do + _ <- lift $ startSession con + return $ Right Nothing return Nothing -- Produces a `bind' element, optionally wrapping a resource. diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 88871c8..2d76173 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -1036,6 +1036,10 @@ data StreamConfiguration = , socketDetails :: Maybe (Socket, SockAddr) -- | DNS resolver configuration , resolvConf :: ResolvConf + -- | Whether or not to perform the legacy + -- session bind as defined in the (outdated) + -- RFC 3921 specification + , establishSession :: Bool } @@ -1044,6 +1048,7 @@ instance Default StreamConfiguration where , toJid = Nothing , socketDetails = Nothing , resolvConf = defaultResolvConf + , establishSession = False } data Hostname = Hostname Text deriving (Eq, Show)