{-# 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" ( ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
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
() -> ExceptT AuthFailure (StateT StreamState IO) ()
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
[ ByteString
authzid''
, ByteString
"\NUL"
, Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
authcid
, ByteString
"\NUL"
, Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
passwd
]
where
authzid'' :: ByteString
authzid'' = ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
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 <- ExceptT AuthFailure (StateT StreamState IO) ()
-> StateT StreamState IO (Either AuthFailure ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT AuthFailure (StateT StreamState IO) ()
-> StateT StreamState IO (Either AuthFailure ()))
-> ExceptT AuthFailure (StateT StreamState IO) ()
-> StateT StreamState IO (Either AuthFailure ())
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) -> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure)))
-> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall a b. (a -> b) -> a -> b
$ XmppFailure -> Either XmppFailure (Maybe AuthFailure)
forall a b. a -> Either a b
Left XmppFailure
e
Left AuthFailure
e -> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure)))
-> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall a b. (a -> b) -> a -> b
$ Maybe AuthFailure -> Either XmppFailure (Maybe AuthFailure)
forall a b. b -> Either a b
Right (Maybe AuthFailure -> Either XmppFailure (Maybe AuthFailure))
-> Maybe AuthFailure -> Either XmppFailure (Maybe AuthFailure)
forall a b. (a -> b) -> a -> b
$ AuthFailure -> Maybe AuthFailure
forall a. a -> Maybe a
Just AuthFailure
e
Right () -> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure)))
-> Either XmppFailure (Maybe AuthFailure)
-> StateT StreamState IO (Either XmppFailure (Maybe AuthFailure))
forall a b. (a -> b) -> a -> b
$ Maybe AuthFailure -> Either XmppFailure (Maybe AuthFailure)
forall a b. b -> Either a b
Right Maybe AuthFailure
forall a. Maybe a
Nothing
)