diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/Yesod/Auth/HashDB.hs b/Yesod/Auth/HashDB.hs --- a/Yesod/Auth/HashDB.hs +++ b/Yesod/Auth/HashDB.hs @@ -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 -- 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: . --- --- 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__ +-- ____ -- -- 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 " #-} - -- | 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 - } diff --git a/test/ExampleData.hs b/test/ExampleData.hs --- a/test/ExampleData.hs +++ b/test/ExampleData.hs @@ -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 diff --git a/test/NonDBTests.hs b/test/NonDBTests.hs --- a/test/NonDBTests.hs +++ b/test/NonDBTests.hs @@ -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 diff --git a/yesod-auth-hashdb.cabal b/yesod-auth-hashdb.cabal --- a/yesod-auth-hashdb.cabal +++ b/yesod-auth-hashdb.cabal @@ -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