haskell/ldap-client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add tests for the Bind operation

Browse Source
This commit is contained in:
Matvey Aksenov 2015-03-28 11:11:32 +00:00
parent 86f256fbd8
commit 3630ddf506
2 changed files with 64 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Ldap/Client.hs
View File

@ -6,11 +6,13 @@ module Ldap.Client
, PortNumber
, Ldap
, LdapError(..)
, Type.ResultCode(..)
, Async
, with
-- * Bind Request
, Dn(..)
, Password(..)
, BindError(..)
, bind
, bindEither
, bindAsync

81
test/Ldap/ClientSpec.hs
View File

@ -9,25 +9,68 @@ import qualified Ldap.Client as Ldap
spec :: Spec
spec =
context "Examples stolen from the LDAP package tests" $
spec = do
context "public LDAP server at MIT" $ do
context "public LDAP server at MIT\
\<https://github.com/ezyang/ldap-haskell/blob/371a200f14317f8943d2aebdcc56a09dac46c0ed/testsrc/Tests.hs>" $ do
it "searches the whole tree for the entries that have ‘uid’ attribute" $ do
res <- Ldap.with (Plain "scripts.mit.edu") 389 $ \l -> do
res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu")
(scope WholeSubtree <> typesOnly True)
(Present (Attr "uid"))
[]
res `shouldSatisfy` (not . null)
res `shouldBe` Right ()
it "searches the whole tree for the entries that have ‘uid’ attribute" $ do
Right () <- Ldap.with mit 389 $ \l -> do
res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu")
(scope WholeSubtree)
(Present (Attr "uid"))
[]
res `shouldSatisfy` (not . null)
return ()
it "searches the single level for the first 10 entries that have ‘uid’ attribute" $ do
res <- Ldap.with (Plain "scripts.mit.edu") 389 $ \l -> do
res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu")
(scope WholeSubtree <> typesOnly True <> size 10)
(Present (Attr "uid"))
[]
length res `shouldBe` 10
res `shouldBe` Right ()
it "searches the single level for the first 10 entries that have ‘uid’ attribute" $ do
Right () <- Ldap.with mit 389 $ \l -> do
res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu")
(scope SingleLevel <> size 10)
(Present (Attr "uid"))
[]
length res `shouldBe` 10
return ()
it "searches the single level for the first 10 entries that do not have ‘uid’ attribute" $ do
Right () <- Ldap.with mit 389 $ \l -> do
res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu")
(scope SingleLevel <> size 10)
(Not (Present (Attr "uid")))
[]
res `shouldBe` []
return ()
context "online LDAP test server \
\<http://www.forumsys.com/tutorials/integration-how-to/ldap/online-ldap-test-server>" $ do
it "can bind" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
Ldap.bind l (Dn "cn=read-only-admin,dc=example,dc=com")
(Password "password")
return ()
it "can try to bind with a wrong password" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
res <- Ldap.bindEither l (Dn "cn=read-only-admin,dc=example,dc=com")
(Password "drowssap")
res `shouldBe` Left (BindErrorCode InvalidCredentials)
return ()
it "can login as another user" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
Ldap.bind l (Dn "cn=read-only-admin,dc=example,dc=com")
(Password "password")
Ldap.SearchEntry udn _ : _
<- Ldap.search l (Dn "dc=example,dc=com")
(Ldap.scope WholeSubtree <> Ldap.typesOnly True)
(Attr "uid" := "euler")
[]
Ldap.bind l udn (Password "password")
return ()
mit :: Host
mit = Plain "scripts.mit.edu"
forumsys :: Host
forumsys = Plain "ldap.forumsys.com"