diff --git a/Crypto/KDF/BCrypt.hs b/Crypto/KDF/BCrypt.hs new file mode 100644 index 0000000..516747e --- /dev/null +++ b/Crypto/KDF/BCrypt.hs @@ -0,0 +1,110 @@ + +module Crypto.KDF.BCrypt + ( hashPassword + , validatePassword + , bcrypt + ) +where + +import Control.Monad (unless, when) +import Crypto.Cipher.Blowfish.Primitive (eksBlowfish, encrypt) +import Crypto.Random (MonadRandom, getRandomBytes) +import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import qualified Data.ByteArray as B +import Data.ByteArray.Encoding +import Data.Char + +data BCryptHash = BCH Char Int Bytes Bytes + +-- | Create a bcrypt hash for a password with a provided cost value. +-- +-- Each increment of the cost approximately doubles the time taken. +-- The 16 bytes of random salt will be generated internally. +hashPassword :: (MonadRandom m, ByteArray password, ByteArray hash) + => Int + -- ^ The cost parameter. Should be between 4 and 31 (inclusive). + -- Values which lie outside this range will be adjusted accordingly. + -> password + -- ^ The password. + -> m hash + -- ^ The bcrypt hash in standard format. +hashPassword cost password = do + salt <- getRandomBytes 16 + return $ bcrypt cost (salt :: Bytes) password + +-- | Create a bcrypt hash for a password with a provided cost value and salt. +bcrypt :: (ByteArray salt, ByteArray password, ByteArray output) + => Int + -- ^ The cost parameter. Should be between 4 and 31 (inclusive). + -- Values which lie outside this range will be adjusted accordingly. + -> salt + -- ^ The salt. Must be 16 bytes in length or an error will be raised. + -> password + -- ^ The password. + -> output + -- ^ The bcrypt hash in standard format. +bcrypt cost salt password = B.concat [header, B.snoc costBytes dollar, b64 salt, b64 hash] + where + hash = rawHash 'b' realCost salt password + header = B.pack [dollar, fromIntegral (ord '2'), fromIntegral (ord 'a'), dollar] + dollar = fromIntegral (ord '$') + zero = fromIntegral (ord '0') + costBytes = B.pack [zero + fromIntegral (realCost `div` 10), zero + fromIntegral (realCost `mod` 10)] + realCost + | cost < 4 = 4 + | cost > 31 = 31 + | otherwise = cost + + b64 :: (ByteArray ba) => ba -> ba + b64 = convertToBase Base64OpenBSD + +-- | Check a password against a bcrypt hash +-- +-- Returns @False@ if the password doesn't match the hash, or if the hash is +-- invalid or an unsupported version. +validatePassword :: (ByteArray password, ByteArray hash) => password -> hash -> Bool +validatePassword password bcHash = case parseBCryptHash bcHash of + Right (BCH version cost salt hash) -> (rawHash version cost salt password :: Bytes) `B.constEq` hash + Left _ -> False + +rawHash :: (ByteArrayAccess salt, ByteArray password, ByteArray output) => Char -> Int -> salt -> password -> output +rawHash version cost salt password = B.take 23 hash + where + hash = loop (0 :: Int) orpheanBeholder + + loop i input + | i < 64 = loop (i+1) (encrypt ctx input) + | otherwise = input + + -- Truncate the password if necessary and append a null byte for C compatibility + key = B.snoc (B.take 72 password) 0 + + ctx = eksBlowfish cost salt key + + -- The BCrypt plaintext: "OrpheanBeholderScryDoubt" + orpheanBeholder = B.pack [79,114,112,104,101,97,110,66,101,104,111,108,100,101,114,83,99,114,121,68,111,117,98,116] + +-- "$2a$10$XajjQvNhvvRt5GSeFk1xFeyqRrsxkhBkUiQeg0dt.wU1qD4aFDcga" +parseBCryptHash :: (ByteArray ba) => ba -> Either String BCryptHash +parseBCryptHash bc = do + unless (B.length bc == 60 && + B.index bc 0 == dollar && + B.index bc 1 == fromIntegral (ord '2') && + B.index bc 3 == dollar && + B.index bc 6 == dollar) (Left "Invalid hash format") + when (costTens > 3 || cost > 31 || cost < 4) (Left "Invalid bcrypt cost") + (salt, hash) <- decodeSaltHash (B.drop 7 bc) + return (BCH version cost salt hash) + where + dollar = fromIntegral (ord '$') + zero = ord '0' + costTens = fromIntegral (B.index bc 4) - zero + costUnits = fromIntegral (B.index bc 5) - zero + version = chr (fromIntegral (B.index bc 2)) + cost = costUnits + (if costTens == 0 then 0 else 10^costTens) :: Int + + decodeSaltHash saltHash = do + let (s, h) = B.splitAt 22 saltHash + salt <- convertFromBase Base64OpenBSD s + hash <- convertFromBase Base64OpenBSD h + return (salt, hash) diff --git a/cryptonite.cabal b/cryptonite.cabal index 556a75f..733b258 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -96,6 +96,7 @@ Library Crypto.Number.Serialize.Internal Crypto.KDF.PBKDF2 Crypto.KDF.Scrypt + Crypto.KDF.BCrypt Crypto.Hash Crypto.Hash.IO Crypto.Hash.Algorithms