Migrate from ErrorT to ExceptT

source/Network/Xmpp/Concurrent.hs

@@ -24,7 +24,7 @@ import           Control.Concurrent (threadDelay)
 import           Control.Concurrent.STM
 import qualified Control.Exception as Ex
 import           Control.Monad
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.List as List
 import qualified Data.Map as Map
 import           Data.Maybe
@@ -168,7 +168,7 @@ newSession :: Stream
            -> HostName
            -> Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
            -> IO (Either XmppFailure Session)
-newSession stream config realm mbSasl = runErrorT $ do
+newSession stream config realm mbSasl = runExceptT $ do
     write' <- liftIO $ withStream' (gets $ streamSend . streamHandle) stream
     writeSem <- liftIO $ newTMVarIO write'
     stanzaChan <- lift newTChanIO
@@ -202,7 +202,7 @@ newSession stream config realm mbSasl = runErrorT $ do
                         , rosterH
                         , [ handleIQ iqHands sXmppElement]
                         ]
-    (kill, sState, reader) <- ErrorT $ startThreadsWith writeSem stanzaHandler
+    (kill, sState, reader) <- ExceptT $ startThreadsWith writeSem stanzaHandler
                                                         eh stream
                                                         (keepAlive config)
     idGen <- liftIO $ sessionStanzaIDs config
@@ -249,13 +249,13 @@ connectStream realm config mbSasl = do
         (\stream' -> case stream' of
               Left e -> return $ Left e
               Right stream -> do
-                  res <- runErrorT $ do
-                      ErrorT $ tls stream
+                  res <- runExceptT $ do
+                      ExceptT $ tls stream
                       cs <- liftIO $ withStream (gets streamConnectionState)
                                                 stream
                       mbAuthError <- case mbSasl of
                           Nothing -> return Nothing
-                          Just (handlers, resource) -> ErrorT $ auth (handlers cs)
+                          Just (handlers, resource) -> ExceptT $ auth (handlers cs)
                                                                 resource stream
                       case mbAuthError of
                           Nothing -> return ()
@@ -278,9 +278,9 @@ session :: HostName                          -- ^ The hostname / realm
         -> AuthData
         -> SessionConfiguration              -- ^ configuration details
         -> IO (Either XmppFailure Session)
-session realm mbSasl config = runErrorT $ do
-    stream <- ErrorT $ connectStream realm config mbSasl
-    ses <- ErrorT $ newSession stream config realm mbSasl
+session realm mbSasl config = runExceptT $ do
+    stream <- ExceptT $ connectStream realm config mbSasl
+    ses <- ExceptT $ newSession stream config realm mbSasl
     liftIO $ when (enableRoster config) $ initRoster ses
     return ses
 

source/Network/Xmpp/Concurrent/IQ.hs

@@ -9,7 +9,7 @@ import           Control.Concurrent (forkIO)
 import           Control.Concurrent.STM
 import           Control.Concurrent.Thread.Delay (delay)
 import           Control.Monad
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.Trans
 import qualified Data.Map as Map
 import           Data.Maybe

source/Network/Xmpp/Concurrent/Threads.hs

@@ -9,7 +9,7 @@ import           Control.Concurrent
 import           Control.Concurrent.STM
 import qualified Control.Exception.Lifted as Ex
 import           Control.Monad
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.ByteString as BS
 import           GHC.IO (unsafeUnmask)
 import           Network.Xmpp.Concurrent.Types

source/Network/Xmpp/Concurrent/Types.hs

@@ -7,7 +7,7 @@ module Network.Xmpp.Concurrent.Types where
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import qualified Control.Exception.Lifted as Ex
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.ByteString as BS
 import           Data.Default
 import qualified Data.Map as Map
@@ -68,7 +68,7 @@ data Plugin' = Plugin'
 
 type Plugin = (XmppElement -> IO (Either XmppFailure ())) -- ^ pass stanza to
                                                           -- next plugin
-              -> ErrorT XmppFailure IO Plugin'
+              -> ExceptT XmppFailure IO Plugin'
 
 type RosterPushCallback = Roster -> RosterUpdate -> IO ()
 

source/Network/Xmpp/Sasl.hs

@@ -14,7 +14,7 @@ module Network.Xmpp.Sasl
     , auth
     ) where
 
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State.Strict
 import           Data.Text (Text)
 import           Data.XML.Pickle
