yesod-auth-hashdb 1.4.0 → 1.4.1
raw patch · 5 files changed
+258/−29 lines, 5 filesdep +hspecdep +yesod-auth-hashdbdep ~text
Dependencies added: hspec, yesod-auth-hashdb
Dependency ranges changed: text
Files
- Yesod/Auth/HashDB.hs +51/−26
- test/ExampleData.hs +82/−0
- test/NonDBTests.hs +102/−0
- test/main.hs +7/−0
- yesod-auth-hashdb.cabal +16/−3
Yesod/Auth/HashDB.hs view
@@ -19,8 +19,8 @@ -- Stability : Stable -- Portability : Portable ----- A yesod-auth AuthPlugin designed to look users up in Persist where--- their user id's and a hash of their password is stored.+-- A yesod-auth AuthPlugin designed to look users up in a Persistent+-- database where their user id and a hash of their password is stored. -- -- This module was removed from @yesod-auth-1.3.0.0@ and is now -- maintained separately.@@ -71,7 +71,7 @@ -- -- > instance HashDBUser User where -- > userPasswordHash = userPassword--- > setPasswordHash h p = p { userPassword = Just h }+-- > setPasswordHash h u = u { userPassword = Just h } -- -- In the YesodAuth instance declaration for your app, include 'authHashDB' -- like so:@@ -95,7 +95,8 @@ -- > > import Crypto.PasswordStore -- > > makePassword "MyPassword" 14 ----- where \"14\" is the default strength parameter used in this module.+-- where \"14\" is the default strength parameter ('defaultStrength') used+-- in this module. -- -- == Custom Login Form --@@ -129,8 +130,9 @@ , defaultStrength , setPasswordStrength , setPassword+ , validatePass , upgradePasswordHash- -- * Authentication+ -- * Interface to database and Yesod.Auth , validateUser , authHashDB , authHashDBWithForm@@ -207,7 +209,9 @@ setSaltAndPasswordHash = setUserHashAndSalt {-# 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" #-} -- | Calculate salted hash using SHA1. Retained for compatibility with@@ -241,6 +245,42 @@ setPassword :: (MonadIO m, HashDBUser user) => Text -> user -> m user setPassword = setPasswordStrength defaultStrength +-- | Validate a plaintext password against the hash in the user data structure.+-- This function retains compatibility with user data produced by old+-- versions of this module (prior to 1.3), although the hashes are less+-- secure and should be upgraded as soon as possible. They can be+-- upgraded using 'upgradePasswordHash', or by insisting that users set+-- new passwords.+--+-- The result distinguishes two types of validation failure, which may+-- be useful in an application which supports multiple authentication+-- methods:+--+-- * Just False - the user has a password set up, but the given one does+-- not match it+--+-- * Nothing - the user does not have a password (the hash is Nothing)+--+-- Since 1.4.1+--+validatePass :: HashDBUser u => u -> Text -> Maybe Bool+validatePass user passwd = do+ hash <- userPasswordHash user+ salt <- userPasswordSalt user+ -- NB plaintext password characters are truncated to 8 bits here, and also+ -- in saltedHash and passwordHash above (the hash and old salt are already+ -- 8 bit). This is for historical compatibility, but in practice it is+ -- unlikely to reduce the entropy of most users' alphabets by much.+ let hash' = BS.pack $ unpack hash+ passwd' = BS.pack $ unpack $ if salt == "" then passwd+ else+ -- Extra layer for an upgraded old hash+ saltedHash salt passwd+ if passwordStrength hash' > 0+ -- Will give >0 for new-style hash, else fall back+ then return $ verifyPassword passwd' hash'+ 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@@ -280,10 +320,10 @@ ------------------------------------------------------------------- Authentication+-- Interface to database and Yesod.Auth ---------------------------------------------------------------- --- | Constraint for types of functions in this module+-- | Constraint for types of interface functions in this module -- type HashDBPersist master user = ( YesodAuthPersist master@@ -296,32 +336,17 @@ ) -- | Given a user ID and password in plaintext, validate them against--- the database values. This function retains compatibility with--- databases containing hashes produced by previous versions of this--- module, although they are less secure and should be upgraded as--- soon as possible. They can be upgraded using 'upgradePasswordHash',--- or by insisting that users set new passwords.+-- the database values. This function simply looks up the user id in the+-- database and calls 'validatePass' to do the work.+-- validateUser :: HashDBPersist site user => Unique user -- ^ User unique identifier -> Text -- ^ Password in plaintext -> HandlerT site IO Bool validateUser userID passwd = do- -- Checks that hash and password match- let validate u = do hash <- userPasswordHash u- salt <- userPasswordSalt u- let hash' = BS.pack $ unpack hash- passwd' = BS.pack $ unpack- $ if salt == "" then passwd- else- -- Extra layer for an upgraded old hash- saltedHash salt passwd- if passwordStrength hash' > 0- -- Will give >0 for new-style hash, else fall back- then return $ verifyPassword passwd' hash'- else return $ hash == saltedHash salt passwd -- Get user data user <- runDB $ getBy userID- return $ fromMaybe False $ validate . entityVal =<< user+ return $ fromMaybe False $ flip validatePass passwd . entityVal =<< user login :: AuthRoute
+ test/ExampleData.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}+module ExampleData (+ OldStyleUser (..),+ NewStyleUser (..),+ mypassword,+ changedpw,+ equivpassword,+ equivchangedpw,+ oldStyleValidUser,+ oldStyleBadUser1,+ oldStyleBadUser2,+ newStyleValidUser,+ newStyleBadUser,+ stronger+) where++import Yesod.Auth.HashDB (HashDBUser(..), defaultStrength)+import Data.Text (Text)++data OldStyleUser = OldStyleUser {+ oldStyleName :: Text,+ oldStylePass :: Maybe Text,+ oldStyleSalt :: Maybe Text+ } deriving (Eq, Show)++instance HashDBUser OldStyleUser where+ userPasswordHash = oldStylePass+ userPasswordSalt = oldStyleSalt+ setSaltAndPasswordHash s h u = u { oldStyleSalt = Just s,+ oldStylePass = Just h+ }++data NewStyleUser = NewStyleUser {+ newStyleName :: Text,+ newStylePass :: Maybe Text+ } deriving (Eq, Show)++instance HashDBUser NewStyleUser where+ userPasswordHash = newStylePass+ setPasswordHash h u = u { newStylePass = Just h }++mypassword :: Text+mypassword = "mypassword"+changedpw :: Text+changedpw = "changedpw"++-- These are equivalent to the above if each character is truncated to 8 bits+equivpassword :: Text+equivpassword = "\x46d\x479\x470\x461\x473\x473\x477\x46f\x472\x464"+equivchangedpw :: Text+equivchangedpw = "\xbc63\xbc68\xbc61\xbc6e\xbc67\xbc65\xbc64\xbc70\xbc77"++oldStyleValidUser :: OldStyleUser+oldStyleValidUser =+ OldStyleUser "foo"+ (Just "8e3e33029e71b4e25ba95a00a88c4bfeb93d766a")+ (Just "somesalt")++oldStyleBadUser1 :: OldStyleUser+oldStyleBadUser1 =+ OldStyleUser "bar"+ Nothing+ (Just "pepper")++oldStyleBadUser2 :: OldStyleUser+oldStyleBadUser2 =+ OldStyleUser "baz"+ (Just "8e3e33029e71b4e25ba95a00a88c4bfeb93d766a")+ Nothing++newStyleValidUser :: NewStyleUser+newStyleValidUser =+ NewStyleUser "fox"+ (Just "sha256|14|2hL7cNopkA/dGy/5CQTuSg==|CUTPW6ICMISSjohFep851f9PdqIn7Y4B75/I77BvEYM=")++newStyleBadUser :: NewStyleUser+newStyleBadUser =+ NewStyleUser "bad"+ Nothing++stronger :: Int+stronger = defaultStrength + 2
+ test/NonDBTests.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+module NonDBTests (+ nonDBTests+) where++import Test.Hspec+import Yesod.Auth.HashDB+import Data.Text (pack, isInfixOf)++import ExampleData+++nonDBTests :: Spec+nonDBTests = do++ describe "validatePass" $ do++ context "Old-style valid user" $ do+ it "verifies OK with correct password" $+ validatePass oldStyleValidUser mypassword `shouldBe` Just True+ it "fails validation with a wrong password giving Just False" $+ validatePass oldStyleValidUser changedpw `shouldBe` Just False++ context "Old-style user with no password hash" $ do+ it "fails validation giving Nothing" $+ validatePass oldStyleBadUser1 mypassword `shouldBe` Nothing++ context "Old-style user with no salt" $ do+ it "fails validation giving Nothing" $+ validatePass oldStyleBadUser2 mypassword `shouldBe` Nothing++ context "New style valid user" $ do+ it "verifies OK with correct password" $+ validatePass newStyleValidUser mypassword `shouldBe` Just True+ it "fails validation with a wrong password giving Just False" $+ validatePass newStyleValidUser changedpw `shouldBe` Just False++ context "New-style user with no password hash" $ do+ it "fails validation giving Nothing" $+ validatePass newStyleBadUser mypassword `shouldBe` Nothing+++ 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+ newuser <- upgradePasswordHash defaultStrength oldStyleValidUser+ neweruser <- case newuser of+ Just u -> upgradePasswordHash stronger u+ Nothing -> return $ Just oldStyleBadUser1 -- failure+ let valid = neweruser >>= flip validatePass mypassword+ valid `shouldBe` Just True+ it "is Nothing if there is no password hash" $ do+ newuser <- upgradePasswordHash defaultStrength oldStyleBadUser1+ newuser `shouldBe` Nothing+ it "is Nothing if there is no salt" $ do+ newuser <- upgradePasswordHash defaultStrength oldStyleBadUser2+ newuser `shouldBe` Nothing++ context "Upgrade of new-style password hash to stronger setting" $ do+ it "really does have a hash containing the new strength" $ do+ newuser <- upgradePasswordHash stronger newStyleValidUser+ let s = pack $ "|" ++ show stronger ++ "|"+ found = fmap (s `isInfixOf`) $ newuser >>= newStylePass+ found `shouldBe` Just True+ it "still verifies with the same password" $ do+ newuser <- upgradePasswordHash stronger newStyleValidUser+ let valid = newuser >>= flip validatePass mypassword+ valid `shouldBe` Just True+ it "is Nothing if there is no password hash" $ do+ newuser <- upgradePasswordHash stronger newStyleBadUser+ newuser `shouldBe` Nothing+++ describe "setPassword" $ do+ it "produces hash which verifies OK starting from old-style user" $ do+ newuser <- setPassword changedpw oldStyleValidUser+ validatePass newuser changedpw `shouldBe` Just True+ it "produces empty salt (in the case of old-style user)" $ do+ newuser <- setPassword changedpw oldStyleValidUser+ userPasswordSalt newuser `shouldBe` Just ""+ it "produces hash which verifies OK starting from new-style user" $ do+ newuser <- setPassword changedpw newStyleValidUser+ validatePass newuser changedpw `shouldBe` Just True+++ describe "Only the bottom 8 bits of password characters are used" $ do+ it "when verifying old-style password hash" $+ validatePass oldStyleValidUser equivpassword `shouldBe` Just True+ it "when verifying new-style password hash" $+ validatePass newStyleValidUser equivpassword `shouldBe` Just True+ it "when setting a new password" $ do+ newuser <- setPassword equivchangedpw oldStyleValidUser+ validatePass newuser changedpw `shouldBe` Just True
+ test/main.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+import Test.Hspec++import NonDBTests++main :: IO ()+main = hspec nonDBTests
yesod-auth-hashdb.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-hashdb-version: 1.4.0+version: 1.4.1 license: MIT license-file: LICENSE author: Patrick Brisbin, later changes Paul Rouse@@ -7,9 +7,10 @@ synopsis: Authentication plugin for Yesod. category: Web, Yesod stability: Stable-cabal-version: >= 1.6.0+cabal-version: >= 1.8.0 build-type: Simple-homepage: http://www.yesodweb.com/+homepage: https://github.com/paul-rouse/yesod-auth-hashdb+bug-reports: https://github.com/paul-rouse/yesod-auth-hashdb/issues description: This package is the Yesod.Auth.HashDB plugin, originally included in yesod-auth, but now modified to be more secure and placed in a separate package. library@@ -26,6 +27,18 @@ exposed-modules: Yesod.Auth.HashDB ghc-options: -Wall++test-suite test+ type: exitcode-stdio-1.0+ main-is: main.hs+ hs-source-dirs: test+ ghc-options: -Wall+ other-modules: ExampleData+ NonDBTests+ build-depends: base >= 4 && < 5+ , yesod-auth-hashdb+ , hspec+ , text source-repository head type: git