diff --git a/Yesod/Auth/Account.hs b/Yesod/Auth/Account.hs --- a/Yesod/Auth/Account.hs +++ b/Yesod/Auth/Account.hs @@ -199,7 +199,7 @@ -- >instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where -- > runAccountDB = runAccountPersistDB -- > --- >getHomeR :: Handler RepHtml +-- >getHomeR :: Handler Html -- >getHomeR = do -- > maid <- maybeAuthId -- > case maid of @@ -270,11 +270,8 @@ data AccountMsg = MsgUsername | MsgForgotPassword | MsgInvalidUsername - | MsgInvalidUserOrPwd | MsgUsernameExists T.Text | MsgResendVerifyEmail - | MsgResetPwdTitle - | MsgSendResetPwdEmail | MsgResetPwdEmailSent | MsgEmailVerified | MsgEmailUnverified @@ -283,12 +280,9 @@ renderMessage _ _ MsgUsername = "Username" renderMessage _ _ MsgForgotPassword = "Forgot password?" renderMessage _ _ MsgInvalidUsername = "Invalid username" - renderMessage _ _ MsgInvalidUserOrPwd = "Invalid username or password" renderMessage _ _ (MsgUsernameExists u) = T.concat ["The username ", u, " already exists. Please choose an alternate username."] renderMessage _ _ MsgResendVerifyEmail = "Resend verification email" - renderMessage _ _ MsgResetPwdTitle = "Reset your password" - renderMessage _ _ MsgSendResetPwdEmail = "Send email to reset password" 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." @@ -331,21 +325,21 @@ _{MsgForgotPassword} |] -postLoginR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) RepHtml +postLoginR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html postLoginR = do ((result, _), _) <- lift $ runFormPostNoToken $ renderDivs loginForm - mr <- getMessageRender + mr <- lift getMessageRender muser <- case result of FormMissing -> invalidArgs ["Form is missing"] FormFailure msg -> return $ Left msg FormSuccess (LoginData uname pwd) -> do mu <- lift $ runAccountDB $ loadUser uname case mu of - Nothing -> return $ Left [mr MsgInvalidUserOrPwd] + Nothing -> return $ Left [mr Msg.InvalidUsernamePass] Just u -> return $ if verifyPassword pwd (userPasswordHash u) then Right u - else Left [mr MsgInvalidUserOrPwd] + else Left [mr Msg.InvalidUsernamePass] case muser of Left errs -> do @@ -384,7 +378,7 @@ -- -- * A POST to 'resendVerifyR' of 'resendVerifyEmailForm' will generate a new verification key -- and resend the email. By default, 'unregisteredLogin' displays the form for resending --- the eamil. +-- the email. -- | The data collected in the new account form. data NewAccountData = NewAccountData { @@ -531,7 +525,7 @@ -- where the user can set a new password. The key is set as a hidden field in this form. You -- can customize the look of this page by overriding 'setPasswordHandler'. -- --- * A POST to 'setPasswordR' of 'setPasswordForm' checks if the key is correct and if so, +-- * A POST to 'setPasswordR' of 'resetPasswordForm' checks if the key is correct and if so, -- resets the password. It then calls 'setCreds' to successfully log in and so redirects to -- 'loginDest'. -- @@ -549,17 +543,18 @@ where userSettings = FieldSettings (SomeMessage MsgUsername) Nothing (Just "username") Nothing [] -- | A default rendering of 'resetPasswordForm'. -resetPasswordWidget :: RenderMessage master FormMessage => (Route Auth -> Route master) -> WidgetT master IO () +resetPasswordWidget :: (YesodAuth master, RenderMessage master FormMessage) + => (Route Auth -> Route master) -> WidgetT master IO () resetPasswordWidget tm = do ((_,widget), enctype) <- liftHandlerT $ runFormPost $ renderDivs resetPasswordForm [whamlet|
^{widget} - + |] -postResetPasswordR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) RepHtml +postResetPasswordR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html postResetPasswordR = do allow <- allowPasswordReset <$> lift getYesod unless allow notFound @@ -620,7 +615,7 @@ |] -getNewPasswordR :: YesodAuthAccount db master => Username -> T.Text -> HandlerT Auth (HandlerT master IO) RepHtml +getNewPasswordR :: YesodAuthAccount db master => Username -> T.Text -> HandlerT Auth (HandlerT master IO) Html getNewPasswordR uname k = do allow <- allowPasswordReset <$> lift getYesod unless allow notFound @@ -712,7 +707,7 @@ -- For example, -- -- > newtype MyAccountDB a = MyAccountDB {runMyAccountDB :: HandlerT MyApp IO a} --- > deriving (Monad, MonadIO, MonadTrans, MonadHandler) +-- > deriving (Monad, MonadIO) -- > instance AccountDB MyAccountDB where -- > .... -- @@ -755,7 +750,8 @@ -- | A class to send email. -- -- Both of the methods are implemented by default to just log a message, --- so during development there are no required methods. +-- so during development there are no required methods. For production, +-- I recommend . class AccountSendEmail master where sendVerifyEmail :: Username -> T.Text -- ^ email address @@ -794,7 +790,7 @@ -- a minimal instance is -- -- > instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where --- > runAccountDB = runPersistAccountDB +-- > runAccountDB = runAccountPersistDB -- class (YesodAuth master , AccountSendEmail master @@ -824,7 +820,7 @@ -- By default, this displays a message and contains 'resendVerifyEmailForm', allowing -- the user to resend the verification email. The handler is run inside the post -- handler for login, so you can call 'setCreds' to preform a successful login. - unregisteredLogin :: UserAccount db -> HandlerT Auth (HandlerT master IO) RepHtml + unregisteredLogin :: UserAccount db -> HandlerT Auth (HandlerT master IO) Html unregisteredLogin u = do tm <- getRouteToParent lift $ defaultLayout $ do @@ -838,7 +834,7 @@ -- -- This is the page which is displayed on a GET to 'newAccountR', and defaults to -- an embedding of 'newAccountWidget'. - getNewAccountR :: HandlerT Auth (HandlerT master IO) RepHtml + getNewAccountR :: HandlerT Auth (HandlerT master IO) Html getNewAccountR = do tm <- getRouteToParent lift $ defaultLayout $ do @@ -850,7 +846,7 @@ -- By default, this processes 'newAccountForm', calls 'createNewAccount', sets a message -- and redirects to LoginR. If an error occurs, a message is set and the user is -- redirected to 'newAccountR'. - postNewAccountR :: HandlerT Auth (HandlerT master IO) RepHtml + postNewAccountR :: HandlerT Auth (HandlerT master IO) Html postNewAccountR = do tm <- getRouteToParent mr <- lift getMessageRender @@ -875,18 +871,18 @@ -- | The page which prompts for a username and sends an email allowing password reset. -- By default, it embeds 'resetPasswordWidget'. - getResetPasswordR :: HandlerT Auth (HandlerT master IO) RepHtml + getResetPasswordR :: HandlerT Auth (HandlerT master IO) Html getResetPasswordR = do tm <- getRouteToParent lift $ defaultLayout $ do - setTitleI MsgResetPwdTitle + setTitleI Msg.PasswordResetTitle resetPasswordWidget tm -- | The page which allows the user to set a new password. -- -- This is called only when the email key has been verified as correct. By default, it embeds -- 'newPasswordWidget'. - setPasswordHandler :: UserAccount db -> HandlerT Auth (HandlerT master IO) RepHtml + setPasswordHandler :: UserAccount db -> HandlerT Auth (HandlerT master IO) Html setPasswordHandler u = do tm <- getRouteToParent lift $ defaultLayout $ do diff --git a/example.hs b/example.hs --- a/example.hs +++ b/example.hs @@ -66,7 +66,7 @@ instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where runAccountDB = runAccountPersistDB -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do maid <- maybeAuthId case maid of @@ -82,4 +82,3 @@ main = withSqlitePool "test.db3" 10 $ \pool -> do runStderrLoggingT $ runSqlPool (runMigration migrateAll) pool warp 3000 $ MyApp pool - diff --git a/tests/BasicTests.hs b/tests/BasicTests.hs --- a/tests/BasicTests.hs +++ b/tests/BasicTests.hs @@ -23,7 +23,7 @@ statusIs 303 get' "/auth/login" statusIs 200 - bodyContains "Invalid username or password" + bodyContains "Invalid username/password combination" yit "new account page looks ok" $ do get' "/auth/page/account/newaccount" @@ -34,7 +34,7 @@ yit "reset password page looks ok" $ do get' "/auth/page/account/resetpassword" statusIs 200 - bodyContains "Send email to reset password" + bodyContains "Send password reset email" post' "/auth/page/account/resetpassword" $ do byLabel "Username" "abc" diff --git a/tests/Foundation.hs b/tests/Foundation.hs --- a/tests/Foundation.hs +++ b/tests/Foundation.hs @@ -89,7 +89,7 @@ instance YesodAuthAccount (AccountPersistDB MyApp User) MyApp where runAccountDB = runAccountPersistDB -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do maid <- maybeAuthId case maid of diff --git a/tests/NewAccount.hs b/tests/NewAccount.hs --- a/tests/NewAccount.hs +++ b/tests/NewAccount.hs @@ -61,7 +61,7 @@ statusIs 303 get' "/auth/login" statusIs 200 - bodyContains "Invalid username or password" + bodyContains "Invalid username/password combination" -- valid login post'"/auth/page/account/login" $ do @@ -111,7 +111,7 @@ -- reset password get' "/auth/page/account/resetpassword" statusIs 200 - bodyContains "Send email to reset password" + bodyContains "Send password reset email" post'"/auth/page/account/resetpassword" $ do byLabel "Username" "abc" addNonce diff --git a/yesod-auth-account.cabal b/yesod-auth-account.cabal --- a/yesod-auth-account.cabal +++ b/yesod-auth-account.cabal @@ -1,5 +1,5 @@ name: yesod-auth-account -version: 1.2.0 +version: 1.2.1 cabal-version: >= 1.8 build-type: Simple synopsis: An account authentication plugin for Yesod