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

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

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

11
source/Network/Xmpp/Types.hs

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