Make the stream failure types more intuitive and clear

StreamError has been renamed to StreamFailure, as it's neither an
error or an exception, and since the term "stream error" is ambigous
(it can also refer to the stream error element on the XMPP stream).
Furthermore, XmppTLSError has been renamed to TLSFailure.

The data types related to the above mentioned failures are now
exported.

We do no longer clutter the API with detailed error conditions such as
StreamNotStreamElement. These kinds of conditions are such rare
occurances, and details about them are better suited in the logging
system (to be implemented soon).

Stream failures can occur either when a `stream:error' first-level
XML element is encountered, or if something unexpected happens in the
stream. Currently, `StreamErrorFailure', `StreamEndFailure', and
`StreamOtherFailure' are defined for these purposes, but additional
exceptions can be added if that would be helpful for the developers.

TLSFailure is moved to Types.hs and is now exported.

Also temporarily removed findStreamErrors.

source/Network/Xmpp.hs

@@ -2,11 +2,11 @@
 -- Module:      $Header$
 -- Description: RFC 6120 (XMPP: Core).
 -- License:     Apache License 2.0
---
+-- 
 -- Maintainer:  info@jonkri.com
 -- Stability:   unstable
 -- Portability: portable
---
+-- 
 -- The Extensible Messaging and Presence Protocol (XMPP) is an open technology
 -- for near-real-time communication, which powers a wide range of applications
 -- including instant messaging, presence, multi-party chat, voice and video
@@ -15,14 +15,10 @@
 -- asynchronous, end-to-end exchange of structured data by means of direct,
 -- persistent XML streams among a distributed network of globally addressable,
 -- presence-aware clients and servers.
---
+-- 
 -- Pontarius is an XMPP client library, implementing the core capabilities of
 -- XMPP (RFC 6120): setup and teardown of XML streams, channel encryption,
 -- authentication, error handling, and communication primitives for messaging.
---
--- Note that we are not recommending anyone to use Pontarius XMPP at this time
--- as it's still in an experimental stage and will have its API and data types
--- modified frequently.
 
 {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-}
 
@@ -149,6 +145,10 @@ module Network.Xmpp
   , LangTag(..)
   , exampleParams
   , PortID(..)
+  , StreamFailure(..)
+  , StreamErrorInfo(..)
+  , StreamErrorCondition(..)
+  , TLSFailure(..)
 
   ) where
 

source/Network/Xmpp/Bind.hs

@@ -34,8 +34,8 @@ xmppBind rsrc c = do
     jid <- case () of () | Right IQResult{iqResultPayload = Just b} <- answer
                          , Right jid <- unpickleElem xpJid b
                            -> return jid
-                         | otherwise -> throw $ StreamXMLError
-                                               ("Bind couldn't unpickle JID from " ++ show answer)
+                         | otherwise -> throw StreamOtherFailure
+                                               -- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer)
     withConnection (modify $ \s -> s{sJid = Just jid}) c
     return jid
   where

source/Network/Xmpp/Concurrent/Monad.hs

@@ -71,7 +71,7 @@ modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f
       writeTVar var (f x)
 
 -- | Sets the handler to be executed when the server connection is closed.
-setConnectionClosedHandler :: (StreamError -> Context -> IO ()) -> Context -> IO ()
+setConnectionClosedHandler :: (StreamFailure -> Context -> IO ()) -> Context -> IO ()
 setConnectionClosedHandler eh session = do
     modifyHandlers (\s -> s{connectionClosedHandler =
                                  \e -> eh e session}) session

source/Network/Xmpp/Concurrent/Threads.hs

@@ -23,7 +23,7 @@ import           GHC.IO (unsafeUnmask)
 -- Worker to read stanzas from the stream and concurrently distribute them to
 -- all listener threads.
 readWorker :: (Stanza -> IO ())
-           -> (StreamError -> IO ())
+           -> (StreamFailure -> IO ())
            -> TMVar Connection
            -> IO a
 readWorker onStanza onConnectionClosed stateRef =
@@ -43,7 +43,7 @@ readWorker onStanza onConnectionClosed stateRef =
                    [ Ex.Handler $ \(Interrupt t) -> do
                          void $ handleInterrupts [t]
                          return Nothing
-                   , Ex.Handler $ \(e :: StreamError) -> do
+                   , Ex.Handler $ \(e :: StreamFailure) -> do
                          onConnectionClosed e
                          return Nothing
                    ]
@@ -96,7 +96,7 @@ startThreadsWith stanzaHandler eh con = do
         _ <- forM threads killThread
         return ()
     -- Call the connection closed handlers.
-    noCon :: TVar EventHandlers -> StreamError -> IO ()
+    noCon :: TVar EventHandlers -> StreamFailure -> IO ()
     noCon h e = do
         hands <- atomically $ readTVar h
         _ <- forkIO $ connectionClosedHandler hands e

source/Network/Xmpp/Concurrent/Types.hs

@@ -15,7 +15,7 @@ import           Network.Xmpp.Types
 -- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is
 -- closed.
 data EventHandlers = EventHandlers
-    { connectionClosedHandler :: StreamError -> IO ()
+    { connectionClosedHandler :: StreamFailure -> IO ()
     }
 
 -- | Xmpp Context object

source/Network/Xmpp/Connection.hs

@@ -78,14 +78,14 @@ pullElement = do
     Ex.catches (do
         e <- runEventsSink (elements =$ await)
         case e of
-            Nothing -> liftIO $ Ex.throwIO StreamConnectionError
+            Nothing -> liftIO $ Ex.throwIO StreamOtherFailure
             Just r -> return r
         )
-        [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamStreamEnd)
-        , Ex.Handler (\(InvalidXmppXml s)
-                     -> liftIO . Ex.throwIO $ StreamXMLError s)
-        , Ex.Handler $ \(e :: InvalidEventStream)
-                     -> liftIO . Ex.throwIO $ StreamXMLError (show e)
+        [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamEndFailure)
+        , Ex.Handler (\(InvalidXmppXml s) -- Invalid XML `Event' encountered, or missing element close tag
+                     -> liftIO . Ex.throwIO $ StreamOtherFailure) -- TODO: Log: s
+        , Ex.Handler $ \(e :: InvalidEventStream) -- xml-conduit exception
+                     -> liftIO . Ex.throwIO $ StreamOtherFailure -- TODO: Log: (show e)
         ]
 
 -- Pulls an element and unpickles it.
