From 6c7aa54ea4586a982f82e70986c401e9ee4630b9 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 31 Dec 2012 06:09:58 +0100 Subject: [PATCH] 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 | 14 +++---- source/Network/Xmpp/Bind.hs | 4 +- source/Network/Xmpp/Concurrent/Monad.hs | 2 +- source/Network/Xmpp/Concurrent/Threads.hs | 6 +-- source/Network/Xmpp/Concurrent/Types.hs | 2 +- source/Network/Xmpp/Connection.hs | 32 +++++++------- source/Network/Xmpp/Errors.hs | 35 ---------------- source/Network/Xmpp/Marshal.hs | 8 ++-- source/Network/Xmpp/Sasl/Types.hs | 2 +- source/Network/Xmpp/Session.hs | 28 ++++++------- source/Network/Xmpp/Stream.hs | 22 +++++----- source/Network/Xmpp/TLS.hs | 22 +++------- source/Network/Xmpp/Types.hs | 51 ++++++++++++++--------- 13 files changed, 97 insertions(+), 131 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index d2547da..c276b8b 100644 --- a/source/Network/Xmpp.hs +++ b/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 diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index 50e9fe7..a61e556 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/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 diff --git a/source/Network/Xmpp/Concurrent/Monad.hs b/source/Network/Xmpp/Concurrent/Monad.hs index 070cab3..c6edf44 100644 --- a/source/Network/Xmpp/Concurrent/Monad.hs +++ b/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 diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 1ab1a23..89bf372 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/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 diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 962dbd1..0df18c3 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/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 diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 2269d8b..4e0d31f 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/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 "" 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) diff --git a/source/Network/Xmpp/Errors.hs b/source/Network/Xmpp/Errors.hs index 0172b6d..6e04d49 100644 --- a/source/Network/Xmpp/Errors.hs +++ b/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 _ = "" \ No newline at end of file diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs index 4de88c4..bf5e5fa 100644 --- a/source/Network/Xmpp/Marshal.hs +++ b/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" diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index a11f9ef..8c104d3 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/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 diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 9070d0b..59b4b72 100644 --- a/source/Network/Xmpp/Session.hs +++ b/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 diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 9af9a5c..87bba00 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/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 diff --git a/source/Network/Xmpp/TLS.hs b/source/Network/Xmpp/TLS.hs index 13742c7..ac68f3e 100644 --- a/source/Network/Xmpp/TLS.hs +++ b/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 ", waits for "", 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 diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 63e139a..6af878c 100644 --- a/source/Network/Xmpp/Types.hs +++ b/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