{-# 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 -> () -> ()
`seq` ()
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish :: 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
freezeKeySchedule :: KeySchedule -> IO Context
freezeKeySchedule :: KeySchedule -> IO Context
freezeKeySchedule (KeySchedule MutableArray32
ma) = Array32 -> Context
Context (Array32 -> Context) -> IO Array32 -> IO Context
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 :: 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 :: 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
-> key
-> salt
-> IO ()
expandKeyWithSaltAny :: 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)
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
-> ba
-> Word64
-> Word64
-> IO ()
expandKeyWithSalt128 :: 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)
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 (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 :: ByteArray ba => Context -> ba -> ba
encrypt :: 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 :: ByteArray ba => Context -> ba -> ba
decrypt :: 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
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
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)
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
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
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
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 (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)
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 (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)
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 :: 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
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 #-}