a8c80e9531
Raises an error (as the original doc claimed) if the salt is not the required length of 16 bytes. validatePasswordEither doesn't require separate checking since the hash length as a whole is checked, implicitly ensuring the salt is the right length. Therefore it shouldn't be possible to trigger the error by calling this function. Fixes #93.
202 lines
8.1 KiB
Haskell
202 lines
8.1 KiB
Haskell
-- |
|
|
-- Module : Crypto.Cipher.Blowfish.Primitive
|
|
-- License : BSD-style
|
|
-- Stability : experimental
|
|
-- Portability : Good
|
|
|
|
-- Rewritten by Vincent Hanquez (c) 2015
|
|
--
|
|
-- Original code:
|
|
-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
|
|
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
|
|
-- (as found in Crypto-4.2.4)
|
|
|
|
module Crypto.Cipher.Blowfish.Primitive
|
|
( Context
|
|
, initBlowfish
|
|
, encrypt
|
|
, decrypt
|
|
, eksBlowfish
|
|
) where
|
|
|
|
import Control.Monad (when)
|
|
import Data.Bits
|
|
import Data.Memory.Endian
|
|
import Data.Word
|
|
|
|
import Crypto.Error
|
|
import Crypto.Internal.Compat
|
|
import Crypto.Internal.Imports
|
|
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
|
|
import qualified Crypto.Internal.ByteArray as B
|
|
import Crypto.Internal.Words
|
|
import Crypto.Internal.WordArray
|
|
import Crypto.Cipher.Blowfish.Box
|
|
|
|
-- | variable keyed blowfish state
|
|
data Context = BF (Int -> Word32) -- p
|
|
(Int -> Word32) -- sbox0
|
|
(Int -> Word32) -- sbox1
|
|
(Int -> Word32) -- sbox2
|
|
(Int -> Word32) -- sbox2
|
|
|
|
instance NFData Context where
|
|
rnf (BF p a b c d) = p `seq` a `seq` b `seq` c `seq` d `seq` ()
|
|
|
|
-- | Encrypt blocks
|
|
--
|
|
-- Input need to be a multiple of 8 bytes
|
|
encrypt :: ByteArray ba => Context -> ba -> ba
|
|
encrypt = cipher
|
|
|
|
-- | Decrypt blocks
|
|
--
|
|
-- Input need to be a multiple of 8 bytes
|
|
decrypt :: ByteArray ba => Context -> ba -> ba
|
|
decrypt = cipher . decryptContext
|
|
|
|
decryptContext :: Context -> Context
|
|
decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3
|
|
|
|
cipher :: ByteArray ba => Context -> ba -> ba
|
|
cipher ctx b
|
|
| B.length b == 0 = B.empty
|
|
| B.length b `mod` 8 /= 0 = error "invalid data length"
|
|
| otherwise = B.mapAsWord64 (coreCrypto ctx) b
|
|
|
|
-- | Initialize a new Blowfish context from a key.
|
|
--
|
|
-- key needs to be between 0 and 448 bits.
|
|
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
|
|
initBlowfish key
|
|
| len > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
|
|
| otherwise = CryptoPassed $ makeKeySchedule key (Nothing :: Maybe (Bytes, Int))
|
|
where len = B.length key
|
|
|
|
-- | The BCrypt "expensive key schedule" version of blowfish.
|
|
--
|
|
-- Salt must be 128 bits
|
|
-- Cost must be between 4 and 31 inclusive
|
|
-- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
|
|
eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context
|
|
eksBlowfish cost salt key
|
|
| B.length salt /= 16 = error "bcrypt salt must be 16 bytes"
|
|
| otherwise = makeKeySchedule key (Just (salt, cost))
|
|
|
|
coreCrypto :: Context -> Word64 -> Word64
|
|
coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
|
|
where
|
|
-- transform the input over 16 rounds
|
|
doRound :: Word64 -> Int -> Word64
|
|
doRound i roundIndex
|
|
| roundIndex == 16 =
|
|
let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)
|
|
in rotateL (i `xor` final) 32
|
|
| otherwise =
|
|
let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex)
|
|
newi = ((i `shiftL` 32) `xor` (f newr)) .|. (fromIntegral newr)
|
|
in doRound newi (roundIndex+1)
|
|
f :: Word32 -> Word64
|
|
f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff)
|
|
b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff)
|
|
c = s2 (fromIntegral $ (t `shiftR` 8) .&. 0xff)
|
|
d = s3 (fromIntegral $ t .&. 0xff)
|
|
in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32
|
|
|
|
|
|
-- | Create a key schedule for either plain Blowfish or the BCrypt "EKS" version
|
|
-- For the expensive version, the salt and cost factor are supplied. Salt must be
|
|
-- a 128-bit byte array.
|
|
--
|
|
-- The standard case is just a single key expansion with the salt set to zero.
|
|
makeKeySchedule :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> Maybe (salt, Int) -> Context
|
|
makeKeySchedule keyBytes saltCost =
|
|
let v = unsafeDoIO $ do
|
|
mv <- createKeySchedule
|
|
case saltCost of
|
|
-- Standard blowfish
|
|
Nothing -> expandKey mv 0 0 keyBytes
|
|
-- The expensive case
|
|
Just (s, cost) -> do
|
|
let (salt1, salt2) = splitSalt s
|
|
expandKey mv salt1 salt2 keyBytes
|
|
forM_ [1..2^cost :: Int] $ \_ -> do
|
|
expandKey mv 0 0 keyBytes
|
|
expandKey mv 0 0 s
|
|
mutableArray32Freeze mv
|
|
in BF (\i -> arrayRead32 v i)
|
|
(\i -> arrayRead32 v (s0+i))
|
|
(\i -> arrayRead32 v (s1+i))
|
|
(\i -> arrayRead32 v (s2+i))
|
|
(\i -> arrayRead32 v (s3+i))
|
|
where
|
|
splitSalt s = (fromBE (B.toW64BE s 0), fromBE (B.toW64BE s 8))
|
|
|
|
-- Indices of the S-Box arrays, each containing 256 32-bit words
|
|
-- The first 18 words contain the P-Array of subkeys
|
|
s0 = 18
|
|
s1 = 274
|
|
s2 = 530
|
|
s3 = 786
|
|
|
|
expandKey :: ByteArrayAccess ba
|
|
=> MutableArray32 -- ^ The key schedule
|
|
-> Word64 -- ^ First word of the salt
|
|
-> Word64 -- ^ Second word of the salt
|
|
-> ba -- ^ The key
|
|
-> IO ()
|
|
expandKey mv salt1 salt2 key = do
|
|
when (len > 0) $ forM_ [0..17] $ \i -> do
|
|
let a = B.index key ((i * 4 + 0) `mod` len)
|
|
b = B.index key ((i * 4 + 1) `mod` len)
|
|
c = B.index key ((i * 4 + 2) `mod` len)
|
|
d = B.index key ((i * 4 + 3) `mod` len)
|
|
k = (fromIntegral a `shiftL` 24) .|.
|
|
(fromIntegral b `shiftL` 16) .|.
|
|
(fromIntegral c `shiftL` 8) .|.
|
|
(fromIntegral d)
|
|
mutableArrayWriteXor32 mv i k
|
|
prepare mv
|
|
return ()
|
|
where
|
|
len = B.length key
|
|
|
|
-- | Go through the entire key schedule overwriting the P-Array and S-Boxes
|
|
prepare mctx = loop 0 salt1 salt1 salt2
|
|
where loop i input slt1 slt2
|
|
| i == 1042 = return ()
|
|
| otherwise = do
|
|
ninput <- coreCryptoMutable input
|
|
let (nl, nr) = w64to32 ninput
|
|
mutableArrayWrite32 mctx i nl
|
|
mutableArrayWrite32 mctx (i+1) nr
|
|
loop (i+2) (ninput `xor` slt2) slt2 slt1
|
|
|
|
-- | Blowfish encrypt a Word using the current state of the key schedule
|
|
coreCryptoMutable :: Word64 -> IO Word64
|
|
coreCryptoMutable input = doRound input 0
|
|
where doRound i roundIndex
|
|
| roundIndex == 16 = do
|
|
pVal1 <- mutableArrayRead32 mctx 16
|
|
pVal2 <- mutableArrayRead32 mctx 17
|
|
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
|
|
return $ rotateL (i `xor` final) 32
|
|
| otherwise = do
|
|
pVal <- mutableArrayRead32 mctx roundIndex
|
|
let newr = fromIntegral (i `shiftR` 32) `xor` pVal
|
|
newr' <- f newr
|
|
let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr)
|
|
doRound newi (roundIndex+1)
|
|
|
|
-- The Blowfish Feistel function F
|
|
f :: Word32 -> IO Word64
|
|
f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff))
|
|
b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff))
|
|
c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff))
|
|
d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff))
|
|
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
|
|
where s0 = 18
|
|
s1 = 274
|
|
s2 = 530
|
|
s3 = 786
|