authenticate-ldap 0.0.1.1 → 0.0.2

raw patch · 2 files changed

+24/−17 lines, 2 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Web/Authenticate/LDAP.hs +22/−16
• authenticate-ldap.cabal +2/−1

@@ -14,18 +14,22 @@ 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 -> -- user's identifier+             String -> -- user's DN              String -> -- user's password              String -> -- LDAPHost              LDAPInt -> -- LDAP port@@ -34,24 +38,26 @@              Maybe String -> --  Base DN for user search, if any              LDAPScope -> -- Scope of User search              IO LDAPAuthResult-loginLDAP user pass ldapHost ldapPort' initDN initPassword searchDN ldapScope =+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 -- Successful initial bind-       ldapOBJ' <- ldapInit ldapHost ldapPort'-       userBindResult <- try (ldapSimpleBind ldapOBJ' (unpack user) pass) -                                                 :: IO (Either LDAPException ())-       case userBindResult of-         Right _ -> do -- Successful user bind-           entry <- ldapSearch ldapOBJ  -                               searchDN -                               ldapScope-                               (Just ("sAMAccountName=" ++ (unpack user)))-                               LDAPAllUserAttrs-                               False-           return $ Ok entry-         Left _ -> return WrongPassword-     Left _ -> return NoSuchUser    +       entry <- ldapSearch ldapOBJ+                           searchDN+                           ldapScope+                           (Just ("sAMAccountName=" ++  (unpack user)))+                           LDAPAllUserAttrs+                           False+-- FIXME y u no make new function for nested case statement?       +       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 -- Successful user bind+                               Left _ -> return WrongPassword+         _               -> return NoSuchUser+     Left _ -> return InitialBindFail    

@@ -1,5 +1,5 @@ name:            authenticate-ldap-version:         0.0.1.1 +version:         0.0.2  license:         BSD3 license-file:    LICENSE author:          Michael Litchard @@ -17,6 +17,7 @@     build-depends:   base                          >= 4        && < 5                    , text                    , LDAP                          == 0.6.6+                   , transformers                  == 0.2.2.0     exposed-modules: Web.Authenticate.LDAP     ghc-options:     -Wall