diff --git a/Crypto/Cipher/Blowfish/Box.hs b/Crypto/Cipher/Blowfish/Box.hs index 65a6942..2a2f42c 100644 --- a/Crypto/Cipher/Blowfish/Box.hs +++ b/Crypto/Cipher/Blowfish/Box.hs @@ -3,39 +3,17 @@ -- License : BSD-style -- Stability : experimental -- Portability : Good +{-# LANGUAGE MagicHash #-} module Crypto.Cipher.Blowfish.Box - ( Pbox - , boxes + ( createKeySchedule ) where -import Data.Bits -import Data.Char (ord) -import Data.Word -import Data.Vector (Vector, (!), (//)) -import qualified Data.Vector as V -import qualified Data.ByteString as B +import Crypto.Internal.WordArray (mutableArray32FromAddrBE, MutableArray32) -type Pbox = Vector Word32 - -mkBox :: [Char] -> Vector Word32 -mkBox = V.fromList . map decode32be . doChunks 4 id . B.pack . map (fromIntegral . ord) - -doChunks :: Int -> (B.ByteString -> B.ByteString) -> B.ByteString -> [B.ByteString] -doChunks n f b = - let (x, rest) = B.splitAt n b in - if B.length rest >= n - then f x : doChunks n f rest - else [ f x ] - -decode32be :: B.ByteString -> Word32 -decode32be s = id $! - (fromIntegral (s `B.index` 0) `shiftL` 24) .|. - (fromIntegral (s `B.index` 1) `shiftL` 16) .|. - (fromIntegral (s `B.index` 2) `shiftL` 8) .|. - (fromIntegral (s `B.index` 3) ) - -boxes :: Pbox -boxes = mkBox "\ +-- | Create a key schedule mutable array of the pbox followed by +-- all the sboxes. +createKeySchedule :: IO MutableArray32 +createKeySchedule = mutableArray32FromAddrBE 1042 "\ \\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\ \\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\ \\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\ @@ -297,4 +275,4 @@ boxes = mkBox "\ \\x19\x48\xc2\x5c\x02\xfb\x8a\x8c\x01\xc3\x6a\xe4\xd6\xeb\xe1\xf9\ \\x90\xd4\xf8\x69\xa6\x5c\xde\xa0\x3f\x09\x25\x2d\xc2\x08\xe6\x9f\ \\xb7\x4e\x61\x32\xce\x77\xe2\x5b\x57\x8f\xdf\xe3\x3a\xc3\x72\xe6\ - \" + \"# diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index d09eb4f..f2b8cd8 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -19,9 +19,6 @@ module Crypto.Cipher.Blowfish.Primitive ) where import Control.Monad (forM_) -import Data.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 @@ -30,6 +27,7 @@ import Crypto.Error import Crypto.Internal.Compat import Crypto.Internal.ByteArray import Crypto.Internal.Words +import Crypto.Internal.WordArray import Crypto.Cipher.Blowfish.Box -- | variable keyed blowfish state @@ -96,17 +94,15 @@ coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 makeKeySchedule :: [Word32] -> Context makeKeySchedule key = let v = unsafeDoIO $ do - mv <- V.thaw boxes - forM_ (zip key [0..17]) $ \(k, i) -> - V.unsafeRead mv i >>= \pVal -> V.unsafeWrite mv i (k `xor` pVal) - --mutableArrayWriteXor32 mv i k + mv <- createKeySchedule + forM_ (zip key [0..17]) $ \(k, i) -> mutableArrayWriteXor32 mv i k prepare mv - V.unsafeFreeze mv - 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 !) + 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 s0 = 18 s1 = 274 @@ -119,20 +115,20 @@ makeKeySchedule key = | otherwise = do ninput <- coreCryptoMutable input let (nl, nr) = w64to32 ninput - V.unsafeWrite mctx i nl - V.unsafeWrite mctx (i+1) nr + mutableArrayWrite32 mctx i nl + mutableArrayWrite32 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 + 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 <- V.unsafeRead mctx roundIndex + pVal <- mutableArrayRead32 mctx roundIndex let newr = fromIntegral (i `shiftR` 32) `xor` pVal newr' <- f newr let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr) @@ -140,8 +136,8 @@ makeKeySchedule key = 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)) + 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)