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.Char8 as B8 (ByteString, pack, singleton)
import Data.Monoid
type Username = B8.ByteString
type Password = B8.ByteString
authenticate :: Server -> Username -> Password -> IO Bool
authenticate = saslAuthPlain
saslAuthPlain :: Server -> Username -> Password -> IO Bool
saslAuthPlain c u p = do
let credentials = singleton '\0' <> u <> singleton '\0' <> p
msg = emptyReq { reqOp = ReqSASLStart (B8.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 :: Server -> IO B8.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