Browse Source

Add `StreamSettings' record with `Default' instance

master
Jon Kristensen 13 years ago
parent
commit
4259206466
  1. 3
      source/Network/Xmpp/Concurrent.hs
  2. 1
      source/Network/Xmpp/Internal.hs
  3. 29
      source/Network/Xmpp/Stream.hs
  4. 29
      source/Network/Xmpp/Types.hs

3
source/Network/Xmpp/Concurrent.hs

@ -45,6 +45,7 @@ import Network.Xmpp.Stream
import Network.Xmpp.Utilities import Network.Xmpp.Utilities
import Control.Monad.Error import Control.Monad.Error
import Data.Default
toChans :: TChan Stanza toChans :: TChan Stanza
-> TVar IQHandlers -> TVar IQHandlers
@ -139,7 +140,7 @@ session :: HostName -- ^ Host to connect to
-- the server decide) -- the server decide)
-> IO (Either XmppFailure (Session, Maybe AuthFailure)) -> IO (Either XmppFailure (Session, Maybe AuthFailure))
session hostname realm port tls sasl = runErrorT $ do session hostname realm port tls sasl = runErrorT $ do
con <- ErrorT $ openStream hostname port realm con <- ErrorT $ openStream hostname port realm def
if isJust tls if isJust tls
then ErrorT $ startTls (fromJust tls) con then ErrorT $ startTls (fromJust tls) con
else return () else return ()

1
source/Network/Xmpp/Internal.hs

@ -18,6 +18,7 @@
module Network.Xmpp.Internal module Network.Xmpp.Internal
( Stream(..) ( Stream(..)
, StreamConfiguration(..)
, StreamState(..) , StreamState(..)
, StreamHandle(..) , StreamHandle(..)
, StreamFeatures(..) , StreamFeatures(..)

29
source/Network/Xmpp/Stream.hs

@ -104,10 +104,11 @@ startStream = runErrorT $ do
stream <- liftIO $ mkStream state stream <- liftIO $ mkStream state
-- Set the `from' (which is also the expected to) attribute depending on the -- Set the `from' (which is also the expected to) attribute depending on the
-- state of the stream. -- state of the stream.
let expectedTo = case streamState state of let expectedTo = case (streamState state, toJid $ streamConfiguration state) of
Plain -> if includeJidWhenPlain state (Plain, (Just (jid, True))) -> Just jid
then toJid state else Nothing (Secured, (Just (jid, _))) -> Just jid
Secured -> toJid state (Plain, Nothing) -> Nothing
(Secured, Nothing) -> Nothing
case streamHostname state of case streamHostname state of
Nothing -> throwError XmppOtherFailure -- TODO: When does this happen? Nothing -> throwError XmppOtherFailure -- TODO: When does this happen?
Just hostname -> lift $ do Just hostname -> lift $ do
@ -117,7 +118,7 @@ startStream = runErrorT $ do
, expectedTo , expectedTo
, Just (Jid Nothing hostname Nothing) , Just (Jid Nothing hostname Nothing)
, Nothing , Nothing
, preferredLang state , preferredLang $ streamConfiguration state
) )
response <- ErrorT $ runEventsSink $ runErrorT $ streamS expectedTo response <- ErrorT $ runEventsSink $ runErrorT $ streamS expectedTo
case response of case response of
@ -243,9 +244,9 @@ streamS expectedTo = do
-- | Connects to the XMPP server and opens the XMPP stream against the given -- | Connects to the XMPP server and opens the XMPP stream against the given
-- host name, port, and realm. -- host name, port, and realm.
openStream :: HostName -> PortID -> Text -> IO (Either XmppFailure (TMVar Stream)) openStream :: HostName -> PortID -> Text -> StreamConfiguration -> IO (Either XmppFailure (TMVar Stream))
openStream address port hostname = do openStream address port hostname config = do
stream <- connectTcp address port hostname stream <- connectTcp address port hostname config
case stream of case stream of
Right stream' -> do Right stream' -> do
result <- withStream startStream stream' result <- withStream startStream stream'
@ -389,16 +390,14 @@ xmppNoStream = Stream {
, streamId = Nothing , streamId = Nothing
, streamLang = Nothing , streamLang = Nothing
, streamJid = Nothing , streamJid = Nothing
, preferredLang = Nothing , streamConfiguration = StreamConfiguration Nothing Nothing
, toJid = Nothing
, includeJidWhenPlain = False
} }
where where
zeroSource :: Source IO output zeroSource :: Source IO output
zeroSource = liftIO . ExL.throwIO $ XmppOtherFailure zeroSource = liftIO . ExL.throwIO $ XmppOtherFailure
connectTcp :: HostName -> PortID -> Text -> IO (Either XmppFailure (TMVar Stream)) connectTcp :: HostName -> PortID -> Text -> StreamConfiguration -> IO (Either XmppFailure (TMVar Stream))
connectTcp host port hostname = do connectTcp host port hostname config = do
let PortNumber portNumber = port let PortNumber portNumber = port
debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++
(show portNumber) ++ " through the realm " ++ (T.unpack hostname) ++ "." (show portNumber) ++ " through the realm " ++ (T.unpack hostname) ++ "."
@ -434,9 +433,7 @@ connectTcp host port hostname = do
, streamId = Nothing , streamId = Nothing
, streamLang = Nothing , streamLang = Nothing
, streamJid = Nothing , streamJid = Nothing
, preferredLang = Nothing -- TODO: Allow user to set , streamConfiguration = config
, toJid = Nothing -- TODO: Allow user to set
, includeJidWhenPlain = False -- TODO: Allow user to set
} }
stream' <- mkStream stream stream' <- mkStream stream
return $ Right stream' return $ Right stream'

