From bfa6a968a6e413abe60f51e7ae54b9aec5422a7f Mon Sep 17 00:00:00 2001
From: "Adam C. Baker" <adam.durandal@gmail.com>
Date: Wed, 1 Oct 2014 15:42:57 -0700
Subject: [PATCH] more unit-y unit tests

---
 src/PgQuery.hs           |  6 +++++-
 test/Unit/PgQuerySpec.hs | 39 +++++++++++++++++++++------------------
 2 files changed, 26 insertions(+), 19 deletions(-)

diff --git a/src/PgQuery.hs b/src/PgQuery.hs
index a1a2f98fd..6909d37b0 100644
--- a/src/PgQuery.hs
+++ b/src/PgQuery.hs
@@ -10,6 +10,7 @@ module PgQuery (
   signInRole,
   pgSetRole,
   pgResetRole,
+  checkPass,
   RangedResult(..),
   DbRole
 ) where
@@ -131,12 +132,15 @@ addUser identity pass role conn = do
     ]) conn
   return ()
 
+checkPass :: BS.ByteString -> BS.ByteString -> Bool
+checkPass = validatePassword
+
 signInRole :: BS.ByteString -> BS.ByteString -> Connection -> IO(Maybe DbRole)
 signInRole user pass conn = do
   u <- quickQuery conn "select pass, rolname from dbapi.auth where id = ?" [toSql user]
   return $ case u of
     [[hashed, role]] ->
-      if validatePassword (fromSql hashed) (cs pass)
+      if checkPass (fromSql hashed) (cs pass)
          then Just $ fromSql role
          else Nothing
     _ -> Nothing
diff --git a/test/Unit/PgQuerySpec.hs b/test/Unit/PgQuerySpec.hs
index 8d0e317b4..69f0d3835 100644
--- a/test/Unit/PgQuerySpec.hs
+++ b/test/Unit/PgQuerySpec.hs
@@ -4,15 +4,15 @@ module Unit.PgQuerySpec where
 
 import Test.Hspec
 
-import Database.HDBC (IConnection, SqlValue, toSql, prepare,
-                      execute, seState, fetchAllRowsAL)
+import Database.HDBC (IConnection, SqlValue, toSql, prepare, quickQuery,
+  fromSql, execute, seState, fetchAllRowsAL)
 
-import PgQuery (insert, addUser, signInRole)
+import PgQuery (insert, addUser, signInRole, checkPass)
 import Types (SqlRow(SqlRow))
 import TestTypes (fromList, incStr, incNullableStr, incInsert, incId)
 import Data.Map (toList)
-import Data.Monoid ((<>))
 import Data.String.Conversions (cs)
+import Data.Monoid ((<>))
 import Control.Arrow
 
 import SpecHelper(dbWithSchema)
@@ -53,22 +53,25 @@ spec = around dbWithSchema $ do
           ("nullable_string", toSql ("a string"::String))]) conn
           `shouldThrow` \e -> seState e == "23502"
 
-  describe "addUser and signInRole" $ do
+  let {user = "jdoe"; pass = "secret"; role = "test_default_role"}
+  describe "addUser" $ do
     it "adds a correct user to the right table" $ \conn -> do
-      let {user = "jdoe"; pass = "secret"; role = "test_default_role"}
-
-      r <- signInRole user pass conn
-      r `shouldBe` Nothing
-
       addUser user pass role conn
-
-      r2 <- signInRole user pass conn
-      r2 `shouldBe` Just role
-
-      r3 <- signInRole user (pass <> "crap") conn
-      r3 `shouldBe` Nothing
+      [r] <- quickQuery conn "select * from dbapi.auth" []
+      let [newUser, newRole, encryptedPass] = map fromSql r :: [String]
+      cs newUser `shouldBe` user
+      cs newRole `shouldBe` role
+      checkPass (cs encryptedPass) pass `shouldBe` True
 
     it "will not add a user with an unknown role" $ \conn -> do
-      let {user = "jdoe"; pass = "secret"; role = "fake_role"}
+      addUser user pass "not-a-real-role" conn `shouldThrow` anyException
 
-      addUser user pass role conn `shouldThrow` anyException
+  describe "signInRole" $ beforeWith (\conn -> do
+    addUser user pass role conn
+    return conn) $ do
+    it "accepts correct credentials and return the role" $ \conn ->
+      signInRole user pass conn `shouldReturn` Just role
+
+    it "returns nothing with bad creds" $ \conn -> do
+      signInRole "not-a-user" pass conn `shouldReturn` Nothing
+      signInRole user (pass <> "crap") conn `shouldReturn` Nothing