Added more test, polished existing ones.

test/suite/Snap/Snaplet/Auth/Handlers/Tests.hs

@@ -31,6 +31,8 @@ tests = testGroup "Snap.Snaplet.Auth.Handlers"
         ,testCreateEmptyUser
         ,testCreateDupUser
         ,testUsernameExists 
+        ,testLoginByUsername 
+        ,testLoginByUsernameEnc
         ]
     ]
 
@@ -59,7 +61,9 @@ testCreateUserGood = testCase "createUser good params" assertGoodUser
         res <- evalHandler (ST.get "" Map.empty) createGoodUserHdlr appInit
         case res of
           (Left e) -> assertFailure $ show e
-          (Right res') -> assertBool "user successfully created" $ isRight res'
+          (Right res') -> assertBool failMsg $ isRight res'
+
+    failMsg = "createUser failed: Couldn't create a new user."
 
 
 ------------------------------------------------------------------------------
@@ -73,7 +77,9 @@ testCreateEmptyUser = testCase "createUser empty username" assertEmptyUser
         res <- evalHandler (ST.get "" Map.empty) createEmptyUserHdlr appInit
         case res of
           (Left e) -> assertFailure $ show e
-          (Right res') -> assertBool "empty username rejected" $ isLeft res'
+          (Right res') -> assertBool failMsg $ isLeft res'
+
+    failMsg = "createUser: Was created an empty username despite they aren't allowed."
 
 
 ------------------------------------------------------------------------------
@@ -87,7 +93,9 @@ testCreateDupUser = testCase "createUser duplicate user" assertDupUser
         res <- evalHandler (ST.get "" Map.empty) createDupUserHdlr appInit
         case res of
           (Left e) -> assertFailure $ show e
-          (Right res') -> assertBool "duplicate user rejected" $ isLeft res'
+          (Right res') -> assertBool failMsg $ isLeft res'
+
+    failMsg = "createUser: Expected to find a duplicate user, but I haven't."
 
 
 ------------------------------------------------------------------------------
@@ -99,10 +107,42 @@ testUsernameExists = testCase "username exists" assertUserExists
   where
     assertUserExists :: Assertion
     assertUserExists = do
-        res <- evalHandler (ST.get "" Map.empty)
-                          (with auth $ usernameExists "foo")
-                          appInit
+        let hdl = with auth $ usernameExists "foo"
+        res <- evalHandler (ST.get "" Map.empty) hdl appInit
+        case res of
+          (Left e) -> assertFailure $ show e
+          (Right res') -> assertBool failMsg res'
+
+    failMsg = "usernameExists: Expected to return True, but it didn't."
+
+
+------------------------------------------------------------------------------
+testLoginByUsername :: Test
+testLoginByUsername = testCase "successful loginByUsername" assertion
+  where
+    assertion :: Assertion
+    assertion = do
+        let pwd = ClearText "foo"
+        let hdl = with auth $ loginByUsername "foo" pwd False
+        res <- evalHandler (ST.get "" Map.empty) hdl appInit
+        case res of
+          (Left e) -> assertFailure $ show e
+          (Right res') -> assertBool failMsg $ isRight res'
+
+    failMsg = "loginByUsername: Failed with ClearText pwd."
+
+
+------------------------------------------------------------------------------
+testLoginByUsernameEnc :: Test
+testLoginByUsernameEnc = testCase "loginByUsername encrypted pwd" assertion
+  where
+    assertion :: Assertion
+    assertion = do
+        let pwd = Encrypted "foo"
+        let hdl = with auth $ loginByUsername "foo" pwd False
+        res <- evalHandler (ST.get "" Map.empty) hdl appInit
         case res of
           (Left e) -> assertFailure $ show e
-          (Right res') -> assertBool "username exists" res'
+          (Right res') -> assertBool failMsg $ isLeft res'
 
+    failMsg = "loginByUsername: Expected to find an Encrypted password, but I haven't."

test/users.json

@@ -1 +1 @@
-{"tokenCache":{},"loginCache":{"foo":"1"},"uidCounter":1,"uidCache":[["1",{"activated_at":null,"current_ip":null,"pw":"sha256|12|qJvYB6oGHRER8ujCFpzf9w==|WMNhbNhWPm6QjrxWeq42mubbu69LkQCdZw3Wret3p7w=","login_count":0,"last_login_at":null,"suspended_at":null,"login":"foo","failed_login_count":0,"meta":{},"current_login_at":null,"locked_until":null,"roles":[],"updated_at":"2012-10-18T10:40:12.237Z","last_ip":null,"remember_token":null,"uid":"1","created_at":"2012-10-18T10:40:12.237Z"}]]}
+{"tokenCache":{},"loginCache":{"foo":"1"},"uidCounter":1,"uidCache":[["1",{"activated_at":null,"current_ip":"127.0.0.1","pw":"sha256|12|hO/7/JX3iTfESuICvZTvPA==|ukFuA2Yq+RruFsVshR/5d7yBmuWRyycC+AN/pUJwsxg=","login_count":1,"last_login_at":null,"suspended_at":null,"login":"foo","failed_login_count":0,"meta":{},"current_login_at":"2012-10-18T13:21:34.594Z","locked_until":null,"roles":[],"updated_at":"2012-10-18T13:21:34.594Z","last_ip":null,"remember_token":null,"uid":"1","created_at":"2012-10-18T13:21:34.555Z"}]]}