<commit_before>-- |
-- Module      : Crypto.Cipher.Blowfish.Primitive
-- License     : BSD-style
-- Stability   : experimental
-- Portability : Good

-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 <NAME>
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, <NAME>
--           (as found in Crypto-4.2.4)

module Crypto.Cipher.Blowfish.Primitive
    ( Context
    , initBlowfish
    , encrypt
    , decrypt
    ) where

import Data.Vector (Vector, (!), (//))
import qualified Data.Vector as V
import Data.Bits
import Data.Word
import qualified Data.ByteString as B

import Crypto.Error
import Crypto.Internal.ByteArray
import Crypto.Internal.Words
import Crypto.Cipher.Blowfish.Box

-- | variable keyed blowfish state
data Context = BF Pbox Sbox Sbox Sbox Sbox

encrypt, decrypt :: ByteArray ba => Context -> ba -> ba
encrypt = cipher . selectEncrypt
decrypt = cipher . selectDecrypt

selectEncrypt, selectDecrypt :: Context -> (Pbox, Context)
selectEncrypt x@(BF p _ _ _ _) = (p, x)
selectDecrypt x@(BF p _ _ _ _) = (V.reverse p, x)

cipher :: ByteArray ba => (Pbox, Context) -> ba -> ba
cipher (p, bs) b
    | byteArrayLength b == 0         = empty
    | byteArrayLength b `mod` 8 /= 0 = error "invalid data length"
    | otherwise                      = byteArrayMapAsWord64 (coreCrypto p bs) 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 
  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
  where
    w8tow32 :: [Word8] -> [Word32]
    w8tow32 [] = []
    w8tow32 (a:b:c:d:xs) = ( (fromIntegral a `shiftL` 24) .|.
                             (fromIntegral b `shiftL` 16) .|.
                             (fromIntegral c `shiftL`  8) .|.
                             (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
  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)
             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

bfMakeKey :: Vector Word32 -> Context
bfMakeKey k = procKey 0 (BF (V.zipWith xor k iPbox) iSbox0 iSbox1 iSbox2 iSbox3) 0

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

        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)])<commit_msg>rewrite blowfish core to mostly generate its key schedule in one allocation.<commit_after>-- |
-- Module      : Crypto.Cipher.Blowfish.Primitive
-- License     : BSD-style
-- Stability   : experimental
-- Portability : Good

-- Rewritten by <NAME> (c) 2015
--
-- Original code:
--      Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 <NAME>
--      based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, <NAME>
--           (as found in Crypto-4.2.4)

module Crypto.Cipher.Blowfish.Primitive
    ( Context
    , initBlowfish
    , encrypt
    , decrypt
    ) where

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 (Int -> Word32) -- p
                  (Int -> Word32) -- sbox0
                  (Int -> Word32) -- sbox1
                  (Int -> Word32) -- sbox2
                  (Int -> Word32) -- sbox2

encrypt, decrypt :: ByteArray ba => Context -> ba -> ba
encrypt = cipher
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
    | byteArrayLength b == 0         = empty
    | byteArrayLength b `mod` 8 /= 0 = error "invalid data length"
    | 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
  where len = byteArrayLength key

keyFromByteString :: B.ByteString -> CryptoFailable Context
keyFromByteString k
    | B.length k /= (18 * 4) = CryptoFailed CryptoError_KeySizeInvalid
    | otherwise              = CryptoPassed . bfMakeKey . w8tow32 . B.unpack $ k
  where
    w8tow32 :: [Word8] -> [Word32]
    w8tow32 [] = []
    w8tow32 (a:b:c:d:xs) = ( (fromIntegral a `shiftL` 24) .|.
                             (fromIntegral b `shiftL` 16) .|.
                             (fromIntegral c `shiftL`  8) .|.
                             (fromIntegral d) ) : w8tow32 xs
    w8tow32 _ = error $ "internal error: Crypto.Cipher.Blowfish:keyFromByteString"

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)
             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

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 :: [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

        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)
{'fraction_non_alphanumeric': 0.11885863558726012, 'fraction_numerical': 0.042097859941726115, 'mean_word_length': 1.8448128036581881, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 65, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 3, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4493887', 'n_tokens_mistral': 3628, 'n_tokens_neox': 3278, 'n_words': 992}