module Database.Memcache.SASL (
authenticate, Username, Password
) where
import Database.Memcache.Errors
import Database.Memcache.Server
import Database.Memcache.Types
import Control.Monad
import Data.ByteString
import qualified Data.ByteString.Char8 as BC
import Data.Monoid
type Username = ByteString
type Password = ByteString
authenticate :: Connection -> Username -> Password -> IO Bool
authenticate = saslAuthPlain
saslAuthPlain :: Connection -> Username -> Password -> IO Bool
saslAuthPlain c u p = do
let credentials = singleton 0 <> u <> singleton 0 <> p
msg = emptyReq { reqOp = ReqSASLStart (BC.pack "PLAIN") credentials }
r <- sendRecv c msg
when (resOp r /= ResSASLStart) $ throwIncorrectRes r "SASL_START"
case resStatus r of
NoError -> return True
SaslAuthFail -> return False
_ -> throwStatus r
saslListMechs :: Connection -> IO ByteString
saslListMechs c = do
let msg = emptyReq { reqOp = ReqSASLList }
r <- sendRecv c msg
v <- case resOp r of
ResSASLList v -> return v
_ -> throwIncorrectRes r "SASL_LIST"
case resStatus r of
NoError -> return v
_ -> throwStatus r