Commits

Anonymous committed cef7644

Add some more tests

Comments (0)

Files changed (5)

tests/BasicTests.hs

 
 basicSpecs :: SpecsConn Connection
 basicSpecs =
-    describe "Some basic tests" $
-        it "home page is not logged in" $ do
+    describe "Basic tests" $ do
+        it "checks the home page is not logged in" $ do
             get_ "/"
             statusIs 200
             bodyContains "Please visit the <a href=\"/auth/login\">Login page"
+
+        it "tests an invalid login" $ do
+            get_ "/auth/login"
+            statusIs 200
+
+            post "/auth/page/account/login" $ do
+                byLabel "Username" "abc"
+                byLabel "Password" "xxx"
+
+            statusIs 303
+            get_ "/auth/login"
+            statusIs 200
+            bodyContains "Invalid username or password"
+
+        it "new account page looks ok" $ do
+            get_ "/auth/page/account/newaccount"
+            statusIs 200
+            htmlAllContain "title" "Register a new account"
+            bodyContains "Register"
+
+        it "reset password page looks ok" $ do
+            get_ "/auth/page/account/resetpassword"
+            statusIs 200
+            bodyContains "Send email to reset password"
+
+            post "/auth/page/account/resetpassword" $ do
+                byLabel "Username" "abc"
+                addNonce
+
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "Invalid username"
+
+        it "verify page returns an error" $ do
+            get_ "/auth/page/account/verify/abc/xxxxxx"
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "invalid verification key"
+
+        it "new password returns an error" $ do
+            get_ "/auth/page/account/newpassword/abc/xxxxxx"
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "invalid verification key"
+
+        it "set password returns an error" $ do
+            post "/auth/page/account/setpassword" $ do
+                byName "f1" "xxx"
+                byName "f2" "xxx"
+                byName "f3" "xxx"
+                byName "f4" "xxx"
+                byName "f5" "xxx"
+
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "As a protection against cross-site"
+
+        it "resend verify email returns an error" $ do
+            post "/auth/page/account/resendverifyemail" $ do
+                byName "f1" "xxx"
+                byName "f2" "xxx"
+
+            statusIs 400
+            bodyContains "As a protection against cross-site"
+  

tests/Foundation.hs

 import Data.ByteString (ByteString)
 import Database.Persist.Sqlite
 import Data.IORef
+import Control.Monad.Trans (MonadIO)
+import System.IO.Unsafe (unsafePerformIO)
 import Yesod
 import Yesod.Auth
 import Yesod.Auth.Account
 
     userCreate name email key pwd = User name pwd email False key ""
 
-data MyApp = MyApp { connPool :: ConnectionPool
-                   , lastVerifyEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)
-                   , lastNewPwdEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)
-                   }
+data MyApp = MyApp ConnectionPool
 
-lastVerifyEmail :: GHandler s MyApp (Username, Text, Text)
-lastVerifyEmail = do
-    app <- getYesod
-    liftIO $ readIORef $ lastVerifyEmailR app
+lastVerifyEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)
+{-# NOINLINE lastVerifyEmailR #-}
+lastVerifyEmailR = unsafePerformIO (newIORef ("", "", ""))
 
-lastNewPwdEmail :: GHandler s MyApp (Username, Text, Text)
-lastNewPwdEmail = do
-    app <- getYesod
-    liftIO $ readIORef $ lastNewPwdEmailR app
+lastNewPwdEmailR :: IORef (Username, Text, Text) -- ^ (username, email, verify url)
+{-# NOINLINE lastNewPwdEmailR #-}
+lastNewPwdEmailR = unsafePerformIO (newIORef ("", "", ""))
+
+lastVerifyEmail :: MonadIO m => m (Username, Text, Text)
+lastVerifyEmail = liftIO $ readIORef lastVerifyEmailR
+
+lastNewPwdEmail :: MonadIO m => m (Username, Text, Text)
+lastNewPwdEmail = liftIO $ readIORef lastNewPwdEmailR
 
 mkYesod "MyApp" [parseRoutes|
 / HomeR GET
 instance YesodPersist MyApp where
     type YesodPersistBackend MyApp = SqlPersist
     runDB action = do
-        app <- getYesod
-        runSqlPool action $ connPool app
+        MyApp pool <- getYesod
+        runSqlPool action pool
 
 instance YesodAuth MyApp where
     type AuthId MyApp = Username
     onLogin = return ()
 
 instance AccountSendEmail MyApp where
-    sendVerifyEmail name email url = do
-        app <- getYesod
-        liftIO $ writeIORef (lastVerifyEmailR app) (name, email, url)
+    sendVerifyEmail name email url =
+        liftIO $ writeIORef lastVerifyEmailR (name, email, url)
 
-    sendNewPasswordEmail name email url = do
-        app <- getYesod
-        liftIO $ writeIORef (lastNewPwdEmailR app) (name, email, url)
+    sendNewPasswordEmail name email url =
+        liftIO $ writeIORef lastNewPwdEmailR (name, email, url)
 
 instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where
     runAccountDB = runAccountPersistDB

tests/NewAccount.hs

+{-# LANGUAGE OverloadedStrings #-}
+module NewAccount (newAccountSpecs) where
+
+import Yesod.Test
+import Foundation
+import Database.Persist.Sqlite
+
+newAccountSpecs :: SpecsConn Connection
+newAccountSpecs =
+    describe "New account tests" $ do
+        it "new account with mismatched passwords" $ do
+            get_ "/auth/page/account/newaccount"
+            statusIs 200
+            bodyContains "Register"
+
+            post "/auth/page/account/newaccount" $ do
+                addNonce
+                byLabel "Username" "abc"
+                byLabel "Email" "test@example.com"
+                byLabel "Password" "xxx"
+                byLabel "Confirm" "yyy"
+
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "Passwords did not match"
+
+        it "creates a new account" $ do
+            get_ "/auth/page/account/newaccount"
+            statusIs 200
+
+            post "/auth/page/account/newaccount" $ do
+                addNonce
+                byLabel "Username" "abc"
+                byLabel "Email" "test@example.com"
+                byLabel "Password" "xxx"
+                byLabel "Confirm" "xxx"
+
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "A confirmation e-mail has been sent to test@example.com"
+
+            (username, email, verify) <- lastVerifyEmail
+            assertEqual "username" username "abc"
+            assertEqual "email" email "test@example.com"
+
+            get_ "/auth/page/account/verify/abc/zzzzzz"
+            statusIs 303
+            get_ "/"
+            statusIs 200
+            bodyContains "invalid verification key"
 import Yesod
 import Foundation
 import Yesod.Test
-import Data.IORef
 import Database.Persist.Sqlite
 import Control.Monad.Logger (runStderrLoggingT)
+import Control.Monad.Trans.Resource (runResourceT)
 
 import BasicTests
+import NewAccount
 
 main :: IO ()
-main = do
-    verify <- newIORef ("", "", "")
-    newPwd <- newIORef ("", "", "")
-
-    withSqlitePool "test.db3" 10 $ \pool -> do
-        runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool
-        let myapp = MyApp pool verify newPwd
-        app <- toWaiAppPlain myapp
-        runTests app pool basicSpecs
+main = withSqlitePool "test.db3" 10 $ \pool -> do
+          runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool
+          runResourceT $ runStderrLoggingT $ runSqlPool (deleteWhere ([] :: [Filter User])) pool
+          let myapp = MyApp pool
+          app <- toWaiAppPlain myapp
+          runTests app pool basicSpecs
+          runTests app pool newAccountSpecs

yesod-auth-account.cabal

     build-depends: base
                  , bytestring
                  , monad-logger >= 0.3
+                 , mtl
                  , persistent-sqlite
+                 , resourcet
                  , text
                  , yesod
                  , yesod-test