yesod-auth-account 1.2.0 → 1.2.1
raw patch · 6 files changed
+29/−34 lines, 6 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- 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_a9rf -> (asWidgetT . toWidget) (urender_a9rf 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 MsgResetPwdTitle; 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_a9sK -> (asWidgetT . toWidget) (urender_a9sK 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: getNewAccountR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) RepHtml
+ Yesod.Auth.Account: getNewAccountR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html
- Yesod.Auth.Account: getResetPasswordR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) RepHtml
+ Yesod.Auth.Account: getResetPasswordR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html
- Yesod.Auth.Account: postNewAccountR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) RepHtml
+ Yesod.Auth.Account: postNewAccountR :: YesodAuthAccount db master => HandlerT Auth (HandlerT master IO) Html
- Yesod.Auth.Account: resetPasswordWidget :: RenderMessage master FormMessage => (Route Auth -> Route master) -> WidgetT master IO ()
+ Yesod.Auth.Account: resetPasswordWidget :: (YesodAuth master, RenderMessage master FormMessage) => (Route Auth -> Route master) -> WidgetT master IO ()
- Yesod.Auth.Account: setPasswordHandler :: YesodAuthAccount db master => UserAccount db -> HandlerT Auth (HandlerT master IO) RepHtml
+ Yesod.Auth.Account: setPasswordHandler :: YesodAuthAccount db master => UserAccount db -> HandlerT Auth (HandlerT master IO) Html
- Yesod.Auth.Account: unregisteredLogin :: YesodAuthAccount db master => UserAccount db -> HandlerT Auth (HandlerT master IO) RepHtml
+ Yesod.Auth.Account: unregisteredLogin :: YesodAuthAccount db master => UserAccount db -> HandlerT Auth (HandlerT master IO) Html
Files
- Yesod/Auth/Account.hs +22/−26
- example.hs +1/−2
- tests/BasicTests.hs +2/−2
- tests/Foundation.hs +1/−1
- tests/NewAccount.hs +2/−2
- yesod-auth-account.cabal +1/−1
Yesod/Auth/Account.hs view
@@ -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 @@ <a href="@{tm resetPasswordR}">_{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| <div .resetPasswordDiv> <form method=post enctype=#{enctype} action=@{tm resetPasswordR}> ^{widget}- <input type=submit value=_{MsgSendResetPwdEmail}>+ <input type=submit value=_{Msg.SendPasswordResetEmail}> |] -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 @@ <input type=submit value=_{Msg.SetPassTitle}> |] -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 <http://hackage.haskell.org/package/mime-mail>. 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
example.hs view
@@ -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-
tests/BasicTests.hs view
@@ -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"
tests/Foundation.hs view
@@ -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
tests/NewAccount.hs view
@@ -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
yesod-auth-account.cabal view
@@ -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