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

rewrite blowfish core to mostly generate its key schedule in one allocation.

Browse Source
This commit is contained in:
Vincent Hanquez 2015-04-11 07:00:21 +01:00
parent e0e0d8dafd
commit b191ef461c
1 changed files with 80 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,8 +4,11 @@
-- Stability : experimental
-- Portability : Good
-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
-- 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
@ -17,43 +20,51 @@ module Crypto.Cipher.Blowfish.Primitive
import Data.Vector (Vector, (!), (//))
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as V (unsafeRead, unsafeWrite)
import Data.Bits
import Data.Word
import qualified Data.ByteString as B
import Crypto.Error
import Crypto.Internal.Compat
import Crypto.Internal.ByteArray
import Crypto.Internal.Words
import Crypto.Cipher.Blowfish.Box
import Debug.Trace
import Text.Printf
-- | variable keyed blowfish state
data Context = BF Pbox Sbox Sbox Sbox Sbox
data Context = BF (Int -> Word32) -- p
(Int -> Word32) -- sbox0
(Int -> Word32) -- sbox1
(Int -> Word32) -- sbox2
(Int -> Word32) -- sbox2
encrypt, decrypt :: ByteArray ba => Context -> ba -> ba
encrypt = cipher . selectEncrypt
decrypt = cipher . selectDecrypt
encrypt = cipher
decrypt = cipher . decryptContext
selectEncrypt, selectDecrypt :: Context -> (Pbox, Context)
selectEncrypt x@(BF p _ _ _ _) = (p, x)
selectDecrypt x@(BF p _ _ _ _) = (V.reverse p, x)
decryptContext :: Context -> Context
decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3
cipher :: ByteArray ba => (Pbox, Context) -> ba -> ba
cipher (p, bs) b
cipher :: ByteArray ba => Context -> ba -> ba
cipher ctx b
| byteArrayLength b == 0 = empty
| byteArrayLength b `mod` 8 /= 0 = error "invalid data length"
| otherwise = byteArrayMapAsWord64 (coreCrypto p bs) b
| otherwise = byteArrayMapAsWord64 (coreCrypto ctx) b
initBlowfish :: ByteArray key => key -> CryptoFailable Context
initBlowfish key
| len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid
| len == 0 = keyFromByteString (B.replicate (18*4) 0)
| otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack . byteArrayToBS $ key
| otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack . byteArrayToBS $ key
where len = byteArrayLength key
keyFromByteString :: B.ByteString -> CryptoFailable Context
keyFromByteString k
| B.length k /= (18 * 4) = CryptoFailed CryptoError_KeySizeInvalid
| otherwise = CryptoPassed . bfMakeKey . (\ws -> V.generate 18 (ws!!)) . w8tow32 . B.unpack $ k
| otherwise = CryptoPassed . bfMakeKey . w8tow32 . B.unpack $ k
where
w8tow32 :: [Word8] -> [Word32]
w8tow32 [] = []
@ -63,39 +74,74 @@ keyFromByteString k
(fromIntegral d) ) : w8tow32 xs
w8tow32 _ = error $ "internal error: Crypto.Cipher.Blowfish:keyFromByteString"
coreCrypto :: Pbox -> Context -> Word64 -> Word64
coreCrypto p (BF _ s0 s1 s2 s3) input = doRound input 0
coreCrypto :: Context -> Word64 -> Word64
coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
where
-- transform the input @i over 16 rounds
doRound :: Word64 -> Int -> Word64
doRound i roundIndex
| roundIndex == 16 =
let final = (fromIntegral (p ! 16) `shiftL` 32) .|. fromIntegral (p ! 17)
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)
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)
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
bfMakeKey :: Vector Word32 -> Context
bfMakeKey k = procKey 0 (BF (V.zipWith xor k iPbox) iSbox0 iSbox1 iSbox2 iSbox3) 0
bfMakeKey :: [Word32] -> Context
bfMakeKey k = procKey [mixedBox,iSbox0,iSbox1,iSbox2,iSbox3]
where mixedBox = V.fromList $ zipWith xor k (map (\i -> iPbox ! i) [0..17])
procKey :: Word64 -> Context -> Int -> Context
procKey _ tpbf 1042 = tpbf
procKey input tpbf@(BF p s0 s1 s2 s3) i = procKey ni newbf (i+2)
where ni = coreCrypto p tpbf input
(nl,nr) = w64to32 ni
procKey :: [Vector Word32] -> Context
procKey initialContext =
let v = unsafeDoIO (V.unsafeThaw (V.concat initialContext) >>= prepare >>= V.unsafeFreeze)
in BF (V.slice 0 18 v !)
(V.slice s0 256 v !)
(V.slice s1 256 v !)
(V.slice s2 256 v !)
(V.slice s3 256 v !)
where
s0 = 18
s1 = 274
s2 = 530
s3 = 786
newbf
| i < 18 = BF (p // [(i,nl),(i+1,nr)]) s0 s1 s2 s3
| i < 274 = BF p (s0 // [(i-18,nl),(i-17,nr)]) s1 s2 s3
| i < 530 = BF p s0 (s1 // [(i-274,nl),(i-273,nr)]) s2 s3
| i < 786 = BF p s0 s1 (s2 // [(i-530,nl),(i-529,nr)]) s3
| otherwise = BF p s0 s1 s2 (s3 // [(i-786,nl),(i-785,nr)])
prepare mctx = loop 0 0 >> return mctx
where loop i input
| i == 1042 = return ()
| otherwise = do
ninput <- coreCryptoMutable input
let (nl, nr) = w64to32 ninput
V.unsafeWrite mctx i nl
V.unsafeWrite mctx (i+1) nr
loop (i+2) ninput
coreCryptoMutable :: Word64 -> IO Word64
coreCryptoMutable input = doRound input 0
where doRound i roundIndex
| roundIndex == 16 = do
pVal1 <- V.unsafeRead mctx 16
pVal2 <- V.unsafeRead mctx 17
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
return $ rotateL (i `xor` final) 32
| otherwise = do
pVal <- V.unsafeRead 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)
f :: Word32 -> IO Word64
f t = do a <- V.unsafeRead mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff))
b <- V.unsafeRead mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff))
c <- V.unsafeRead mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff))
d <- V.unsafeRead mctx (s3 + fromIntegral (t .&. 0xff))
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)