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

.gitignore

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

src/Network/XMPP.hs

@@ -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 ())
 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

src/Network/XMPP/Concurrent.hs

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

src/Network/XMPP/Concurrent/Monad.hs

@@ -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?)
 -- | Close the connection to the server
 closeConnection :: XMPPThread ()
 closeConnection = withConnection xmppKillConnection
+

src/Tests.hs

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