@@ -48,10 +48,10 @@ xmppSasl handlers stream = do
                     Closed -> do
                         lift $ errorM "Pontarius.Xmpp" "xmppSasl: Stream state closed."
                         return . Left $ XmppNoStream
-                    _ -> runErrorT $ do
+                    _ -> runExceptT $ do
                            -- TODO: Log details about handler? SaslHandler "show" instance?
                            lift $ lift $ debugM "Pontarius.Xmpp" "xmppSasl: Performing handler..."
-                           r <- ErrorT handler
+                           r <- ExceptT handler
                            case r of
                                Just ae -> do
                                    lift $ lift $ errorM "Pontarius.Xmpp" $
@@ -60,7 +60,7 @@ xmppSasl handlers stream = do
                                    return $ Just ae
                                Nothing -> do
                                    lift $ lift $ debugM "Pontarius.Xmpp" "xmppSasl: Authentication successful, restarting stream."
-                                   _ <- ErrorT restartStream
+                                   _ <- ExceptT restartStream
                                    lift $ lift $ debugM "Pontarius.Xmpp" "xmppSasl: Stream restarted."
                                    return Nothing
 
@@ -70,12 +70,12 @@ auth :: [SaslHandler]
      -> Maybe Text
      -> Stream
      -> IO (Either XmppFailure (Maybe AuthFailure))
-auth mechanisms resource con = runErrorT $ do
-    mbAuthFail <- ErrorT $ xmppSasl mechanisms con
+auth mechanisms resource con = runExceptT $ do
+    mbAuthFail <- ExceptT $ xmppSasl mechanisms con
     case mbAuthFail of
         Nothing -> do
-            _jid <- ErrorT $ xmppBind resource con
-            ErrorT $ flip withStream' con $ do
+            _jid <- ExceptT $ xmppBind resource con
+            ExceptT $ flip withStream' con $ do
                 s <- get
 
                 case sendStreamElement s of
