Extend YesodAuthEmail to support extensible password hashing.

This change introduces `hashAndSaltPassword` and `verifyPassword` to the
`YesodAuthEmail` type class, allowing users to implement their own hashing
schemes (i.e. to provide compatibility with an existing database). It also
updates the default handlers to use these new functions when appropriate. The
functions have default implementation such that behavior for legacy applications
should not change.

yesod-auth/ChangeLog.md

@@ -1,3 +1,8 @@
+## 1.4.20
+
+* Extend `YesodAuthEmail` to support extensible password hashing via
+  `hashAndSaltPassword` and `verifyPassword` functions
+
 ## 1.4.19
 
 * Adjust English localization to distinguish between "log in" (verb) and "login" (noun)

yesod-auth/Yesod/Auth/Email.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE PatternGuards           #-}
 {-# LANGUAGE QuasiQuotes             #-}
 {-# LANGUAGE Rank2Types              #-}
-{-# LANGUAGE ScopedTypeVariables#-}
+{-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE TypeFamilies            #-}
 -- | A Yesod plugin for Authentication via e-mail
 --
@@ -132,7 +132,7 @@ import           Safe                     (readMay)
 import           System.IO.Unsafe         (unsafePerformIO)
 import qualified Text.Email.Validate
 import           Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?))
-import           Data.Maybe (isJust, isNothing, fromJust)
+import           Data.Maybe (isJust)
 import Data.ByteArray (convert)
 
 loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
@@ -203,6 +203,22 @@ class ( YesodAuth site
     -- @since 1.1.0
     setVerifyKey :: AuthEmailId site -> VerKey -> HandlerT site IO ()
 
+    -- | Hash and salt a password
+    --
+    -- Default: 'saltPass'.
+    --
+    -- @since 1.4.20
+    hashAndSaltPassword :: Text -> HandlerT site IO SaltedPass
+    hashAndSaltPassword = liftIO . saltPass
+
+    -- | Verify a password matches the stored password for the given account.
+    --
+    -- Default: Fetch a password with 'getPassword' and match using 'Yesod.Auth.Util.PasswordStore.verifyPassword'.
+    --
+    -- @since 1.4.20
+    verifyPassword :: Text -> SaltedPass -> HandlerT site IO Bool
+    verifyPassword plain salted = return $ isValidPass plain salted
+
     -- | Verify the email address on the given account.
     --
     -- __/Warning!/__ If you have persisted the @'AuthEmailId' site@
@@ -620,12 +636,14 @@ postLoginR = do
                    , emailCredsStatus <$> mecreds
                    ) of
                 (Just aid, Just email', Just True) -> do
-                       mrealpass <- lift $ getPassword aid
+                      mrealpass <- lift $ getPassword aid
-                       case mrealpass of
+                      case mrealpass of
-                         Nothing -> return Nothing
+                        Nothing -> return Nothing
-                         Just realpass -> return $ if isValidPass pass realpass
+                        Just realpass -> do
-                                                   then Just email'
+                            passValid <- lift $ verifyPassword pass realpass 
-                                                   else Nothing
+                            return $ if passValid
+                                    then Just email'
+                                    else Nothing
                 _ -> return Nothing
           let isEmail = Text.Email.Validate.isValid $ encodeUtf8 identifier
           case maid of
@@ -753,14 +771,16 @@ postPasswordR = do
                               then getThird jcreds
                               else fcurrent
                 mrealpass <- lift $ getPassword aid
-                case mrealpass of
+                case (mrealpass, current) of
-                    Nothing ->
+                    (Nothing, _) ->
                         lift $ loginErrorMessage (tm setpassR) "You do not currently have a password set on your account"
-                    Just realpass
+                    (_, Nothing) ->
-                        | isNothing current -> loginErrorMessageI LoginR Msg.BadSetPass
+                        loginErrorMessageI LoginR Msg.BadSetPass
-                        | isValidPass (fromJust current) realpass -> confirmPassword aid tm jcreds
+                    (Just realpass, Just current') -> do
-                        | otherwise ->
+                        passValid <- lift $ verifyPassword current' realpass
-                            lift $ loginErrorMessage (tm setpassR) "Invalid current password, please try again"
+                        if passValid
+                          then confirmPassword aid tm jcreds
+                          else lift $ loginErrorMessage (tm setpassR) "Invalid current password, please try again"
 
   where
     msgOk = Msg.PassUpdated
@@ -787,7 +807,7 @@ postPasswordR = do
                 case isSecure of
                   Left e -> lift $ loginErrorMessage (tm setpassR) e
                   Right () -> do
-                     salted <- liftIO $ saltPass new
+                     salted <- lift $ hashAndSaltPassword new
                      y <- lift $ do
                                 setPassword aid salted
                                 deleteSession loginLinkKey

yesod-auth/yesod-auth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         1.4.19
+version:         1.4.20
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin