yesod-auth-account 1.2.6 → 1.4.0
raw patch · 9 files changed
+175/−83 lines, 9 filesdep +noncedep −base64-bytestringdep −randomdep ~persistentdep ~yesoddep ~yesod-authPVP ok
version bump matches the API change (PVP)
Dependencies added: nonce
Dependencies removed: base64-bytestring, random
Dependency ranges changed: persistent, yesod, yesod-auth, yesod-core, yesod-form
API changes (from Hackage documentation)
- Yesod.Auth.Account: instance RenderMessage m AccountMsg
+ Yesod.Auth.Account: instance YesodAuthAccount db master => RenderMessage master AccountMsg
+ Yesod.Auth.Account: renderAccountMessage :: YesodAuthAccount db master => master -> [Text] -> AccountMsg -> Text
+ Yesod.Auth.Account.Message: MsgEmailUnverified :: AccountMsg
+ Yesod.Auth.Account.Message: MsgEmailVerified :: AccountMsg
+ Yesod.Auth.Account.Message: MsgForgotPassword :: AccountMsg
+ Yesod.Auth.Account.Message: MsgInvalidUsername :: AccountMsg
+ Yesod.Auth.Account.Message: MsgResendVerifyEmail :: AccountMsg
+ Yesod.Auth.Account.Message: MsgResetPwdEmailSent :: AccountMsg
+ Yesod.Auth.Account.Message: MsgUsername :: AccountMsg
+ Yesod.Auth.Account.Message: MsgUsernameExists :: Text -> AccountMsg
+ Yesod.Auth.Account.Message: data AccountMsg
+ Yesod.Auth.Account.Message: defaultAccountMsg :: AccountMsg -> Text
+ Yesod.Auth.Account.Message: englishAccountMsg :: AccountMsg -> Text
- Yesod.Auth.Account: class (YesodAuth master, AccountSendEmail master, AccountDB db, UserCredentials (UserAccount db), RenderMessage master FormMessage) => YesodAuthAccount db master | master -> db where checkValidUsername u | all isAlphaNum u = return $ Right u checkValidUsername _ = do { mr <- getMessageRender; return $ Left $ mr MsgInvalidUsername } unregisteredLogin u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI MsgEmailUnverified; do { (asWidgetT . toWidget) ((preEscapedText . pack) "<p>"); ((liftM (toHtml .) getMessageRender) >>= (\ urender_a6H4 -> (asWidgetT . toWidget) (urender_a6H4 MsgEmailUnverified))); (asWidgetT . toWidget) ((preEscapedText . pack) "</p>"); (asWidgetT . toWidget) (resendVerifyEmailWidget (username u) tm) } } } getNewAccountR = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI RegisterLong; newAccountWidget tm } } postNewAccountR = do { tm <- getRouteToParent; mr <- lift getMessageRender; ((result, _), _) <- lift $ runFormPost $ renderDivs newAccountForm; mdata <- case result of { FormMissing -> invalidArgs ["Form is missing"] FormFailure msg -> return $ Left msg FormSuccess d -> return $ if newAccountPassword1 d == newAccountPassword2 d then Right d else Left [mr PassMismatch] }; case mdata of { Left errs -> do { setMessage $ toHtml $ concat errs; redirect newAccountR } Right d -> do { void $ lift $ createNewAccount d tm; redirect LoginR } } } allowPasswordReset _ = True getResetPasswordR = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI PasswordResetTitle; resetPasswordWidget tm } } setPasswordHandler u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI SetPassTitle; newPasswordWidget u tm } }
+ Yesod.Auth.Account: class (YesodAuth master, AccountSendEmail master, AccountDB db, UserCredentials (UserAccount db), RenderMessage master FormMessage) => YesodAuthAccount db master | master -> db where checkValidUsername u | all isAlphaNum u = return $ Right u checkValidUsername _ = do { mr <- getMessageRender; return $ Left $ mr MsgInvalidUsername } unregisteredLogin u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI MsgEmailUnverified; do { (asWidgetT . toWidget) ((preEscapedText . pack) "<p>"); ((liftM (toHtml .) getMessageRender) >>= (\ urender_a7gl -> (asWidgetT . toWidget) (urender_a7gl MsgEmailUnverified))); (asWidgetT . toWidget) ((preEscapedText . pack) "</p>"); (asWidgetT . toWidget) (resendVerifyEmailWidget (username u) tm) } } } getNewAccountR = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI RegisterLong; newAccountWidget tm } } postNewAccountR = do { tm <- getRouteToParent; mr <- lift getMessageRender; ((result, _), _) <- lift $ runFormPost $ renderDivs newAccountForm; mdata <- case result of { FormMissing -> invalidArgs ["Form is missing"] FormFailure msg -> return $ Left msg FormSuccess d -> return $ if newAccountPassword1 d == newAccountPassword2 d then Right d else Left [mr PassMismatch] }; case mdata of { Left errs -> do { setMessage $ toHtml $ concat errs; redirect newAccountR } Right d -> do { void $ lift $ createNewAccount d tm; redirect LoginR } } } allowPasswordReset _ = True getResetPasswordR = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI PasswordResetTitle; resetPasswordWidget tm } } setPasswordHandler u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI SetPassTitle; newPasswordWidget u tm } } renderAccountMessage _ _ = defaultAccountMsg
- Yesod.Auth.Account: resendVerifyEmailWidget :: RenderMessage master FormMessage => Username -> (Route Auth -> Route master) -> WidgetT master IO ()
+ Yesod.Auth.Account: resendVerifyEmailWidget :: YesodAuthAccount db master => Username -> (Route Auth -> Route master) -> WidgetT master IO ()
- Yesod.Auth.Account: resetPasswordForm :: (RenderMessage master FormMessage, MonadHandler m, HandlerSite m ~ master) => AForm m Username
+ Yesod.Auth.Account: resetPasswordForm :: (YesodAuthAccount db master, MonadHandler m, HandlerSite m ~ master) => AForm m Username
- Yesod.Auth.Account: resetPasswordWidget :: (YesodAuth master, RenderMessage master FormMessage) => (Route Auth -> Route master) -> WidgetT master IO ()
+ Yesod.Auth.Account: resetPasswordWidget :: YesodAuthAccount db master => (Route Auth -> Route master) -> WidgetT master IO ()
- Yesod.Auth.Account: runAccountPersistDB :: (Yesod master, YesodPersist master, PersistEntity user, PersistUserCredentials user, b ~ YesodPersistBackend master, PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend user, PersistUnique (b (HandlerT master IO)), PersistQuery (b (HandlerT master IO))) => AccountPersistDB master user a -> HandlerT master IO a
+ Yesod.Auth.Account: runAccountPersistDB :: (Yesod master, YesodPersist master, PersistEntity user, PersistUserCredentials user, b ~ YesodPersistBackend master, b ~ PersistEntityBackend user, PersistUnique b, YesodAuthAccount db master, db ~ AccountPersistDB master user) => AccountPersistDB master user a -> HandlerT master IO a
Files
- Changelog.md +15/−0
- Yesod/Auth/Account.hs +44/−43
- Yesod/Auth/Account/Message.hs +54/−0
- example.hs +5/−5
- tests/BasicTests.hs +13/−6
- tests/Foundation.hs +5/−1
- tests/NewAccount.hs +19/−12
- tests/main.hs +10/−6
- yesod-auth-account.cabal +10/−10
+ Changelog.md view
@@ -0,0 +1,15 @@+# 1.4.0++* Add proper support for i18n:+ * Moved messages into Yesod.Auth.Account.Message module+ * Added renderAccountMessage function to YesodAuthAccount class, which defaults to+ the english messages.+ * resendVerifyEmailWidget, resetPasswordWidget, newAccountForm, resetPasswordForm, and+ runAccountPersistDB had their context's updated with a constraint for+ `YesodAuthAccount db master`, which shouldn't be a problem.++* Use the nonce package for generating the keys sent in the verification and reset+ password emails. The `nonce` package provides efficient and cryptographically secure+ nonces.++* Support yesod 1.4 and persistent 2.1 (also bump our version to 1.4 to match yesod)
Yesod/Auth/Account.hs view
@@ -31,6 +31,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- Only orphan instance is RenderMessage AccountMessage -- | An auth plugin for accounts. Each account consists of a username, email, and password. --@@ -112,10 +114,10 @@ import Control.Applicative import Control.Monad.Reader hiding (lift) import Data.Char (isAlphaNum)-import System.Random (newStdGen, randoms)+import System.IO.Unsafe (unsafePerformIO) import qualified Crypto.PasswordStore as PS+import qualified Crypto.Nonce as Nonce import qualified Data.ByteString as B-import qualified Data.ByteString.Base64.URL as B64 import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Database.Persist as P@@ -126,10 +128,13 @@ import Yesod.Persist hiding (get, replace, insertKey, Entity, entityVal) import qualified Yesod.Auth.Message as Msg +import Yesod.Auth.Account.Message+ -- | Each user is uniquely identified by a username. type Username = T.Text --- | The account authentication plugin. Here is a complete example using persistent.+-- | The account authentication plugin. Here is a complete example using persistent 2.1+-- and yesod 1.4. -- -- >{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-} -- >{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, OverloadedStrings #-}@@ -179,7 +184,7 @@ -- > renderMessage _ _ = defaultFormMessage -- > -- >instance YesodPersist MyApp where--- > type YesodPersistBackend MyApp = SqlPersistT+-- > type YesodPersistBackend MyApp = SqlBackend -- > runDB action = do -- > MyApp pool <- getYesod -- > runSqlPool action pool@@ -192,7 +197,7 @@ -- > authPlugins _ = [accountPlugin] -- > authHttpManager _ = error "No manager needed" -- > onLogin = return ()--- > maybeAuthId = lookupSession "_ID"+-- > maybeAuthId = lookupSession credsKey -- > -- >instance AccountSendEmail MyApp -- >@@ -212,9 +217,9 @@ -- >|] -- > -- >main :: IO ()--- >main = withSqlitePool "test.db3" 10 $ \pool -> do--- > runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool--- > warp 3000 $ MyApp pool+-- >main = runStderrLoggingT $ withSqlitePool "test.db3" 10 $ \pool -> do+-- > runSqlPool (runMigration migrateAll) pool+-- > liftIO $ warp 3000 $ MyApp pool -- accountPlugin :: YesodAuthAccount db master => AuthPlugin master accountPlugin = AuthPlugin "account" dispatch loginWidget@@ -266,28 +271,6 @@ setPasswordR :: AuthRoute setPasswordR = PluginR "account" ["setpassword"] --- | TODO: move these into Yesod.Auth.Message-data AccountMsg = MsgUsername- | MsgForgotPassword- | MsgInvalidUsername- | MsgUsernameExists T.Text- | MsgResendVerifyEmail- | MsgResetPwdEmailSent- | MsgEmailVerified- | MsgEmailUnverified--instance RenderMessage m AccountMsg where- renderMessage _ _ MsgUsername = "Username"- renderMessage _ _ MsgForgotPassword = "Forgot password?"- renderMessage _ _ MsgInvalidUsername = "Invalid username"- renderMessage _ _ (MsgUsernameExists u) =- T.concat ["The username ", u, " already exists. Please choose an alternate username."]- renderMessage _ _ MsgResendVerifyEmail = "Resend verification email"- renderMessage _ _ MsgResetPwdEmailSent = "A password reset email has been sent to your email address."- renderMessage _ _ MsgEmailVerified = "Your email has been verified."- renderMessage _ _ MsgEmailUnverified = "Your email has not yet been verified."-- --------------------------------------------------------------------------------------------------- -- | The data collected in the login form.@@ -303,8 +286,9 @@ -- posted to 'loginFormPostTargetR'. loginForm :: (MonadHandler m, YesodAuthAccount db master, HandlerSite m ~ master) => AForm m LoginData-loginForm = LoginData <$> areq (checkM checkValidUsername textField) userSettings Nothing- <*> areq passwordField pwdSettings Nothing+loginForm =+ LoginData <$> areq (checkM checkValidUsername textField) userSettings Nothing+ <*> areq passwordField pwdSettings Nothing where userSettings = FieldSettings (SomeMessage MsgUsername) Nothing (Just "username") Nothing [] pwdSettings = FieldSettings (SomeMessage Msg.Password) Nothing (Just "password") Nothing [] @@ -327,8 +311,8 @@ postLoginR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html postLoginR = do- ((result, _), _) <- lift $ runFormPostNoToken $ renderDivs loginForm mr <- lift getMessageRender+ ((result, _), _) <- lift $ runFormPostNoToken $ renderDivs loginForm muser <- case result of FormMissing -> invalidArgs ["Form is missing"] FormFailure msg -> return $ Left msg@@ -462,7 +446,7 @@ lift $ setMessageI Msg.InvalidKey redirect LoginR lift $ runAccountDB $ verifyAccount user- setMessageI MsgEmailVerified+ lift $ setMessageI MsgEmailVerified lift $ setCreds True $ Creds "account" uname [] -- | A form to allow the user to request the email validation be resent.@@ -476,7 +460,7 @@ resendVerifyEmailForm u = areq hiddenField "" $ Just u -- | A default rendering of 'resendVerifyEmailForm'-resendVerifyEmailWidget :: RenderMessage master FormMessage => Username -> (Route Auth -> Route master) -> WidgetT master IO ()+resendVerifyEmailWidget :: YesodAuthAccount db master => Username -> (Route Auth -> Route master) -> WidgetT master IO () resendVerifyEmailWidget u tm = do ((_,widget), enctype) <- liftHandlerT $ runFormPost $ renderDivs $ resendVerifyEmailForm u [whamlet|@@ -534,7 +518,7 @@ -- | A form for the user to request that an email be sent to them to allow them to reset -- their password. This form contains a field for the username (plus the CSRF token). -- The form should be posted to 'resetPasswordR'.-resetPasswordForm :: (RenderMessage master FormMessage+resetPasswordForm :: (YesodAuthAccount db master , MonadHandler m , HandlerSite m ~ master ) => AForm m Username@@ -542,7 +526,7 @@ where userSettings = FieldSettings (SomeMessage MsgUsername) Nothing (Just "username") Nothing [] -- | A default rendering of 'resetPasswordForm'.-resetPasswordWidget :: (YesodAuth master, RenderMessage master FormMessage)+resetPasswordWidget :: YesodAuthAccount db master => (Route Auth -> Route master) -> WidgetT master IO () resetPasswordWidget tm = do ((_,widget), enctype) <- liftHandlerT $ runFormPost $ renderDivs resetPasswordForm@@ -569,7 +553,7 @@ redirect LoginR Right Nothing -> do- setMessageI MsgInvalidUsername+ lift $ setMessageI MsgInvalidUsername redirect resetPasswordR Right (Just u) -> do key <- newVerifyKey@@ -577,7 +561,7 @@ render <- getUrlRender lift $ sendNewPasswordEmail (username u) (userEmail u) $ render $ newPasswordR (username u) key -- Don't display the email in the message since anybody can request the resend.- setMessageI MsgResetPwdEmailSent+ lift $ setMessageI MsgResetPwdEmailSent redirect LoginR -- | The data for setting a new password.@@ -888,6 +872,15 @@ setTitleI Msg.SetPassTitle newPasswordWidget u tm + -- | Used for i18n of 'AccountMsg', defaults to 'defaultAccountMsg'. To support+ -- multiple languages, you can implement this method using the various translations+ -- from "Yesod.Auth.Account.Message".+ renderAccountMessage :: master -> [T.Text] -> AccountMsg -> T.Text+ renderAccountMessage _ _ = defaultAccountMsg++instance YesodAuthAccount db master => RenderMessage master AccountMsg where+ renderMessage = renderAccountMessage+ -- | Salt and hash a password. hashPassword :: MonadIO m => T.Text -> m B.ByteString hashPassword pwd = liftIO $ PS.makePassword (TE.encodeUtf8 pwd) 12@@ -898,12 +891,13 @@ -> Bool verifyPassword pwd = PS.verifyPassword (TE.encodeUtf8 pwd) +nonceGen :: Nonce.Generator+nonceGen = unsafePerformIO Nonce.new+{-# NOINLINE nonceGen #-}+ -- | Randomly create a new verification key. newVerifyKey :: MonadIO m => m T.Text-newVerifyKey = do- g <- liftIO newStdGen- let bs = B.pack $ take 32 $ randoms g- return $ TE.decodeUtf8 $ B64.encode bs+newVerifyKey = Nonce.nonce128urlT nonceGen --------------------------------------------------------------------------------------------------- @@ -968,9 +962,16 @@ , P.PersistEntity user , PersistUserCredentials user , b ~ YesodPersistBackend master+#if MIN_VERSION_persistent(2,1,0)+ , b ~ PersistEntityBackend user+ , PersistUnique b+#else , PersistMonadBackend (b (HandlerT master IO)) ~ P.PersistEntityBackend user , P.PersistUnique (b (HandlerT master IO)) , P.PersistQuery (b (HandlerT master IO))+#endif+ , YesodAuthAccount db master+ , db ~ AccountPersistDB master user ) => AccountPersistDB master user a -> HandlerT master IO a runAccountPersistDB (AccountPersistDB m) = runReaderT m funcs
+ Yesod/Auth/Account/Message.hs view
@@ -0,0 +1,54 @@+{- Copyright (c) 2014 John Lenz++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE OverloadedStrings #-}+module Yesod.Auth.Account.Message(+ AccountMsg(..)+ , defaultAccountMsg+ , englishAccountMsg+) where++import qualified Data.Text as T++-- | Messages specific to yesod-auth-account. We also use messages from "Yesod.Auth.Message".+data AccountMsg = MsgUsername+ | MsgForgotPassword+ | MsgInvalidUsername+ | MsgUsernameExists T.Text+ | MsgResendVerifyEmail+ | MsgResetPwdEmailSent+ | MsgEmailVerified+ | MsgEmailUnverified++-- | Defaults to 'englishAccountMsg'+defaultAccountMsg :: AccountMsg -> T.Text+defaultAccountMsg = englishAccountMsg++englishAccountMsg :: AccountMsg -> T.Text+englishAccountMsg MsgUsername = "Username"+englishAccountMsg MsgForgotPassword = "Forgot password?"+englishAccountMsg MsgInvalidUsername = "Invalid username"+englishAccountMsg (MsgUsernameExists u) =+ T.concat ["The username ", u, " already exists. Please choose an alternate username."]+englishAccountMsg MsgResendVerifyEmail = "Resend verification email"+englishAccountMsg MsgResetPwdEmailSent = "A password reset email has been sent to your email address."+englishAccountMsg MsgEmailVerified = "Your email has been verified."+englishAccountMsg MsgEmailUnverified = "Your email has not yet been verified."
example.hs view
@@ -46,7 +46,7 @@ renderMessage _ _ = defaultFormMessage instance YesodPersist MyApp where- type YesodPersistBackend MyApp = SqlPersistT+ type YesodPersistBackend MyApp = SqlBackend runDB action = do MyApp pool <- getYesod runSqlPool action pool@@ -59,7 +59,7 @@ authPlugins _ = [accountPlugin] authHttpManager _ = error "No manager needed" onLogin = return ()- maybeAuthId = lookupSession "_ID"+ maybeAuthId = lookupSession credsKey instance AccountSendEmail MyApp @@ -79,6 +79,6 @@ |] main :: IO ()-main = withSqlitePool "test.db3" 10 $ \pool -> do- runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool- warp 3000 $ MyApp pool+main = runStderrLoggingT $ withSqlitePool "test.db3" 10 $ \pool -> do+ runSqlPool (runMigration migrateAll) pool+ liftIO $ warp 3000 $ MyApp pool
tests/BasicTests.hs view
@@ -1,9 +1,16 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} module BasicTests (basicSpecs) where import Yesod.Test import Foundation +redirectCode :: Int+#if MIN_VERSION_yesod_test(1,4,0)+redirectCode = 303+#else+redirectCode = 302+#endif+ basicSpecs :: YesodSpec MyApp basicSpecs = ydescribe "Basic tests" $ do@@ -20,7 +27,7 @@ byLabel "Username" "abc" byLabel "Password" "xxx" - statusIs 302+ statusIs redirectCode get' "/auth/login" statusIs 200 bodyContains "Invalid username/password combination"@@ -40,21 +47,21 @@ byLabel "Username" "abc" addNonce - statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "Invalid username" yit "verify page returns an error" $ do get' "/auth/page/account/verify/abc/xxxxxx"- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "invalid verification key" yit "new password returns an error" $ do get' "/auth/page/account/newpassword/abc/xxxxxx"- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "invalid verification key"@@ -67,7 +74,7 @@ addPostParam "f4" "xxx" addPostParam "f5" "xxx" - statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "As a protection against cross-site"
tests/Foundation.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, OverloadedStrings #-} {-# LANGUAGE GADTs, MultiParamTypeClasses, TypeSynonymInstances #-} @@ -64,7 +64,11 @@ renderMessage _ _ = defaultFormMessage instance YesodPersist MyApp where+#if MIN_VERSION_yesod(1,4,0)+ type YesodPersistBackend MyApp = SqlBackend+#else type YesodPersistBackend MyApp = SqlPersistT+#endif runDB action = do MyApp pool <- getYesod runSqlPool action pool
tests/NewAccount.hs view
@@ -8,6 +8,13 @@ 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@@ -36,7 +43,7 @@ byLabel "Password" "xxx" byLabel "Confirm" "yyy" - statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "Passwords did not match"@@ -52,7 +59,7 @@ byLabel "Password" "xxx" byLabel "Confirm" "xxx" - statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "A confirmation e-mail has been sent to test@example.com"@@ -62,7 +69,7 @@ assertEqual "email" email "test@example.com" get' "/auth/page/account/verify/abc/zzzzzz"- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "invalid verification key"@@ -73,7 +80,7 @@ post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "yyy"- statusIs 302+ statusIs redirectCode get' "/auth/login" statusIs 200 bodyContains "Invalid username/password combination"@@ -89,7 +96,7 @@ post'"/auth/page/account/resendverifyemail" $ do addNonce addPostParam f1 "abc" -- username is also a hidden field- statusIs 302+ statusIs redirectCode get' "/" bodyContains "A confirmation e-mail has been sent to test@example.com" @@ -100,13 +107,13 @@ -- verify email get' verify'- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "You are logged in as abc" post $ AuthR LogoutR- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "Please visit the <a href=\"/auth/login\">Login page"@@ -116,7 +123,7 @@ post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "xxx"- statusIs 302+ statusIs redirectCode get' "/" bodyContains "You are logged in as abc" @@ -130,7 +137,7 @@ post'"/auth/page/account/resetpassword" $ do byLabel "Username" "abc" addNonce- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "A password reset email has been sent to your email address"@@ -164,7 +171,7 @@ [] -> error "Unable to find set password key" element:_ -> return $ head $ attribute "value" $ parseHTML element addPostParam f2 key- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "Password updated"@@ -177,7 +184,7 @@ post'"/auth/page/account/login" $ do byLabel "Username" "abc" byLabel "Password" "www"- statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "You are logged in as abc"@@ -193,7 +200,7 @@ byLabel "Password" "hunter2" byLabel "Confirm" "hunter2" - statusIs 302+ statusIs redirectCode get' "/" statusIs 200 bodyContains "Invalid username" -- Issue #2: a valid username was not checked on creation
tests/main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} module Main where @@ -7,16 +7,20 @@ import Test.Hspec import Yesod.Test import Database.Persist.Sqlite-import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)+import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Trans.Resource (runResourceT) import BasicTests import NewAccount main :: IO ()-main = withSqlitePool "test.db3" 10 $ \pool -> do- runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool- runResourceT $ runNoLoggingT $ runSqlPool (deleteWhere ([] :: [Filter User])) pool- hspec $ yesodSpec (MyApp pool) $ do+#if MIN_VERSION_persistent(2,1,0)+main = runNoLoggingT $ withSqlitePool "test.db3" 10 $ \pool -> do+#else+main = withSqlitePool "test.db3" 10 $ \pool -> runNoLoggingT $ do+#endif+ runSqlPool (runMigration migrateAll) pool+ runResourceT $ runSqlPool (deleteWhere ([] :: [Filter User])) pool+ liftIO $ hspec $ yesodSpec (MyApp pool) $ do basicSpecs newAccountSpecs
yesod-auth-account.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-account-version: 1.2.6+version: 1.4.0 cabal-version: >= 1.8 build-type: Simple synopsis: An account authentication plugin for Yesod@@ -20,6 +20,7 @@ , tests/BasicTests.hs , tests/Foundation.hs , tests/NewAccount.hs+ , Changelog.md source-repository head@@ -28,21 +29,20 @@ library hs-source-dirs: .- exposed-modules: Yesod.Auth.Account+ exposed-modules: Yesod.Auth.Account, Yesod.Auth.Account.Message ghc-options: -Wall -O2 build-depends: base >= 4 && < 5- , base64-bytestring >= 1.0 , bytestring >= 0.10 , blaze-html >= 0.6 , mtl >= 2.1+ , nonce >= 1.0 , text >= 0.11- , persistent >= 1.3 && < 1.4+ , persistent >= 1.3 && < 2.2 , pwstore-fast >= 2.0- , random >= 1.0- , yesod-auth >= 1.2 && < 1.4- , yesod-core >= 1.2 && < 1.3- , yesod-form >= 1.3 && < 1.4+ , yesod-auth >= 1.2 && < 1.5+ , yesod-core >= 1.2 && < 1.5+ , yesod-form >= 1.3 && < 1.5 , yesod-persistent >= 1.2 test-suite test@@ -60,7 +60,7 @@ , resourcet , text , xml-conduit- , yesod >= 1.2 && < 1.3+ , yesod >= 1.2 && < 1.5 , yesod-test >= 1.2.1.5- , yesod-auth >= 1.2 && < 1.4+ , yesod-auth >= 1.2 && < 1.5 , yesod-auth-account