Password.hs

{-# LANGUAGE TemplateHaskell,DeriveDataTypeable,FlexibleInstances,MultiParamTypeClasses,FlexibleContexts,UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |Module      :  HAppS.Data.User.Password
-- Copyright   :  (c) 2008 Jeremy Shaw <jeremy@n-heptane.com>, 
-- modified by Thomas Hartman to use PBKDF2, and uploaded to hackage
-- License     :  BSD3-style
-- 
-- Maintainer  :  Thomas Hartman, thomashartman1@gmail.com
-- Stability   :  experimental
-- Portability :  requires all sorts of crazy GHC extensions
--
-- Data types and functions for handling salted passwords.
-----------------------------------------------------------------------------
module Happstack.Data.User.Password where

import Control.Monad
import Happstack.Data
import System.Random
import qualified Crypto.PBKDF2 as PBKDF2
import qualified Data.ByteString.Char8 as B
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

-- |check if the submitted password matches the stored password
checkPassword :: Password -- ^ stored salt and password hash
              -> String  -- ^ password to test (unhashed)
              -> Bool -- ^ did it match
checkPassword (Password salt hash) password = doHash salt password == hash

mkP salt password = Password salt $ doHash salt password

t = doHash ( Salt "fooie" ) "blee"

{- |hash a password using the supplied salt
Originally implemented using SHA1. By switching to pbkdf2, we don't rely on implementation of randomIO being cryptographically secure.
-}

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
    -- PasswordHash (sha1 (salt ++ password))


{- |changepass oldpassTryString newpassString p@(Password salt hash) = ... 
  Change password, requires old password as an additional security measure
-}
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"

-- |generate some random salt
 -- returns 4 'Char' of salt.
genSalt :: MonadIO m => m Salt
genSalt = liftIO . liftM Salt $ ( replicateM 4 randomIO :: IO String)

-- |generate a new salted/hashed 'Password' from the given input string
newPassword :: MonadIO m => String -> m Password
newPassword password =
    do salt <- genSalt
       return $ mkP salt password



--t = putStrLn . show =<< newPassword "blee"