module Web.Authenticate.LDAP
( loginLDAP
, LDAPAuthResult (..)
) where
import Data.Text (Text,unpack)
import LDAP
import Control.Exception
import Control.Monad.IO.Class
data LDAPAuthResult = Ok [LDAPEntry]
| NoSuchUser
| WrongPassword
| InitialBindFail
instance Show LDAPAuthResult where
show (Ok _ ) = "Login successful"
show NoSuchUser = "Wrong username"
show WrongPassword = "Wrong password"
show InitialBindFail = "The initial bind attempt to the ldap" ++
"server failed"
loginLDAP :: Text ->
String ->
String ->
String ->
LDAPInt ->
String ->
String ->
Maybe String ->
LDAPScope ->
IO LDAPAuthResult
loginLDAP user userDN pass ldapHost ldapPort' initDN initPassword searchDN ldapScope =
do
ldapOBJ <- ldapInit ldapHost ldapPort'
initBindResult <- try (ldapSimpleBind ldapOBJ initDN initPassword)
:: IO (Either LDAPException ())
case initBindResult of
Right _ -> do
entry <- ldapSearch ldapOBJ
searchDN
ldapScope
(Just ("sAMAccountName=" ++ (unpack user)))
LDAPAllUserAttrs
False
case entry of
[LDAPEntry _ _] -> do
ldapOBJ' <- ldapInit ldapHost ldapPort'
userBindResult <- try (ldapSimpleBind ldapOBJ' userDN pass) :: IO (Either LDAPException ())
case userBindResult of
Right _ -> return $ Ok entry
Left _ -> return WrongPassword
_ -> return NoSuchUser
Left _ -> return InitialBindFail