(untested) sasl plain implementation

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

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

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]

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 <auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/> element.
-saslInitE :: Text -> Element
-saslInitE mechanism =
+-- The <auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/> 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 =

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