Add conection state to connection object, rename some types

rename XMPPConState to XmppConnection
rename xmppZeroCon to xmppNoConnection
add XmppConnectionState
remove sHaveTLS from XmppConnection
add (sConnectionState :: XmppConnectionState) to XmppConnection

src/Network/XMPP/Concurrent/Monad.hs

@@ -152,8 +152,7 @@ waitForPresence f = do
 -- Reader and writer workers will be temporarily stopped
 -- and resumed with the new session details once the action returns.
 -- The Action will run in the calling thread/
--- NB: This will /not/ catch any exceptions. If you action dies, deadlocks
+-- Any uncaught exceptions will be interpreted as connection failure
--- or otherwisely exits abnormaly the XMPP session will be dead.
 withConnection :: XMPPConMonad a -> XMPP a
 withConnection a = do
   readerId <- asks readerThread

src/Network/XMPP/Concurrent/Threads.hs

@@ -40,7 +40,7 @@ handleInterrupts ts =
 readWorker :: TChan (Either MessageError Message)
            -> TChan (Either PresenceError Presence)
            -> TVar IQHandlers
-           -> TMVar XMPPConState
+           -> TMVar XmppConnection
            -> IO ()
 readWorker messageC presenceC handlers stateRef =
     Ex.mask_ . forever $ do
@@ -131,7 +131,7 @@ startThreads
         , TChan Stanza
         , IO ()
         , TMVar (BS.ByteString -> IO ())
-        , TMVar XMPPConState
+        , TMVar XmppConnection
         , ThreadId
         , TVar EventHandlers
         )
@@ -143,7 +143,7 @@ startThreads = do
   outC <- newTChanIO
   handlers <- newTVarIO ( Map.empty, Map.empty)
   eh <- newTVarIO  zeroEventHandlers
-  conS <- newTMVarIO xmppZeroConState
+  conS <- newTMVarIO xmppNoConnection
   lw <- forkIO $ writeWorker outC writeLock
   cp <- forkIO $ connPersist writeLock
   rd <- forkIO $ readWorker messageC presenceC handlers conS

src/Network/XMPP/Concurrent/Types.hs

@@ -50,7 +50,7 @@ data Session = Session { messagesRef :: IORef (Maybe ( TChan (Either
                        , writeRef :: TMVar (BS.ByteString -> IO () )
                        , readerThread :: ThreadId
                        , idGenerator :: IO StanzaId
-                       , conStateRef :: TMVar XMPPConState
+                       , conStateRef :: TMVar XmppConnection
                        , eventHandlers :: TVar EventHandlers
                        , stopThreads :: IO ()
                        }

src/Network/XMPP/Monad.hs

@@ -8,7 +8,6 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class
 --import Control.Monad.Trans.Resource
-import           Control.Concurrent
 import qualified Control.Exception as Ex
 import           Control.Monad.State.Strict
 
@@ -69,38 +68,36 @@ pullStanza = do
 
 xmppFromHandle :: Handle
                -> Text
-               -> Text
-               -> Maybe Text
                -> XMPPConMonad a
-               -> IO (a, XMPPConState)
+               -> IO (a, XmppConnection)
-xmppFromHandle handle hostname username res f = do
+xmppFromHandle handle hostname f = do
   liftIO $ hSetBuffering handle NoBuffering
   let raw = sourceHandle handle
   let src = raw $= XP.parseBytes def
-  let st = XMPPConState
+  let st = XmppConnection
              src
              (raw)
              (BS.hPut handle)
              (Just handle)
              (SF Nothing [] [])
-             False
+             XmppConnectionPlain
              (Just hostname)
-             (Just username)
+             Nothing
-             res
+             Nothing
              (hClose handle)
   runStateT f st
 
 zeroSource :: Source IO output
-zeroSource = liftIO . forever $ threadDelay 10000000
+zeroSource = liftIO . Ex.throwIO $ XmppNoConnection
 
-xmppZeroConState :: XMPPConState
+xmppNoConnection :: XmppConnection
-xmppZeroConState = XMPPConState
+xmppNoConnection = XmppConnection
                { sConSrc    = zeroSource
                , sRawSrc    = zeroSource
-               , sConPushBS = (\_ -> return ())
+               , sConPushBS = \_ -> Ex.throwIO $ XmppNoConnection
                , sConHandle = Nothing
                , sFeatures  = SF Nothing [] []
-               , sHaveTLS   = False
+               , sConnectionState = XmppConnectionClosed
                , sHostname  = Nothing
                , sUsername  = Nothing
                , sResource  = Nothing
@@ -116,29 +113,32 @@ xmppRawConnect host hostname = do
       return con
   let raw = sourceHandle con
   src <- liftIO . bufferSource $ raw $= XP.parseBytes def
-  let st = XMPPConState
+  let st = XmppConnection
              src
              (raw)
              (BS.hPut con)
              (Just con)
              (SF Nothing [] [])
-             False
+             XmppConnectionPlain
              (Just hostname)
              uname
              Nothing
              (hClose con)
   put st
 
-xmppNewSession :: XMPPConMonad a -> IO (a, XMPPConState)
+xmppNewSession :: XMPPConMonad a -> IO (a, XmppConnection)
 xmppNewSession action = do
-  runStateT action xmppZeroConState
+  runStateT action xmppNoConnection
 
 xmppKillConnection :: XMPPConMonad ()
 xmppKillConnection = do
     cc <- gets sCloseConnection
     void . liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ()))
-    put xmppZeroConState
+    put xmppNoConnection
 
+xmppSendIQ' :: StanzaId -> Maybe JID -> IQRequestType
+            -> Maybe LangTag -> Element
+            -> XMPPConMonad (Either IQError IQResult)
 xmppSendIQ' iqID to tp lang body = do
     push . IQRequestS $ IQRequest iqID Nothing to lang tp body
     res <- pullPickle $ xpEither xpIQError xpIQResult

src/Network/XMPP/TLS.hs

@@ -70,6 +70,6 @@ startTLS params = Ex.handle (return . Left . TLSError)
                     , sCloseConnection = TLS.bye ctx >> sCloseConnection x
                     })
       either (lift . Ex.throwIO) return =<< lift xmppRestartStream
