Browse Source

lifted xmppConnect (connect), xmppStartTLS(startTLS) and xmppSASL(auth)

master
Philipp Balzarek 14 years ago
parent
commit
c17c62985b
  1. 1
      .gitignore
  2. 16
      src/Network/XMPP.hs
  3. 14
      src/Network/XMPP/Concurrent.hs
  4. 2
      src/Network/XMPP/Concurrent/Monad.hs
  5. 9
      src/Tests.hs

1
.gitignore vendored

@ -1,5 +1,6 @@ @@ -1,5 +1,6 @@
dist/
cabal-dev/
wiki/
*.o
*.hi
*~

16
src/Network/XMPP.hs

@ -42,11 +42,15 @@ module Network.XMPP @@ -42,11 +42,15 @@ module Network.XMPP
, module Network.XMPP.Message
, xmppConnect
, xmppNewSession
, connect
, startTLS
, auth
) where
import Data.Text as Text
import Network
import qualified Network.TLS as TLS
import Network.XMPP.Bind
import Network.XMPP.Concurrent
import Network.XMPP.Message
@ -62,4 +66,14 @@ xmppConnect :: HostName -> Text -> XMPPConMonad (Either StreamError ()) @@ -62,4 +66,14 @@ xmppConnect :: HostName -> Text -> XMPPConMonad (Either StreamError ())
xmppConnect address hostname = xmppRawConnect address hostname >> xmppStartStream
xmppNewSession :: XMPPThread a -> IO (a, XMPPConState)
xmppNewSession = withNewSession . runThreaded
xmppNewSession = withNewSession . runThreaded
startTLS :: TLS.TLSParams -> XMPPThread (Either XMPPTLSError ())
startTLS = withConnection . xmppStartTLS
auth :: Text.Text -> Text.Text -> XMPPThread (Either String Text.Text)
auth username passwd = withConnection $ xmppSASL username passwd
connect :: HostName -> Text -> XMPPThread (Either StreamError ())
connect address hostname = withConnection $ xmppConnect address hostname

14
src/Network/XMPP/Concurrent.hs

@ -5,14 +5,8 @@ module Network.XMPP.Concurrent @@ -5,14 +5,8 @@ module Network.XMPP.Concurrent
, module Network.XMPP.Concurrent.IQ
) where
import Network.XMPP.Concurrent.Types
import Network.XMPP.Concurrent.Monad
import Network.XMPP.Concurrent.Threads
import Network.XMPP.Concurrent.IQ
import Network.XMPP.Concurrent.Types
import Network.XMPP.Concurrent.Monad
import Network.XMPP.Concurrent.Threads
import Network.XMPP.Concurrent.IQ

2
src/Network/XMPP/Concurrent/Monad.hs

@ -16,6 +16,7 @@ import Data.Text(Text) @@ -16,6 +16,7 @@ import Data.Text(Text)
import Network.XMPP.Concurrent.Types
import Network.XMPP.Monad
-- | Register a new IQ listener. IQ requests matching the type and namespace will
-- be put in the channel.
listenIQChan :: IQRequestType -- ^ type of IQs to receive (Get / Set)
@ -196,3 +197,4 @@ endSession = do -- TODO: This has to be idempotent (is it?) @@ -196,3 +197,4 @@ endSession = do -- TODO: This has to be idempotent (is it?)
-- | Close the connection to the server
closeConnection :: XMPPThread ()
closeConnection = withConnection xmppKillConnection

9
src/Tests.hs

@ -86,11 +86,10 @@ runMain debug number = do @@ -86,11 +86,10 @@ runMain debug number = do
debug . (("Thread " ++ show number ++ ":") ++)
xmppNewSession $ do
debug' "running"
withConnection $ do
xmppConnect "localhost" "species64739.dyndns.org"
xmppStartTLS exampleParams
saslResponse <- xmppSASL (fromJust $ localpart we) "pwd"
case saslResponse of
connect "localhost" "species64739.dyndns.org"
startTLS exampleParams
saslResponse <- auth (fromJust $ localpart we) "pwd"
case saslResponse of
Right _ -> return ()
Left e -> error e
xmppThreadedBind (resourcepart we)

Loading…
Cancel
Save