diff --git a/pontarius.cabal b/pontarius.cabal index 49a8090..0225035 100644 --- a/pontarius.cabal +++ b/pontarius.cabal @@ -62,7 +62,7 @@ Library , Network.Xmpp.Presence , Network.Xmpp.Sasl , Network.Xmpp.Sasl.Plain - , Network.Xmpp.Sasl.DigestMD5 + , Network.Xmpp.Sasl.DigestMd5 , Network.Xmpp.Sasl.Scram , Network.Xmpp.Sasl.Types , Network.Xmpp.Session @@ -70,7 +70,7 @@ Library , Network.Xmpp.TLS , Network.Xmpp.Types Other-modules: - Network.Xmpp.JID + Network.Xmpp.Jid , Network.Xmpp.Concurrent.Types , Network.Xmpp.Concurrent.IQ , Network.Xmpp.Concurrent.Threads diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index cf00495..6fb2860 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -40,4 +40,4 @@ xmppBind rsrc = do -- A `bind' element pickler. xpBind :: PU [Node] b -> PU [Node] b -xpBind c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c \ No newline at end of file +xpBind c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c diff --git a/source/Network/Xmpp/IM/Message.hs b/source/Network/Xmpp/IM/Message.hs index 7f8ba99..45463a9 100644 --- a/source/Network/Xmpp/IM/Message.hs +++ b/source/Network/Xmpp/IM/Message.hs @@ -67,7 +67,7 @@ body m = ms -- | Generate a new instant message newIM - :: JID + :: Jid -> Maybe StanzaId -> Maybe LangTag -> MessageType @@ -90,7 +90,7 @@ newIM t i lang tp sbj thrd bdy payload = Message } -- | Generate a simple instance message -simpleIM :: JID -> Text -> Message +simpleIM :: Jid -> Text -> Message simpleIM t bd = newIM t Nothing diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index fe91a57..c2b31c2 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -32,30 +32,24 @@ import qualified System.Random as Random import Network.Xmpp.Sasl.Types - -runSasl :: SaslM a -> XmppConMonad (Either AuthError a) -runSasl authAction = runErrorT $ do - cs <- gets sConnectionState - case cs of - XmppConnectionClosed -> throwError AuthConnectionError - _ -> do - r <- authAction - _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream - return r - - -- Uses the first supported mechanism to authenticate, if any. Updates the -- XmppConMonad state with non-password credentials and restarts the stream upon -- success. This computation wraps an ErrorT computation, which means that -- catchError can be used to catch any errors. -xmppSasl :: [SaslHandler] -- ^ Acceptable authentication - -- mechanisms and their corresponding - -- handlers +xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their + -- corresponding handlers -> XmppConMonad (Either AuthError ()) xmppSasl handlers = do -- Chooses the first mechanism that is acceptable by both the client and the -- server. mechanisms <- gets $ saslMechanisms . sFeatures - case (filter (\(name,_) -> name `elem` mechanisms)) handlers of + case (filter (\(name, _) -> name `elem` mechanisms)) handlers of [] -> return . Left $ AuthNoAcceptableMechanism mechanisms - (_name, handler):_ -> runSasl handler + (_name, handler):_ -> runErrorT $ do + cs <- gets sConnectionState + case cs of + XmppConnectionClosed -> throwError AuthConnectionError + _ -> do + r <- handler + _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream + return r diff --git a/source/Network/Xmpp/Sasl/Common.hs b/source/Network/Xmpp/Sasl/Common.hs index c65328d..03cb432 100644 --- a/source/Network/Xmpp/Sasl/Common.hs +++ b/source/Network/Xmpp/Sasl/Common.hs @@ -26,9 +26,6 @@ import Network.Xmpp.Sasl.Types import qualified System.Random as Random -data SaslElement = SaslSuccess (Maybe Text.Text) - | SaslChallenge (Maybe Text.Text) - --makeNonce :: SaslM BS.ByteString makeNonce :: IO BS.ByteString makeNonce = do @@ -53,9 +50,10 @@ saslResponseE resp = [] (maybeToList $ NodeContent . ContentText <$> resp) +-- The element. xpSuccess :: PU [Node] (Maybe Text.Text) xpSuccess = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}success" - (xpOption $ xpContent xpId) + (xpOption $ xpContent xpId) -- Parses the incoming SASL data to a mapped list of pairs. pairs :: BS.ByteString -> Either String Pairs @@ -91,7 +89,7 @@ xpChallenge :: PU [Node] (Maybe Text.Text) xpChallenge = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}challenge" (xpOption $ xpContent xpId) --- | pickler for SaslElement +-- | Pickler for SaslElement. xpSaslElement :: PU [Node] SaslElement xpSaslElement = xpAlt saslSel [ xpWrap SaslSuccess (\(SaslSuccess x) -> x) xpSuccess @@ -101,7 +99,7 @@ xpSaslElement = xpAlt saslSel saslSel (SaslSuccess _) = 0 saslSel (SaslChallenge _) = 1 --- | Add quotationmarks around a byte string +-- | Add quotationmarks around a byte string. quote :: BS.ByteString -> BS.ByteString quote x = BS.concat ["\"",x,"\""] @@ -109,7 +107,7 @@ saslInit :: Text.Text -> Maybe BS.ByteString -> SaslM Bool saslInit mechanism payload = lift . pushElement . saslInitE mechanism $ Text.decodeUtf8 . B64.encode <$> payload --- | Pull the next element +-- | Pull the next element. pullSaslElement :: SaslM SaslElement pullSaslElement = do el <- lift $ pullPickle (xpEither xpFailure xpSaslElement) @@ -117,7 +115,7 @@ pullSaslElement = do Left e ->throwError $ AuthSaslFailure e Right r -> return r --- | Pull the next element, checking that it is a challenge +-- | Pull the next element, checking that it is a challenge. pullChallenge :: SaslM (Maybe BS.ByteString) pullChallenge = do e <- pullSaslElement @@ -128,12 +126,12 @@ pullChallenge = do -> return $ Just sc _ -> throwError AuthChallengeError --- | Extract value from Just, failing with AuthChallengeError on Nothing +-- | Extract value from Just, failing with AuthChallengeError on Nothing. saslFromJust :: Maybe a -> SaslM a saslFromJust Nothing = throwError $ AuthChallengeError saslFromJust (Just d) = return d --- | Pull the next element and check that it is success +-- | Pull the next element and check that it is success. pullSuccess :: SaslM (Maybe Text.Text) pullSuccess = do e <- pullSaslElement @@ -142,7 +140,7 @@ pullSuccess = do _ -> throwError $ AuthXmlError -- | Pull the next element. When it's success, return it's payload. --- If it's a challenge, send an empty response and pull success +-- If it's a challenge, send an empty response and pull success. pullFinalMessage :: SaslM (Maybe BS.ByteString) pullFinalMessage = do challenge2 <- pullSaslElement @@ -158,14 +156,13 @@ pullFinalMessage = do Left _e -> throwError $ AuthChallengeError Right x -> return $ Just x --- | Extract p=q pairs from a challenge +-- | Extract p=q pairs from a challenge. toPairs :: BS.ByteString -> SaslM Pairs toPairs ctext = case pairs ctext of Left _e -> throwError AuthChallengeError Right r -> return r --- | Send a SASL response element. The content will be base64-encoded for you +-- | Send a SASL response element. The content will be base64-encoded. respond :: Maybe BS.ByteString -> SaslM Bool respond = lift . pushElement . saslResponseE . - fmap (Text.decodeUtf8 . B64.encode) - + fmap (Text.decodeUtf8 . B64.encode) \ No newline at end of file diff --git a/source/Network/Xmpp/Sasl/DigestMd5 b/source/Network/Xmpp/Sasl/DigestMd5 deleted file mode 100644 index 2f3b6e1..0000000 --- a/source/Network/Xmpp/Sasl/DigestMd5 +++ /dev/null @@ -1,134 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Network.Xmpp.Sasl.DigestMd5 where - -import Control.Applicative -import Control.Arrow (left) -import Control.Monad -import Control.Monad.Error -import Control.Monad.State.Strict -import Data.Maybe (fromJust, isJust) - -import qualified Crypto.Classes as CC - -import qualified Data.Binary as Binary -import qualified Data.ByteString.Base64 as B64 -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.ByteString.Lazy as BL -import qualified Data.Digest.Pure.MD5 as MD5 -import qualified Data.List as L - -import qualified Data.Text as Text -import Data.Text (Text) -import qualified Data.Text.Encoding as Text - -import Data.XML.Pickle - -import qualified Data.ByteString as BS - -import Data.XML.Types - -import Network.Xmpp.Monad -import Network.Xmpp.Stream -import Network.Xmpp.Types -import Network.Xmpp.Pickle - - -import Network.Xmpp.Sasl.Common -import Network.Xmpp.Sasl.Types - - - -xmppDigestMd5 :: Maybe Text -- Authorization identity (authzid) - -> Text -- Authentication identity (authzid) - -> Text -- Password (authzid) - -> SaslM () -xmppDigestMd5 authzid authcid passwd = do - hn <- gets sHostname - case hn of - Just hn' -> do - xmppDigestMD5' hn' - -- TODO: Save authzid - modify (\s -> s{sUsername = Just authcid}) - Nothing -> throwError AuthConnectionError - where - xmppDigestMD5' :: Text -> SaslM () - xmppDigestMD5' hostname = do - -- Push element and receive the challenge (in SaslM). - _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean? - pairs <- toPairs =<< saslFromJust =<< pullChallenge - cnonce <- liftIO $ makeNonce - _b <- respond . Just $ createResponse hostname pairs cnonce - challenge2 <- pullFinalMessage - _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream - return () - -- Produce the response to the challenge. - createResponse :: Text - -> Pairs - -> BS.ByteString -- nonce - -> BS.ByteString - createResponse hostname pairs cnonce = let - Just qop = L.lookup "qop" pairs -- TODO: proper handling - Just nonce = L.lookup "nonce" pairs - uname_ = Text.encodeUtf8 authcid - passwd_ = Text.encodeUtf8 passwd - -- Using Int instead of Word8 for random 1.0.0.0 (GHC 7) compatibility. - - nc = "00000001" - digestURI = "xmpp/" `BS.append` Text.encodeUtf8 hostname - digest = md5Digest - uname_ - (lookup "realm" pairs) - passwd_ - digestURI - nc - qop - nonce - cnonce - response = BS.intercalate "," . map (BS.intercalate "=") $ - [["username", quote uname_]] ++ - case L.lookup "realm" pairs of - Just realm -> [["realm" , quote realm ]] - Nothing -> [] ++ - [ ["nonce" , quote nonce ] - , ["cnonce" , quote cnonce ] - , ["nc" , nc ] - , ["qop" , qop ] - , ["digest-uri", quote digestURI] - , ["response" , digest ] - , ["charset" , "utf-8" ] - ] - in B64.encode response - hash :: [BS8.ByteString] -> BS8.ByteString - hash = BS8.pack . show - . (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":") - hashRaw :: [BS8.ByteString] -> BS8.ByteString - hashRaw = toStrict . Binary.encode . - (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":") - toStrict :: BL.ByteString -> BS8.ByteString - toStrict = BS.concat . BL.toChunks - -- TODO: this only handles MD5-sess - md5Digest :: BS8.ByteString - -> Maybe BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - -> BS8.ByteString - md5Digest uname realm password digestURI nc qop nonce cnonce = - let ha1 = hash [ hashRaw [uname, maybe "" id realm, password] - , nonce - , cnonce - ] - ha2 = hash ["AUTHENTICATE", digestURI] - in hash [ha1, nonce, nc, cnonce, qop, ha2] - -digestMd5 :: Maybe Text -- Authorization identity (authzid) - -> Text -- Authentication identity (authzid) - -> Text -- Password (authzid) - -> SaslHandler -digestMd5 authzid authcid password = ( "DIGEST-MD5" - , xmppDigestMd5 authzid authcid password - ) \ No newline at end of file diff --git a/source/Network/Xmpp/Sasl/DigestMd5.hs b/source/Network/Xmpp/Sasl/DigestMd5.hs new file mode 100644 index 0000000..e0125ab --- /dev/null +++ b/source/Network/Xmpp/Sasl/DigestMd5.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Xmpp.Sasl.DigestMd5 where + +import Control.Applicative +import Control.Arrow (left) +import Control.Monad +import Control.Monad.Error +import Control.Monad.State.Strict +import Data.Maybe (fromJust, isJust) + +import qualified Crypto.Classes as CC + +import qualified Data.Binary as Binary +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.Digest.Pure.MD5 as MD5 +import qualified Data.List as L + +import qualified Data.Text as Text +import Data.Text (Text) +import qualified Data.Text.Encoding as Text + +import Data.XML.Pickle + +import qualified Data.ByteString as BS + +import Data.XML.Types + +import Network.Xmpp.Monad +import Network.Xmpp.Pickle +import Network.Xmpp.Stream +import Network.Xmpp.Types + + +import Network.Xmpp.Sasl.Common +import Network.Xmpp.Sasl.StringPrep +import Network.Xmpp.Sasl.Types + + + +xmppDigestMd5 :: Maybe Text -- Authorization identity (authzid) + -> Text -- Authentication identity (authzid) + -> Text -- Password (authzid) + -> SaslM () +xmppDigestMd5 authzid authcid password = do + case credentials of + Nothing -> throwError $ AuthStringPrepError + Just (ac, az, pw) -> do + hn <- gets sHostname + case hn of + Just hn' -> do + xmppDigestMd5' hn' ac az pw + Nothing -> throwError AuthConnectionError + where + credentials = do + ac <- normalizeUsername authcid + az <- case authzid of + Nothing -> Just Nothing + Just az' -> Just <$> normalizeUsername az' + pw <- normalizePassword password + return (ac, az, pw) + xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> SaslM () + xmppDigestMd5' hostname authcid authzid password = do + -- Push element and receive the challenge (in SaslM). + _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean? + pairs <- toPairs =<< saslFromJust =<< pullChallenge + cnonce <- liftIO $ makeNonce + _b <- respond . Just $ createResponse hostname pairs cnonce + challenge2 <- pullFinalMessage + _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream + return () + where + -- Produce the response to the challenge. + createResponse :: Text + -> Pairs + -> BS.ByteString -- nonce + -> BS.ByteString + createResponse hostname pairs cnonce = let + Just qop = L.lookup "qop" pairs -- TODO: proper handling + Just nonce = L.lookup "nonce" pairs + uname_ = Text.encodeUtf8 authcid + passwd_ = Text.encodeUtf8 password + -- Using Int instead of Word8 for random 1.0.0.0 (GHC 7) + -- compatibility. + + nc = "00000001" + digestURI = "xmpp/" `BS.append` Text.encodeUtf8 hostname + digest = md5Digest + uname_ + (lookup "realm" pairs) + passwd_ + digestURI + nc + qop + nonce + cnonce + response = BS.intercalate "," . map (BS.intercalate "=") $ + [["username", quote uname_]] ++ + case L.lookup "realm" pairs of + Just realm -> [["realm" , quote realm ]] + Nothing -> [] ++ + [ ["nonce" , quote nonce ] + , ["cnonce" , quote cnonce ] + , ["nc" , nc ] + , ["qop" , qop ] + , ["digest-uri", quote digestURI] + , ["response" , digest ] + , ["charset" , "utf-8" ] + ] + in B64.encode response + hash :: [BS8.ByteString] -> BS8.ByteString + hash = BS8.pack . show + . (CC.hash' :: BS.ByteString -> MD5.MD5Digest) + . BS.intercalate (":") + hashRaw :: [BS8.ByteString] -> BS8.ByteString + hashRaw = toStrict . Binary.encode . + (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":") + toStrict :: BL.ByteString -> BS8.ByteString + toStrict = BS.concat . BL.toChunks + -- TODO: this only handles MD5-sess + md5Digest :: BS8.ByteString + -> Maybe BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + -> BS8.ByteString + md5Digest uname realm password digestURI nc qop nonce cnonce = + let ha1 = hash [ hashRaw [uname, maybe "" id realm, password] + , nonce + , cnonce + ] + ha2 = hash ["AUTHENTICATE", digestURI] + in hash [ha1, nonce, nc, cnonce, qop, ha2] + +digestMd5 :: Maybe Text -- Authorization identity (authzid) + -> Text -- Authentication identity (authzid) + -> Text -- Password (authzid) + -> SaslHandler +digestMd5 authzid authcid password = ( "DIGEST-MD5" + , xmppDigestMd5 authzid authcid password + ) \ No newline at end of file diff --git a/source/Network/Xmpp/Sasl/Plain.hs b/source/Network/Xmpp/Sasl/Plain.hs index 227c95f..4a2ea1f 100644 --- a/source/Network/Xmpp/Sasl/Plain.hs +++ b/source/Network/Xmpp/Sasl/Plain.hs @@ -46,9 +46,9 @@ import Network.Xmpp.Sasl.Common import Network.Xmpp.Sasl.Types -- TODO: stringprep -xmppPlain :: Text.Text - -> Maybe Text.Text - -> Text.Text +xmppPlain :: Text.Text -- ^ Password + -> Maybe Text.Text -- ^ Authorization identity (authzid) + -> Text.Text -- ^ Authentication identity (authcid) -> SaslM () xmppPlain authcid authzid passwd = do _ <- saslInit "PLAIN" ( Just $ plainMessage authzid authcid passwd) diff --git a/source/Network/Xmpp/Sasl/Scram.hs b/source/Network/Xmpp/Sasl/Scram.hs index 3f04f46..2d0b318 100644 --- a/source/Network/Xmpp/Sasl/Scram.hs +++ b/source/Network/Xmpp/Sasl/Scram.hs @@ -4,7 +4,7 @@ module Network.Xmpp.Sasl.Scram where -import Control.Applicative((<$>)) +import Control.Applicative ((<$>)) import Control.Monad.Error import Control.Monad.Trans (liftIO) import qualified Crypto.Classes as Crypto @@ -16,8 +16,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 as BS8 (unpack) import qualified Data.ByteString.Lazy as LBS -import Data.List (foldl1') - +import Data.List (foldl1', genericTake) import qualified Data.Binary.Builder as Build @@ -52,11 +51,11 @@ hashToken = undefined -- -- This implementation is independent and polymorphic in the used hash function. scram :: (Crypto.Hash ctx hash) - => hash -- ^ Dummy argument to determine the hash to use. You + => hash -- ^ Dummy argument to determine the hash to use; you -- can safely pass undefined or a 'hashToken' to it - -> Text.Text -- ^ authentication ID (username) - -> Maybe Text.Text -- ^ authorization ID - -> Text.Text -- ^ password + -> Text.Text -- ^ Authentication ID (user name) + -> Maybe Text.Text -- ^ Authorization ID + -> Text.Text -- ^ Password -> SaslM () scram hashToken authcid authzid password = case credentials of Nothing -> throwError $ AuthStringPrepError @@ -84,32 +83,51 @@ scram hashToken authcid authzid password = case credentials of -- We need to jump through some hoops to get a polymorphic solution encode :: Crypto.Hash ctx hash => hash -> hash -> BS.ByteString encode _hashtoken = Crypto.encode + + hash :: BS.ByteString -> BS.ByteString hash str = encode hashToken $ Crypto.hash' str + + hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString hmac key str = encode hashToken $ Crypto.hmac' (Crypto.MacKey key) str + authzid :: Maybe BS.ByteString authzid = (\z -> "a=" +++ Text.encodeUtf8 z) <$> authzid' + + gs2CbindFlag :: BS.ByteString gs2CbindFlag = "n" -- we don't support channel binding yet + + gs2Header :: BS.ByteString gs2Header = merge $ [ gs2CbindFlag , maybe "" id authzid , "" ] + cbindData :: BS.ByteString cbindData = "" -- we don't support channel binding yet + + cFirstMessageBare :: BS.ByteString -> BS.ByteString cFirstMessageBare cnonce = merge [ "n=" +++ Text.encodeUtf8 authcid , "r=" +++ cnonce] + cFirstMessage :: BS.ByteString -> BS.ByteString cFirstMessage cnonce = gs2Header +++ cFirstMessageBare cnonce fromPairs :: Pairs -> BS.ByteString - -> SaslM (BS.ByteString, BS.ByteString, Int) + -> SaslM (BS.ByteString, BS.ByteString, Integer) fromPairs pairs cnonce | Just nonce <- lookup "r" pairs , cnonce `BS.isPrefixOf` nonce , Just salt' <- lookup "s" pairs , Right salt <- B64.decode salt' , Just ic <- lookup "i" pairs , [(i,"")] <- reads $ BS8.unpack ic - = return (nonce, salt, i :: Int) + = return (nonce, salt, i) fromPairs _ _ = throwError $ AuthChallengeError + cFinalMessageAndVerifier :: BS.ByteString + -> BS.ByteString + -> Integer + -> BS.ByteString + -> BS.ByteString + -> (BS.ByteString, BS.ByteString) cFinalMessageAndVerifier nonce salt ic sfm cnonce = (merge [ cFinalMessageWOProof , "p=" +++ B64.encode clientProof @@ -117,22 +135,40 @@ scram hashToken authcid authzid password = case credentials of , B64.encode serverSignature ) where + cFinalMessageWOProof :: BS.ByteString cFinalMessageWOProof = merge [ "c=" +++ B64.encode gs2Header , "r=" +++ nonce] + + saltedPassword :: BS.ByteString saltedPassword = hi (Text.encodeUtf8 password) salt ic + + clientKey :: BS.ByteString clientKey = hmac saltedPassword "Client Key" + + storedKey :: BS.ByteString storedKey = hash clientKey + + authMessage :: BS.ByteString authMessage = merge [ cFirstMessageBare cnonce , sfm , cFinalMessageWOProof ] + + clientSignature :: BS.ByteString clientSignature = hmac storedKey authMessage + + clientProof :: BS.ByteString clientProof = clientKey `xorBS` clientSignature + + serverKey :: BS.ByteString serverKey = hmac saltedPassword "Server Key" + + serverSignature :: BS.ByteString serverSignature = hmac serverKey authMessage -- helper - hi str salt ic = foldl1' xorBS (take ic us) + hi :: BS.ByteString -> BS.ByteString -> Integer -> BS.ByteString + hi str salt ic = foldl1' xorBS (genericTake ic us) where u1 = hmac str (salt +++ (BS.pack [0,0,0,1])) us = iterate (hmac str) u1 diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index c4caf3a..cc0351f 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -11,19 +11,26 @@ data AuthError = AuthXmlError -- offered | AuthChallengeError | AuthServerAuthError -- ^ The server failed to authenticate - -- himself + -- itself | AuthStreamError StreamError -- ^ Stream error on stream restart - | AuthConnectionError -- ^ No host name set in state + -- TODO: Rename AuthConnectionError? + | AuthConnectionError -- ^ Connection is closed | AuthError -- General instance used for the Error instance - | AuthSaslFailure SaslFailure -- ^ defined SASL error condition + | AuthSaslFailure SaslFailure -- ^ Defined SASL error condition | AuthStringPrepError -- ^ StringPrep failed deriving Show instance Error AuthError where noMsg = AuthError +data SaslElement = SaslSuccess (Maybe Text.Text) + | SaslChallenge (Maybe Text.Text) + +-- | SASL mechanism XmppConnection computation, with the possibility of throwing +-- an authentication error. type SaslM a = ErrorT AuthError (StateT XmppConnection IO) a type Pairs = [(ByteString, ByteString)] -type SaslHandler = (Text.Text, SaslM ()) \ No newline at end of file +-- | Tuple defining the SASL Handler's name, and a SASL mechanism computation +type SaslHandler = (Text.Text, SaslM ())