module Happstack.Data.User.Password where
import Control.Monad
import Happstack.Data
import System.Random
import qualified Crypto.PBKDF2 as PBKDF2
import Data.Word
import Control.Monad.Trans
$( deriveAll [''Ord,''Eq,''Read,''Show,''Default]
[d|
data Password = Password Salt PasswordHash
newtype PasswordHash = PasswordHash [Word8]
newtype Salt = Salt String
|] )
$(deriveSerialize ''Password)
instance Version Password
$(deriveSerialize ''PasswordHash)
instance Version PasswordHash
$(deriveSerialize ''Salt)
instance Version Salt
checkPassword :: Password
-> String
-> Bool
checkPassword (Password salt hash) password = doHash salt password == hash
mkP salt password = Password salt $ doHash salt password
t = doHash ( Salt "fooie" ) "blee"
doHash :: Salt -> String -> PasswordHash
doHash (Salt salt) password =
case PBKDF2.pbkdf2 (PBKDF2.Password . PBKDF2.toOctets $ password) (PBKDF2.Salt . PBKDF2.toOctets $ salt)
of (PBKDF2.HashedPass hp) -> PasswordHash hp
changepass :: (Monad m) => String -> String -> Password -> m Password
changepass oldpassTryString newpassString p@(Password salt hash) =
if checkPassword p oldpassTryString
then return $ mkP salt newpassString
else fail "incorrect old password"
genSalt :: MonadIO m => m Salt
genSalt = liftIO . liftM Salt $ ( replicateM 4 randomIO :: IO String)
newPassword :: MonadIO m => String -> m Password
newPassword password =
do salt <- genSalt
return $ mkP salt password