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

1
source/Network/Xmpp/Internal.hs

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

29
source/Network/Xmpp/Stream.hs

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

29
source/Network/Xmpp/Types.hs

@ -35,6 +35,7 @@ module Network.Xmpp.Types @@ -35,6 +35,7 @@ module Network.Xmpp.Types
, Stream(..)
, StreamState(..)
, StreamErrorInfo(..)
, StreamConfiguration(..)
, langTag
, Jid(..)
, isBare
@ -77,6 +78,8 @@ import Data.String (IsString(..)) @@ -77,6 +78,8 @@ import Data.String (IsString(..))
import qualified Text.NamePrep as SP
import qualified Text.StringPrep as SP
import Data.Default
-- |
-- Wraps a string of random characters that, when using an appropriate
-- @IdGenerator@, is guaranteed to be unique for the Xmpp session.
@ -809,14 +812,8 @@ data Stream = Stream @@ -809,14 +812,8 @@ data Stream = Stream
, streamLang :: !(Maybe LangTag)
-- | Our JID as assigned by the server
, streamJid :: !(Maybe Jid)
-- TODO: Move the below fields to a configuration record
, preferredLang :: !(Maybe LangTag) -- ^ Default language when no explicit
-- 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.
-- | Configuration settings for the stream
, streamConfiguration :: StreamConfiguration
}
---------------
@ -1010,3 +1007,19 @@ instance Exception StreamEnd @@ -1010,3 +1007,19 @@ instance Exception StreamEnd
data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
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