@@ -103,9 +103,9 @@ bindBody = pickleElem $
 -- Sends a (synchronous) IQ set request for a (`Just') given or server-generated
 -- resource and extract the JID from the non-error response.
 xmppBind  :: Maybe Text -> Stream -> IO (Either XmppFailure Jid)
-xmppBind rsrc c = runErrorT $ do
+xmppBind rsrc c = runExceptT $ do
     lift $ debugM "Pontarius.Xmpp" "Attempts to bind..."
-    answer <- ErrorT $ pushIQ "bind" Nothing Set Nothing (bindBody rsrc) c
+    answer <- ExceptT $ pushIQ "bind" Nothing Set Nothing (bindBody rsrc) c
     case answer of
         Right IQResult{iqResultPayload = Just b} -> do
             lift $ debugM "Pontarius.Xmpp" "xmppBind: IQ result received; unpickling JID..."

source/Network/Xmpp/Sasl/Common.hs

@@ -6,7 +6,7 @@
 module Network.Xmpp.Sasl.Common where
 
 import           Control.Applicative ((<$>))
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.Attoparsec.ByteString.Char8 as AP
 import           Data.Bits
 import qualified Data.ByteString as BS
@@ -27,7 +27,7 @@ import qualified System.Random as Random
 
 import           Control.Monad.State.Strict
 
---makeNonce :: ErrorT AuthFailure (StateT StreamState IO) BS.ByteString
+--makeNonce :: ExceptT AuthFailure (StateT StreamState IO) BS.ByteString
 makeNonce :: IO BS.ByteString
 makeNonce = do
     g <- liftIO Random.newStdGen
@@ -132,7 +132,7 @@ xpSaslElement = xpAlt saslSel
 quote :: BS.ByteString -> BS.ByteString
 quote x = BS.concat ["\"",x,"\""]
 
-saslInit :: Text.Text -> Maybe BS.ByteString -> ErrorT AuthFailure (StateT StreamState IO) ()
+saslInit :: Text.Text -> Maybe BS.ByteString -> ExceptT AuthFailure (StateT StreamState IO) ()
 saslInit mechanism payload = do
     r <- lift . pushElement . saslInitE mechanism $
         Text.decodeUtf8 . encodeEmpty . B64.encode <$> payload
@@ -145,7 +145,7 @@ saslInit mechanism payload = do
     encodeEmpty x = x
 
 -- | Pull the next element.
-pullSaslElement :: ErrorT AuthFailure (StateT StreamState IO) SaslElement
+pullSaslElement :: ExceptT AuthFailure (StateT StreamState IO) SaslElement
 pullSaslElement = do
     mbse <- lift $ pullUnpickle (xpEither xpFailure xpSaslElement)
     case mbse of
@@ -154,7 +154,7 @@ pullSaslElement = do
         Right (Right r) -> return r
 
 -- | Pull the next element, checking that it is a challenge.
-pullChallenge :: ErrorT AuthFailure (StateT StreamState IO) (Maybe BS.ByteString)
+pullChallenge :: ExceptT AuthFailure (StateT StreamState IO) (Maybe BS.ByteString)
 pullChallenge = do
   e <- pullSaslElement
   case e of
@@ -165,12 +165,12 @@ pullChallenge = do
       _ -> throwError AuthOtherFailure -- TODO: Log
 
 -- | Extract value from Just, failing with AuthOtherFailure on Nothing.
-saslFromJust :: Maybe a -> ErrorT AuthFailure (StateT StreamState IO) a
+saslFromJust :: Maybe a -> ExceptT AuthFailure (StateT StreamState IO) a
 saslFromJust Nothing = throwError $ AuthOtherFailure -- TODO: Log
 saslFromJust (Just d) = return d
 
 -- | Pull the next element and check that it is success.
-pullSuccess :: ErrorT AuthFailure (StateT StreamState IO) (Maybe Text.Text)
+pullSuccess :: ExceptT AuthFailure (StateT StreamState IO) (Maybe Text.Text)
 pullSuccess = do
     e <- pullSaslElement
     case e of
@@ -179,7 +179,7 @@ pullSuccess = do
 
 -- | Pull the next element. When it's success, return it's payload.
 -- If it's a challenge, send an empty response and pull success.
-pullFinalMessage :: ErrorT AuthFailure (StateT StreamState IO) (Maybe BS.ByteString)
+pullFinalMessage :: ExceptT AuthFailure (StateT StreamState IO) (Maybe BS.ByteString)
 pullFinalMessage = do
     challenge2 <- pullSaslElement
     case challenge2 of
@@ -195,13 +195,13 @@ pullFinalMessage = do
         Right x -> return $ Just x
 
 -- | Extract p=q pairs from a challenge.
-toPairs :: BS.ByteString -> ErrorT AuthFailure (StateT StreamState IO) Pairs
+toPairs :: BS.ByteString -> ExceptT AuthFailure (StateT StreamState IO) Pairs
 toPairs ctext = case pairs ctext of
     Left _e -> throwError AuthOtherFailure -- TODO: Log
     Right r -> return r
 
 -- | Send a SASL response element. The content will be base64-encoded.
-respond :: Maybe BS.ByteString -> ErrorT AuthFailure (StateT StreamState IO) ()
+respond :: Maybe BS.ByteString -> ExceptT AuthFailure (StateT StreamState IO) ()
 respond m = do
     r <- lift . pushElement . saslResponseE . fmap (Text.decodeUtf8 . B64.encode) $ m
     case r of
@@ -211,7 +211,7 @@ respond m = do
 -- | Run the appropriate stringprep profiles on the credentials.
 -- May fail with 'AuthStringPrepFailure'
 prepCredentials :: Text.Text -> Maybe Text.Text -> Text.Text
-                -> ErrorT AuthFailure (StateT StreamState IO) (Text.Text, Maybe Text.Text, Text.Text)
+                -> ExceptT AuthFailure (StateT StreamState IO) (Text.Text, Maybe Text.Text, Text.Text)
 prepCredentials authcid authzid password = case credentials of
     Nothing -> throwError $ AuthIllegalCredentials
     Just creds -> return creds

source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs

@@ -5,7 +5,7 @@ module Network.Xmpp.Sasl.Mechanisms.DigestMd5
     ( digestMd5
     ) where
 
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State.Strict
 import qualified Crypto.Classes as CC
 import qualified Data.Binary as Binary
@@ -26,13 +26,13 @@ import           Network.Xmpp.Types
 xmppDigestMd5 ::  Text -- ^ Authentication identity (authzid or username)
                -> Maybe Text -- ^ Authorization identity (authcid)
                -> Text -- ^ Password (authzid)
-               -> ErrorT AuthFailure (StateT StreamState IO) ()
+               -> ExceptT AuthFailure (StateT StreamState IO) ()
 xmppDigestMd5 authcid' authzid' password' = do
     (ac, az, pw) <- prepCredentials authcid' authzid' password'
     Just address <- gets streamAddress
     xmppDigestMd5' address ac az pw
   where
-    xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> ErrorT AuthFailure (StateT StreamState IO) ()
+    xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> ExceptT AuthFailure (StateT StreamState IO) ()
     xmppDigestMd5' hostname authcid _authzid password = do -- TODO: use authzid?
         -- Push element and receive the challenge.
         _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean?
@@ -114,7 +114,7 @@ digestMd5 :: Username -- ^ Authentication identity (authcid or username)
 digestMd5 authcid authzid password =
     ( "DIGEST-MD5"
     , do
-          r <- runErrorT $ xmppDigestMd5 authcid authzid password
+          r <- runExceptT $ xmppDigestMd5 authcid authzid password
           case r of
               Left (AuthStreamFailure e) -> return $ Left e
               Left e -> return $ Right $ Just e

source/Network/Xmpp/Sasl/Mechanisms/Plain.hs

@@ -8,7 +8,7 @@ module Network.Xmpp.Sasl.Mechanisms.Plain
     ( plain
     ) where
 
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State.Strict
 import qualified Data.ByteString as BS
 import qualified Data.Text as Text
@@ -21,7 +21,7 @@ import           Network.Xmpp.Types
 xmppPlain :: Text.Text -- ^ Password
           -> Maybe Text.Text -- ^ Authorization identity (authzid)
           -> Text.Text -- ^ Authentication identity (authcid)
-          -> ErrorT AuthFailure (StateT StreamState IO) ()
+          -> ExceptT AuthFailure (StateT StreamState IO) ()
 xmppPlain authcid' authzid' password  = do
     (ac, az, pw) <- prepCredentials authcid' authzid' password
     _ <- saslInit "PLAIN" ( Just $ plainMessage ac az pw)
@@ -51,7 +51,7 @@ plain :: Username -- ^ authentication ID (username)
 plain authcid authzid passwd =
     ( "PLAIN"
     , do
-          r <- runErrorT $ xmppPlain authcid authzid passwd
+          r <- runExceptT $ xmppPlain authcid authzid passwd
           case r of
               Left (AuthStreamFailure e) -> return $ Left e
               Left e -> return $ Right $ Just e

source/Network/Xmpp/Sasl/Mechanisms/Scram.hs

@@ -7,7 +7,7 @@ module Network.Xmpp.Sasl.Mechanisms.Scram
   where
 
 import           Control.Applicative ((<$>))
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State.Strict
 import qualified Crypto.Classes          as Crypto
 import qualified Crypto.HMAC             as Crypto
@@ -37,7 +37,7 @@ scram :: (Crypto.Hash ctx hash)
       -> Text.Text       -- ^ Authentication ID (user name)
       -> Maybe Text.Text -- ^ Authorization ID
       -> Text.Text       -- ^ Password
-      -> ErrorT AuthFailure (StateT StreamState IO) ()
+      -> ExceptT AuthFailure (StateT StreamState IO) ()
 scram hToken authcid authzid password = do
     (ac, az, pw) <- prepCredentials authcid authzid password
     scramhelper ac az pw
@@ -86,7 +86,7 @@ scram hToken authcid authzid password = do
 
         fromPairs :: Pairs
                   -> BS.ByteString
-                  -> ErrorT AuthFailure (StateT StreamState IO) (BS.ByteString, BS.ByteString, Integer)
+                  -> ExceptT AuthFailure (StateT StreamState IO) (BS.ByteString, BS.ByteString, Integer)
         fromPairs prs cnonce | Just nonce <- lookup "r" prs
                              , cnonce `BS.isPrefixOf` nonce
                              , Just salt' <- lookup "s" prs
@@ -154,7 +154,7 @@ scramSha1 :: Username  -- ^ username
 scramSha1 authcid authzid passwd =
     ( "SCRAM-SHA-1"
     , do
-          r <- runErrorT $ scram (hashToken :: Crypto.SHA1) authcid authzid passwd
+          r <- runExceptT $ scram (hashToken :: Crypto.SHA1) authcid authzid passwd
           case r of
               Left (AuthStreamFailure e) -> return $ Left e
               Left e -> return $ Right $ Just e

source/Network/Xmpp/Stream.hs

@@ -15,7 +15,7 @@ import           Control.Concurrent.STM
 import qualified Control.Exception as Ex
 import qualified Control.Exception.Lifted as ExL
 import           Control.Monad
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State.Strict
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -82,8 +82,8 @@ streamUnpickleElem p x = do
         Right r -> return r
 
 -- This is the conduit sink that handles the stream XML events. We extend it
--- with ErrorT capabilities.
-type StreamSink a = ConduitM Event Void (ErrorT XmppFailure IO) a
+-- with ExceptT capabilities.
+type StreamSink a = ConduitM Event Void (ExceptT XmppFailure IO) a
 
 -- Discards all events before the first EventBeginElement.
 throwOutJunk :: Monad m => ConduitM Event a m ()
@@ -110,7 +110,7 @@ openElementFromEvents = do
 -- generated, the connection to the server will be closed, and a XmppFailure
 -- will be produced.
 startStream :: StateT StreamState IO (Either XmppFailure ())
-startStream = runErrorT $ do
+startStream = runExceptT $ do
     lift $ lift $ debugM "Pontarius.Xmpp" "Starting stream..."
     st <- lift $ get
     -- Set the `from' (which is also the expected to) attribute depending on the
@@ -128,15 +128,15 @@ startStream = runErrorT $ do
             lift $ lift $ errorM "Pontarius.Xmpp" "Server sent no hostname."
             throwError XmppOtherFailure
         Just address -> do
-            ErrorT $ pushXmlDecl
-            ErrorT . pushOpenElement . streamNSHack $
+            ExceptT $ pushXmlDecl
+            ExceptT . pushOpenElement . streamNSHack $
                 pickleElem xpStream ( "1.0"
                                     , expectedTo
                                     , Just (Jid Nothing (Nonempty address) Nothing)
                                     , Nothing
                                     , preferredLang $ streamConfiguration st
                                     )
-    response <- ErrorT $ runEventsSink $ streamS expectedTo
+    response <- ExceptT $ runEventsSink $ streamS expectedTo
     case response of
       Right (ver, from, to, sid, lt, features)
         | versionFromText ver == Nothing -> closeStreamWithError
@@ -181,14 +181,14 @@ startStream = runErrorT $ do
         | (isJust $ namePrefix name) && (fromJust (namePrefix name) /= "stream") ->
             closeStreamWithError StreamBadNamespacePrefix Nothing
                 "Root name prefix set and not stream"
-        | otherwise -> ErrorT $ checkchildren (flattenAttrs attrs)
+        | otherwise -> ExceptT $ checkchildren (flattenAttrs attrs)
   where
     -- HACK: We include the default namespace to make isode's M-LINK server happy.
     streamNSHack e = e{elementAttributes = elementAttributes e
                                            ++ [( "xmlns"
                                                , [ContentText "jabber:client"])]}
     closeStreamWithError  :: StreamErrorCondition -> Maybe Element -> String
-                          -> ErrorT XmppFailure (StateT StreamState IO) ()
+                          -> ExceptT XmppFailure (StateT StreamState IO) ()
     closeStreamWithError sec el msg = do
         void . lift . pushElement . pickleElem xpStreamError
             $ StreamErrorInfo sec Nothing el
@@ -200,19 +200,19 @@ startStream = runErrorT $ do
             ver' = lookup "version" children
             xl   = lookup xmlLang   children
           in case () of () | Just Nothing == fmap jidFromText to' ->
-                               runErrorT $ closeStreamWithError
+                               runExceptT $ closeStreamWithError
                                    StreamBadNamespacePrefix Nothing
                                    "stream to not a valid JID"
                            | Nothing == ver' ->
-                               runErrorT $ closeStreamWithError
+                               runExceptT $ closeStreamWithError
                                    StreamUnsupportedVersion Nothing
                                    "stream no version"
                            | Just (Nothing :: Maybe LangTag) == (safeRead <$> xl) ->
-                               runErrorT $ closeStreamWithError
+                               runExceptT $ closeStreamWithError
                                    StreamInvalidXml Nothing
                                    "stream no language tag"
                            | otherwise ->
-                               runErrorT $ closeStreamWithError
+                               runExceptT $ closeStreamWithError
                                    StreamBadFormat Nothing
                                    ""
     safeRead x = case reads $ Text.unpack x of
@@ -281,8 +281,8 @@ logInput = go Nothing
 -- We buffer sources because we don't want to lose data when multiple
 -- xml-entities are sent with the same packet and we don't want to eternally
 -- block the StreamState while waiting for data to arrive
-bufferSrc :: Source (ErrorT XmppFailure IO) o
-          -> IO (ConduitM i o (ErrorT XmppFailure IO) ())
+bufferSrc :: Source (ExceptT XmppFailure IO) o
+          -> IO (ConduitM i o (ExceptT XmppFailure IO) ())
 bufferSrc src = do
     ref <- newTMVarIO $ DCI.sealConduitT src
     let go = do
@@ -290,7 +290,7 @@ bufferSrc src = do
                       (atomically $ takeTMVar ref)
                       (\_ -> atomically . putTMVar ref $ zeroResumableSource)
                       (\s -> do
-                            res <- runErrorT (s $$++ await)
+                            res <- runExceptT (s $$++ await)
                             case res of
                                 Left e -> do
                                     atomically $ putTMVar ref zeroResumableSource
@@ -349,10 +349,10 @@ streamS _expectedTo = do -- TODO: check expectedTo
 -- | Connects to the XMPP server and opens the XMPP stream against the given
 -- realm.
 openStream :: HostName -> StreamConfiguration -> IO (Either XmppFailure (Stream))
-openStream realm config = runErrorT $ do
+openStream realm config = runExceptT $ do
     lift $ debugM "Pontarius.Xmpp" "Opening stream..."
     stream' <- createStream realm config
-    ErrorT . liftIO $ withStream startStream stream'
+    ExceptT . liftIO $ withStream startStream stream'
     return stream'
 
 -- | Send \"</stream:stream>\" and wait for the server to finish processing and
@@ -455,11 +455,11 @@ pushOpenElement e = do
 
 -- `Connect-and-resumes' the given sink to the stream source, and pulls a
 -- `b' value.
-runEventsSink :: Sink Event (ErrorT XmppFailure IO) b
+runEventsSink :: Sink Event (ExceptT XmppFailure IO) b
               -> StateT StreamState IO (Either XmppFailure b)
 runEventsSink snk = do -- TODO: Wrap exceptions?
     src <- gets streamEventSource
-    lift . runErrorT $ src $$ snk
+    lift . runExceptT $ src $$ snk
 
 pullElement :: StateT StreamState IO (Either XmppFailure Element)
 pullElement = do
@@ -543,7 +543,7 @@ xmppNoStream = StreamState {
     , streamConfiguration = def
     }
 
-zeroSource :: Source (ErrorT XmppFailure IO) a
+zeroSource :: Source (ExceptT XmppFailure IO) a
 zeroSource = do
     liftIO $ debugM "Pontarius.Xmpp" "zeroSource"
     throwError XmppNoStream
@@ -559,11 +559,11 @@ handleToStreamHandle h = StreamHandle { streamSend = \d ->
                                       , streamClose = hClose h
                                       }
 
-createStream :: HostName -> StreamConfiguration -> ErrorT XmppFailure IO (Stream)
+createStream :: HostName -> StreamConfiguration -> ExceptT XmppFailure IO (Stream)
 createStream realm config = do
     result <- connect realm config
     case result of
-        Just hand -> ErrorT $ do
+        Just hand -> ExceptT $ do
             debugM "Pontarius.Xmpp" "Acquired handle."
             debugM "Pontarius.Xmpp" "Setting NoBuffering mode on handle."
             eSource <- liftIO . bufferSrc $
@@ -598,7 +598,7 @@ createStream realm config = do
     maybeSetTlsHost host = over tlsIdentL (updateHost host)
 
 -- Connects using the specified method. Returns the Handle acquired, if any.
-connect :: HostName -> StreamConfiguration -> ErrorT XmppFailure IO
+connect :: HostName -> StreamConfiguration -> ExceptT XmppFailure IO
            (Maybe StreamHandle)
 connect realm config = do
     case connectionDetails config of
@@ -626,7 +626,7 @@ connect realm config = do
                     return . Just $ handleToStreamHandle h'
         UseConnection mkC -> Just <$> mkC
 
-connectSrv :: ResolvConf -> String -> ErrorT XmppFailure IO (Maybe Handle)
+connectSrv :: ResolvConf -> String -> ExceptT XmppFailure IO (Maybe Handle)
 connectSrv config host = do
     case checkHostName (Text.pack host) of
         Just host' -> do
@@ -735,8 +735,8 @@ rethrowErrorCall action = do
 
 -- Provides a list of A(AAA) names and port numbers upon a successful
 -- DNS-SRV request, or `Nothing' if the DNS-SRV request failed.
-srvLookup :: Text -> ResolvSeed -> ErrorT XmppFailure IO (Maybe [(Domain, Word16)])
-srvLookup realm resolvSeed = ErrorT $ do
+srvLookup :: Text -> ResolvSeed -> ExceptT XmppFailure IO (Maybe [(Domain, Word16)])
+srvLookup realm resolvSeed = ExceptT $ do
     result <- Ex.try $ rethrowErrorCall $ withResolver resolvSeed
               $ \resolver -> do
         srvResult <- lookupSRV resolver $ BSC8.pack $ "_xmpp-client._tcp." ++ (Text.unpack realm) ++ "."
@@ -818,8 +818,8 @@ pushIQ :: Text
        -> Element
        -> Stream
        -> IO (Either XmppFailure (Either IQError IQResult))
-pushIQ iqID to tp lang body stream = runErrorT $ do
-    ErrorT $ pushStanza
+pushIQ iqID to tp lang body stream = runExceptT $ do
+    ExceptT $ pushStanza
         (IQRequestS $ IQRequest iqID Nothing to lang tp body []) stream
     res <- lift $ pullStanza stream
     case res of

source/Network/Xmpp/Tls.hs

@@ -9,7 +9,7 @@ module Network.Xmpp.Tls where
 import                 Control.Applicative ((<$>))
 import qualified       Control.Exception.Lifted as Ex
 import                 Control.Monad
-import                 Control.Monad.Error
+import                 Control.Monad.Except
 import                 Control.Monad.State.Strict
 import "crypto-random" Crypto.Random
 import qualified       Data.ByteString as BS
@@ -56,7 +56,7 @@ tls con = fmap join -- We can have Left values both from exceptions and the
                     -- error monad. Join unifies them into one error layer
           . wrapExceptions
           . flip withStream con
-          . runErrorT $ do
+          . runExceptT $ do
     conf <- gets streamConfiguration
     sState <- gets streamConnectionState
     case sState of
@@ -85,7 +85,7 @@ tls con = fmap join -- We can have Left values both from exceptions and the
     startTls = do
         liftIO $ infoM "Pontarius.Xmpp.Tls" "Running StartTLS"
         params <- gets $ tlsParams . streamConfiguration
-        ErrorT $ pushElement starttlsE
+        ExceptT $ pushElement starttlsE
         answer <- lift $ pullElement
         case answer of
             Left e -> throwError e
@@ -173,7 +173,7 @@ connectTls :: ResolvConf -- ^ Resolv conf to use (try 'defaultResolvConf' as a
            -> ClientParams  -- ^ TLS parameters to use when securing the connection
            -> String     -- ^ Host to use when connecting (will be resolved
                          -- using SRV records)
-           -> ErrorT XmppFailure IO StreamHandle
+           -> ExceptT XmppFailure IO StreamHandle
 connectTls config params host = do
     h <- connectSrv config host >>= \h' -> case h' of
         Nothing -> throwError TcpConnectionFailure

source/Network/Xmpp/Types.hs

@@ -89,7 +89,7 @@ module Network.Xmpp.Types
 import           Control.Applicative ((<$>), (<|>), many)
 import           Control.Concurrent.STM
 import           Control.Exception
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.Attoparsec.Text as AP
 import qualified Data.ByteString as BS
 import           Data.Char (isSpace)
@@ -623,7 +623,6 @@ data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream
                  deriving (Show, Eq, Typeable)
 
 instance Exception XmppFailure
-instance Error XmppFailure where noMsg = XmppOtherFailure
 
 -- | Signals a SASL authentication error condition.
 data AuthFailure = -- | No mechanism offered by the server was matched
@@ -641,9 +640,6 @@ data AuthFailure = -- | No mechanism offered by the server was matched
                  | AuthOtherFailure
                  deriving (Eq, Show)
 
-instance Error AuthFailure where
-    noMsg = AuthOtherFailure
-
 -- =============================================================================
 --  XML TYPES
 -- =============================================================================
@@ -791,7 +787,7 @@ data StreamState = StreamState
       -- | Functions to send, receive, flush, and close the stream
     , streamHandle :: StreamHandle
       -- | Event conduit source, and its associated finalizer
-    , streamEventSource :: Source (ErrorT XmppFailure IO) Event
+    , streamEventSource :: Source (ExceptT XmppFailure IO) Event
       -- | Stream features advertised by the server
     , streamFeatures :: !StreamFeatures -- TODO: Maybe?
       -- | The hostname or IP specified for the connection
@@ -1229,7 +1225,7 @@ data ConnectionDetails = UseRealm -- ^ Use realm to resolv host. This is the
                                   -- default.
                        | UseSrv HostName -- ^ Use this hostname for a SRV lookup
                        | UseHost HostName PortNumber -- ^ Use specified host
-                       | UseConnection (ErrorT XmppFailure IO StreamHandle)
+                       | UseConnection (ExceptT XmppFailure IO StreamHandle)
                          -- ^ Use a custom method to create a StreamHandle. This
                          -- will also be used by reconnect. For example, to
                          -- establish TLS before starting the stream as done by

source/Network/Xmpp/Xep/InbandRegistration.hs

@@ -11,7 +11,7 @@ module Network.Xmpp.Xep.InbandRegistration where
 import           Control.Applicative((<$>))
 import           Control.Arrow(left)
 import           Control.Exception
-import           Control.Monad.Error
+import           Control.Monad.Except
 import           Control.Monad.State
 
 import           Data.Either (partitionEithers)
@@ -35,8 +35,6 @@ data IbrError = IbrNotSupported
               | IbrTimeout
 
                 deriving (Show)
-instance Error IbrError
-
 
 data Query = Query { instructions :: Maybe Text.Text
                    , registered   :: Bool
@@ -82,8 +80,6 @@ data RegisterError = IbrError IbrError
                    | AlreadyRegistered
                      deriving (Show)
 
-instance Error RegisterError
-
 mapError f = mapErrorT (liftM $ left f)
 
 -- | Retrieve the necessary fields and fill them in to register an account with
@@ -91,8 +87,8 @@ mapError f = mapErrorT (liftM $ left f)
 registerWith :: [(Field, Text.Text)]
              -> Stream
              -> IO  (Either RegisterError Query)
-registerWith givenFields con = runErrorT $ do
-    fs <- mapError IbrError . ErrorT $ requestFields con
+registerWith givenFields con = runExceptT $ do
+    fs <- mapError IbrError . ExceptT $ requestFields con
     when (registered fs) . throwError $ AlreadyRegistered
     let res = flip map (fields fs) $ \(field,_) ->
             case lookup field givenFields of
@@ -101,18 +97,18 @@ registerWith givenFields con = runErrorT $ do
     fields <- case partitionEithers res of
         ([],fs) -> return fs
         (fs,_) -> throwError $ MissingFields fs
-    result <- mapError IbrError . ErrorT $ query Set (emptyQuery {fields}) con
+    result <- mapError IbrError . ExceptT $ query Set (emptyQuery {fields}) con
     return result
 
 
 
-createAccountWith host hostname port fields = runErrorT $ do
+createAccountWith host hostname port fields = runExceptT $ do
       con' <- liftIO $ connectTcp host port hostname
       con <- case con' of
           Left e -> throwError $ IbrError IbrNoConnection
           Right r -> return r
       lift $ startTLS exampleParams con
-      ErrorT $ registerWith fields con
+      ExceptT $ registerWith fields con
 
 deleteAccount host hostname port username password = do
     con <- simpleConnect host port hostname username password Nothing
@@ -127,8 +123,8 @@ unregister = query Set $ emptyQuery {remove = True}
 unregister' :: Session -> IO (Either IbrError Query)
 unregister' = query' Set $ emptyQuery {remove = True}
 
-requestFields con = runErrorT $ do
-    qr <- ErrorT $ query Get emptyQuery con
+requestFields con = runExceptT $ do
+    qr <- ExceptT $ query Get emptyQuery con
     return $ qr
 
 xpQuery :: PU [XML.Node] Query

source/Network/Xmpp/Xep/ServiceDiscovery.hs

@@ -17,7 +17,7 @@ module Network.Xmpp.Xep.ServiceDiscovery
   where
 
 import           Control.Applicative ((<$>))
-import           Control.Monad.Error
+import           Control.Monad.Except
 import qualified Data.Map as Map
 import qualified Data.Text as Text
 import           Data.XML.Pickle
@@ -36,8 +36,6 @@ data DiscoError = DiscoNoQueryElement
 
                 deriving (Show)
 
-instance Error DiscoError
-
 -- Identity
 ---------------------