diff --git a/Yesod/Auth.hs b/Yesod/Auth.hs --- a/Yesod/Auth.hs +++ b/Yesod/Auth.hs @@ -110,7 +110,7 @@ authPlugins :: master -> [AuthPlugin master] -- | What to show on the login page. - loginHandler :: AuthHandler master RepHtml + loginHandler :: AuthHandler master Html loginHandler = do tp <- getRouteToParent lift $ authLayout $ do @@ -340,7 +340,7 @@ master <- getYesod when (redirectToReferer master) setUltDestReferer -getLoginR :: AuthHandler master RepHtml +getLoginR :: AuthHandler master Html getLoginR = setUltDestReferer' >> loginHandler getLogoutR :: AuthHandler master () diff --git a/Yesod/Auth/Email.hs b/Yesod/Auth/Email.hs --- a/Yesod/Auth/Email.hs +++ b/Yesod/Auth/Email.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE Rank2Types #-} module Yesod.Auth.Email ( -- * Plugin authEmail @@ -24,6 +25,10 @@ -- * Misc , loginLinkKey , setLoginLinkKey + -- * Default handlers + , defaultRegisterHandler + , defaultForgotPasswordHandler + , defaultSetPasswordHandler ) where import Network.Mail.Mime (randomString) @@ -174,15 +179,49 @@ -- | Additional normalization of email addresses, besides standard canonicalization. -- - -- Default: do nothing. Note that in future versions of Yesod, the default - -- will change to lower casing the email address. At that point, you will - -- need to either ensure your database values are migrated to lower case, - -- or change this default back to doing nothing. + -- Default: Lower case the email address. -- -- Since 1.2.3 normalizeEmailAddress :: site -> Text -> Text normalizeEmailAddress _ = TS.toLower + -- | Handler called to render the registration page. The + -- default works fine, but you may want to override it in + -- order to have a different DOM. + -- + -- Default: 'defaultRegisterHandler'. + -- + -- Since: 1.2.6. + registerHandler :: AuthHandler site Html + registerHandler = defaultRegisterHandler + + -- | Handler called to render the \"forgot password\" page. + -- The default works fine, but you may want to override it in + -- order to have a different DOM. + -- + -- Default: 'defaultForgotPasswordHandler'. + -- + -- Since: 1.2.6. + forgotPasswordHandler :: AuthHandler site Html + forgotPasswordHandler = defaultForgotPasswordHandler + + -- | Handler called to render the \"set password\" page. The + -- default works fine, but you may want to override it in + -- order to have a different DOM. + -- + -- Default: 'defaultSetPasswordHandler'. + -- + -- Since: 1.2.6. + setPasswordHandler :: + Bool + -- ^ Whether the old password is needed. If @True@, a + -- field for the old password should be presented. + -- Otherwise, just two fields for the new password are + -- needed. + -> AuthHandler site Html + setPasswordHandler = defaultSetPasswordHandler + + authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> @@ -218,7 +257,13 @@ dispatch _ _ = notFound getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html -getRegisterR = do +getRegisterR = registerHandler + +-- | Default implementation of 'registerHandler'. +-- +-- Since: 1.2.6 +defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html +defaultRegisterHandler = do email <- newIdent tp <- getRouteToParent lift $ authLayout $ do @@ -272,7 +317,13 @@ postRegisterR = registerHelper False registerR getForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html -getForgotPasswordR = do +getForgotPasswordR = forgotPasswordHandler + +-- | Default implementation of 'forgotPasswordHandler'. +-- +-- Since: 1.2.6 +defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html +defaultForgotPasswordHandler = do tp <- getRouteToParent email <- newIdent lift $ authLayout $ do @@ -350,14 +401,21 @@ getPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html getPasswordR = do maid <- lift maybeAuthId - pass0 <- newIdent - pass1 <- newIdent - pass2 <- newIdent case maid of Just _ -> return () Nothing -> loginErrorMessageI LoginR Msg.BadSetPass - tp <- getRouteToParent needOld <- maybe (return True) (lift . needOldPassword) maid + setPasswordHandler needOld + +-- | Default implementation of 'setPasswordHandler'. +-- +-- Since: 1.2.6 +defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master Html +defaultSetPasswordHandler needOld = do + tp <- getRouteToParent + pass0 <- newIdent + pass1 <- newIdent + pass2 <- newIdent lift $ authLayout $ do setTitleI Msg.SetPassTitle [whamlet| @@ -394,7 +452,7 @@ Just aid -> return aid tm <- getRouteToParent - + needOld <- lift $ needOldPassword aid when needOld $ do current <- lift $ runInputPost $ ireq textField "current" @@ -432,7 +490,7 @@ -- | Salt a password with a randomly generated salt. saltPass :: Text -> IO Text saltPass = fmap (decodeUtf8With lenientDecode) - . flip PS.makePassword 12 + . flip PS.makePassword 14 . encodeUtf8 saltPass' :: String -> String -> String diff --git a/Yesod/Auth/HashDB.hs b/Yesod/Auth/HashDB.hs --- a/Yesod/Auth/HashDB.hs +++ b/Yesod/Auth/HashDB.hs @@ -18,6 +18,11 @@ -- Stability : Stable -- Portability : Portable -- +-- /WARNING/: This module was /not/ designed with security in mind, and is not +-- suitable for production sites. In the near future, it will likely be either +-- deprecated or rewritten to have a more secure implementation. For more +-- information, see: . +-- -- A yesod-auth AuthPlugin designed to look users up in Persist where -- their user id's and a salted SHA1 hash of their password is stored. -- diff --git a/yesod-auth.cabal b/yesod-auth.cabal --- a/yesod-auth.cabal +++ b/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.2.5.3 +version: 1.2.6 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin