-- |
-- Module      : Crypto.Cipher.Camellia.Primitive
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
-- this only cover Camellia 128 bits for now, API will change once
-- 192 and 256 mode are implemented too

module Crypto.Cipher.Camellia.Primitive
    ( Camellia
    , initCamellia
    , encrypt
    , decrypt
    ) where

import Data.Word
import Data.Vector.Unboxed
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B

data Mode = Decrypt | Encrypt

-- should probably use crypto large word ?
data Word128 = Word128 !Word64 !Word64 deriving (Int -> Word128 -> ShowS
[Word128] -> ShowS
Word128 -> String
(Int -> Word128 -> ShowS)
-> (Word128 -> String) -> ([Word128] -> ShowS) -> Show Word128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word128] -> ShowS
$cshowList :: [Word128] -> ShowS
show :: Word128 -> String
$cshow :: Word128 -> String
showsPrec :: Int -> Word128 -> ShowS
$cshowsPrec :: Int -> Word128 -> ShowS
Show, Word128 -> Word128 -> Bool
(Word128 -> Word128 -> Bool)
-> (Word128 -> Word128 -> Bool) -> Eq Word128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word128 -> Word128 -> Bool
$c/= :: Word128 -> Word128 -> Bool
== :: Word128 -> Word128 -> Bool
$c== :: Word128 -> Word128 -> Bool
Eq)

w128tow64 :: Word128 -> (Word64, Word64)
w128tow64 :: Word128 -> (Word64, Word64)
w128tow64 (Word128 w1 :: Word64
w1 w2 :: Word64
w2) = (Word64
w1, Word64
w2)

w64tow128 :: (Word64, Word64) -> Word128
w64tow128 :: (Word64, Word64) -> Word128
w64tow128 (x1 :: Word64
x1, x2 :: Word64
x2) = Word64 -> Word64 -> Word128
Word128 Word64
x1 Word64
x2

w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 x :: Word64
x = (Word8
t1, Word8
t2, Word8
t3, Word8
t4, Word8
t5, Word8
t6, Word8
t7, Word8
t8)
    where
        t1 :: Word8
t1 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 56)
        t2 :: Word8
t2 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 48)
        t3 :: Word8
t3 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 40)
        t4 :: Word8
t4 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32)
        t5 :: Word8
t5 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 24)
        t6 :: Word8
t6 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 16)
        t7 :: Word8
t7 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 8)
        t8 :: Word8
t8 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x)

w8tow64 :: B.ByteString -> Word64
w8tow64 :: ByteString -> Word64
w8tow64 b :: ByteString
b = (Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t1 56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t2 48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t3 40 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t4 32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t5 24 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t6 16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t7 8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word64
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
sh Word8
t8 0)
    where
        t1 :: Word8
t1     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 0
        t2 :: Word8
t2     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 1
        t3 :: Word8
t3     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 2
        t4 :: Word8
t4     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 3
        t5 :: Word8
t5     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 4
        t6 :: Word8
t6     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 5
        t7 :: Word8
t7     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 6
        t8 :: Word8
t8     = ByteString -> Int -> Word8
B.unsafeIndex ByteString
b 7
        sh :: a -> Int -> a
sh i :: a
i r :: Int
r = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i) a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
r

w64tow32 :: Word64 -> (Word32, Word32)
w64tow32 :: Word64 -> (Word32, Word32)
w64tow32 w :: Word64
w = (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32), Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xffffffff))

w32tow64 :: (Word32, Word32) -> Word64
w32tow64 :: (Word32, Word32) -> Word64
w32tow64 (x1 :: Word32
x1, x2 :: Word32
x2) = ((Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x2)

w128tow8 :: Word128 -> [Word8]
w128tow8 :: Word128 -> [Word8]
w128tow8 (Word128 x1 :: Word64
x1 x2 :: Word64
x2) = [Word8
t1,Word8
t2,Word8
t3,Word8
t4,Word8
t5,Word8
t6,Word8
t7,Word8
t8,Word8
u1,Word8
u2,Word8
u3,Word8
u4,Word8
u5,Word8
u6,Word8
u7,Word8
u8]
    where
        (t1 :: Word8
t1, t2 :: Word8
t2, t3 :: Word8
t3, t4 :: Word8
t4, t5 :: Word8
t5, t6 :: Word8
t6, t7 :: Word8
t7, t8 :: Word8
t8) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 Word64
x1
        (u1 :: Word8
u1, u2 :: Word8
u2, u3 :: Word8
u3, u4 :: Word8
u4, u5 :: Word8
u5, u6 :: Word8
u6, u7 :: Word8
u7, u8 :: Word8
u8) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 Word64
x2

getWord64 :: B.ByteString -> Word64
getWord64 :: ByteString -> Word64
getWord64 s :: ByteString
s = Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 0 56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 1 48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 2 40 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 3 32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 4 24 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 5 16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 6 8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Word64
forall a. (Bits a, Num a) => Int -> Int -> a
sh 7 0
    where
        sh :: Int -> Int -> a
sh i :: Int
i l :: Int
l = (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.index` Int
i) a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
l)

getWord128 :: B.ByteString -> Word128
getWord128 :: ByteString -> Word128
getWord128 s :: ByteString
s = Word64 -> Word64 -> Word128
Word128 (ByteString -> Word64
getWord64 ByteString
s) (ByteString -> Word64
getWord64 (Int -> ByteString -> ByteString
B.drop 8 ByteString
s))

putWord128 :: Word128 -> B.ByteString
putWord128 :: Word128 -> ByteString
putWord128 = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (Word128 -> [Word8]) -> Word128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word128 -> [Word8]
w128tow8

sbox :: Vector Word8
sbox :: Vector Word8
sbox = [Word8] -> Vector Word8
forall a. Unbox a => [a] -> Vector a
fromList
    [112,130, 44,236,179, 39,192,229,228,133, 87, 53,234, 12,174, 65
    , 35,239,107,147, 69, 25,165, 33,237, 14, 79, 78, 29,101,146,189
    ,134,184,175,143,124,235, 31,206, 62, 48,220, 95, 94,197, 11, 26
    ,166,225, 57,202,213, 71, 93, 61,217,  1, 90,214, 81, 86,108, 77
    ,139, 13,154,102,251,204,176, 45,116, 18, 43, 32,240,177,132,153
    ,223, 76,203,194, 52,126,118,  5,109,183,169, 49,209, 23,  4,215
    , 20, 88, 58, 97,222, 27, 17, 28, 50, 15,156, 22, 83, 24,242, 34
    ,254, 68,207,178,195,181,122,145, 36,  8,232,168, 96,252,105, 80
    ,170,208,160,125,161,137, 98,151, 84, 91, 30,149,224,255,100,210
    , 16,196,  0, 72,163,247,117,219,138,  3,230,218,  9, 63,221,148
    ,135, 92,131,  2,205, 74,144, 51,115,103,246,243,157,127,191,226
    , 82,155,216, 38,200, 55,198, 59,129,150,111, 75, 19,190, 99, 46
    ,233,121,167,140,159,110,188,142, 41,245,249,182, 47,253,180, 89
    ,120,152,  6,106,231, 70,113,186,212, 37,171, 66,136,162,141,250
    ,114,  7,185, 85,248,238,172, 10, 54, 73, 42,104, 60, 56,241,164
    , 64, 40,211,123,187,201, 67,193, 21,227,173,244,119,199,128,158
    ]

sbox1 :: Word8 -> Word8
sbox1 :: Word8 -> Word8
sbox1 x :: Word8
x = Vector Word8
sbox Vector Word8 -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
! (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)

sbox2 :: Word8 -> Word8
sbox2 :: Word8 -> Word8
sbox2 x :: Word8
x = Word8 -> Word8
sbox1 Word8
x Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`rotateL` 1;

sbox3 :: Word8 -> Word8
sbox3 :: Word8 -> Word8
sbox3 x :: Word8
x = Word8 -> Word8
sbox1 Word8
x Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`rotateL` 7;

sbox4 :: Word8 -> Word8
sbox4 :: Word8 -> Word8
sbox4 x :: Word8
x = Word8 -> Word8
sbox1 (Word8
x Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`rotateL` 1);

sigma1, sigma2, sigma3, sigma4, sigma5, sigma6 :: Word64
sigma1 :: Word64
sigma1 = 0xA09E667F3BCC908B
sigma2 :: Word64
sigma2 = 0xB67AE8584CAA73B2
sigma3 :: Word64
sigma3 = 0xC6EF372FE94F82BE
sigma4 :: Word64
sigma4 = 0x54FF53A5F1D36F1C
sigma5 :: Word64
sigma5 = 0x10E527FADE682D1D
sigma6 :: Word64
sigma6 = 0xB05688C2B3E6C1FD

rotl128 :: Word128 -> Int -> Word128
rotl128 :: Word128 -> Int -> Word128
rotl128 v :: Word128
v               0  = Word128
v
rotl128 (Word128 x1 :: Word64
x1 x2 :: Word64
x2) 64 = Word64 -> Word64 -> Word128
Word128 Word64
x2 Word64
x1

rotl128 v :: Word128
v@(Word128 x1 :: Word64
x1 x2 :: Word64
x2) w :: Int
w
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 64    = (Word128
v Word128 -> Int -> Word128
`rotl128` 64) Word128 -> Int -> Word128
`rotl128` (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 64)
    | Bool
otherwise = Word64 -> Word64 -> Word128
Word128 (Word64
x1high Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
x2low) (Word64
x2high Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
x1low)
        where
            splitBits :: b -> (b, b)
splitBits i :: b
i = (b
i b -> b -> b
forall a. Bits a => a -> a -> a
.&. b -> b
forall a. Bits a => a -> a
complement b
x, b
i b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
x)
                where x :: b
x = 2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
w b -> b -> b
forall a. Num a => a -> a -> a
- 1
            (x1high :: Word64
x1high, x1low :: Word64
x1low) = Word64 -> (Word64, Word64)
forall b. (Bits b, Num b) => b -> (b, b)
splitBits (Word64
x1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
w)
            (x2high :: Word64
x2high, x2low :: Word64
x2low) = Word64 -> (Word64, Word64)
forall b. (Bits b, Num b) => b -> (b, b)
splitBits (Word64
x2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
w)

data Camellia = Camellia
    { Camellia -> Vector Word64
k  :: Vector Word64
    , Camellia -> Vector Word64
kw :: Vector Word64
    , Camellia -> Vector Word64
ke :: Vector Word64
    }

setKeyInterim :: B.ByteString -> (Word128, Word128, Word128, Word128)
setKeyInterim :: ByteString -> (Word128, Word128, Word128, Word128)
setKeyInterim keyseed :: ByteString
keyseed = ((Word64, Word64) -> Word128
w64tow128 (Word64, Word64)
kL, (Word64, Word64) -> Word128
w64tow128 (Word64, Word64)
kR, (Word64, Word64) -> Word128
w64tow128 (Word64, Word64)
kA, (Word64, Word64) -> Word128
w64tow128 (Word64, Word64)
kB)
  where kL :: (Word64, Word64)
kL = (ByteString -> Word64
w8tow64 (ByteString -> Word64) -> ByteString -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take 8 ByteString
keyseed, ByteString -> Word64
w8tow64 (ByteString -> Word64) -> ByteString -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop 8 ByteString
keyseed)
        kR :: (Word64, Word64)
kR = (0, 0)

        kA :: (Word64, Word64)
kA = let d1 :: Word64
d1 = ((Word64, Word64) -> Word64
forall a b. (a, b) -> a
fst (Word64, Word64)
kL Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64, Word64) -> Word64
forall a b. (a, b) -> a
fst (Word64, Word64)
kR)
                 d2 :: Word64
d2 = ((Word64, Word64) -> Word64
forall a b. (a, b) -> b
snd (Word64, Word64)
kL Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64, Word64) -> Word64
forall a b. (a, b) -> b
snd (Word64, Word64)
kR)
                 d3 :: Word64
d3 = Word64
d2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d1 Word64
sigma1
                 d4 :: Word64
d4 = Word64
d1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d3 Word64
sigma2
                 d5 :: Word64
d5 = Word64
d4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` ((Word64, Word64) -> Word64
forall a b. (a, b) -> a
fst (Word64, Word64)
kL)
                 d6 :: Word64
d6 = Word64
d3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` ((Word64, Word64) -> Word64
forall a b. (a, b) -> b
snd (Word64, Word64)
kL)
                 d7 :: Word64
d7 = Word64
d6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d5 Word64
sigma3
                 d8 :: Word64
d8 = Word64
d5 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d7 Word64
sigma4
              in (Word64
d8, Word64
d7)

        kB :: (Word64, Word64)
kB = let d1 :: Word64
d1 = ((Word64, Word64) -> Word64
forall a b. (a, b) -> a
fst (Word64, Word64)
kA Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64, Word64) -> Word64
forall a b. (a, b) -> a
fst (Word64, Word64)
kR)
                 d2 :: Word64
d2 = ((Word64, Word64) -> Word64
forall a b. (a, b) -> b
snd (Word64, Word64)
kA Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64, Word64) -> Word64
forall a b. (a, b) -> b
snd (Word64, Word64)
kR)
                 d3 :: Word64
d3 = Word64
d2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d1 Word64
sigma5
                 d4 :: Word64
d4 = Word64
d1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d3 Word64
sigma6
              in (Word64
d4, Word64
d3)

-- | Initialize a 128-bit key
-- Return the initialized key or a error message if the given 
-- keyseed was not 16-bytes in length.
--
initCamellia :: B.ByteString -- ^ The seed to use when creating the key
             -> Either String Camellia
initCamellia :: ByteString -> Either String Camellia
initCamellia keyseed :: ByteString
keyseed 
    | ByteString -> Int
B.length ByteString
keyseed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 16 = String -> Either String Camellia
forall a b. a -> Either a b
Left "wrong key size"
    | Bool
otherwise              =
        let (kL :: Word128
kL, _, kA :: Word128
kA, _) = ByteString -> (Word128, Word128, Word128, Word128)
setKeyInterim ByteString
keyseed in

        let (kw1 :: Word64
kw1, kw2 :: Word64
kw2) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 0) in
        let (k1 :: Word64
k1, k2 :: Word64
k2)   = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 0) in
        let (k3 :: Word64
k3, k4 :: Word64
k4)   = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 15) in
        let (k5 :: Word64
k5, k6 :: Word64
k6)   = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 15) in
        let (ke1 :: Word64
ke1, ke2 :: Word64
ke2) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 30) in --ke1 = (KA <<<  30) >> 64; ke2 = (KA <<<  30) & MASK64;
        let (k7 :: Word64
k7, k8 :: Word64
k8)   = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 45) in --k7  = (KL <<<  45) >> 64; k8  = (KL <<<  45) & MASK64;
        let (k9 :: Word64
k9, _)    = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 45) in --k9  = (KA <<<  45) >> 64;
        let (_, k10 :: Word64
k10)   = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 60) in
        let (k11 :: Word64
k11, k12 :: Word64
k12) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 60) in
        let (ke3 :: Word64
ke3, ke4 :: Word64
ke4) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 77) in
        let (k13 :: Word64
k13, k14 :: Word64
k14) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 94) in
        let (k15 :: Word64
k15, k16 :: Word64
k16) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 94) in
        let (k17 :: Word64
k17, k18 :: Word64
k18) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kL Word128 -> Int -> Word128
`rotl128` 111) in
        let (kw3 :: Word64
kw3, kw4 :: Word64
kw4) = Word128 -> (Word64, Word64)
w128tow64 (Word128
kA Word128 -> Int -> Word128
`rotl128` 111) in

        Camellia -> Either String Camellia
forall a b. b -> Either a b
Right (Camellia -> Either String Camellia)
-> Camellia -> Either String Camellia
forall a b. (a -> b) -> a -> b
$ Camellia :: Vector Word64 -> Vector Word64 -> Vector Word64 -> Camellia
Camellia
            { kw :: Vector Word64
kw = [Word64] -> Vector Word64
forall a. Unbox a => [a] -> Vector a
fromList [ Word64
kw1, Word64
kw2, Word64
kw3, Word64
kw4 ]
            , ke :: Vector Word64
ke = [Word64] -> Vector Word64
forall a. Unbox a => [a] -> Vector a
fromList [ Word64
ke1, Word64
ke2, Word64
ke3, Word64
ke4 ]
            , k :: Vector Word64
k  = [Word64] -> Vector Word64
forall a. Unbox a => [a] -> Vector a
fromList [ Word64
k1, Word64
k2, Word64
k3, Word64
k4, Word64
k5, Word64
k6, Word64
k7, Word64
k8, Word64
k9,
                      Word64
k10, Word64
k11, Word64
k12, Word64
k13, Word64
k14, Word64
k15, Word64
k16, Word64
k17, Word64
k18 ]
            }

feistel :: Word64 -> Word64 -> Word64
feistel :: Word64 -> Word64 -> Word64
feistel fin :: Word64
fin sk :: Word64
sk = 
    let x :: Word64
x = Word64
fin Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
sk in
    let (t1 :: Word8
t1, t2 :: Word8
t2, t3 :: Word8
t3, t4 :: Word8
t4, t5 :: Word8
t5, t6 :: Word8
t6, t7 :: Word8
t7, t8 :: Word8
t8) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 Word64
x in
    let t1' :: Word8
t1' = Word8 -> Word8
sbox1 Word8
t1 in
    let t2' :: Word8
t2' = Word8 -> Word8
sbox2 Word8
t2 in
    let t3' :: Word8
t3' = Word8 -> Word8
sbox3 Word8
t3 in
    let t4' :: Word8
t4' = Word8 -> Word8
sbox4 Word8
t4 in
    let t5' :: Word8
t5' = Word8 -> Word8
sbox2 Word8
t5 in
    let t6' :: Word8
t6' = Word8 -> Word8
sbox3 Word8
t6 in
    let t7' :: Word8
t7' = Word8 -> Word8
sbox4 Word8
t7 in
    let t8' :: Word8
t8' = Word8 -> Word8
sbox1 Word8
t8 in
    let y1 :: Word8
y1 = Word8
t1' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t3' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t4' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y2 :: Word8
y2 = Word8
t1' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t2' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t4' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y3 :: Word8
y3 = Word8
t1' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t2' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t3' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y4 :: Word8
y4 = Word8
t2' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t3' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t4' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' in
    let y5 :: Word8
y5 = Word8
t1' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t2' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y6 :: Word8
y6 = Word8
t2' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t3' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y7 :: Word8
y7 = Word8
t3' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t4' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t8' in
    let y8 :: Word8
y8 = Word8
t1' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t4' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t5' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t6' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
t7' in
    ByteString -> Word64
w8tow64 (ByteString -> Word64) -> ByteString -> Word64
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
y1, Word8
y2, Word8
y3, Word8
y4, Word8
y5, Word8
y6, Word8
y7, Word8
y8]

fl :: Word64 -> Word64 -> Word64
fl :: Word64 -> Word64 -> Word64
fl fin :: Word64
fin sk :: Word64
sk =
    let (x1 :: Word32
x1, x2 :: Word32
x2) = Word64 -> (Word32, Word32)
w64tow32 Word64
fin in
    let (k1 :: Word32
k1, k2 :: Word32
k2) = Word64 -> (Word32, Word32)
w64tow32 Word64
sk in
    let y2 :: Word32
y2 = Word32
x2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` ((Word32
x1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
k1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 1) in
    let y1 :: Word32
y1 = Word32
x1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
y2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
k2) in
    (Word32, Word32) -> Word64
w32tow64 (Word32
y1, Word32
y2)

flinv :: Word64 -> Word64 -> Word64
flinv :: Word64 -> Word64 -> Word64
flinv fin :: Word64
fin sk :: Word64
sk =
    let (y1 :: Word32
y1, y2 :: Word32
y2) = Word64 -> (Word32, Word32)
w64tow32 Word64
fin in
    let (k1 :: Word32
k1, k2 :: Word32
k2) = Word64 -> (Word32, Word32)
w64tow32 Word64
sk in
    let x1 :: Word32
x1 = Word32
y1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
y2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
k2) in
    let x2 :: Word32
x2 = Word32
y2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` ((Word32
x1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
k1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 1) in
    (Word32, Word32) -> Word64
w32tow64 (Word32
x1, Word32
x2)

{- in decrypt mode 0->17 1->16 ... -}
getKeyK :: Mode -> Camellia -> Int -> Word64
getKeyK :: Mode -> Camellia -> Int -> Word64
getKeyK Encrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
k Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
i
getKeyK Decrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
k Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! (17 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)

{- in decrypt mode 0->3 1->2 2->1 3->0 -}
getKeyKe :: Mode -> Camellia -> Int -> Word64
getKeyKe :: Mode -> Camellia -> Int -> Word64
getKeyKe Encrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
ke Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
i
getKeyKe Decrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
ke Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)

{- in decrypt mode 0->2 1->3 2->0 3->1 -}
getKeyKw :: Mode -> Camellia -> Int -> Word64
getKeyKw :: Mode -> Camellia -> Int -> Word64
getKeyKw Encrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
kw Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
i
getKeyKw Decrypt key :: Camellia
key i :: Int
i = Camellia -> Vector Word64
kw Camellia
key Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4)

{- perform the following
    D2 = D2 ^ F(D1, k1);     // Round 1
    D1 = D1 ^ F(D2, k2);     // Round 2
    D2 = D2 ^ F(D1, k3);     // Round 3
    D1 = D1 ^ F(D2, k4);     // Round 4
    D2 = D2 ^ F(D1, k5);     // Round 5
    D1 = D1 ^ F(D2, k6);     // Round 6
 -}
doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound mode :: Mode
mode key :: Camellia
key d1 :: Word64
d1 d2 :: Word64
d2 i :: Int
i =
    let r1 :: Word64
r1 = Word64
d2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
d1 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 1+i -}
    let r2 :: Word64
r2 = Word64
d1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
r1 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 2+i -}
    let r3 :: Word64
r3 = Word64
r1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
r2 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 3+i -}
    let r4 :: Word64
r4 = Word64
r2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
r3 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 4+i -}
    let r5 :: Word64
r5 = Word64
r3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
r4 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 5+i -}
    let r6 :: Word64
r6 = Word64
r4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64 -> Word64
feistel Word64
r5 (Mode -> Camellia -> Int -> Word64
getKeyK Mode
mode Camellia
key (5Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) in     {- Round 6+i -}
    (Word64
r6, Word64
r5)

doBlock :: Mode -> Camellia -> Word128 -> Word128
doBlock :: Mode -> Camellia -> Word128 -> Word128
doBlock mode :: Mode
mode key :: Camellia
key m :: Word128
m =
    let (d1 :: Word64
d1, d2 :: Word64
d2) = Word128 -> (Word64, Word64)
w128tow64 Word128
m in

    let d1a :: Word64
d1a = Word64
d1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Mode -> Camellia -> Int -> Word64
getKeyKw Mode
mode Camellia
key 0) in {- Prewhitening -}
    let d2a :: Word64
d2a = Word64
d2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Mode -> Camellia -> Int -> Word64
getKeyKw Mode
mode Camellia
key 1) in

    let (d1b :: Word64
d1b, d2b :: Word64
d2b) = Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound Mode
mode Camellia
key Word64
d1a Word64
d2a 0 in

    let d1c :: Word64
d1c = Word64 -> Word64 -> Word64
fl    Word64
d1b (Mode -> Camellia -> Int -> Word64
getKeyKe Mode
mode Camellia
key 0) in {- FL -}
    let d2c :: Word64
d2c = Word64 -> Word64 -> Word64
flinv Word64
d2b (Mode -> Camellia -> Int -> Word64
getKeyKe Mode
mode Camellia
key 1) in {- FLINV -}

    let (d1d :: Word64
d1d, d2d :: Word64
d2d) = Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound Mode
mode Camellia
key Word64
d1c Word64
d2c 6 in

    let d1e :: Word64
d1e = Word64 -> Word64 -> Word64
fl    Word64
d1d (Mode -> Camellia -> Int -> Word64
getKeyKe Mode
mode Camellia
key 2) in {- FL -}
    let d2e :: Word64
d2e = Word64 -> Word64 -> Word64
flinv Word64
d2d (Mode -> Camellia -> Int -> Word64
getKeyKe Mode
mode Camellia
key 3) in {- FLINV -}

    let (d1f :: Word64
d1f, d2f :: Word64
d2f) = Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound Mode
mode Camellia
key Word64
d1e Word64
d2e 12 in

    let d2g :: Word64
d2g = Word64
d2f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Mode -> Camellia -> Int -> Word64
getKeyKw Mode
mode Camellia
key 2) in {- Postwhitening -}
    let d1g :: Word64
d1g = Word64
d1f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Mode -> Camellia -> Int -> Word64
getKeyKw Mode
mode Camellia
key 3) in
    (Word64, Word64) -> Word128
w64tow128 (Word64
d2g, Word64
d1g)

{- encryption for 128 bits blocks -}
encryptBlock :: Camellia -> Word128 -> Word128
encryptBlock :: Camellia -> Word128 -> Word128
encryptBlock = Mode -> Camellia -> Word128 -> Word128
doBlock Mode
Encrypt

{- decryption for 128 bits blocks -}
decryptBlock :: Camellia -> Word128 -> Word128
decryptBlock :: Camellia -> Word128 -> Word128
decryptBlock = Mode -> Camellia -> Word128 -> Word128
doBlock Mode
Decrypt

encryptChunk :: Camellia -> B.ByteString -> B.ByteString
encryptChunk :: Camellia -> ByteString -> ByteString
encryptChunk key :: Camellia
key b :: ByteString
b = Word128 -> ByteString
putWord128 (Word128 -> ByteString) -> Word128 -> ByteString
forall a b. (a -> b) -> a -> b
$ Camellia -> Word128 -> Word128
encryptBlock Camellia
key (Word128 -> Word128) -> Word128 -> Word128
forall a b. (a -> b) -> a -> b
$ ByteString -> Word128
getWord128 ByteString
b

decryptChunk :: Camellia -> B.ByteString -> B.ByteString
decryptChunk :: Camellia -> ByteString -> ByteString
decryptChunk key :: Camellia
key b :: ByteString
b = Word128 -> ByteString
putWord128 (Word128 -> ByteString) -> Word128 -> ByteString
forall a b. (a -> b) -> a -> b
$ Camellia -> Word128 -> Word128
decryptBlock Camellia
key (Word128 -> Word128) -> Word128 -> Word128
forall a b. (a -> b) -> a -> b
$ ByteString -> Word128
getWord128 ByteString
b

doChunks :: (B.ByteString -> B.ByteString) -> B.ByteString -> [B.ByteString]
doChunks :: (ByteString -> ByteString) -> ByteString -> [ByteString]
doChunks f :: ByteString -> ByteString
f b :: ByteString
b =
    let (x :: ByteString
x, rest :: ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 16 ByteString
b in
    if ByteString -> Int
B.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 16
        then ByteString -> ByteString
f ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (ByteString -> ByteString) -> ByteString -> [ByteString]
doChunks ByteString -> ByteString
f ByteString
rest
        else [ ByteString -> ByteString
f ByteString
x ]

-- | Encrypts the given ByteString using the given Key
encrypt :: Camellia     -- ^ The key to use
        -> B.ByteString -- ^ The data to encrypt
        -> B.ByteString
encrypt :: Camellia -> ByteString -> ByteString
encrypt key :: Camellia
key b :: ByteString
b = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> ByteString -> [ByteString]
doChunks (Camellia -> ByteString -> ByteString
encryptChunk Camellia
key) ByteString
b

-- | Decrypts the given ByteString using the given Key
decrypt :: Camellia     -- ^ The key to use
        -> B.ByteString -- ^ The data to decrypt
        -> B.ByteString
decrypt :: Camellia -> ByteString -> ByteString
decrypt key :: Camellia
key b :: ByteString
b = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> ByteString -> [ByteString]
doChunks (Camellia -> ByteString -> ByteString
decryptChunk Camellia
key) ByteString
b