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

-- Rewritten by Vincent Hanquez (c) 2015
--              Lars Petersen (c) 2018
--
-- 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)
{-# LANGUAGE BangPatterns #-}
module Crypto.Cipher.Blowfish.Primitive
    ( Context
    , initBlowfish
    , encrypt
    , decrypt
    , KeySchedule
    , createKeySchedule
    , freezeKeySchedule
    , expandKey
    , expandKeyWithSalt
    , cipherBlockMutable
    ) where

import           Control.Monad              (when)
import           Data.Bits
import           Data.Memory.Endian
import           Data.Word

import           Crypto.Cipher.Blowfish.Box
import           Crypto.Error
import           Crypto.Internal.ByteArray  (ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray  as B
import           Crypto.Internal.Compat
import           Crypto.Internal.Imports
import           Crypto.Internal.WordArray

newtype Context = Context Array32

instance NFData Context where
    rnf :: Context -> ()
rnf Context
a = Context
a Context -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Initialize a new Blowfish context from a key.
--
-- key needs to be between 0 and 448 bits.
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish :: forall key. ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish key
key
    | key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
448 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) = CryptoError -> CryptoFailable Context
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_KeySizeInvalid
    | Bool
otherwise                    = Context -> CryptoFailable Context
forall a. a -> CryptoFailable a
CryptoPassed (Context -> CryptoFailable Context)
-> Context -> CryptoFailable Context
forall a b. (a -> b) -> a -> b
$ IO Context -> Context
forall a. IO a -> a
unsafeDoIO (IO Context -> Context) -> IO Context -> Context
forall a b. (a -> b) -> a -> b
$ do
        KeySchedule
ks <- IO KeySchedule
createKeySchedule
        KeySchedule -> key -> IO ()
forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
expandKey KeySchedule
ks key
key
        KeySchedule -> IO Context
freezeKeySchedule KeySchedule
ks

-- | Get an immutable Blowfish context by freezing a mutable key schedule.
freezeKeySchedule :: KeySchedule -> IO Context
freezeKeySchedule :: KeySchedule -> IO Context
freezeKeySchedule (KeySchedule MutableArray32
ma) = Array32 -> Context
Context (Array32 -> Context) -> IO Array32 -> IO Context
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MutableArray32 -> IO Array32
mutableArray32Freeze MutableArray32
ma

expandKey :: (ByteArrayAccess key) => KeySchedule -> key -> IO ()
expandKey :: forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
expandKey ks :: KeySchedule
ks@(KeySchedule MutableArray32
ma) key
key = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ key
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall x.
ByteArrayAccess x =>
x
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
iterKeyStream key
key Word32
0 Word32
0 ((Int
  -> Word32
  -> Word32
  -> Word32
  -> Word32
  -> (Word32 -> Word32 -> IO ())
  -> IO ())
 -> IO ())
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i Word32
l Word32
r Word32
a0 Word32
a1 Word32 -> Word32 -> IO ()
cont-> do
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma Int
i Word32
l
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
r
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
18) (Word32 -> Word32 -> IO ()
cont Word32
a0 Word32
a1)
    Int -> Word32 -> Word32 -> IO ()
loop Int
0 Word32
0 Word32
0
    where
        loop :: Int -> Word32 -> Word32 -> IO ()
loop Int
i Word32
l Word32
r = do
            Word64
n <- KeySchedule -> Word64 -> IO Word64
cipherBlockMutable KeySchedule
ks (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
r)
            let nl :: Word32
nl = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
                nr :: Word32
nr = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff)
            MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma Int
i Word32
nl
            MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
nr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1024) (Int -> Word32 -> Word32 -> IO ()
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word32
nl Word32
nr)

expandKeyWithSalt :: (ByteArrayAccess key, ByteArrayAccess salt)
    => KeySchedule
    -> key
    -> salt
    -> IO ()
expandKeyWithSalt :: forall key salt.
(ByteArrayAccess key, ByteArrayAccess salt) =>
KeySchedule -> key -> salt -> IO ()
expandKeyWithSalt KeySchedule
ks key
key salt
salt
    | salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = KeySchedule -> key -> Word64 -> Word64 -> IO ()
