{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Xmpp.Sasl.Mechanisms.Plain
( plain
) where
import Control.Monad.Except
import Control.Monad.State.Strict
import qualified Data.ByteString as BS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Network.Xmpp.Sasl.Common
import Network.Xmpp.Sasl.Types
import Network.Xmpp.Types
xmppPlain :: Text.Text
-> Maybe Text.Text
-> Text.Text
-> ExceptT AuthFailure (StateT StreamState IO) ()
xmppPlain :: Text
-> Maybe Text
-> Text
-> ExceptT AuthFailure (StateT StreamState IO) ()
xmppPlain Text
authcid' Maybe Text
authzid' Text
password = do
(Text
ac, Maybe Text
az, Text
pw) <- Text
-> Maybe Text
-> Text
-> ExceptT
AuthFailure (StateT StreamState IO) (Text, Maybe Text, Text)
prepCredentials Text
authcid' Maybe Text
authzid' Text
password
()
_ <- Text
-> Maybe ByteString
-> ExceptT AuthFailure (StateT StreamState IO) ()
saslInit Text
"PLAIN" ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text -> ByteString
plainMessage Text
ac Maybe Text
az Text
pw)
Maybe Text
_ <- ExceptT AuthFailure (StateT StreamState IO) (Maybe Text)
pullSuccess
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
plainMessage :: Text.Text
-> Maybe Text.Text
-> Text.Text
-> BS.ByteString
plainMessage :: Text -> Maybe Text -> Text -> ByteString
plainMessage Text
authcid Maybe Text
_authzid Text
passwd = [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$
[ ByteString
authzid''
, ByteString
"\NUL"
, Text -> ByteString
Text.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
authcid
, ByteString
"\NUL"
, Text -> ByteString
Text.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
passwd
]
where
authzid'' :: ByteString
authzid'' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" Text -> ByteString
Text.encodeUtf8 Maybe Text
authzid'
plain :: Username
-> Maybe AuthZID
-> Password
-> SaslHandler
plain :: Text -> Maybe Text -> Text -> SaslHandler
plain Text
authcid Maybe Text
authzid Text
passwd =
( Text
"PLAIN"
, do
Either AuthFailure ()
r <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Text
-> ExceptT AuthFailure (StateT StreamState IO) ()
xmppPlain Text
authcid Maybe Text
authzid Text
passwd
case Either AuthFailure ()
r of
Left (AuthStreamFailure XmppFailure
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left XmppFailure
e
Left AuthFailure
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AuthFailure
e
Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
)