    -- 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
    -- License     : BSD-style
    -- Stability   : experimental
    -- Portability : Good
    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
            ks <- IO KeySchedule
    createKeySchedule
            expandKey ks key
            freezeKeySchedule 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
            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 = 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 = 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)
            mutableArrayWrite32 ma i nl
            mutableArrayWrite32 ma (i + 1) nr
            when (i < 18 + 1024) (loop (i + 2) nl 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
            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 = 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 = 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)
            mutableArrayWrite32 ma i nl
            mutableArrayWrite32 ma (i + 1) nr
            when (i + 2 < 18 + 1024) (cont nl 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
                n <- KeySchedule -> Word64 -> IO Word64
    cipherBlockMutable KeySchedule
    ks Word64
    input
                let 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 = 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)
                mutableArrayWrite32 ma i nl
                mutableArrayWrite32 ma (i + 1) nr
                loop (i + 2) (n `xor` slt2) slt2 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
    roundIndex Int -> 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
                pVal1 <- MutableArray32 -> Int -> IO Word32
    mutableArrayRead32 MutableArray32
    ma Int
    16
                pVal2 <- mutableArrayRead32 ma 17
                let 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
                return $ rotateL (i `xor` final) 32
            | Bool
    otherwise = do
                pVal <- MutableArray32 -> Int -> IO Word32
    mutableArrayRead32 MutableArray32
    ma Int
    roundIndex
                let 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
                newr' <- f newr
                let 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
                doRound newi (roundIndex + 1)

        -- \| The Blowfish Feistel function F
        f :: Word32 -> IO Word64
        f :: Word32 -> IO Word64
    f Word32
    t = do
            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))
            b <- s1 (0xff .&. (t `shiftR` 16))
            c <- s2 (0xff .&. (t `shiftR` 8))
            d <- s3 (0xff .&. t)
            return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 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.