{-# LANGUAGE CPP, OverloadedStrings #-} module NewAccount (newAccountSpecs) where import Data.Monoid import Yesod.Auth import Yesod.Test import Foundation import Text.XML.Cursor (attribute) import qualified Data.Text as T redirectCode :: Int #if MIN_VERSION_yesod_test(1,4,0) redirectCode = 303 #else redirectCode = 302 #endif -- In 9f379bc219bd1fdf008e2c179b03e98a05b36401 (which went into yesod-form-1.3.9) -- the numbering of fields was changed. We normally wouldn't care because fields -- can be set via 'byLabel', but hidden fields have no label so we must use the id -- directly. We temporarily support both versions of yesod form with the following. f1, f2 :: T.Text #if MIN_VERSION_yesod_form(1,3,9) f1 = "f1" f2 = "f2" #else f1 = "f2" f2 = "f3" #endif newAccountSpecs :: YesodSpec MyApp newAccountSpecs = 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 addToken byLabel "Username" "abc" byLabel "Email" "test@example.com" byLabel "Password" "xxx" byLabel "Confirm" "yyy" statusIs redirectCode get' "/" statusIs 200 bodyContains "Passwords did not match" yit "creates a new account" $ do get' "/auth/page/account/newaccount" statusIs 200 post'"/auth/page/account/newaccount" $ do addToken byLabel "Username" "abc" byLabel "Email" "test@example.com" byLabel "Password" "xxx" byLabel "Confirm" "xxx" statusIs redirectCode 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 redirectCode get' "/" statusIs 200 bodyContains "invalid verification key" -- try login get' "/auth/login" statusIs 200 post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "yyy" statusIs redirectCode get' "/auth/login" statusIs 200 bodyContains "Invalid username/password combination" -- valid login 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 addToken addPostParam f1 "abc" -- username is also a hidden field statusIs redirectCode get' "/" 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" assertEqual "verify" True (verify /= verify') -- verify email get' verify' statusIs redirectCode get' "/" statusIs 200 bodyContains "You are logged in as abc" post $ AuthR LogoutR statusIs redirectCode get' "/" statusIs 200 bodyContains "Please visit the Login page" -- valid login get' "/auth/login" post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "xxx" statusIs redirectCode get' "/" bodyContains "You are logged in as abc" -- logout post $ AuthR LogoutR -- reset password get' "/auth/page/account/resetpassword" statusIs 200 bodyContains "Send password reset email" post'"/auth/page/account/resetpassword" $ do byLabel "Username" "abc" addToken statusIs redirectCode get' "/" statusIs 200 bodyContains "A password reset email has been sent to your email address" (username'', email'', newpwd) <- lastNewPwdEmail assertEqual "User" username'' "abc" assertEqual "Email" email'' "test@example.com" -- bad key get' newpwd statusIs 200 post'"/auth/page/account/setpassword" $ do addToken byLabel "New password" "www" byLabel "Confirm" "www" addPostParam f1 "abc" addPostParam f2 "qqqqqqqqqqqqqq" statusIs 403 bodyContains "Invalid key" -- good key get' newpwd statusIs 200 matches <- htmlQuery $ "input[name=" <> f2 <> "][type=hidden][value]" post'"/auth/page/account/setpassword" $ do addToken byLabel "New password" "www" byLabel "Confirm" "www" addPostParam f1 "abc" key <- case matches of [] -> error "Unable to find set password key" element:_ -> return $ head $ attribute "value" $ parseHTML element addPostParam f2 key statusIs redirectCode get' "/" statusIs 200 bodyContains "Password updated" bodyContains "You are logged in as abc" post $ AuthR LogoutR -- check new password get' "/auth/login" post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "www" statusIs redirectCode get' "/" statusIs 200 bodyContains "You are logged in as abc" yit "errors with a username with a period" $ do get' "/auth/page/account/newaccount" statusIs 200 post' "/auth/page/account/newaccount" $ do addToken byLabel "Username" "x.y" byLabel "Email" "xy@example.com" byLabel "Password" "hunter2" byLabel "Confirm" "hunter2" statusIs redirectCode get' "/" statusIs 200 bodyContains "Invalid username" -- Issue #2: a valid username was not checked on creation