yesod-auth-account-fork 2.0.2 → 2.0.3
raw patch · 4 files changed
+12/−13 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Yesod.Auth.Account: instance (PersistEntity u, PersistUserCredentials u) => UserCredentials (Entity u)
- Yesod.Auth.Account: instance (Yesod master, PersistUserCredentials user) => AccountDB (AccountPersistDB master user)
- Yesod.Auth.Account: instance Applicative (AccountPersistDB master user)
- Yesod.Auth.Account: instance Functor (AccountPersistDB master user)
- Yesod.Auth.Account: instance Monad (AccountPersistDB master user)
- Yesod.Auth.Account: instance MonadIO (AccountPersistDB master user)
- Yesod.Auth.Account: instance Show LoginData
- Yesod.Auth.Account: instance Show NewAccountData
- Yesod.Auth.Account: instance Show NewPasswordData
- Yesod.Auth.Account: instance YesodAuthAccount db master => RenderMessage master AccountMsg
- Yesod.Auth.Account: loginPassword :: LoginData -> Text
- Yesod.Auth.Account: loginUsername :: LoginData -> Text
- Yesod.Auth.Account: newAccountEmail :: NewAccountData -> Text
- Yesod.Auth.Account: newAccountPassword1 :: NewAccountData -> Text
- Yesod.Auth.Account: newAccountPassword2 :: NewAccountData -> Text
- Yesod.Auth.Account: newAccountUsername :: NewAccountData -> Username
- Yesod.Auth.Account: newPasswordKey :: NewPasswordData -> Maybe Text
- Yesod.Auth.Account: newPasswordOld :: NewPasswordData -> Maybe Text
- Yesod.Auth.Account: newPasswordPwd1 :: NewPasswordData -> Text
- Yesod.Auth.Account: newPasswordPwd2 :: NewPasswordData -> Text
- Yesod.Auth.Account: newPasswordUser :: NewPasswordData -> Username
+ Yesod.Auth.Account: [loginPassword] :: LoginData -> Text
+ Yesod.Auth.Account: [loginUsername] :: LoginData -> Text
+ Yesod.Auth.Account: [newAccountEmail] :: NewAccountData -> Text
+ Yesod.Auth.Account: [newAccountPassword1] :: NewAccountData -> Text
+ Yesod.Auth.Account: [newAccountPassword2] :: NewAccountData -> Text
+ Yesod.Auth.Account: [newAccountUsername] :: NewAccountData -> Username
+ Yesod.Auth.Account: [newPasswordKey] :: NewPasswordData -> Maybe Text
+ Yesod.Auth.Account: [newPasswordOld] :: NewPasswordData -> Maybe Text
+ Yesod.Auth.Account: [newPasswordPwd1] :: NewPasswordData -> Text
+ Yesod.Auth.Account: [newPasswordPwd2] :: NewPasswordData -> Text
+ Yesod.Auth.Account: [newPasswordUser] :: NewPasswordData -> Username
+ Yesod.Auth.Account: instance (Database.Persist.Class.PersistEntity.PersistEntity u, Yesod.Auth.Account.PersistUserCredentials u) => Yesod.Auth.Account.UserCredentials (Database.Persist.Class.PersistEntity.Entity u)
+ Yesod.Auth.Account: instance (Yesod.Core.Class.Yesod.Yesod master, Yesod.Auth.Account.PersistUserCredentials user) => Yesod.Auth.Account.AccountDB (Yesod.Auth.Account.AccountPersistDB master user)
+ Yesod.Auth.Account: instance Control.Monad.IO.Class.MonadIO (Yesod.Auth.Account.AccountPersistDB master user)
+ Yesod.Auth.Account: instance GHC.Base.Applicative (Yesod.Auth.Account.AccountPersistDB master user)
+ Yesod.Auth.Account: instance GHC.Base.Functor (Yesod.Auth.Account.AccountPersistDB master user)
+ Yesod.Auth.Account: instance GHC.Base.Monad (Yesod.Auth.Account.AccountPersistDB master user)
+ Yesod.Auth.Account: instance GHC.Show.Show Yesod.Auth.Account.LoginData
+ Yesod.Auth.Account: instance GHC.Show.Show Yesod.Auth.Account.NewAccountData
+ Yesod.Auth.Account: instance GHC.Show.Show Yesod.Auth.Account.NewPasswordData
+ Yesod.Auth.Account: instance Yesod.Auth.Account.YesodAuthAccount db master => Text.Shakespeare.I18N.RenderMessage master Yesod.Auth.Account.Message.AccountMsg
- Yesod.Auth.Account: class AccountSendEmail master where sendVerifyEmail uname email url = ((monadLoggerLog (Loc "src/Yesod/Auth/Account.hs" "yesod-auth-account-fork-2.0.2" "Yesod.Auth.Account" (803, 11) (803, 18)) (pack "") LevelInfo) . (id :: Text -> Text)) $ concat ["Verification email for ", uname, " (", email, "): ", url] sendNewPasswordEmail uname email url = ((monadLoggerLog (Loc "src/Yesod/Auth/Account.hs" "yesod-auth-account-fork-2.0.2" "Yesod.Auth.Account" (814, 11) (814, 18)) (pack "") LevelInfo) . (id :: Text -> Text)) $ concat ["Reset password email for ", uname, " (", email, "): ", url]
+ Yesod.Auth.Account: class AccountSendEmail master where sendVerifyEmail uname email url = ((monadLoggerLog (Loc "src/Yesod/Auth/Account.hs" "yesod_7DqIyweWE9uJ6B4LEbzQlI" "Yesod.Auth.Account" (803, 11) (803, 18)) (pack "") LevelInfo) . (id :: Text -> Text)) $ concat ["Verification email for ", uname, " (", email, "): ", url] sendNewPasswordEmail uname email url = ((monadLoggerLog (Loc "src/Yesod/Auth/Account.hs" "yesod_7DqIyweWE9uJ6B4LEbzQlI" "Yesod.Auth.Account" (814, 11) (814, 18)) (pack "") LevelInfo) . (id :: Text -> Text)) $ concat ["Reset password email for ", uname, " (", email, "): ", url]
- 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 } checkValidEmail u = do { mr <- getMessageRender; return . either (Left . (\ e -> mr MsgInvalidEmail' <> ": " <> pack e)) (Right . decodeUtf8 . toByteString) . validate $ encodeUtf8 u } checkValidLogin u = do { validUser <- checkValidUsername u; validEmail <- checkValidEmail u; return $ case validUser of { Left _ -> validEmail Right _ -> validUser } } unregisteredLogin u = selectRep $ do { provideRep $ do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI MsgEmailUnverified; (do { (asWidgetT . toWidget) ((preEscapedText . pack) "<p>"); ((liftM (toHtml .) getMessageRender) >>= (\ urender_adEk -> (asWidgetT . toWidget) (urender_adEk MsgEmailUnverified))); (asWidgetT . toWidget) ((preEscapedText . pack) "</p>"); (asWidgetT . toWidget) (resendVerifyEmailWidget (username u) tm) }) } }; provideRep $ do { let obj = object ["unverified" .= True, "message" .= msg] msg = "User account has not been verified (check your e-mail)" :: Text; void $ sendResponseStatus unauthorized401 obj; return obj } } 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 withKey u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI SetPassTitle; newPasswordWidget withKey u tm } } renderAccountMessage _ _ = defaultAccountMsg
+ 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 } checkValidEmail u = do { mr <- getMessageRender; return . either (Left . (\ e -> mr MsgInvalidEmail' <> ": " <> pack e)) (Right . decodeUtf8 . toByteString) . validate $ encodeUtf8 u } checkValidLogin u = do { validUser <- checkValidUsername u; validEmail <- checkValidEmail u; return $ case validUser of { Left _ -> validEmail Right _ -> validUser } } unregisteredLogin u = selectRep $ do { provideRep $ do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI MsgEmailUnverified; (do { (asWidgetT . toWidget) ((preEscapedText . pack) "<p>"); ((liftM (toHtml .) getMessageRender) >>= (\ urender_ag9Q -> (asWidgetT . toWidget) (urender_ag9Q MsgEmailUnverified))); (asWidgetT . toWidget) ((preEscapedText . pack) "</p>\n"); (asWidgetT . toWidget) (resendVerifyEmailWidget (username u) tm) }) } }; provideRep $ do { let obj = object ["unverified" .= True, "message" .= msg] msg = "User account has not been verified (check your e-mail)" :: Text; void $ sendResponseStatus unauthorized401 obj; return obj } } 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 withKey u = do { tm <- getRouteToParent; lift $ defaultLayout $ do { setTitleI SetPassTitle; newPasswordWidget withKey u tm } } renderAccountMessage _ _ = defaultAccountMsg
Files
- tests/BasicTests.hs +1/−2
- tests/ChangePasswordLogged.hs +3/−3
- tests/NewAccount.hs +7/−7
- yesod-auth-account-fork.cabal +1/−1
tests/BasicTests.hs view
@@ -45,7 +45,7 @@ post' "/auth/page/account/resetpassword" $ do byLabel "Username" "abc"- addNonce+ addToken statusIs redirectCode get' "/"@@ -86,4 +86,3 @@ statusIs 400 bodyContains "As a protection against cross-site"-
tests/ChangePasswordLogged.hs view
@@ -32,7 +32,7 @@ statusIs 200 post'"/auth/page/account/newaccount" $ do- addNonce+ addToken byLabel "Username" "aaa" byLabel "Email" "tst@example.com" byLabel "Password" "xxx"@@ -57,7 +57,7 @@ -- resend verify email post'"/auth/page/account/resendverifyemail" $ do- addNonce+ addToken addPostParam f1 "aaa" -- username is also a hidden field statusIs redirectCode get' "/"@@ -94,7 +94,7 @@ -- good key get' "/auth/page/account/newpasswordlgd" post'"/auth/page/account/setpassword" $ do- addNonce+ addToken byLabel "Please fill in your current password" "xxx" byLabel "New password" "www" byLabel "Confirm" "www"
tests/NewAccount.hs view
@@ -37,7 +37,7 @@ bodyContains "Register" post'"/auth/page/account/newaccount" $ do- addNonce+ addToken byLabel "Username" "abc" byLabel "Email" "test@example.com" byLabel "Password" "xxx"@@ -53,7 +53,7 @@ statusIs 200 post'"/auth/page/account/newaccount" $ do- addNonce+ addToken byLabel "Username" "abc" byLabel "Email" "test@example.com" byLabel "Password" "xxx"@@ -104,7 +104,7 @@ -- resend verify email post'"/auth/page/account/resendverifyemail" $ do- addNonce+ addToken addPostParam f1 "abc" -- username is also a hidden field statusIs redirectCode get' "/"@@ -159,7 +159,7 @@ bodyContains "Send password reset email" post'"/auth/page/account/resetpassword" $ do byLabel "Username" "abc"- addNonce+ addToken statusIs redirectCode get' "/" statusIs 200@@ -173,7 +173,7 @@ get' newpwd statusIs 200 post'"/auth/page/account/setpassword" $ do- addNonce+ addToken byLabel "New password" "www" byLabel "Confirm" "www" addPostParam f1 "abc"@@ -186,7 +186,7 @@ statusIs 200 matches <- htmlQuery $ "input[name=" <> f2 <> "][type=hidden][value]" post'"/auth/page/account/setpassword" $ do- addNonce+ addToken byLabel "New password" "www" byLabel "Confirm" "www" addPostParam f1 "abc"@@ -217,7 +217,7 @@ statusIs 200 post' "/auth/page/account/newaccount" $ do- addNonce+ addToken byLabel "Username" "x.y" byLabel "Email" "xy@example.com" byLabel "Password" "hunter2"
yesod-auth-account-fork.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-account-fork-version: 2.0.2+version: 2.0.3 cabal-version: >= 1.8 build-type: Simple synopsis: An account authentication plugin for Yesod