From 3630ddf50652fecc2d40bc172e1183e2a171ac53 Mon Sep 17 00:00:00 2001
From: Matvey Aksenov <matvey.aksenov@gmail.com>
Date: Sat, 28 Mar 2015 11:11:32 +0000
Subject: [PATCH] Add tests for the Bind operation

---
 src/Ldap/Client.hs      |  2 +
 test/Ldap/ClientSpec.hs | 81 +++++++++++++++++++++++++++++++----------
 2 files changed, 64 insertions(+), 19 deletions(-)

diff --git a/src/Ldap/Client.hs b/src/Ldap/Client.hs
index 399d72b..e4d3ac8 100644
--- a/src/Ldap/Client.hs
+++ b/src/Ldap/Client.hs
@@ -6,11 +6,13 @@ module Ldap.Client
   , PortNumber
   , Ldap
   , LdapError(..)
+  , Type.ResultCode(..)
   , Async
   , with
     -- * Bind Request
   , Dn(..)
   , Password(..)
+  , BindError(..)
   , bind
   , bindEither
   , bindAsync
diff --git a/test/Ldap/ClientSpec.hs b/test/Ldap/ClientSpec.hs
index 58297dd..15e7ee4 100644
--- a/test/Ldap/ClientSpec.hs
+++ b/test/Ldap/ClientSpec.hs
@@ -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"