forall ba.
ByteArrayAccess ba =>
KeySchedule -> ba -> Word64 -> Word64 -> IO ()
expandKeyWithSalt128 KeySchedule
ks key
key (BE Word64 -> Word64
forall a. ByteSwap a => BE a -> a
fromBE (BE Word64 -> Word64) -> BE Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ salt -> Int -> BE Word64
forall bs. ByteArrayAccess bs => bs -> Int -> BE Word64
B.toW64BE salt
salt Int
0) (BE Word64 -> Word64
forall a. ByteSwap a => BE a -> a
fromBE (BE Word64 -> Word64) -> BE Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ salt -> Int -> BE Word64
forall bs. ByteArrayAccess bs => bs -> Int -> BE Word64
B.toW64BE salt
salt Int
8)
    | Bool
otherwise           = KeySchedule -> key -> salt -> IO ()
forall key salt.
(ByteArrayAccess key, ByteArrayAccess salt) =>
KeySchedule -> key -> salt -> IO ()
expandKeyWithSaltAny KeySchedule
ks key
key salt
salt

expandKeyWithSaltAny :: (ByteArrayAccess key, ByteArrayAccess salt)
    => KeySchedule         -- ^ The key schedule
    -> key                 -- ^ The key
    -> salt                -- ^ The salt
    -> IO ()
expandKeyWithSaltAny :: forall key salt.
(ByteArrayAccess key, ByteArrayAccess salt) =>
KeySchedule -> key -> salt -> IO ()
expandKeyWithSaltAny ks :: KeySchedule
ks@(KeySchedule MutableArray32
ma) key
key salt
salt = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ key
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall x.
ByteArrayAccess x =>
x
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
iterKeyStream key
key Word32
0 Word32
0 ((Int
  -> Word32
  -> Word32
  -> Word32
  -> Word32
  -> (Word32 -> Word32 -> IO ())
  -> IO ())
 -> IO ())
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i Word32
l Word32
r Word32
a0 Word32
a1 Word32 -> Word32 -> IO ()
cont-> do
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma Int
i Word32
l
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
r
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
18) (Word32 -> Word32 -> IO ()
cont Word32
a0 Word32
a1)
    -- Go through the entire key schedule overwriting the P-Array and S-Boxes
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ salt
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall x.
ByteArrayAccess x =>
x
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
iterKeyStream salt
salt Word32
0 Word32
0 ((Int
  -> Word32
  -> Word32
  -> Word32
  -> Word32
  -> (Word32 -> Word32 -> IO ())
  -> IO ())
 -> IO ())
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i Word32
l Word32
r Word32
a0 Word32
a1 Word32 -> Word32 -> IO ()
cont-> do
        let l' :: Word32
l' = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor Word32
l Word32
a0
        let r' :: Word32
r' = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor Word32
r Word32
a1
        Word64
n <- KeySchedule -> Word64 -> IO Word64
cipherBlockMutable KeySchedule
ks (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
r')
        let nl :: Word32
nl = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
            nr :: Word32
nr = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff)
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma Int
i Word32
nl
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
nr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1024) (Word32 -> Word32 -> IO ()
cont Word32
nl Word32
nr)

expandKeyWithSalt128 :: ByteArrayAccess ba
    => KeySchedule         -- ^ The key schedule
    -> ba                  -- ^ The key
    -> Word64              -- ^ First word of the salt
    -> Word64              -- ^ Second word of the salt
    -> IO ()
expandKeyWithSalt128 :: forall ba.
ByteArrayAccess ba =>
KeySchedule -> ba -> Word64 -> Word64 -> IO ()
expandKeyWithSalt128 ks :: KeySchedule
ks@(KeySchedule MutableArray32
ma) ba
key Word64
salt1 Word64
salt2 = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ba
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall x.
ByteArrayAccess x =>
x
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
iterKeyStream ba
key Word32
0 Word32
0 ((Int
  -> Word32
  -> Word32
  -> Word32
  -> Word32
  -> (Word32 -> Word32 -> IO ())
  -> IO ())
 -> IO ())
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i Word32
l Word32
r Word32
a0 Word32
a1 Word32 -> Word32 -> IO ()
cont-> do
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma Int
i Word32
l
        MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 MutableArray32
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
r
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
18) (Word32 -> Word32 -> IO ()
cont Word32
a0 Word32
a1)
    -- Go through the entire key schedule overwriting the P-Array and S-Boxes
    Int -> Word64 -> Word64 -> Word64 -> IO ()
loop Int
0 Word64
salt1 Word64
salt1 Word64
salt2
    where
        loop :: Int -> Word64 -> Word64 -> Word64 -> IO ()
loop Int
i Word64
input Word64
slt1 Word64
slt2
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1042   = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                Word64
n <- KeySchedule -> Word64 -> IO Word64
cipherBlockMutable KeySchedule
ks Word64
input
                let nl :: Word32
