module Passman.Core.Hash
(
generatePassword
, MasterPassword
, masterPassword
, fromMasterPassword
, hashMasterPassword
, checkMasterPassword
) where
import Numeric.Natural (Natural)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.IntCast (intCastMaybe)
import qualified Crypto.BCrypt as BCrypt
import qualified Crypto.Hash.MD5 as MD5
import qualified Data.ByteArray.Encoding as BAE
import Passman.Core.Info (fromInfo)
import Passman.Core.Entry (Entry (Entry))
import Passman.Core.Mode (toCharset)
import Passman.Core.Internal.Util (toBase, bytesToInt)
newtype MasterPassword = MP ByteString
deriving Eq
fromMasterPassword :: MasterPassword -> Text
fromMasterPassword (MP bs) = decodeUtf8 bs
masterPassword :: Text -> Maybe MasterPassword
masterPassword s = let bs = encodeUtf8 s in
if (BS.length bs > 72) || BS.elem 0 bs
then Nothing
else Just $ MP bs
shorten :: Natural -> Text -> Text
shorten 0 = id
shorten n = case intCastMaybe n of
Nothing -> shorten 0
Just n' -> T.take n'
generatePassword :: Entry
-> MasterPassword
-> Text
generatePassword (Entry i l m) (MP p) = shorten l $ customDigest (toCharset m) $
runBCrypt p $ MD5.hash $ encodeUtf8 $ fromInfo i
runBCrypt :: ByteString
-> ByteString
-> ByteString
runBCrypt passwd salt = case BCrypt.genSalt "$2y$" 12 salt of
Nothing -> error "BCrypt: Invalid salt (needed 16-byte)"
Just salt' -> case BCrypt.hashPassword passwd salt' of
Nothing -> error "BCrypt: Unable to hash password"
Just hash -> either error id $
BAE.convertFromBase BAE.Base64OpenBSD $ BS.drop 29 hash
hashMasterPassword :: MasterPassword
-> IO Text
hashMasterPassword (MP p) = do
Just salt <- BCrypt.genSaltUsingPolicy BCrypt.slowerBcryptHashingPolicy
{BCrypt.preferredHashCost = 12}
let Just hash = BCrypt.hashPassword p salt
return $ decodeUtf8 hash
checkMasterPassword :: Text
-> MasterPassword
-> Bool
checkMasterPassword hash (MP p) = BCrypt.validatePassword (encodeUtf8 hash) p
customDigest :: Text -> ByteString -> Text
customDigest charSet cs = T.pack (T.index charSet <$> is)
where
is :: [Int]
is = map fromIntegral $ toBase l (bytesToInt cs)
l :: Natural
l = fromIntegral $ (T.length charSet :: Int)