haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add implementation of bcrypt_pbkdf

Browse Source
This commit is contained in:
Lars Petersen 2019-03-14 20:19:35 +01:00
parent 0ce2e5f325
commit 2a26202a32
6 changed files with 283 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Crypto/Cipher/Blowfish/Box.hs
View File

@ -7,13 +7,27 @@
module Crypto.Cipher.Blowfish.Box
( KeySchedule(..)
, createKeySchedule
, copyKeySchedule
) where
import Crypto.Internal.WordArray (MutableArray32,
mutableArray32FromAddrBE)
mutableArray32FromAddrBE,
mutableArrayRead32,
mutableArrayWrite32)
newtype KeySchedule = KeySchedule MutableArray32
-- | Copy the state of one key schedule into the other.
-- The first parameter is the destination and the second the source.
copyKeySchedule :: KeySchedule -> KeySchedule -> IO ()
copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0
where
loop 1042 = return ()
loop i = do
w32 <-mutableArrayRead32 src i
mutableArrayWrite32 dst i w32
loop (i + 1)
-- | Create a key schedule mutable array of the pbox followed by
-- all the sboxes.
createKeySchedule :: IO KeySchedule

1
Crypto/Cipher/Blowfish/Primitive.hs
View File

@ -22,6 +22,7 @@ module Crypto.Cipher.Blowfish.Primitive
, freezeKeySchedule
, expandKey
, expandKeyWithSalt
, cipherBlockMutable
) where
import Control.Monad (when)

187
Crypto/KDF/BCryptPBKDF.hs Normal file
View File