nl = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
                    nr :: Word32
nr = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff)
                MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma Int
i     Word32
nl
                MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 MutableArray32
ma (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word32
nr
                Int -> Word64 -> Word64 -> Word64 -> IO ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
slt2) Word64
slt2 Word64
slt1

-- | Encrypt blocks
--
-- Input need to be a multiple of 8 bytes
encrypt :: ByteArray ba => Context -> ba -> ba
encrypt :: forall ba. ByteArray ba => Context -> ba -> ba
encrypt Context
ctx ba
ba
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         = ba
forall a. ByteArray a => a
B.empty
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = [Char] -> ba
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid data length"
    | Bool
otherwise                = (Word64 -> Word64) -> ba -> ba
forall bs. ByteArray bs => (Word64 -> Word64) -> bs -> bs
B.mapAsWord64 (Context -> Bool -> Word64 -> Word64
cipherBlock Context
ctx Bool
False) ba
ba

-- | Decrypt blocks
--
-- Input need to be a multiple of 8 bytes
decrypt :: ByteArray ba => Context -> ba -> ba
decrypt :: forall ba. ByteArray ba => Context -> ba -> ba
decrypt Context
ctx ba
ba
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         = ba
forall a. ByteArray a => a
B.empty
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = [Char] -> ba
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid data length"
    | Bool
otherwise                = (Word64 -> Word64) -> ba -> ba
forall bs. ByteArray bs => (Word64 -> Word64) -> bs -> bs
B.mapAsWord64 (Context -> Bool -> Word64 -> Word64
cipherBlock Context
ctx Bool
True) ba
ba

-- | Encrypt or decrypt a single block of 64 bits.
--
-- The inverse argument decides whether to encrypt or decrypt.
cipherBlock :: Context -> Bool -> Word64 -> Word64
cipherBlock :: Context -> Bool -> Word64 -> Word64
cipherBlock (Context Array32
ar) Bool
inverse Word64
input = Word64 -> Int -> Word64
doRound Word64
input Int
0
    where
    -- | Transform the input over 16 rounds
    doRound :: Word64 -> Int -> Word64
    doRound :: Word64 -> Int -> Word64
doRound !Word64
i Int
roundIndex
        | Int
roundIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 =
            let final :: Word64
final = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32
p Int
16) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32
p Int
17)
             in Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL (Word64
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
final) Int
32
        | Bool
otherwise     =
            let newr :: Word32
newr = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Int -> Word32
p Int
roundIndex
                newi :: Word64
newi = ((Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word32 -> Word64
f Word32
newr) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
newr
             in Word64 -> Int -> Word64
doRound Word64
newi (Int
roundIndexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

    -- | The Blowfish Feistel function F
    f   :: Word32 -> Word64
    f :: Word32 -> Word64
f Word32
t = let a :: Word32
a = Word32 -> Word32
s0 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
              b :: Word32
b = Word32 -> Word32
s1 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16))
              c :: Word32
c = Word32 -> Word32
s2 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
              d :: Word32
d = Word32 -> Word32
s3 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&.  Word32
t)
           in Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32

    -- | S-Box arrays, each containing 256 32-bit words
    --   The first 18 words contain the P-Array of subkeys
    s0, s1, s2, s3 :: Word32 -> Word32
    s0 :: Word32 -> Word32
s0 Word32
i            = Array32 -> Int -> Word32
arrayRead32 Array32
ar (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18)
    s1 :: Word32 -> Word32
s1 Word32
i            = Array32 -> Int -> Word32
arrayRead32 Array32
ar (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
274)
    s2 :: Word32 -> Word32
s2 Word32
i            = Array32 -> Int -> Word32
arrayRead32 Array32
ar (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
530)
    s3 :: Word32 -> Word32
s3 Word32
i            = Array32 -> Int -> Word32
arrayRead32 Array32
ar (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
786)
    p              :: Int -> Word32
    p :: Int -> Word32
