Add simple Search operation tests

This commit is contained in:
Matvey Aksenov 2015-03-31 07:59:36 +00:00
parent 3630ddf506
commit 752bdd7cdd

View File

@ -1,10 +1,11 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module Ldap.ClientSpec (spec) where
import Data.Monoid ((<>))
import Test.Hspec
import Ldap.Client
import Ldap.Client (Host(..), Dn(..), Password(..), Filter(..), Scope(..), scope, size, Attr(..), BindError(..), ResultCode(..))
import qualified Ldap.Client as Ldap
@ -44,33 +45,70 @@ spec = do
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 ()
context "bind" $ 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 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 ()
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 ()
context "search" $ do
let search l f = Ldap.search l (Dn "dc=example,dc=com") (Ldap.scope WholeSubtree <> Ldap.typesOnly True) f []
it "can use present filter" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
res <- search l (Present (Attr "initials"))
dns res `shouldMatchList` [Dn "uid=test,dc=example,dc=com"]
return ()
it "can use equality match filter" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
res <- search l (Attr "sn" := "Tesla")
dns res `shouldMatchList` [Dn "uid=tesla,dc=example,dc=com"]
return ()
it "can use or filter" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
res <- search l (Or [ Attr "sn" := "Tesla"
, Attr "cn" := "Issac Newton" -- why the fuck "Issac"?
])
dns res `shouldMatchList` [Dn "uid=tesla,dc=example,dc=com", Dn "uid=newton,dc=example,dc=com"]
return ()
it "can use and and not filters" $ do
Right () <- Ldap.with forumsys 389 $ \l -> do
res <- search l (And [ Attr "uniqueMember" := "uid=tesla,dc=example,dc=com"
, Not (Attr "uniqueMember" := "uid=einstein,dc=example,dc=com")
])
dns res `shouldMatchList` [Dn "ou=italians,ou=scientists,dc=example,dc=com"]
return ()
mit :: Host
mit = Plain "scripts.mit.edu"
forumsys :: Host
forumsys = Plain "ldap.forumsys.com"
dns :: [Ldap.SearchEntry] -> [Dn]
dns (Ldap.SearchEntry dn _ : es) = dn : dns es
dns [] = []
dns _ = error "?"