diff --git a/source/Network/XMPP/SASL.hs b/source/Network/XMPP/SASL.hs
index 105f591..3ce2d1f 100644
--- a/source/Network/XMPP/SASL.hs
+++ b/source/Network/XMPP/SASL.hs
@@ -32,9 +32,9 @@ import qualified System.Random as Random
import Network.XMPP.SASL.SASL
import Network.XMPP.SASL.DIGEST_MD5
+import Network.XMPP.SASL.PLAIN
import Network.XMPP.SASL.Types
-
-- 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
@@ -53,6 +53,10 @@ xmppSASL creds = runErrorT $ do
authzid
authcid
passwd
+ PLAINCredentials authzid authcid passwd -> ErrorT $ xmppPLAIN
+ authzid
+ authcid
+ passwd
_ -> error "xmppSASL: Mechanism not caught"
where
-- Converts the credentials to the appropriate mechanism name, corresponding to
diff --git a/source/Network/XMPP/SASL/DIGEST_MD5.hs b/source/Network/XMPP/SASL/DIGEST_MD5.hs
index b113569..4eb3638 100644
--- a/source/Network/XMPP/SASL/DIGEST_MD5.hs
+++ b/source/Network/XMPP/SASL/DIGEST_MD5.hs
@@ -56,7 +56,7 @@ xmppDIGEST_MD5 authzid authcid passwd = runErrorT $ do
-> XMPPConMonad (Either AuthError ())
xmppDIGEST_MD5' realm = runErrorT $ do
-- Push element and receive the challenge (in XMPPConMonad).
- _ <- lift . pushElement $ saslInitE "DIGEST-MD5" -- TODO: Check boolean?
+ _ <- lift . pushElement $ saslInitE "DIGEST-MD5" Nothing -- TODO: Check boolean?
challenge' <- lift $ B64.decode . Text.encodeUtf8 <$>
pullPickle challengePickle
challenge <- case challenge' of
diff --git a/source/Network/XMPP/SASL/PLAIN.hs b/source/Network/XMPP/SASL/PLAIN.hs
new file mode 100644
index 0000000..6c1ca3e
--- /dev/null
+++ b/source/Network/XMPP/SASL/PLAIN.hs
@@ -0,0 +1,73 @@
+-- Implementation of the PLAIN Simple Authentication and Security Layer (SASL)
+-- Mechanism, http://tools.ietf.org/html/rfc4616.
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.XMPP.SASL.PLAIN 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 Data.Word (Word8)
+
+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 qualified System.Random as Random
+
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+
+import Network.XMPP.SASL.SASL
+import Network.XMPP.SASL.Types
+
+xmppPLAIN :: Maybe T.Text
+ -> T.Text
+ -> T.Text
+ -> XMPPConMonad (Either AuthError ())
+xmppPLAIN authzid authcid passwd = runErrorT $ do
+ _ <- lift . pushElement $ saslInitE "PLAIN" $ -- TODO: Check boolean?
+ Just $ plainMessage authzid authcid passwd
+ lift $ pushElement saslResponse2E
+ e <- lift pullElement
+ case e of
+ Element "{urn:ietf:params:xml:ns:xmpp-sasl}success" [] [] ->
+ return ()
+ _ -> throwError AuthXmlError -- TODO: investigate
+ -- The SASL authentication has succeeded; the stream is restarted.
+ _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream
+ return ()
+ where
+ -- Converts an optional authorization identity, an authentication identity,
+ -- and a password to a \NUL-separated PLAIN message.
+ plainMessage :: Maybe T.Text -- Authorization identity (authzid)
+ -> T.Text -- Authentication identity (authcid)
+ -> T.Text -- Password
+ -> T.Text -- The PLAIN message
+ plainMessage authzid authcid passwd =
+ let authzid' = fromMaybe "" authzid in
+ T.concat [authzid', "\NUL", authcid, "\NUL", passwd]
\ No newline at end of file
diff --git a/source/Network/XMPP/SASL/SASL.hs b/source/Network/XMPP/SASL/SASL.hs
index 8259664..9cba0ef 100644
--- a/source/Network/XMPP/SASL/SASL.hs
+++ b/source/Network/XMPP/SASL/SASL.hs
@@ -10,15 +10,18 @@ import qualified Data.Attoparsec.ByteString.Char8 as AP
import Data.XML.Pickle
import Data.XML.Types
import qualified Data.ByteString as BS
+import Data.Maybe (fromMaybe)
import Network.XMPP.Pickle
--- The element.
-saslInitE :: Text -> Element
-saslInitE mechanism =
+-- The element, with an
+-- optional round-trip value.
+saslInitE :: Text -> Maybe Text -> Element
+saslInitE mechanism rt =
Element "{urn:ietf:params:xml:ns:xmpp-sasl}auth"
[("mechanism", [ContentText mechanism])]
- []
+ [NodeContent $ ContentText $ fromMaybe "" rt]
+
-- SASL response with text payload.
saslResponseE :: Text -> Element
saslResponseE resp =
diff --git a/source/Network/XMPP/Types.hs b/source/Network/XMPP/Types.hs
index f3130c5..5eddfc6 100644
--- a/source/Network/XMPP/Types.hs
+++ b/source/Network/XMPP/Types.hs
@@ -403,11 +403,15 @@ instance Read StanzaErrorCondition where
-- =============================================================================
data SASLCredentials = DIGEST_MD5Credentials (Maybe Text) Text Text
+ | PLAINCredentials (Maybe Text) Text Text
instance Show SASLCredentials where
show (DIGEST_MD5Credentials authzid authcid _) = "DIGEST_MD5Credentials " ++
(Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++
" (password hidden)"
+ show (PLAINCredentials authzid authcid _) = "PLAINCredentials " ++
+ (Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++
+ " (password hidden)"
data SASLMechanism = DIGEST_MD5 deriving Show