p Int
i | Bool
inverse   = Array32 -> Int -> Word32
arrayRead32 Array32
ar (Int
17 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
        | Bool
otherwise = Array32 -> Int -> Word32
arrayRead32 Array32
ar Int
i

-- | Blowfish encrypt a Word using the current state of the key schedule
cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64
cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64
cipherBlockMutable (KeySchedule MutableArray32
ma) Word64
input = Word64 -> Int -> IO Word64
doRound Word64
input Int
0
    where
    -- | Transform the input over 16 rounds
    doRound :: Word64 -> Int -> IO Word64
doRound !Word64
i Int
roundIndex
        | Int
roundIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = do
            Word32
pVal1 <- MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma Int
16
            Word32
pVal2 <- MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma Int
17
            let final :: Word64
final = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pVal1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pVal2
            Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotateL (Word64
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
final) Int
32
        | Bool
otherwise     = do
            Word32
pVal <- MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma Int
roundIndex
            let newr :: Word32
newr = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
pVal
            Word64
newr' <- Word32 -> IO Word64
f Word32
newr
            let newi :: Word64
newi = ((Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
newr') Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
newr
            Word64 -> Int -> IO Word64
doRound Word64
newi (Int
roundIndexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

    -- | The Blowfish Feistel function F
    f   :: Word32 -> IO Word64
    f :: Word32 -> IO Word64
f Word32
t = do
        Word32
a <- Word32 -> IO Word32
s0 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
        Word32
b <- Word32 -> IO Word32
s1 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16))
        Word32
c <- Word32 -> IO Word32
s2 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
        Word32
d <- Word32 -> IO Word32
s3 (Word32
0xff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&.  Word32
t)
        Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)

    -- | S-Box arrays, each containing 256 32-bit words
    --   The first 18 words contain the P-Array of subkeys
    s0, s1, s2, s3 :: Word32 -> IO Word32
    s0 :: Word32 -> IO Word32
s0 Word32
i = MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18)
    s1 :: Word32 -> IO Word32
s1 Word32
i = MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
274)
    s2 :: Word32 -> IO Word32
s2 Word32
i = MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
530)
    s3 :: Word32 -> IO Word32
s3 Word32
i = MutableArray32 -> Int -> IO Word32
mutableArrayRead32 MutableArray32
ma (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
786)

iterKeyStream :: (ByteArrayAccess x)
    => x
    -> Word32
    -> Word32
    -> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ())
    -> IO ()
iterKeyStream :: forall x.
ByteArrayAccess x =>
x
-> Word32
-> Word32
-> (Int
    -> Word32
    -> Word32
    -> Word32
    -> Word32
    -> (Word32 -> Word32 -> IO ())
    -> IO ())
-> IO ()
iterKeyStream x
x Word32
a0 Word32
a1 Int
-> Word32
-> Word32
-> Word32
-> Word32
-> (Word32 -> Word32 -> IO ())
-> IO ()
g = Int -> Int -> Word32 -> Word32 -> IO ()
f Int
0 Int
0 Word32
a0 Word32
a1
    where
        len :: Int
len          = x -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length x
x
        -- Avoiding the modulo operation when interating over the ring
        -- buffer is assumed to be more efficient here. All other
        -- implementations do this, too. The branch prediction shall prefer
        -- the branch with the increment.
        n :: Int -> Int
n Int
j          = if Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Int
0 else Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        f :: Int -> Int -> Word32 -> Word32 -> IO ()
f Int
i Int
j0 Word32
b0 Word32
b1 = Int
-> Word32
-> Word32
-> Word32
-> Word32
-> (Word32 -> Word32 -> IO ())
-> IO ()
g Int
i Word32
l Word32
r Word32
b0 Word32
b1 (Int -> Int -> Word32 -> Word32 -> IO ()
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
j8)
            where
                j1 :: Int
j1 = Int -> Int
n Int
j0
                j2 :: Int
j2 = Int -> Int
n Int
j1
                j3 :: Int
j3 = Int -> Int
n Int
j2
                j4 :: Int
j4 = Int -> Int
n Int
j3
                j5 :: Int
j5 = Int -> Int
n Int
j4
                j6 :: Int
j6 = Int -> Int
n Int
j5
                j7 :: Int
j7 = Int -> Int
n Int
j6
                j8 :: Int
j8 = Int -> Int
n Int
j7
                x0 :: Word32
x0 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j0)
                x1 :: Word32
x1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j1)
                x2 :: Word32
x2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j2)
                x3 :: Word32
x3 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j3)
                x4 :: Word32
x4 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j4)
                x5 :: Word32
x5 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j5)
                x6 :: Word32
x6 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j6)
                x7 :: Word32
x7 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (x -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index x
x Int
j7)
                l :: Word32
l  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x0 Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x1 Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x2 Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
x3
                r :: Word32
r  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x4 Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x5 Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
x6 Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
x7
{-# INLINE iterKeyStream #-}
-- Benchmarking shows that GHC considers this function too big to inline
-- although forcing inlining causes an actual improvement.
-- It is assumed that all function calls (especially the continuation)
-- collapse into a tight loop after inlining.