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