@@ -93,7 +93,7 @@ pullUnpickle :: PU [Node] a -> StateT Connection_ IO a
 pullUnpickle p = do
     res <- unpickleElem p <$> pullElement
     case res of
-        Left e -> liftIO . Ex.throwIO $ StreamXMLError (show e)
+        Left e -> liftIO $ Ex.throwIO e
         Right r -> return r
 
 -- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream
@@ -102,7 +102,7 @@ pullStanza :: Connection -> IO Stanza
 pullStanza = withConnection' $ do
     res <- pullUnpickle xpStreamStanza
     case res of
-        Left e -> liftIO . Ex.throwIO $ StreamError e
+        Left e -> liftIO . Ex.throwIO $ StreamErrorFailure e
         Right r -> return r
 
 -- Performs the given IO operation, catches any errors and re-throws everything
@@ -121,7 +121,7 @@ xmppNoConnection :: Connection_
 xmppNoConnection = Connection_
                { cHand            = Hand { cSend = \_ -> return False
                                          , cRecv = \_ -> Ex.throwIO
-                                                         $ StreamConnectionError
+                                                         $ StreamOtherFailure
                                          , cFlush = return ()
                                          , cClose = return ()
                                          }
@@ -139,7 +139,7 @@ xmppNoConnection = Connection_
                }
   where
     zeroSource :: Source IO output
-    zeroSource = liftIO . Ex.throwIO $ StreamConnectionError
+    zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure
 
 -- Connects to the given hostname on port 5222 (TODO: Make this dynamic) and
 -- updates the XmppConMonad Connection_ state.
@@ -205,12 +205,12 @@ pushIQ' iqID to tp lang body con = do
         IQResultS r -> do
             unless
                 (iqID == iqResultID r) . liftIO . Ex.throwIO $
