packages feed

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 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