module Database.Memcache.SASL (
Authentication(..), Username, Password,
authenticate
) where
import Database.Memcache.Errors
import Database.Memcache.Socket
import Database.Memcache.Types
import Control.Exception (throwIO)
import Control.Monad
import Data.ByteString.Char8 as B8 (ByteString, pack, singleton)
import Data.Monoid
authenticate :: Socket -> Authentication -> IO ()
authenticate _ NoAuth = return ()
authenticate s (Auth u p) = saslAuthPlain s u p
saslAuthPlain :: Socket -> Username -> Password -> IO ()
saslAuthPlain s u p = do
let credentials = singleton '\0' <> u <> singleton '\0' <> p
msg = emptyReq { reqOp = ReqSASLStart (B8.pack "PLAIN") credentials }
send s msg
r <- recv s
when (resOp r /= ResSASLStart) $
throwIO $ wrongOp r "SASL_START"
case resStatus r of
NoError -> return ()
rs -> throwIO $ OpError rs
saslListMechs :: Socket -> IO B8.ByteString
saslListMechs s = do
let msg = emptyReq { reqOp = ReqSASLList }
send s msg
r <- recv s
v <- case resOp r of
ResSASLList v -> return v
_ -> throwIO $ wrongOp r "SASL_LIST"
case resStatus r of
NoError -> return v
rs -> throwIO $ OpError rs