+5
-1
@@ -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
|
||||
|
||||
+21
-18
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user