module Network.Xmpp.Sasl.Mechanisms.Plain
( 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.Stream
import Network.Xmpp.Types
import qualified System.Random as Random
import Data.Maybe (fromMaybe)
import qualified Data.Text as Text
import Network.Xmpp.Sasl.Common
import Network.Xmpp.Sasl.Types
xmppPlain :: Text.Text
-> Maybe Text.Text
-> Text.Text
-> ErrorT AuthFailure (StateT StreamState IO) ()
xmppPlain authcid authzid password = do
(ac, az, pw) <- prepCredentials authcid authzid password
_ <- saslInit "PLAIN" ( Just $ plainMessage ac az pw)
_ <- pullSuccess
return ()
where
plainMessage :: Text.Text
-> Maybe Text.Text
-> Text.Text
-> BS.ByteString
plainMessage authcid authzid passwd = BS.concat $
[ authzid'
, "\NUL"
, Text.encodeUtf8 $ authcid
, "\NUL"
, Text.encodeUtf8 $ passwd
]
where
authzid' = maybe "" Text.encodeUtf8 authzid
plain :: Text.Text
-> Maybe Text.Text
-> Text.Text
-> SaslHandler
plain authcid authzid passwd =
( "PLAIN"
, do
r <- runErrorT $ xmppPlain authcid authzid passwd
case r of
Left (AuthStreamFailure e) -> return $ Left e
Left e -> return $ Right $ Just e
Right () -> return $ Right Nothing
)