326 lines
12 KiB
Haskell
326 lines
12 KiB
Haskell
-- |
|
|
-- 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
|
|
|
|
import Crypto.Error
|
|
import Crypto.Internal.ByteArray
|
|
|
|
data Mode = Decrypt | Encrypt
|
|
|
|
-- should probably use crypto large word ?
|
|
data Word128 = Word128 !Word64 !Word64 deriving (Show, Eq)
|
|
|
|
w128tow64 :: Word128 -> (Word64, Word64)
|
|
w128tow64 (Word128 w1 w2) = (w1, w2)
|
|
|
|
w64tow128 :: (Word64, Word64) -> Word128
|
|
w64tow128 (x1, x2) = Word128 x1 x2
|
|
|
|
w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
|
|
w64tow8 x = (t1, t2, t3, t4, t5, t6, t7, t8)
|
|
where
|
|
t1 = fromIntegral (x `shiftR` 56)
|
|
t2 = fromIntegral (x `shiftR` 48)
|
|
t3 = fromIntegral (x `shiftR` 40)
|
|
t4 = fromIntegral (x `shiftR` 32)
|
|
t5 = fromIntegral (x `shiftR` 24)
|
|
t6 = fromIntegral (x `shiftR` 16)
|
|
t7 = fromIntegral (x `shiftR` 8)
|
|
t8 = fromIntegral (x)
|
|
|
|
w8tow64 :: B.ByteString -> Word64
|
|
w8tow64 b = (sh t1 56 .|. sh t2 48 .|. sh t3 40 .|. sh t4 32 .|. sh t5 24 .|. sh t6 16 .|. sh t7 8 .|. sh t8 0)
|
|
where
|
|
t1 = B.unsafeIndex b 0
|
|
t2 = B.unsafeIndex b 1
|
|
t3 = B.unsafeIndex b 2
|
|
t4 = B.unsafeIndex b 3
|
|
t5 = B.unsafeIndex b 4
|
|
t6 = B.unsafeIndex b 5
|
|
t7 = B.unsafeIndex b 6
|
|
t8 = B.unsafeIndex b 7
|
|
sh i r = (fromIntegral i) `shiftL` r
|
|
|
|
w64tow32 :: Word64 -> (Word32, Word32)
|
|
w64tow32 w = (fromIntegral (w `shiftR` 32), fromIntegral (w .&. 0xffffffff))
|
|
|
|
w32tow64 :: (Word32, Word32) -> Word64
|
|
w32tow64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)
|
|
|
|
w128tow8 :: Word128 -> [Word8]
|
|
w128tow8 (Word128 x1 x2) = [t1,t2,t3,t4,t5,t6,t7,t8,u1,u2,u3,u4,u5,u6,u7,u8]
|
|
where
|
|
(t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x1
|
|
(u1, u2, u3, u4, u5, u6, u7, u8) = w64tow8 x2
|
|
|
|
getWord64 :: B.ByteString -> Word64
|
|
getWord64 s = sh 0 56 .|. sh 1 48 .|. sh 2 40 .|. sh 3 32 .|. sh 4 24 .|. sh 5 16 .|. sh 6 8 .|. sh 7 0
|
|
where
|
|
sh i l = (fromIntegral (s `B.index` i) `shiftL` l)
|
|
|
|
getWord128 :: B.ByteString -> Word128
|
|
getWord128 s = Word128 (getWord64 s) (getWord64 (B.drop 8 s))
|
|
|
|
putWord128 :: Word128 -> B.ByteString
|
|
putWord128 = B.pack . w128tow8
|
|
|
|
sbox :: Vector Word8
|
|
sbox = 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 x = sbox ! (fromIntegral x)
|
|
|
|
sbox2 :: Word8 -> Word8
|
|
sbox2 x = sbox1 x `rotateL` 1;
|
|
|
|
sbox3 :: Word8 -> Word8
|
|
sbox3 x = sbox1 x `rotateL` 7;
|
|
|
|
sbox4 :: Word8 -> Word8
|
|
sbox4 x = sbox1 (x `rotateL` 1);
|
|
|
|
sigma1, sigma2, sigma3, sigma4, sigma5, sigma6 :: Word64
|
|
sigma1 = 0xA09E667F3BCC908B
|
|
sigma2 = 0xB67AE8584CAA73B2
|
|
sigma3 = 0xC6EF372FE94F82BE
|
|
sigma4 = 0x54FF53A5F1D36F1C
|
|
sigma5 = 0x10E527FADE682D1D
|
|
sigma6 = 0xB05688C2B3E6C1FD
|
|
|
|
rotl128 :: Word128 -> Int -> Word128
|
|
rotl128 v 0 = v
|
|
rotl128 (Word128 x1 x2) 64 = Word128 x2 x1
|
|
|
|
rotl128 v@(Word128 x1 x2) w
|
|
| w > 64 = (v `rotl128` 64) `rotl128` (w - 64)
|
|
| otherwise = Word128 (x1high .|. x2low) (x2high .|. x1low)
|
|
where
|
|
splitBits i = (i .&. complement x, i .&. x)
|
|
where x = 2 ^ w - 1
|
|
(x1high, x1low) = splitBits (x1 `rotateL` w)
|
|
(x2high, x2low) = splitBits (x2 `rotateL` w)
|
|
|
|
data Camellia = Camellia
|
|
{ k :: Vector Word64
|
|
, kw :: Vector Word64
|
|
, ke :: Vector Word64
|
|
}
|
|
|
|
setKeyInterim :: B.ByteString -> (Word128, Word128, Word128, Word128)
|
|
setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)
|
|
where kL = (w8tow64 $ B.take 8 keyseed, w8tow64 $ B.drop 8 keyseed)
|
|
kR = (0, 0)
|
|
|
|
kA = let d1 = (fst kL `xor` fst kR)
|
|
d2 = (snd kL `xor` snd kR)
|
|
d3 = d2 `xor` feistel d1 sigma1
|
|
d4 = d1 `xor` feistel d3 sigma2
|
|
d5 = d4 `xor` (fst kL)
|
|
d6 = d3 `xor` (snd kL)
|
|
d7 = d6 `xor` feistel d5 sigma3
|
|
d8 = d5 `xor` feistel d7 sigma4
|
|
in (d8, d7)
|
|
|
|
kB = let d1 = (fst kA `xor` fst kR)
|
|
d2 = (snd kA `xor` snd kR)
|
|
d3 = d2 `xor` feistel d1 sigma5
|
|
d4 = d1 `xor` feistel d3 sigma6
|
|
in (d4, 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 :: ByteArray key
|
|
=> key -- ^ The key to create the camellia context
|
|
-> CryptoFailable Camellia
|
|
initCamellia key
|
|
| byteArrayLength key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid
|
|
| otherwise =
|
|
let (kL, _, kA, _) = setKeyInterim (byteArrayToBS key) in
|
|
|
|
let (kw1, kw2) = w128tow64 (kL `rotl128` 0) in
|
|
let (k1, k2) = w128tow64 (kA `rotl128` 0) in
|
|
let (k3, k4) = w128tow64 (kL `rotl128` 15) in
|
|
let (k5, k6) = w128tow64 (kA `rotl128` 15) in
|
|
let (ke1, ke2) = w128tow64 (kA `rotl128` 30) in --ke1 = (KA <<< 30) >> 64; ke2 = (KA <<< 30) & MASK64;
|
|
let (k7, k8) = w128tow64 (kL `rotl128` 45) in --k7 = (KL <<< 45) >> 64; k8 = (KL <<< 45) & MASK64;
|
|
let (k9, _) = w128tow64 (kA `rotl128` 45) in --k9 = (KA <<< 45) >> 64;
|
|
let (_, k10) = w128tow64 (kL `rotl128` 60) in
|
|
let (k11, k12) = w128tow64 (kA `rotl128` 60) in
|
|
let (ke3, ke4) = w128tow64 (kL `rotl128` 77) in
|
|
let (k13, k14) = w128tow64 (kL `rotl128` 94) in
|
|
let (k15, k16) = w128tow64 (kA `rotl128` 94) in
|
|
let (k17, k18) = w128tow64 (kL `rotl128` 111) in
|
|
let (kw3, kw4) = w128tow64 (kA `rotl128` 111) in
|
|
|
|
CryptoPassed $ Camellia
|
|
{ kw = fromList [ kw1, kw2, kw3, kw4 ]
|
|
, ke = fromList [ ke1, ke2, ke3, ke4 ]
|
|
, k = fromList [ k1, k2, k3, k4, k5, k6, k7, k8, k9,
|
|
k10, k11, k12, k13, k14, k15, k16, k17, k18 ]
|
|
}
|
|
|
|
feistel :: Word64 -> Word64 -> Word64
|
|
feistel fin sk =
|
|
let x = fin `xor` sk in
|
|
let (t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x in
|
|
let t1' = sbox1 t1 in
|
|
let t2' = sbox2 t2 in
|
|
let t3' = sbox3 t3 in
|
|
let t4' = sbox4 t4 in
|
|
let t5' = sbox2 t5 in
|
|
let t6' = sbox3 t6 in
|
|
let t7' = sbox4 t7 in
|
|
let t8' = sbox1 t8 in
|
|
let y1 = t1' `xor` t3' `xor` t4' `xor` t6' `xor` t7' `xor` t8' in
|
|
let y2 = t1' `xor` t2' `xor` t4' `xor` t5' `xor` t7' `xor` t8' in
|
|
let y3 = t1' `xor` t2' `xor` t3' `xor` t5' `xor` t6' `xor` t8' in
|
|
let y4 = t2' `xor` t3' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in
|
|
let y5 = t1' `xor` t2' `xor` t6' `xor` t7' `xor` t8' in
|
|
let y6 = t2' `xor` t3' `xor` t5' `xor` t7' `xor` t8' in
|
|
let y7 = t3' `xor` t4' `xor` t5' `xor` t6' `xor` t8' in
|
|
let y8 = t1' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in
|
|
w8tow64 $ B.pack [y1, y2, y3, y4, y5, y6, y7, y8]
|
|
|
|
fl :: Word64 -> Word64 -> Word64
|
|
fl fin sk =
|
|
let (x1, x2) = w64tow32 fin in
|
|
let (k1, k2) = w64tow32 sk in
|
|
let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in
|
|
let y1 = x1 `xor` (y2 .|. k2) in
|
|
w32tow64 (y1, y2)
|
|
|
|
flinv :: Word64 -> Word64 -> Word64
|
|
flinv fin sk =
|
|
let (y1, y2) = w64tow32 fin in
|
|
let (k1, k2) = w64tow32 sk in
|
|
let x1 = y1 `xor` (y2 .|. k2) in
|
|
let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1) in
|
|
w32tow64 (x1, x2)
|
|
|
|
{- in decrypt mode 0->17 1->16 ... -}
|
|
getKeyK :: Mode -> Camellia -> Int -> Word64
|
|
getKeyK Encrypt key i = k key ! i
|
|
getKeyK Decrypt key i = k key ! (17 - i)
|
|
|
|
{- in decrypt mode 0->3 1->2 2->1 3->0 -}
|
|
getKeyKe :: Mode -> Camellia -> Int -> Word64
|
|
getKeyKe Encrypt key i = ke key ! i
|
|
getKeyKe Decrypt key i = ke key ! (3 - i)
|
|
|
|
{- in decrypt mode 0->2 1->3 2->0 3->1 -}
|
|
getKeyKw :: Mode -> Camellia -> Int -> Word64
|
|
getKeyKw Encrypt key i = kw key ! i
|
|
getKeyKw Decrypt key i = kw key ! ((i + 2) `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 key d1 d2 i =
|
|
let r1 = d2 `xor` feistel d1 (getKeyK mode key (0+i)) in {- Round 1+i -}
|
|
let r2 = d1 `xor` feistel r1 (getKeyK mode key (1+i)) in {- Round 2+i -}
|
|
let r3 = r1 `xor` feistel r2 (getKeyK mode key (2+i)) in {- Round 3+i -}
|
|
let r4 = r2 `xor` feistel r3 (getKeyK mode key (3+i)) in {- Round 4+i -}
|
|
let r5 = r3 `xor` feistel r4 (getKeyK mode key (4+i)) in {- Round 5+i -}
|
|
let r6 = r4 `xor` feistel r5 (getKeyK mode key (5+i)) in {- Round 6+i -}
|
|
(r6, r5)
|
|
|
|
doBlock :: Mode -> Camellia -> Word128 -> Word128
|
|
doBlock mode key m =
|
|
let (d1, d2) = w128tow64 m in
|
|
|
|
let d1a = d1 `xor` (getKeyKw mode key 0) in {- Prewhitening -}
|
|
let d2a = d2 `xor` (getKeyKw mode key 1) in
|
|
|
|
let (d1b, d2b) = doBlockRound mode key d1a d2a 0 in
|
|
|
|
let d1c = fl d1b (getKeyKe mode key 0) in {- FL -}
|
|
let d2c = flinv d2b (getKeyKe mode key 1) in {- FLINV -}
|
|
|
|
let (d1d, d2d) = doBlockRound mode key d1c d2c 6 in
|
|
|
|
let d1e = fl d1d (getKeyKe mode key 2) in {- FL -}
|
|
let d2e = flinv d2d (getKeyKe mode key 3) in {- FLINV -}
|
|
|
|
let (d1f, d2f) = doBlockRound mode key d1e d2e 12 in
|
|
|
|
let d2g = d2f `xor` (getKeyKw mode key 2) in {- Postwhitening -}
|
|
let d1g = d1f `xor` (getKeyKw mode key 3) in
|
|
w64tow128 (d2g, d1g)
|
|
|
|
{- encryption for 128 bits blocks -}
|
|
encryptBlock :: Camellia -> Word128 -> Word128
|
|
encryptBlock = doBlock Encrypt
|
|
|
|
{- decryption for 128 bits blocks -}
|
|
decryptBlock :: Camellia -> Word128 -> Word128
|
|
decryptBlock = doBlock Decrypt
|
|
|
|
encryptChunk :: Camellia -> B.ByteString -> B.ByteString
|
|
encryptChunk key b = putWord128 $ encryptBlock key $ getWord128 b
|
|
|
|
decryptChunk :: Camellia -> B.ByteString -> B.ByteString
|
|
decryptChunk key b = putWord128 $ decryptBlock key $ getWord128 b
|
|
|
|
doChunks :: (B.ByteString -> B.ByteString) -> B.ByteString -> [B.ByteString]
|
|
doChunks f b =
|
|
let (x, rest) = B.splitAt 16 b in
|
|
if B.length rest >= 16
|
|
then f x : doChunks f rest
|
|
else [ f x ]
|
|
|
|
-- | Encrypts the given ByteString using the given Key
|
|
encrypt :: Camellia -- ^ The key to use
|
|
-> B.ByteString -- ^ The data to encrypt
|
|
-> B.ByteString
|
|
encrypt key b = B.concat $ doChunks (encryptChunk key) b
|
|
|
|
-- | Decrypts the given ByteString using the given Key
|
|
decrypt :: Camellia -- ^ The key to use
|
|
-> B.ByteString -- ^ The data to decrypt
|
|
-> B.ByteString
|
|
decrypt key b = B.concat $ doChunks (decryptChunk key) b
|