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
NewAccount.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | {-# 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
|