@ -0,0 +1,187 @@
-- |
-- Module : Crypto.KDF.BCryptPBKDF
-- License : BSD-style
-- Stability : experimental
-- Portability : Good
--
-- Port of the bcrypt_pbkdf key derivation function from OpenBSD
-- as described at <http://man.openbsd.org/bcrypt_pbkdf.3>.
module Crypto.KDF.BCryptPBKDF
( Parameters (..)
, generate
, hashInternal
)
where
import Basement.Block (MutableBlock)
import qualified Basement.Block as Block
import qualified Basement.Block.Mutable as Block
import Basement.Monad (PrimState)
import Basement.Types.OffsetSize (CountOf (..), Offset (..))
import Control.Exception (finally)
import Control.Monad (when)
import qualified Crypto.Cipher.Blowfish.Box as Blowfish
import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish
import Crypto.Hash.Algorithms (SHA512 (..))
import Crypto.Hash.Types (Context,
hashDigestSize,
hashInternalContextSize,
hashInternalFinalize,
hashInternalInit,
hashInternalUpdate)
import Crypto.Internal.Compat (unsafeDoIO)
import Data.Bits
import qualified Data.ByteArray as B
import Data.Foldable (forM_)
import Data.Memory.PtrMethods (memCopy, memSet, memXor)
import Data.Word
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (peekByteOff, pokeByteOff)
data Parameters = Parameters
{ iterCounts :: Int -- ^ The number of user-defined iterations for the algorithm
-- (must be > 0)
, outputLength :: Int -- ^ The number of bytes to generate out of BCryptPBKDF
-- (must be in 1..1024)
} deriving (Eq, Ord, Show)
-- | Derive a key of specified length using the bcrypt_pbkdf algorithm.
generate :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output)
=> Parameters
-> pass
-> salt
-> output
generate params pass salt
| iterCounts params < 1 = error "BCryptPBKDF: iterCounts must be > 0"
| keyLen < 1 || keyLen > 1024 = error "BCryptPBKDF: outputLength must be in 1..1024"
| otherwise = B.unsafeCreate keyLen deriveKey
where
outLen, tmpLen, blkLen, keyLen, passLen, saltLen, ctxLen, hashLen, blocks :: Int
outLen = 32
tmpLen = 32
blkLen = 4
passLen = B.length pass
saltLen = B.length salt
keyLen = outputLength params
ctxLen = hashInternalContextSize SHA512
hashLen = hashDigestSize SHA512 -- 64
blocks = (keyLen + outLen - 1) `div` outLen
deriveKey :: Ptr Word8 -> IO ()
deriveKey keyPtr = do
-- Allocate all necessary memory. The algorihm shall not allocate
-- any more dynamic memory after this point. Blocks need to be pinned
-- as pointers to them are passed to the SHA512 implementation.
ksClean <- Blowfish.createKeySchedule
ksDirty <- Blowfish.createKeySchedule
ctxMBlock <- Block.newPinned (CountOf ctxLen :: CountOf Word8)
outMBlock <- Block.newPinned (CountOf outLen :: CountOf Word8)
tmpMBlock <- Block.newPinned (CountOf tmpLen :: CountOf Word8)
blkMBlock <- Block.newPinned (CountOf blkLen :: CountOf Word8)
passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
-- Finally erase all memory areas that contain information from
-- which the derived key could be reconstructed.
-- As all MutableBlocks are pinned it shall be guaranteed that
-- no temporary trampoline buffers are allocated.
finallyErase outMBlock $ finallyErase passHashMBlock $
B.withByteArray pass $ \passPtr->
B.withByteArray salt $ \saltPtr->
Block.withMutablePtr ctxMBlock $ \ctxPtr->
Block.withMutablePtr outMBlock $ \outPtr->
Block.withMutablePtr tmpMBlock $ \tmpPtr->
Block.withMutablePtr blkMBlock $ \blkPtr->
Block.withMutablePtr passHashMBlock $ \passHashPtr->
Block.withMutablePtr saltHashMBlock $ \saltHashPtr-> do
-- Hash the password.
let shaPtr = castPtr ctxPtr :: Ptr (Context SHA512)
hashInternalInit shaPtr
hashInternalUpdate shaPtr passPtr (fromIntegral passLen)
hashInternalFinalize shaPtr (castPtr passHashPtr)
passHashBlock <- Block.unsafeFreeze passHashMBlock
forM_ [1..blocks] $ \block-> do
-- Poke the increased block counter.
Block.unsafeWrite blkMBlock 0 (fromIntegral $ block `shiftR` 24)
Block.unsafeWrite blkMBlock 1 (fromIntegral $ block `shiftR` 16)
Block.unsafeWrite blkMBlock 2 (fromIntegral $ block `shiftR` 8)
Block.unsafeWrite blkMBlock 3 (fromIntegral $ block `shiftR` 0)
-- First round (slightly different).
hashInternalInit shaPtr
hashInternalUpdate shaPtr saltPtr (fromIntegral saltLen)
hashInternalUpdate shaPtr blkPtr (fromIntegral blkLen)
hashInternalFinalize shaPtr (castPtr saltHashPtr)
Block.unsafeFreeze saltHashMBlock >>= \x-> do
Blowfish.copyKeySchedule ksDirty ksClean
hashInternalMutable ksDirty passHashBlock x tmpMBlock
memCopy outPtr tmpPtr outLen
-- Remaining rounds.
forM_ [2..iterCounts params] $ const $ do
hashInternalInit shaPtr
hashInternalUpdate shaPtr tmpPtr (fromIntegral tmpLen)
hashInternalFinalize shaPtr (castPtr saltHashPtr)
Block.unsafeFreeze saltHashMBlock >>= \x-> do
Blowfish.copyKeySchedule ksDirty ksClean
hashInternalMutable ksDirty passHashBlock x tmpMBlock
memXor outPtr outPtr tmpPtr outLen
-- Spread the current out buffer evenly over the key buffer.
-- After both loops have run every byte of the key buffer
-- will have been written to exactly once and every byte
-- of the output will have been used.
forM_ [0..outLen - 1] $ \outIdx-> do
let keyIdx = outIdx * blocks + block - 1
when (keyIdx < keyLen) $ do
w8 <- peekByteOff outPtr outIdx :: IO Word8
pokeByteOff keyPtr keyIdx w8
-- | Internal hash function used by `generate`.
--
-- Normal users should not need this.
hashInternal :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output)
=> pass
-> salt
-> output
hashInternal passHash saltHash
| B.length passHash /= 64 = error "passHash must be 512 bits"
| B.length saltHash /= 64 = error "saltHash must be 512 bits"
| otherwise = unsafeDoIO $ do
ks0 <- Blowfish.createKeySchedule
outMBlock <- Block.newPinned 32
hashInternalMutable ks0 passHash saltHash outMBlock
B.convert `fmap` Block.freeze outMBlock
hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt)
=> Blowfish.KeySchedule
-> pass
-> salt
-> MutableBlock Word8 (PrimState IO)
-> IO ()
hashInternalMutable bfks passHash saltHash outMBlock = do
Blowfish.expandKeyWithSalt bfks passHash saltHash
forM_ [0..63 :: Int] $ const $ do
Blowfish.expandKey bfks saltHash
Blowfish.expandKey bfks passHash
-- "OxychromaticBlowfishSwatDynamite" represented as 4 Word64 in big-endian.
store 0 =<< cipher 64 0x4f78796368726f6d
store 8 =<< cipher 64 0x61746963426c6f77
store 16 =<< cipher 64 0x6669736853776174
store 24 =<< cipher 64 0x44796e616d697465
where
store :: Offset Word8 -> Word64 -> IO ()
store o w64 = do
Block.unsafeWrite outMBlock (o + 0) (fromIntegral $ w64 `shiftR` 32)
Block.unsafeWrite outMBlock (o + 1) (fromIntegral $ w64 `shiftR` 40)
Block.unsafeWrite outMBlock (o + 2) (fromIntegral $ w64 `shiftR` 48)
Block.unsafeWrite outMBlock (o + 3) (fromIntegral $ w64 `shiftR` 56)
Block.unsafeWrite outMBlock (o + 4) (fromIntegral $ w64 `shiftR` 0)
Block.unsafeWrite outMBlock (o + 5) (fromIntegral $ w64 `shiftR` 8)
Block.unsafeWrite outMBlock (o + 6) (fromIntegral $ w64 `shiftR` 16)
Block.unsafeWrite outMBlock (o + 7) (fromIntegral $ w64 `shiftR` 24)
cipher :: Int -> Word64 -> IO Word64
cipher 0 block = return block
cipher i block = Blowfish.cipherBlockMutable bfks block >>= cipher (i - 1)
finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
finallyErase mblock action =
action `finally` Block.withMutablePtr mblock (\ptr-> memSet ptr 0 len)
where
CountOf len = Block.mutableLengthBytes mblock