-      modify (\s -> s{sHaveTLS = True})
+      modify (\s -> s{sConnectionState = XmppConnectionSecured})
       return ()
 

src/Network/XMPP/Types.hs

@@ -38,7 +38,9 @@ module Network.XMPP.Types
     , StreamError(..)
     , Version(..)
     , XMPPConMonad
-    , XMPPConState(..)
+    , XmppConnection(..)
+    , XmppConnectionState(..)
+    , XmppNoConnection(..)
     , XMPPT(..)
     , XmppStreamError(..)
     , parseLangTag
@@ -704,13 +706,21 @@ data ServerFeatures = SF
   , other :: [Element]
   } deriving Show
 
-data XMPPConState = XMPPConState
+data XmppConnectionState = XmppConnectionClosed  -- ^ No connection at
+                                                 -- this point
+                         | XmppConnectionPlain   -- ^ Connection
+                                                 -- established, but
+                                                 -- not secured
+                         | XmppConnectionSecured -- ^ Connection
+                                                 -- established and
+                                                 -- secured via TLS
+data XmppConnection = XmppConnection
                { sConSrc          :: Source IO Event
                , sRawSrc          :: Source IO BS.ByteString
                , sConPushBS       :: BS.ByteString -> IO ()
                , sConHandle       :: Maybe Handle
                , sFeatures        :: ServerFeatures
-               , sHaveTLS   :: Bool
+               , sConnectionState :: XmppConnectionState
                , sHostname        :: Maybe Text
                , sUsername        :: Maybe Text
                , sResource        :: Maybe Text
@@ -723,14 +733,14 @@ data XMPPConState = XMPPConState
 -- work with Pontarius. Pontarius clients needs to operate in this
 -- context.
 
-newtype XMPPT m a = XMPPT { runXMPPT :: StateT XMPPConState m a } deriving (Monad, MonadIO)
+newtype XMPPT m a = XMPPT { runXMPPT :: StateT XmppConnection m a } deriving (Monad, MonadIO)
 
-type XMPPConMonad a = StateT XMPPConState IO a
+type XMPPConMonad a = StateT XmppConnection IO a
 
 -- Make XMPPT derive the Monad and MonadIO instances.
 
-deriving instance (Monad m, MonadIO m) => MonadState (XMPPConState) (XMPPT m)
+deriving instance (Monad m, MonadIO m) => MonadState (XmppConnection) (XMPPT m)
 
+data XmppNoConnection = XmppNoConnection deriving (Show, Typeable)
+instance Exception XmppNoConnection
 
--- We need a channel because multiple threads needs to append events,
--- and we need to wait for events when there are none.