-                    StreamXMLError
-                ("In sendIQ' IDs don't match: " ++ show iqID ++ " /= " ++
-                    show (iqResultID r) ++ " .")
+                    StreamOtherFailure
+                -- TODO: Log: ("In sendIQ' IDs don't match: " ++ show iqID ++
+                -- " /= " ++ show (iqResultID r) ++ " .")
             return $ Right r
-        _ -> liftIO . Ex.throwIO . StreamXMLError $
-               "sendIQ': unexpected stanza type "
+        _ -> liftIO $ Ex.throwIO StreamOtherFailure
+             -- TODO: Log: "sendIQ': unexpected stanza type "
 
 -- | Send "</stream:stream>" and wait for the server to finish processing and to
 -- close the connection. Any remaining elements from the server and whether or
@@ -232,7 +232,7 @@ closeStreams = withConnection $ do
     collectElems es = do
         result <- Ex.try pullElement
         case result of
-            Left StreamStreamEnd -> return (es, True)
+            Left StreamEndFailure -> return (es, True)
             Left _ -> return (es, False)
             Right e -> collectElems (e:es)
 

source/Network/Xmpp/Errors.hs

@@ -12,38 +12,3 @@ import           Network.Xmpp.Types
 import           Network.Xmpp.Pickle
 
 
--- Finds unpickling problems. Not to be used for data validation
-findStreamErrors :: Element -> StreamError
-findStreamErrors (Element name attrs children)
-    | (nameLocalName name /= "stream")
-        = StreamNotStreamElement $ nameLocalName name
-    | (nameNamespace name /= Just "http://etherx.jabber.org/streams")
-        = StreamInvalidStreamNamespace  $ nameNamespace name
-    | otherwise = checkchildren (flattenAttrs attrs)
-  where
-    checkchildren children =
-        let to'  = lookup "to"      children
-            ver' = lookup "version" children
-            xl   = lookup xmlLang   children
-          in case () of () | Just (Nothing :: Maybe Jid) == (safeRead <$> to')
-                             -> StreamWrongTo to'
-                           | Nothing == ver'
-                             -> StreamWrongVersion Nothing
-                           | Just (Nothing :: Maybe LangTag) ==
-                             (safeRead <$> xl)
-                             -> StreamWrongLangTag xl
-                           | otherwise
-                             -> StreamUnknownError
-    safeRead x = case reads $ Text.unpack x of
-        [] -> Nothing
-        [(y,_),_] -> Just y
-
-flattenAttrs :: [(Name, [Content])] -> [(Name, Text.Text)]
-flattenAttrs attrs = map (\(name, content) ->
-                             ( name
-                             , Text.concat $ map uncontentify content)
-                             )
-                         attrs
-  where
-    uncontentify (ContentText t) = t
-    uncontentify _ = ""

source/Network/Xmpp/Marshal.hs

@@ -14,7 +14,7 @@ import Data.XML.Types
 import Network.Xmpp.Pickle
 import Network.Xmpp.Types
 
-xpStreamStanza :: PU [Node] (Either XmppStreamError Stanza)
+xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza)
 xpStreamStanza = xpEither xpStreamError xpStanza
 
 xpStanza :: PU [Node] Stanza
@@ -182,10 +182,10 @@ xpIQError = xpWrap
          (xp2Tuple xpStanzaError (xpOption xpElemVerbatim))
     )
 
-xpStreamError :: PU [Node] XmppStreamError
+xpStreamError :: PU [Node] StreamErrorInfo
 xpStreamError = xpWrap