4
cryptonite.cabal
View File

@ -12,7 +12,7 @@ Description:
.
* Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448
.
* Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2
* Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2, BCrypt, BCryptPBKDF
.
* Cryptographic Random generation: System Entropy, Deterministic Random Generator
.
@ -138,6 +138,7 @@ Library
Crypto.KDF.PBKDF2
Crypto.KDF.Scrypt
Crypto.KDF.BCrypt
Crypto.KDF.BCryptPBKDF
Crypto.KDF.HKDF
Crypto.Hash
Crypto.Hash.IO
@ -378,6 +379,7 @@ Test-Suite test-cryptonite
Other-modules: BlockCipher
ChaCha
BCrypt
BCryptPBKDF
ECC
ECC.Edwards25519
Hash

75
tests/BCryptPBKDF.hs Normal file
View File

@ -0,0 +1,75 @@
{-# LANGUAGE OverloadedStrings #-}
module BCryptPBKDF (tests) where
import qualified Data.ByteString as B
import Test.Tasty
import Test.Tasty.HUnit
import Crypto.KDF.BCryptPBKDF (Parameters (..), generate,
hashInternal)
tests :: TestTree
tests = testGroup "BCryptPBKDF"
[ testGroup "generate"
[ testCase "1" generate1
, testCase "2" generate2
, testCase "3" generate3
]
, testGroup "hashInternal"
[ testCase "1" hashInternal1
]
]
where
-- test vector taken from the go implementation by @dchest
generate1 = expected @=? generate params pass salt
where
params = Parameters 12 32
pass = "password" :: B.ByteString
salt = "salt" :: B.ByteString
expected = B.pack
[ 0x1a, 0xe4, 0x2c, 0x05, 0xd4, 0x87, 0xbc, 0x02
, 0xf6, 0x49, 0x21, 0xa4, 0xeb, 0xe4, 0xea, 0x93
, 0xbc, 0xac, 0xfe, 0x13, 0x5f, 0xda, 0x99, 0x97
, 0x4c, 0x06, 0xb7, 0xb0, 0x1f, 0xae, 0x14, 0x9a
] :: B.ByteString
-- test vector generated with the go implemenation by @dchest
generate2 = expected @=? generate params pass salt
where
params = Parameters 7 71
pass = "DieWuerdeDesMenschenIstUnantastbar" :: B.ByteString
salt = "Tafelsalz" :: B.ByteString
expected = B.pack
[ 0x17, 0xb4, 0x76, 0xaa, 0xd7, 0x42, 0x33, 0x49
, 0x5c, 0xe8, 0x79, 0x49, 0x15, 0x74, 0x4c, 0x71
, 0xf9, 0x99, 0x66, 0x89, 0x7a, 0x60, 0xc3, 0x70
, 0xb4, 0x3c, 0xa8, 0x83, 0x80, 0x5a, 0x56, 0xde
, 0x38, 0xbc, 0x51, 0x8c, 0xd4, 0xeb, 0xd1, 0xcf
, 0x46, 0x0a, 0x68, 0x3d, 0xc8, 0x12, 0xcf, 0xf8
, 0x43, 0xce, 0x21, 0x9d, 0x98, 0x81, 0x20, 0x26
, 0x6e, 0x42, 0x0f, 0xaa, 0x75, 0x5d, 0x09, 0x8d
, 0x45, 0xda, 0xd5, 0x15, 0x6e, 0x65, 0x1d
] :: B.ByteString
-- test vector generated with the go implemenation by @dchest
generate3 = expected @=? generate params pass salt
where
params = Parameters 5 5
pass = "ABC" :: B.ByteString
salt = "DEF" :: B.ByteString
expected = B.pack
[ 0xdd, 0x6e, 0xa0, 0x69, 0x29
] :: B.ByteString
hashInternal1 = expected @=? hashInternal passHash saltHash
where
passHash = B.pack [ 0 .. 63 ] :: B.ByteString
saltHash = B.pack [ 64 .. 127 ] :: B.ByteString
expected = B.pack
[ 0x87, 0x90, 0x48, 0x70, 0xee, 0xf9, 0xde, 0xdd
, 0xf8, 0xe7, 0x61, 0x1a, 0x14, 0x01, 0x06, 0xe6
, 0xaa, 0xf1, 0xa3, 0x63, 0xd9, 0xa2, 0xc5, 0x04
, 0xdb, 0x35, 0x64, 0x43, 0x72, 0x1e, 0xb5, 0x55
] :: B.ByteString

2
tests/Tests.hs
View File

@ -6,6 +6,7 @@ import Imports
import qualified Number
import qualified Number.F2m
import qualified BCrypt
import qualified BCryptPBKDF
import qualified ECC
import qualified ECC.Edwards25519
import qualified Hash
@ -63,6 +64,7 @@ tests = testGroup "cryptonite"
[ KAT_PBKDF2.tests
, KAT_Scrypt.tests
, BCrypt.tests
, BCryptPBKDF.tests
, KAT_HKDF.tests
, KAT_Argon2.tests
]