Authentication backend for Vervis, fork of Hackage package by the same name

[[ 🗃 ^VE2Kr yesod-auth-account ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/VE2Kr

SSH: git clone USERNAME@vervis.peers.community:VE2Kr

Branches

Tags

lts10 :: tests /

NewAccount.hs

{-# LANGUAGE CPP, OverloadedStrings #-}
module NewAccount (newAccountSpecs) where

import Data.Monoid
import Yesod.Auth
import Yesod.Test
import Foundation
import Text.Email.Validate (emailAddress)
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" (Just email) (emailAddress "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" (Just email') (emailAddress "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 <a href=\"/auth/login\">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" (Just email'') (emailAddress "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
[See repo JSON]