-    (\((cond,() ,()), txt, el) -> XmppStreamError cond txt el)
-    (\(XmppStreamError cond txt el) ->((cond,() ,()), txt, el))
+    (\((cond,() ,()), txt, el) -> StreamErrorInfo cond txt el)
+    (\(StreamErrorInfo cond txt el) ->((cond,() ,()), txt, el))
     (xpElemNodes
          (Name
               "error"

source/Network/Xmpp/Sasl/Types.hs

@@ -13,7 +13,7 @@ data AuthError = AuthXmlError
                | AuthChallengeError
                | AuthServerAuthError -- ^ The server failed to authenticate
                                      -- itself
-               | AuthStreamError StreamError -- ^ Stream error on stream restart
+               | AuthStreamError StreamFailure -- ^ Stream error on stream restart
                -- TODO: Rename AuthConnectionError?
                | AuthConnectionError -- ^ Connection is closed
                | AuthError -- General instance used for the Error instance

source/Network/Xmpp/Session.hs

@@ -61,7 +61,7 @@ simpleConnect host port hostname username password resource = do
 
 
 -- | Connect to host with given address.
-connectTcp :: HostName -> PortID -> Text -> IO (Either StreamError Connection)
+connectTcp :: HostName -> PortID -> Text -> IO (Either StreamFailure Connection)
 connectTcp address port hostname = do
     con <- connectTcpRaw address port hostname
     result <- withConnection startStream con
@@ -73,20 +73,20 @@ connectTcp address port hostname = do
             return $ Left e
         Right () -> return $ Right con
   where
-        toError  (StreamNotStreamElement _name) =
-                XmppStreamError StreamInvalidXml Nothing Nothing
-        toError  (StreamInvalidStreamNamespace _ns) =
-                XmppStreamError StreamInvalidNamespace Nothing Nothing
-        toError  (StreamInvalidStreamPrefix _prefix) =
-                XmppStreamError StreamBadNamespacePrefix Nothing Nothing
-        toError  (StreamWrongVersion _ver) =
-                XmppStreamError StreamUnsupportedVersion Nothing Nothing
-        toError  (StreamWrongLangTag _) =
-                XmppStreamError StreamInvalidXml Nothing Nothing
-        toError  StreamUnknownError =
-                XmppStreamError StreamBadFormat Nothing Nothing
+        -- toError  (StreamNotStreamElement _name) =
+        --         XmppStreamFailure StreamInvalidXml Nothing Nothing
+        -- toError  (StreamInvalidStreamNamespace _ns) =
+        --         XmppStreamFailure StreamInvalidNamespace Nothing Nothing
+        -- toError  (StreamInvalidStreamPrefix _prefix) =
+        --         XmppStreamFailure StreamBadNamespacePrefix Nothing Nothing
+        -- toError  (StreamWrongVersion _ver) =
+        --         XmppStreamFailure StreamUnsupportedVersion Nothing Nothing
+        -- toError  (StreamWrongLangTag _) =
+        --         XmppStreamFailure StreamInvalidXml Nothing Nothing
+        -- toError  StreamUnknownError =
+        --         XmppStreamFailure StreamBadFormat Nothing Nothing
         -- TODO: Catch remaining xmppStartStream errors.
-        toError _ = XmppStreamError StreamBadFormat Nothing Nothing
+        toError _ = StreamErrorInfo StreamBadFormat Nothing Nothing
 
 sessionXML :: Element
 sessionXML = pickleElem

source/Network/Xmpp/Stream.hs

@@ -36,12 +36,12 @@ streamUnpickleElem :: PU [Node] a
                    -> StreamSink a
 streamUnpickleElem p x = do
     case unpickleElem p x of
-        Left l -> throwError $ StreamXMLError (show l)
+        Left l -> throwError $ StreamOtherFailure -- TODO: Log: StreamXMLError (show l)
         Right r -> return r
 
 -- This is the conduit sink that handles the stream XML events. We extend it
 -- with ErrorT capabilities.
-type StreamSink a = ErrorT StreamError (Pipe Event Event Void () IO) a
+type StreamSink a = ErrorT StreamFailure (Pipe Event Event Void () IO) a
 
 -- Discards all events before the first EventBeginElement.
 throwOutJunk :: Monad m => Sink Event m ()
@@ -59,10 +59,10 @@ openElementFromEvents = do
     hd <- lift CL.head
     case hd of
         Just (EventBeginElement name attrs) -> return $ Element name attrs []
-        _ -> throwError $ StreamConnectionError
+        _ -> throwError $ StreamOtherFailure
 
 -- Sends the initial stream:stream element and pulls the server features.
-startStream :: StateT Connection_ IO (Either StreamError ())
+startStream :: StateT Connection_ IO (Either StreamFailure ())
 startStream = runErrorT $ do
     state <- get
     -- Set the `to' attribute depending on the state of the connection.
@@ -71,7 +71,7 @@ startStream = runErrorT $ do
                                         then sJid state else Nothing
                  ConnectionSecured -> sJid state
     case sHostname state of
-        Nothing -> throwError StreamConnectionError
+        Nothing -> throwError StreamOtherFailure
         Just hostname -> lift $ do
             pushXmlDecl
             pushOpenElement $
@@ -92,7 +92,7 @@ startStream = runErrorT $ do
 
 -- Sets a new Event source using the raw source (of bytes)
 -- and calls xmppStartStream.
-restartStream :: StateT Connection_ IO (Either StreamError ())
+restartStream :: StateT Connection_ IO (Either StreamFailure ())
 restartStream = do
     raw <- gets (cRecv . cHand)
     let newSource = DCI.ResumableSource (loopRead raw $= XP.parseBytes def)
@@ -126,19 +126,19 @@ streamS expectedTo = do
         -- and validate what we get.
         el <- openElementFromEvents
         case unpickleElem xpStream el of
-            Left _  -> throwError $ findStreamErrors el
+            Left _  -> throwError StreamOtherFailure -- TODO: findStreamErrors el
             Right r -> validateData r
 
-    validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing
+    validateData (_, _, _, _, Nothing) = throwError StreamOtherFailure -- StreamWrongLangTag Nothing
     validateData (ver, from, to, i, Just lang)
-      | ver /= "1.0" = throwError $ StreamWrongVersion (Just ver)
-      | isJust to && to /= expectedTo = throwError $ StreamWrongTo (Text.pack . show <$> to)
+      | ver /= "1.0" = throwError StreamOtherFailure -- StreamWrongVersion (Just ver)
+      | isJust to && to /= expectedTo = throwError StreamOtherFailure -- StreamWrongTo (Text.pack . show <$> to)
       | otherwise = return (from, to, i, lang)
     xmppStreamFeatures :: StreamSink ServerFeatures
     xmppStreamFeatures = do
         e <- lift $ elements =$ CL.head
         case e of
-            Nothing -> liftIO $ Ex.throwIO StreamConnectionError
+            Nothing -> liftIO $ Ex.throwIO StreamOtherFailure
             Just r -> streamUnpickleElem xpStreamFeatures r
 
 

source/Network/Xmpp/TLS.hs

@@ -72,21 +72,9 @@ exampleParams = TLS.defaultParamsClient
           return TLS.CertificateUsageAccept
     }
 
--- | Error conditions that may arise during TLS negotiation.
-data XmppTLSError = TLSError TLSError
-                  | TLSNoServerSupport
-                  | TLSNoConnection
-                  | TLSConnectionSecured -- ^ Connection already secured
-                  | TLSStreamError StreamError
-                  | XmppTLSError -- General instance used for the Error instance
-                    deriving (Show, Eq, Typeable)
-
-instance Error XmppTLSError where
-  noMsg = XmppTLSError
-
 -- Pushes "<starttls/>, waits for "<proceed/>", performs the TLS handshake, and
--- restarts the stream. May throw errors.
-startTLS :: TLS.TLSParams -> Connection -> IO (Either XmppTLSError ())
+-- restarts the stream.
+startTLS :: TLS.TLSParams -> Connection -> IO (Either TLSFailure ())
 startTLS params con = Ex.handle (return . Left . TLSError)
                       . flip withConnection con
                       . runErrorT $ do
@@ -103,10 +91,10 @@ startTLS params con = Ex.handle (return . Left . TLSError)
     case answer of
         Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] -> return ()
         Element "{urn:ietf:params:xml:ns:xmpp-tls}failure" _ _ ->
-            lift . Ex.throwIO $ StreamConnectionError
+            lift $ Ex.throwIO StreamOtherFailure
             -- TODO: find something more suitable
-        e -> lift . Ex.throwIO . StreamXMLError $
-            "Unexpected element: " ++ ppElement e
+        e -> lift $ Ex.throwIO StreamOtherFailure
+            -- TODO: Log: "Unexpected element: " ++ ppElement e
     (raw, _snk, psh, read, ctx) <- lift $ TLS.tlsinit debug params (mkBackend con)
     let newHand = Hand { cSend = catchPush . psh
                        , cRecv = read

source/Network/Xmpp/Types.hs

@@ -28,7 +28,7 @@ module Network.Xmpp.Types
     , StanzaErrorCondition(..)
     , StanzaErrorType(..)
     , StanzaId(..)
-    , StreamError(..)
+    , StreamFailure(..)
     , StreamErrorCondition(..)
     , Version(..)
     , HandleLike(..)
@@ -38,8 +38,9 @@ module Network.Xmpp.Types
     , withConnection'
     , mkConnection
     , ConnectionState(..)
-    , XmppStreamError(..)
+    , StreamErrorInfo(..)
     , langTag
+    , TLSFailure(..)
     , module Network.Xmpp.Jid
     )
        where
@@ -62,6 +63,7 @@ import qualified Data.Text as Text
 import           Data.Typeable(Typeable)
 import           Data.XML.Types
 
+import qualified Network.TLS as TLS
 
 import qualified Network as N
 
@@ -619,28 +621,26 @@ instance Read StreamErrorCondition where
     readsPrec _ "unsupported-version"      = [(StreamUnsupportedVersion   , "")]
     readsPrec _ _                          = [(StreamUndefinedCondition   , "")]
 
-data XmppStreamError = XmppStreamError
+-- | Encapsulates information about an XMPP stream error.
+data StreamErrorInfo = StreamErrorInfo
     { errorCondition :: !StreamErrorCondition
     , errorText      :: !(Maybe (Maybe LangTag, Text))
     , errorXML       :: !(Maybe Element)
     } deriving (Show, Eq)
 
-data StreamError = StreamError XmppStreamError
-                 | StreamUnknownError -- Something has gone wrong, but we don't
-                                      -- know what
-                 | StreamNotStreamElement Text
-                 | StreamInvalidStreamNamespace (Maybe Text)
-                 | StreamInvalidStreamPrefix (Maybe Text)
-                 | StreamWrongTo (Maybe Text)
-                 | StreamWrongVersion (Maybe Text)
-                 | StreamWrongLangTag (Maybe Text)
-                 | StreamXMLError String -- If stream pickling goes wrong.
-                 | StreamStreamEnd -- received closing stream tag
-                 | StreamConnectionError
-                 deriving (Show, Eq, Typeable)
-
-instance Exception StreamError
-instance Error StreamError where noMsg = StreamConnectionError
+-- | Signals an XMPP stream error or another unpredicted stream-related
+-- situation.
+data StreamFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream
+                                                        -- element has been
+                                                        -- encountered.
+                   | StreamEndFailure -- ^ The server has closed the stream.
+                   | StreamOtherFailure -- ^ Undefined condition. More
+                                        -- information should be available in
+                                        -- the log.
+                   deriving (Show, Eq, Typeable)
+
+instance Exception StreamFailure
+instance Error StreamFailure where noMsg = StreamOtherFailure
 
 -- =============================================================================
 --  XML TYPES
@@ -811,3 +811,16 @@ withConnection' action (Connection con) = do
 
 mkConnection :: Connection_ -> IO Connection
 mkConnection con = Connection `fmap` (atomically $ newTMVar con)
+
+
+-- | Failure conditions that may arise during TLS negotiation.
+data TLSFailure = TLSError TLS.TLSError
+                | TLSNoServerSupport
+                | TLSNoConnection
+                | TLSConnectionSecured -- ^ Connection already secured
+                | TLSStreamError StreamFailure
+                | TLSFailureError -- General instance used for the Error instance (TODO)
+                deriving (Show, Eq, Typeable)
+
+instance Error TLSFailure where
+  noMsg = TLSFailureError