29
source/Network/Xmpp/Types.hs

@ -35,6 +35,7 @@ module Network.Xmpp.Types
, Stream(..) , Stream(..)
, StreamState(..) , StreamState(..)
, StreamErrorInfo(..) , StreamErrorInfo(..)
, StreamConfiguration(..)
, langTag , langTag
, Jid(..) , Jid(..)
, isBare , isBare
@ -77,6 +78,8 @@ import Data.String (IsString(..))
import qualified Text.NamePrep as SP import qualified Text.NamePrep as SP
import qualified Text.StringPrep as SP import qualified Text.StringPrep as SP
import Data.Default
-- | -- |
-- Wraps a string of random characters that, when using an appropriate -- Wraps a string of random characters that, when using an appropriate
-- @IdGenerator@, is guaranteed to be unique for the Xmpp session. -- @IdGenerator@, is guaranteed to be unique for the Xmpp session.
@ -809,14 +812,8 @@ data Stream = Stream
, streamLang :: !(Maybe LangTag) , streamLang :: !(Maybe LangTag)
-- | Our JID as assigned by the server -- | Our JID as assigned by the server
, streamJid :: !(Maybe Jid) , streamJid :: !(Maybe Jid)
-- TODO: Move the below fields to a configuration record -- | Configuration settings for the stream
, preferredLang :: !(Maybe LangTag) -- ^ Default language when no explicit , streamConfiguration :: StreamConfiguration
-- language tag is set
, toJid :: !(Maybe Jid) -- ^ JID to include in the stream element's `to'
-- attribute when the connection is secured. See
-- also below.
, includeJidWhenPlain :: !Bool -- ^ Whether or not to also include the Jid when
-- the connection is plain.
} }
--------------- ---------------
@ -1010,3 +1007,19 @@ instance Exception StreamEnd
data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable) data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
instance Exception InvalidXmppXml instance Exception InvalidXmppXml
data StreamConfiguration =
StreamConfiguration { -- | Default language when no language tag is set
preferredLang :: !(Maybe LangTag)
-- | JID to include in the stream element's `to'
-- attribute when the connection is secured; if the
-- boolean is set to 'True', then the JID is also
-- included when the 'ConnectionState' is 'Plain'
, toJid :: !(Maybe (Jid, Bool))
}
instance Default StreamConfiguration where
def = StreamConfiguration { preferredLang = Nothing
, toJid = Nothing
}

Loading…
Cancel
Save