yesod-auth-hashdb 1.4.3 → 1.5

raw patch · 5 files changed

+108/−201 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• Yesod/Auth/HashDB.hs +51/−179
• test/ExampleData.hs +17/−3
• test/NonDBTests.hs +30/−18
• yesod-auth-hashdb.cabal +1/−1

@@ -1,3 +1,12 @@+## 1.5++This release can break both old code and old database entries.  For details+of upgrading, please see+[Upgrading.md](https://github.com/paul-rouse/yesod-auth-hashdb/blob/master/Upgrading.md).++* First phase of removing compatibility with old databases designed for versions before 1.3+* Remove deprecated utilities (`getAuthIdHashDB` and pre-defined `User` data type)+ ## 1.4.3  * Changes to work with persistent-2.5

@@ -1,60 +1,26 @@ {-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE QuasiQuotes                #-} {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE GADTs                      #-} ------------------------------------------------------------------------------- -- | -- Module      :  Yesod.Auth.HashDB--- Copyright   :  (c) Patrick Brisbin 2010, Paul Rouse 2014-2015+-- Copyright   :  (c) Patrick Brisbin 2010, Paul Rouse 2014-2016 -- License     :  MIT -- -- Maintainer  :  Paul Rouse <pyr@doynton.org> -- Stability   :  Stable -- Portability :  Portable ----- A yesod-auth AuthPlugin designed to look users up in a Persistent+-- A Yesod authentication plugin designed to look users up in a Persistent -- database where the hash of their password is stored. ----- This module was removed from @yesod-auth-1.3.0.0@ and is now--- maintained separately.--- Versions of this module prior to @yesod-auth-1.3@ used a relatively weak--- hashing algorithm (a single round of SHA1) which does not provide--- adequate protection against an attacker who discovers the hashed passwords.--- See: <https://github.com/yesodweb/yesod/issues/668>.------ It has now been rewritten to use "Crypto.PasswordStore", but this has been--- done in a way which preserves compatibility both with the API and--- with databases which have been set up using older versions of this module.--- There are two levels of database compatibility:------ * The verification code recognises both the old and new hash formats,---   so passwords can be verified against database entries which still---   contain old-style hashes.------ * The function 'upgradePasswordHash' can be used to migrate---   existing user records to use the new format hash.  Unlike---   freshly created password hashes, entries converted this way---   must still have the old salt field, since the old hash function---   remains part of the algorithm needed for verification.  (The---   new hash is layered on top of the old one.)------ On the other hand, new passwords set up by 'setPassword' or--- 'setPasswordStrength' no longer use a separate salt field, so new users--- of this module need only provide a single password field in the user data,--- and can ignore the salt.------ In a system which has been migrated from the old format, passwords--- which are reset will use the new format and will have an empty salt field.--- Once all the entries are of this form, it is safe to change the model--- to remove the salt, and change the 'HashDBUser' instance accordingly.+-- __Release 1.5 is the first of two which remove compatibility with old__+-- __(pre 1.3) databases.  Some other deprecated functionality is removed__+-- __too.  Please see__+-- __<https://github.com/paul-rouse/yesod-auth-hashdb/blob/master/Upgrading.md>__ -- -- To use this in a Yesod application, the foundation data type must be an -- instance of YesodPersist, and the username and hashed passwords should@@ -69,9 +35,7 @@ -- >     password Text Maybe   -- password hash for HashDB -- >     UniqueUser name ----- Create an instance of 'HashDBUser' for this data type.  For historical--- reasons "Yesod.Auth.HashDB" exports some names which are quite likely to--- clash with your own, so it is a good idea to import just the ones you need:+-- Create an instance of 'HashDBUser' for this data type: -- -- > import Yesod.Auth.HashDB (HashDBUser(..)) -- > ....@@ -140,7 +104,6 @@ ------------------------------------------------------------------------------- module Yesod.Auth.HashDB     ( HashDBUser(..)-    , Unique (..)     , defaultStrength     , setPasswordStrength     , setPassword@@ -150,32 +113,23 @@     , validateUser     , authHashDB     , authHashDBWithForm-    , getAuthIdHashDB-      -- * Predefined data type-    , User-    , UserGeneric (..)-    , UserId-    , EntityField (..)-    , migrateUsers     ) where -import Yesod.Persist-import Yesod.Form-import Yesod.Auth-import Yesod.Core-import qualified Yesod.Auth.Message as Msg  #if __GLASGOW_HASKELL__ < 710-import Control.Applicative         ((<$>), (<*>))+import           Control.Applicative         ((<$>), (<*>)) #endif-import Data.Typeable-+import qualified Crypto.Hash           as CH (SHA1, Digest, hash)+import           Crypto.PasswordStore        (makePassword, strengthenPassword,+                                              verifyPassword, passwordStrength) import qualified Data.ByteString.Char8 as BS (pack, unpack)-import qualified Crypto.Hash as CH (SHA1, Digest, hash)-import Data.Text                   (Text, pack, unpack, append)-import Data.Maybe                  (fromMaybe)-import Crypto.PasswordStore        (makePassword, verifyPassword,-                                    passwordStrength, strengthenPassword)+import           Data.Maybe                  (fromMaybe)+import           Data.Text                   (Text, pack, unpack, append)+import           Yesod.Auth+import qualified Yesod.Auth.Message    as Msg+import           Yesod.Core+import           Yesod.Form+import           Yesod.Persist  -- | Default strength used for passwords (see "Crypto.PasswordStore" for --   details).@@ -186,50 +140,23 @@ --   be an instance of this class.  It just provides the getters and setters --   used by the functions in this module. class HashDBUser user where-  -- | Retrieve password hash from user data-  userPasswordHash :: user -> Maybe Text-  -- | Retrieve salt for password from user data.  This is needed only for-  --   compatibility with old database entries, which contain the salt-  --   as a separate field.  New implementations do not require a separate-  --   salt field in the user data, and should leave this as the default.-  userPasswordSalt :: user -> Maybe Text-  userPasswordSalt _ = Just ""--  -- | Callback for 'setPassword' and 'upgradePasswordHash'.  Produces a-  --   version of the user data with the hash set to the new value.-  ---  --   This is the method which you should define for new applications, which-  --   do not require compatibility with databases containing hashes written-  --   by previous versions of this module.  If you do need compatibility,-  --   define 'setSaltAndPasswordHash' instead.-  setPasswordHash :: Text   -- ^ Password hash-                     -> user -> user-  setPasswordHash = setSaltAndPasswordHash ""--  setUserHashAndSalt :: Text    -- ^ Salt-                     -> Text    -- ^ Password hash-                     -> user -> user-  setUserHashAndSalt =-      error "Define setSaltAndPasswordHash to get old-database compatibility"+    -- | Retrieve password hash from user data+    userPasswordHash :: user -> Maybe Text+    -- | Retrieve salt for password from user data.  This is needed only for+    --   compatibility with old database entries, which contain the salt+    --   as a separate field.  New implementations do not require a separate+    --   salt field in the user data, and should leave this as the default.+    userPasswordSalt :: user -> Maybe Text+    userPasswordSalt _ = Just "" -  -- | Callback used in 'upgradePasswordHash' when compatibility is needed-  --   with old-style hashes (including ones already upgraded using-  --   'upgradePasswordHash').  This is not required for new applications,-  --   which do not have a separate salt field in user data: please define-  --   'setPasswordHash' instead.-  ---  --   The default implementation produces a runtime error, and will only be-  --   called if a non-empty salt value needs to be set for compatibility-  --   with an old database.-  setSaltAndPasswordHash :: Text    -- ^ Salt-                     -> Text    -- ^ Password hash-                     -> user -> user-  setSaltAndPasswordHash = setUserHashAndSalt+    -- | Callback for 'setPassword' and 'upgradePasswordHash'.  Produces a+    --   version of the user data with the hash set to the new value.+    --+    setPasswordHash :: Text   -- ^ Password hash+                       -> user -> user -  {-# MINIMAL userPasswordHash, (setPasswordHash | (userPasswordSalt, setSaltAndPasswordHash)) #-}-{-# DEPRECATED userPasswordSalt "Compatibility with old data containing a separate salt field will be removed eventually" #-}-{-# DEPRECATED setUserHashAndSalt "Please use setSaltAndPasswordHash instead" #-}-{-# DEPRECATED setSaltAndPasswordHash "Compatibility with old data containing a separate salt field will be removed eventually" #-}+    {-# MINIMAL userPasswordHash, setPasswordHash #-}+{-# DEPRECATED userPasswordSalt "Verification against old data containing a separate salt field will be removed in version 1.6" #-}   -- | Calculate salted hash using SHA1.  Retained for compatibility with@@ -238,7 +165,7 @@            -> Text              -- ^ Password            -> Text saltedHash salt pw =-  pack $ show (CH.hash $ BS.pack $ unpack $ append salt pw :: CH.Digest CH.SHA1)+    pack $ show (CH.hash $ BS.pack $ unpack $ append salt pw :: CH.Digest CH.SHA1)  -- | Calculate a new-style password hash using "Crypto.PasswordStore". passwordHash :: MonadIO m => Int -> Text -> m Text@@ -300,28 +227,25 @@         else return $ hash == saltedHash salt passwd  -- | Upgrade existing user credentials to a stronger hash.  The existing---   hash may have been produced either by previous versions of this module,---   which used a weak algorithm, or from a weaker setting in the current+--   hash will have been produced from a weaker setting in the current --   algorithm.  Use this function to produce an updated user record to --   store in the database. -----   To allow transitional use, starting from hashes produced by older---   versions of this module, and upgrading them to the new format,---   we have to use the hash alone, without knowledge of the user's---   plaintext password.  In this case, we apply the new algorithm to the---   old hash, resulting in both hash functions, old and new, being used---   one on top of the other; this situation is recognised by the hash---   having the new format while the separate salt field is non-empty.+--   As of version 1.5 this function cannot be used to upgrade a hash+--   which has a non-empty separate salt field.  Such entries would have+--   been produced originally by versions of this module prior to 1.3,+--   but may have been upgraded using earlier versions of this function. -- --   Returns Nothing if the user has no password (ie if 'userPasswordHash' u---   is 'Nothing' and/or 'userPasswordSalt' u is 'Nothing').+--   is 'Nothing'), if the password hash is not in the new format, or if the+--   user has a non-empty salt field resulting from the old-style hashing+--   algorithm. upgradePasswordHash :: (MonadIO m, HashDBUser user) => Int -> user -> m (Maybe user) upgradePasswordHash strength u = do-    let old = do h <- userPasswordHash u-                 s <- userPasswordSalt u-                 return (h, s)+    let old = userPasswordHash u+        oldSalt = fromMaybe "" $ userPasswordSalt u     case old of-        Just (oldHash, oldSalt) -> do+        Just oldHash -> do             let oldHash' = BS.pack $ unpack oldHash             if passwordStrength oldHash' > 0               then@@ -329,11 +253,10 @@                 let newHash = pack $ BS.unpack $ strengthenPassword oldHash' strength                 in if oldSalt == ""                    then return $ Just $ setPasswordHash newHash u-                   else return $ Just $ setSaltAndPasswordHash oldSalt newHash u+                   else return Nothing   -- Can't handle non-empty salt               else do-                -- Old-style hash: do extra layer of hash with the new algorithm-                newHash <- passwordHash strength oldHash-                return $ Just $ setSaltAndPasswordHash oldSalt newHash u+                -- Old-style hash: cannot upgrade+                return Nothing         Nothing -> return Nothing  @@ -347,7 +270,6 @@     ( YesodAuthPersist master     , PersistUnique (YesodPersistBackend master)     , AuthEntity master ~ user-    , AuthId master ~ Key user #if MIN_VERSION_persistent(2,5,0)     , PersistEntityBackend user ~ BaseBackend (YesodPersistBackend master) #else@@ -366,9 +288,9 @@              -> Text            -- ^ Password in plaintext              -> HandlerT site IO Bool validateUser userID passwd = do-  -- Get user data-  user <- runDB $ getBy userID-  return $ fromMaybe False $ flip validatePass passwd . entityVal =<< user+    -- Get user data+    user <- runDB $ getBy userID+    return $ fromMaybe False $ flip validatePass passwd . entityVal =<< user   login :: AuthRoute@@ -392,32 +314,6 @@         else loginErrorMessageI LoginR Msg.InvalidUsernamePass  --- | A drop in for the getAuthId method of your YesodAuth instance which---   can be used if authHashDB is the only plugin in use.-getAuthIdHashDB :: HashDBPersist site user =>-                   (AuthRoute -> Route site)     -- ^ your site's Auth Route-                -> (Text -> Maybe (Unique user)) -- ^ gets user ID-                -> Creds site                    -- ^ the creds argument-                -> HandlerT site IO (Maybe (AuthId site))-getAuthIdHashDB authR uniq creds = do-    muid <- maybeAuthId-    case muid of-        -- user already authenticated-        Just uid -> return $ Just uid-        Nothing       -> do-            x <- case uniq (credsIdent creds) of-                   Nothing -> return Nothing-                   Just u  -> runDB (getBy u)-            case x of-                -- user exists-                Just (Entity uid _) -> return $ Just uid-                Nothing       -> do-                    mr <- getMessageRender-                    _ <- loginErrorMessage (authR LoginR) (mr Msg.InvalidUsernamePass)-                    return Nothing--{-# DEPRECATED getAuthIdHashDB "If this is a problem, please discuss at <https://github.com/paul-rouse/yesod-auth-hashdb/issues/5>" #-}- -- | Prompt for username and password, validate that against a database --   which holds the username and a hash of the password authHashDB :: HashDBPersist site user =>@@ -476,27 +372,3 @@                 }  |]---------------------------------------------------------------------- Predefined datatype--------------------------------------------------------------------- | Generate data base instances for a valid user-share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateUsers"]-         [persistUpperCase|-User-    username Text Eq-    password Text-    salt     Text-    UniqueUser username-    deriving Typeable-|]-{-# DEPRECATED User, migrateUsers "The predefined User data type will be removed soon - please define your own database table and accompanying instance of HashDBUser" #-}--instance HashDBUser (UserGeneric backend) where-  userPasswordHash = Just . userPassword-  userPasswordSalt = Just . userSalt-  setSaltAndPasswordHash s h u = u { userSalt     = s-                               , userPassword = h-                               }

@@ -9,8 +9,10 @@     oldStyleValidUser,     oldStyleBadUser1,     oldStyleBadUser2,+    oldStyleUpgradedUser,     newStyleValidUser,     newStyleBadUser,+    newStyleInOldFormat,     stronger ) where @@ -26,9 +28,9 @@ instance HashDBUser OldStyleUser where     userPasswordHash = oldStylePass     userPasswordSalt = oldStyleSalt-    setSaltAndPasswordHash s h u = u { oldStyleSalt = Just s,-                                       oldStylePass = Just h-                                     }+    setPasswordHash h u = u { oldStyleSalt = Just "",+                              oldStylePass = Just h+                            }  data NewStyleUser = NewStyleUser {                         newStyleName :: Text,@@ -68,6 +70,12 @@                  (Just "8e3e33029e71b4e25ba95a00a88c4bfeb93d766a")                  Nothing +oldStyleUpgradedUser :: OldStyleUser+oldStyleUpgradedUser =+    OldStyleUser "foo"+                 (Just "sha256|17|GkImOI0oV9RyOE3oJpYKRg==|KPPYL9JaP6UQjwLVvRsK3Pw2tl1LWyjqlh11jjKRQVM=")+                 (Just "somesalt")+ newStyleValidUser :: NewStyleUser newStyleValidUser =     NewStyleUser "fox"@@ -77,6 +85,12 @@ newStyleBadUser =     NewStyleUser "bad"                  Nothing++newStyleInOldFormat :: OldStyleUser+newStyleInOldFormat =+    OldStyleUser "fox"+                 (Just "sha256|14|2hL7cNopkA/dGy/5CQTuSg==|CUTPW6ICMISSjohFep851f9PdqIn7Y4B75/I77BvEYM=")+                 (Just "")  stronger :: Int stronger = defaultStrength + 2

@@ -31,6 +31,12 @@         it "fails validation giving Nothing" $             validatePass oldStyleBadUser2 mypassword `shouldBe` Nothing +      context "Previously upgraded old-style user" $ do+        it "verifies OK with correct password" $+            validatePass oldStyleUpgradedUser mypassword `shouldBe` Just True+        it "fails validation with a wrong password giving Just False" $+            validatePass oldStyleUpgradedUser changedpw `shouldBe` Just False+       context "New style valid user" $ do         it "verifies OK with correct password" $             validatePass newStyleValidUser mypassword `shouldBe` Just True@@ -41,31 +47,26 @@         it "fails validation giving Nothing" $             validatePass newStyleBadUser mypassword `shouldBe` Nothing +      context "New-style hash in old-style format with blank salt" $ do+        it "verifies OK with correct password" $+            validatePass newStyleInOldFormat mypassword `shouldBe` Just True+        it "fails validation with a wrong password giving Just False" $+            validatePass newStyleInOldFormat changedpw `shouldBe` Just False +     describe "upgradePasswordHash" $ do        context "Upgrade of old-style password hash" $ do-        it "has the same salt value" $ do-            newuser <- upgradePasswordHash defaultStrength oldStyleValidUser-            let newsalt = newuser >>= userPasswordSalt-            newsalt `shouldBe` Just "somesalt"-        it "still verifies with the same password" $ do-            newuser <- upgradePasswordHash defaultStrength oldStyleValidUser-            let valid = newuser >>= flip validatePass mypassword-            valid `shouldBe` Just True-        it "still works after a second upgrade to a stronger setting" $ do+        it "is Nothing if the user has a valid password hash" $ do             newuser <- upgradePasswordHash defaultStrength oldStyleValidUser-            case newuser of-                Just u -> do-                    neweruser <- upgradePasswordHash stronger u-                    let valid = neweruser >>= flip validatePass mypassword-                    valid `shouldBe` Just True-                Nothing -> expectationFailure "Failed to upgrade user!"-        it "is Nothing if there is no password hash" $ do+            newuser `shouldBe` Nothing+        it "is Nothing if there is no password hash (but salt non-empty)" $ do             newuser <- upgradePasswordHash defaultStrength oldStyleBadUser1             newuser `shouldBe` Nothing-        it "is Nothing if there is no salt" $ do-            newuser <- upgradePasswordHash defaultStrength oldStyleBadUser2++      context "Upgrade of previously upgraded old-style user" $ do+        it "is Nothing since salt is non-empty" $ do+            newuser <- upgradePasswordHash defaultStrength oldStyleUpgradedUser             newuser `shouldBe` Nothing        context "Upgrade of new-style password hash to stronger setting" $ do@@ -81,6 +82,17 @@         it "is Nothing if there is no password hash" $ do             newuser <- upgradePasswordHash stronger newStyleBadUser             newuser `shouldBe` Nothing++      context "Upgrade of new-style hash in old-style format with blank salt" $ do+        it "really does have a hash containing the new strength" $ do+            newuser <- upgradePasswordHash stronger newStyleInOldFormat+            let s = pack $ "|" ++ show stronger ++ "|"+                found = fmap (s `isInfixOf`) $ newuser >>= oldStylePass+            found `shouldBe` Just True+        it "still verifies with the same password" $ do+            newuser <- upgradePasswordHash stronger newStyleInOldFormat+            let valid = newuser >>= flip validatePass mypassword+            valid `shouldBe` Just True       describe "setPassword" $ do

@@ -1,5 +1,5 @@ name:            yesod-auth-hashdb-version:         1.4.3+version:         1.5 license:         MIT license-file:    LICENSE author:          Patrick Brisbin, later changes Paul Rouse