Commits

Anonymous committed a97053e

Update tests to work with 1.2

  • Participants
  • Parent commits 5ab10b3
  • Tags v1.2.0

Comments (0)

Files changed (5)

File tests/BasicTests.hs

 module BasicTests (basicSpecs) where
 
 import Yesod.Test
-import Database.Persist.Sqlite
+import Foundation
 
-basicSpecs :: SpecsConn Connection
+basicSpecs :: YesodSpec MyApp
 basicSpecs =
-    describe "Basic tests" $ do
-        it "checks the home page is not logged in" $ do
-            get_ "/"
+    ydescribe "Basic tests" $ do
+        yit "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"
+        yit "tests an invalid login" $ do
+            get' "/auth/login"
             statusIs 200
 
-            post "/auth/page/account/login" $ do
+            post' "/auth/page/account/login" $ do
                 byLabel "Username" "abc"
                 byLabel "Password" "xxx"
 
             statusIs 303
-            get_ "/auth/login"
+            get' "/auth/login"
             statusIs 200
             bodyContains "Invalid username or password"
 
-        it "new account page looks ok" $ do
-            get_ "/auth/page/account/newaccount"
+        yit "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"
+        yit "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
+            post' "/auth/page/account/resetpassword" $ do
                 byLabel "Username" "abc"
                 addNonce
 
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "Invalid username"
 
-        it "verify page returns an error" $ do
-            get_ "/auth/page/account/verify/abc/xxxxxx"
+        yit "verify page returns an error" $ do
+            get' "/auth/page/account/verify/abc/xxxxxx"
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "invalid verification key"
 
-        it "new password returns an error" $ do
-            get_ "/auth/page/account/newpassword/abc/xxxxxx"
+        yit "new password returns an error" $ do
+            get' "/auth/page/account/newpassword/abc/xxxxxx"
             statusIs 303
-            get_ "/"
+            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"
+        yit "set password returns an error" $ do
+            post' "/auth/page/account/setpassword" $ do
+                addPostParam "f1" "xxx"
+                addPostParam "f2" "xxx"
+                addPostParam "f3" "xxx"
+                addPostParam "f4" "xxx"
+                addPostParam "f5" "xxx"
 
             statusIs 303
-            get_ "/"
+            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"
+        yit "resend verify email returns an error" $ do
+            post' "/auth/page/account/resendverifyemail" $ do
+                addPostParam "f1" "xxx"
+                addPostParam "f2" "xxx"
 
             statusIs 400
             bodyContains "As a protection against cross-site"

File 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
+import Yesod.Test
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
 User
     renderMessage _ _ = defaultFormMessage
 
 instance YesodPersist MyApp where
-    type YesodPersistBackend MyApp = SqlPersist
+    type YesodPersistBackend MyApp = SqlPersistT
     runDB action = do
         MyApp pool <- getYesod
         runSqlPool action pool
     authPlugins _ = [accountPlugin]
     authHttpManager _ = error "No manager needed"
     onLogin = return ()
+    maybeAuthId = lookupSession "_ID"
 
 instance AccountSendEmail MyApp where
     sendVerifyEmail name email url =
 <p>You are logged in as #{u}
 <p><a href="@{AuthR LogoutR}">Logout</a>
 |]
+
+-- Temporary helpers for testing
+get' :: Yesod site => Text -> YesodExample site ()
+get' url = Yesod.Test.get url
+
+post' :: Yesod site => Text -> RequestBuilder site () -> YesodExample site ()
+post' url builder = request $ do
+    setUrl url
+    setMethod "POST"
+    builder

File tests/NewAccount.hs

 {-# LANGUAGE OverloadedStrings #-}
 module NewAccount (newAccountSpecs) where
 
+import Yesod.Auth
 import Yesod.Test
 import Foundation
-import Database.Persist.Sqlite
 import Text.XML.Cursor (attribute)
-import qualified Data.Text.Encoding as T
 
-newAccountSpecs :: SpecsConn Connection
+newAccountSpecs :: YesodSpec MyApp
 newAccountSpecs =
-    describe "New account tests" $ do
-        it "new account with mismatched passwords" $ do
-            get_ "/auth/page/account/newaccount"
+    ydescribe "New account tests" $ do
+        yit "new account with mismatched passwords" $ do
+            get' "/auth/page/account/newaccount"
             statusIs 200
             bodyContains "Register"
 
-            post "/auth/page/account/newaccount" $ do
+            post'"/auth/page/account/newaccount" $ do
                 addNonce
                 byLabel "Username" "abc"
                 byLabel "Email" "test@example.com"
                 byLabel "Confirm" "yyy"
 
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "Passwords did not match"
 
-        it "creates a new account" $ do
-            get_ "/auth/page/account/newaccount"
+        yit "creates a new account" $ do
+            get' "/auth/page/account/newaccount"
             statusIs 200
 
-            post "/auth/page/account/newaccount" $ do
+            post'"/auth/page/account/newaccount" $ do
                 addNonce
                 byLabel "Username" "abc"
                 byLabel "Email" "test@example.com"
                 byLabel "Confirm" "xxx"
 
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "A confirmation e-mail has been sent to test@example.com"
 
             assertEqual "username" username "abc"
             assertEqual "email" email "test@example.com"
 
-            get_ "/auth/page/account/verify/abc/zzzzzz"
+            get' "/auth/page/account/verify/abc/zzzzzz"
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "invalid verification key"
 
             -- try login
-            get_ "/auth/login"
+            get' "/auth/login"
             statusIs 200
-            post "/auth/page/account/login" $ do
+            post'"/auth/page/account/login" $ do
                 byLabel "Username" "abc"
                 byLabel "Password" "yyy"
             statusIs 303
-            get_ "/auth/login"
+            get' "/auth/login"
             statusIs 200
             bodyContains "Invalid username or password"
 
             -- valid login
-            post "/auth/page/account/login" $ do
+            post'"/auth/page/account/login" $ do
                 byLabel "Username" "abc"
                 byLabel "Password" "xxx"
             statusIs 200
             bodyContains "Your email has not yet been verified"
 
             -- resend verify email
-            post "/auth/page/account/resendverifyemail" $ do
+            post'"/auth/page/account/resendverifyemail" $ do
                 addNonce
-                byName "f2" "abc" -- username is also a hidden field
+                addPostParam "f2" "abc" -- username is also a hidden field
             statusIs 303
-            get_ "/"
+            get' "/"
             bodyContains "A confirmation e-mail has been sent to test@example.com"
 
             (username', email', verify') <- lastVerifyEmail
             assertEqual "verify" True (verify /= verify')
 
             -- verify email
-            get_ $ T.encodeUtf8 verify'
+            get' verify'
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "You are logged in as abc"
 
-            post_ "/auth/logout"
+            post $ AuthR LogoutR
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "Please visit the <a href=\"/auth/login\">Login page"
 
             -- valid login
-            get_ "/auth/login"
-            post "/auth/page/account/login" $ do
+            get' "/auth/login"
+            post'"/auth/page/account/login" $ do
                 byLabel "Username" "abc"
                 byLabel "Password" "xxx"
             statusIs 303
-            get_ "/"
+            get' "/"
             bodyContains "You are logged in as abc"
 
             -- logout
-            post_ "/auth/logout"
+            post $ AuthR LogoutR
 
             -- reset password
-            get_ "/auth/page/account/resetpassword"
+            get' "/auth/page/account/resetpassword"
             statusIs 200
             bodyContains "Send email to reset password"
-            post "/auth/page/account/resetpassword" $ do
+            post'"/auth/page/account/resetpassword" $ do
                 byLabel "Username" "abc"
                 addNonce
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "A password reset email has been sent to your email address"
 
             assertEqual "Email" email'' "test@example.com"
 
             -- bad key
-            get_ $ T.encodeUtf8 newpwd
+            get' newpwd
             statusIs 200
-            post "/auth/page/account/setpassword" $ do
+            post'"/auth/page/account/setpassword" $ do
                 addNonce
                 byLabel "New password" "www"
                 byLabel "Confirm" "www"
-                byName "f2" "abc"
-                byName "f3" "qqqqqqqqqqqqqq"
+                addPostParam "f2" "abc"
+                addPostParam "f3" "qqqqqqqqqqqqqq"
             statusIs 403
             bodyContains "Invalid key"
 
             -- good key
-            get_ $ T.encodeUtf8 newpwd
+            get' newpwd
             statusIs 200
-            post "/auth/page/account/setpassword" $ do
+            matches <- htmlQuery "input[name=f3][type=hidden][value]"
+            post'"/auth/page/account/setpassword" $ do
                 addNonce
                 byLabel "New password" "www"
                 byLabel "Confirm" "www"
-                byName "f2" "abc"
-                matches <- htmlQuery "input[name=f3][type=hidden][value]"
+                addPostParam "f2" "abc"
                 key <- case matches of
                           [] -> error "Unable to find set password key"
                           element:_ -> return $ head $ attribute "value" $ parseHTML element
-                byName "f3" key
+                addPostParam "f3" key
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "Password updated"
             bodyContains "You are logged in as abc"
 
-            post_ "/auth/logout"
+            post $ AuthR LogoutR
 
             -- check new password
-            get_ "/auth/login"
-            post "/auth/page/account/login" $ do
+            get' "/auth/login"
+            post'"/auth/page/account/login" $ do
                 byLabel "Username" "abc"
                 byLabel "Password" "www"
             statusIs 303
-            get_ "/"
+            get' "/"
             statusIs 200
             bodyContains "You are logged in as abc"

File tests/main.hs

 
 import Yesod
 import Foundation
+import Test.Hspec
 import Yesod.Test
 import Database.Persist.Sqlite
 import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
 main = withSqlitePool "test.db3" 10 $ \pool -> do
           runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool
           runResourceT $ runNoLoggingT $ runSqlPool (deleteWhere ([] :: [Filter User])) pool
-          let myapp = MyApp pool
-          app <- toWaiAppPlain myapp
-          runTests app pool basicSpecs
-          runTests app pool newAccountSpecs
+          hspec $ yesodSpec (MyApp pool) $ do
+              basicSpecs
+              newAccountSpecs

File yesod-auth-account.cabal

 
     build-depends: base
                  , bytestring
+                 , hspec
                  , monad-logger >= 0.3
                  , mtl
                  , persistent-sqlite