Browse Source

Add `SessionConfiguration' object

master
Jon Kristensen 13 years ago
parent
commit
500b8c1063
  1. 1
      source/Network/Xmpp.hs
  2. 15
      source/Network/Xmpp/Concurrent.hs
  3. 1
      source/Network/Xmpp/Concurrent/Types.hs
  4. 11
      source/Network/Xmpp/Types.hs

1
source/Network/Xmpp.hs

@ -28,6 +28,7 @@ module Network.Xmpp @@ -28,6 +28,7 @@ module Network.Xmpp
Session
, session
, StreamConfiguration(..)
, SessionConfiguration(..)
-- TODO: Close session, etc.
-- ** Authentication handlers
-- | The use of 'scramSha1' is /recommended/, but 'digestMd5' might be

15
source/Network/Xmpp/Concurrent.hs

@ -88,8 +88,8 @@ toChans stanzaC outC iqHands sta = atomically $ do @@ -88,8 +88,8 @@ toChans stanzaC outC iqHands sta = atomically $ do
iqID (Right iq') = iqResultID iq'
-- | Creates and initializes a new Xmpp context.
newSession :: TMVar Stream -> IO (Either XmppFailure Session)
newSession stream = runErrorT $ do
newSession :: TMVar Stream -> SessionConfiguration -> IO (Either XmppFailure Session)
newSession stream config = runErrorT $ do
outC <- lift newTChanIO
stanzaChan <- lift newTChanIO
iqHandlers <- lift $ newTVarIO (Map.empty, Map.empty)
@ -111,6 +111,7 @@ newSession stream = runErrorT $ do @@ -111,6 +111,7 @@ newSession stream = runErrorT $ do
, streamRef = streamState
, eventHandlers = eh
, stopThreads = kill >> killThread writer
, conf = config
}
-- Worker to write stanzas to the stream concurrently.
@ -133,7 +134,7 @@ writeWorker stCh writeR = forever $ do @@ -133,7 +134,7 @@ writeWorker stCh writeR = forever $ do
-- parameters is a 'Just' value, @session@ will attempt to authenticate and
-- acquire an XMPP resource.
session :: HostName -- ^ The hostname / realm
-> StreamConfiguration -- ^ configuration details
-> SessionConfiguration -- ^ configuration details
-> Maybe TLS.TLSParams -- ^ TLS settings, if securing the
-- connection to the server is
-- desired
@ -142,12 +143,12 @@ session :: HostName -- ^ The hostname / realm @@ -142,12 +143,12 @@ session :: HostName -- ^ The hostname / realm
-- the server decide)
-> IO (Either XmppFailure (Session, Maybe AuthFailure))
session realm config mbTls mbSasl = runErrorT $ do
con <- ErrorT $ openStream realm config
stream <- ErrorT $ openStream realm (sessionStreamConfiguration config)
case mbTls of
Nothing -> return ()
Just tls -> ErrorT $ startTls tls con
Just tls -> ErrorT $ startTls tls stream
aut <- case mbSasl of
Nothing -> return Nothing
Just (handlers, resource) -> ErrorT $ auth handlers resource con
ses <- ErrorT $ newSession con
Just (handlers, resource) -> ErrorT $ auth handlers resource stream
ses <- ErrorT $ newSession stream config
return (ses, aut)

1
source/Network/Xmpp/Concurrent/Types.hs

@ -47,6 +47,7 @@ data Session = Session @@ -47,6 +47,7 @@ data Session = Session
, streamRef :: TMVar (TMVar Stream)
, eventHandlers :: TVar EventHandlers
, stopThreads :: IO ()
, conf :: SessionConfiguration
}
-- | IQHandlers holds the registered channels for incomming IQ requests and

11
source/Network/Xmpp/Types.hs

@ -46,6 +46,7 @@ module Network.Xmpp.Types @@ -46,6 +46,7 @@ module Network.Xmpp.Types
, InvalidXmppXml(..)
, Hostname(..)
, hostname
, SessionConfiguration(..)
)
where
@ -1020,6 +1021,7 @@ data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable) @@ -1020,6 +1021,7 @@ data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
instance Exception InvalidXmppXml
-- | Configuration settings related to the stream.
data StreamConfiguration =
StreamConfiguration { -- | Default language when no language tag is set
preferredLang :: !(Maybe LangTag)
@ -1086,3 +1088,12 @@ hostnameP = do @@ -1086,3 +1088,12 @@ hostnameP = do
if (Text.length label) + 1 + (Text.length r) > 255
then fail "Hostname too long."
else return $ Text.concat [label, Text.pack ".", r]
-- | Configuration for the @Session@ object.
data SessionConfiguration = SessionConfiguration
{ -- | Configuration for the @Stream@ object.
sessionStreamConfiguration :: StreamConfiguration
}
instance Default SessionConfiguration where
def = SessionConfiguration { sessionStreamConfiguration = def }

Loading…
Cancel
Save