1 2-- | 3-- Module : Crypto.Cipher.Camellia.Primitive 4-- License : BSD-style 5-- Maintainer : Vincent Hanquez <vincent@snarc.org> 6-- Stability : experimental 7-- Portability : Good 8-- 9-- This only cover Camellia 128 bits for now. The API will change once 10-- 192 and 256 mode are implemented too. 11{-# LANGUAGE MagicHash #-} 12module Crypto.Cipher.Camellia.Primitive 13 ( Camellia 14 , initCamellia 15 , encrypt 16 , decrypt 17 ) where 18 19import Data.Word 20import Data.Bits 21 22import Crypto.Error 23import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) 24import qualified Crypto.Internal.ByteArray as B 25import Crypto.Internal.Words 26import Crypto.Internal.WordArray 27import Data.Memory.Endian 28 29data Mode = Decrypt | Encrypt 30 31w64tow128 :: (Word64, Word64) -> Word128 32w64tow128 (x1, x2) = Word128 x1 x2 33 34w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) 35w64tow8 x = (t1, t2, t3, t4, t5, t6, t7, t8) 36 where 37 t1 = fromIntegral (x `shiftR` 56) 38 t2 = fromIntegral (x `shiftR` 48) 39 t3 = fromIntegral (x `shiftR` 40) 40 t4 = fromIntegral (x `shiftR` 32) 41 t5 = fromIntegral (x `shiftR` 24) 42 t6 = fromIntegral (x `shiftR` 16) 43 t7 = fromIntegral (x `shiftR` 8) 44 t8 = fromIntegral (x) 45 46w8tow64 :: (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) -> Word64 47w8tow64 (t1,t2,t3,t4,t5,t6,t7,t8) = 48 (fromIntegral t1 `shiftL` 56) .|. 49 (fromIntegral t2 `shiftL` 48) .|. 50 (fromIntegral t3 `shiftL` 40) .|. 51 (fromIntegral t4 `shiftL` 32) .|. 52 (fromIntegral t5 `shiftL` 24) .|. 53 (fromIntegral t6 `shiftL` 16) .|. 54 (fromIntegral t7 `shiftL` 8) .|. 55 (fromIntegral t8) 56 57sbox :: Int -> Word8 58sbox = arrayRead8 t 59 where t = array8 60 "\x70\x82\x2c\xec\xb3\x27\xc0\xe5\xe4\x85\x57\x35\xea\x0c\xae\x41\ 61 \\x23\xef\x6b\x93\x45\x19\xa5\x21\xed\x0e\x4f\x4e\x1d\x65\x92\xbd\ 62 \\x86\xb8\xaf\x8f\x7c\xeb\x1f\xce\x3e\x30\xdc\x5f\x5e\xc5\x0b\x1a\ 63 \\xa6\xe1\x39\xca\xd5\x47\x5d\x3d\xd9\x01\x5a\xd6\x51\x56\x6c\x4d\ 64 \\x8b\x0d\x9a\x66\xfb\xcc\xb0\x2d\x74\x12\x2b\x20\xf0\xb1\x84\x99\ 65 \\xdf\x4c\xcb\xc2\x34\x7e\x76\x05\x6d\xb7\xa9\x31\xd1\x17\x04\xd7\ 66 \\x14\x58\x3a\x61\xde\x1b\x11\x1c\x32\x0f\x9c\x16\x53\x18\xf2\x22\ 67 \\xfe\x44\xcf\xb2\xc3\xb5\x7a\x91\x24\x08\xe8\xa8\x60\xfc\x69\x50\ 68 \\xaa\xd0\xa0\x7d\xa1\x89\x62\x97\x54\x5b\x1e\x95\xe0\xff\x64\xd2\ 69 \\x10\xc4\x00\x48\xa3\xf7\x75\xdb\x8a\x03\xe6\xda\x09\x3f\xdd\x94\ 70 \\x87\x5c\x83\x02\xcd\x4a\x90\x33\x73\x67\xf6\xf3\x9d\x7f\xbf\xe2\ 71 \\x52\x9b\xd8\x26\xc8\x37\xc6\x3b\x81\x96\x6f\x4b\x13\xbe\x63\x2e\ 72 \\xe9\x79\xa7\x8c\x9f\x6e\xbc\x8e\x29\xf5\xf9\xb6\x2f\xfd\xb4\x59\ 73 \\x78\x98\x06\x6a\xe7\x46\x71\xba\xd4\x25\xab\x42\x88\xa2\x8d\xfa\ 74 \\x72\x07\xb9\x55\xf8\xee\xac\x0a\x36\x49\x2a\x68\x3c\x38\xf1\xa4\ 75 \\x40\x28\xd3\x7b\xbb\xc9\x43\xc1\x15\xe3\xad\xf4\x77\xc7\x80\x9e"# 76 77sbox1 :: Word8 -> Word8 78sbox1 x = sbox (fromIntegral x) 79 80sbox2 :: Word8 -> Word8 81sbox2 x = sbox1 x `rotateL` 1 82 83sbox3 :: Word8 -> Word8 84sbox3 x = sbox1 x `rotateL` 7 85 86sbox4 :: Word8 -> Word8 87sbox4 x = sbox1 (x `rotateL` 1) 88 89sigma1, sigma2, sigma3, sigma4, sigma5, sigma6 :: Word64 90sigma1 = 0xA09E667F3BCC908B 91sigma2 = 0xB67AE8584CAA73B2 92sigma3 = 0xC6EF372FE94F82BE 93sigma4 = 0x54FF53A5F1D36F1C 94sigma5 = 0x10E527FADE682D1D 95sigma6 = 0xB05688C2B3E6C1FD 96 97rotl128 :: Word128 -> Int -> Word128 98rotl128 v 0 = v 99rotl128 (Word128 x1 x2) 64 = Word128 x2 x1 100 101rotl128 v@(Word128 x1 x2) w 102 | w > 64 = (v `rotl128` 64) `rotl128` (w - 64) 103 | otherwise = Word128 (x1high .|. x2low) (x2high .|. x1low) 104 where 105 splitBits i = (i .&. complement x, i .&. x) 106 where x = 2 ^ w - 1 107 (x1high, x1low) = splitBits (x1 `rotateL` w) 108 (x2high, x2low) = splitBits (x2 `rotateL` w) 109 110-- | Camellia context 111data Camellia = Camellia 112 { k :: Array64 113 , kw :: Array64 114 , ke :: Array64 115 } 116 117setKeyInterim :: ByteArrayAccess key => key -> (Word128, Word128, Word128, Word128) 118setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB) 119 where kL = (fromBE $ B.toW64BE keyseed 0, fromBE $ B.toW64BE keyseed 8) 120 kR = (0, 0) 121 122 kA = let d1 = (fst kL `xor` fst kR) 123 d2 = (snd kL `xor` snd kR) 124 d3 = d2 `xor` feistel d1 sigma1 125 d4 = d1 `xor` feistel d3 sigma2 126 d5 = d4 `xor` (fst kL) 127 d6 = d3 `xor` (snd kL) 128 d7 = d6 `xor` feistel d5 sigma3 129 d8 = d5 `xor` feistel d7 sigma4 130 in (d8, d7) 131 132 kB = let d1 = (fst kA `xor` fst kR) 133 d2 = (snd kA `xor` snd kR) 134 d3 = d2 `xor` feistel d1 sigma5 135 d4 = d1 `xor` feistel d3 sigma6 136 in (d4, d3) 137 138-- | Initialize a 128-bit key 139-- 140-- Return the initialized key or a error message if the given 141-- keyseed was not 16-bytes in length. 142initCamellia :: ByteArray key 143 => key -- ^ The key to create the camellia context 144 -> CryptoFailable Camellia 145initCamellia key 146 | B.length key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid 147 | otherwise = 148 let (kL, _, kA, _) = setKeyInterim key in 149 150 let (Word128 kw1 kw2) = (kL `rotl128` 0) in 151 let (Word128 k1 k2) = (kA `rotl128` 0) in 152 let (Word128 k3 k4) = (kL `rotl128` 15) in 153 let (Word128 k5 k6) = (kA `rotl128` 15) in 154 let (Word128 ke1 ke2) = (kA `rotl128` 30) in --ke1 = (KA <<< 30) >> 64; ke2 = (KA <<< 30) & MASK64; 155 let (Word128 k7 k8) = (kL `rotl128` 45) in --k7 = (KL <<< 45) >> 64; k8 = (KL <<< 45) & MASK64; 156 let (Word128 k9 _) = (kA `rotl128` 45) in --k9 = (KA <<< 45) >> 64; 157 let (Word128 _ k10) = (kL `rotl128` 60) in 158 let (Word128 k11 k12) = (kA `rotl128` 60) in 159 let (Word128 ke3 ke4) = (kL `rotl128` 77) in 160 let (Word128 k13 k14) = (kL `rotl128` 94) in 161 let (Word128 k15 k16) = (kA `rotl128` 94) in 162 let (Word128 k17 k18) = (kL `rotl128` 111) in 163 let (Word128 kw3 kw4) = (kA `rotl128` 111) in 164 165 CryptoPassed $ Camellia 166 { kw = array64 4 [ kw1, kw2, kw3, kw4 ] 167 , ke = array64 4 [ ke1, ke2, ke3, ke4 ] 168 , k = array64 18 [ k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14, k15, k16, k17, k18 ] 169 } 170 171feistel :: Word64 -> Word64 -> Word64 172feistel fin sk = 173 let x = fin `xor` sk in 174 let (t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x in 175 let t1' = sbox1 t1 in 176 let t2' = sbox2 t2 in 177 let t3' = sbox3 t3 in 178 let t4' = sbox4 t4 in 179 let t5' = sbox2 t5 in 180 let t6' = sbox3 t6 in 181 let t7' = sbox4 t7 in 182 let t8' = sbox1 t8 in 183 let y1 = t1' `xor` t3' `xor` t4' `xor` t6' `xor` t7' `xor` t8' in 184 let y2 = t1' `xor` t2' `xor` t4' `xor` t5' `xor` t7' `xor` t8' in 185 let y3 = t1' `xor` t2' `xor` t3' `xor` t5' `xor` t6' `xor` t8' in 186 let y4 = t2' `xor` t3' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in 187 let y5 = t1' `xor` t2' `xor` t6' `xor` t7' `xor` t8' in 188 let y6 = t2' `xor` t3' `xor` t5' `xor` t7' `xor` t8' in 189 let y7 = t3' `xor` t4' `xor` t5' `xor` t6' `xor` t8' in 190 let y8 = t1' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in 191 w8tow64 (y1, y2, y3, y4, y5, y6, y7, y8) 192 193fl :: Word64 -> Word64 -> Word64 194fl fin sk = 195 let (x1, x2) = w64to32 fin in 196 let (k1, k2) = w64to32 sk in 197 let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in 198 let y1 = x1 `xor` (y2 .|. k2) in 199 w32to64 (y1, y2) 200 201flinv :: Word64 -> Word64 -> Word64 202flinv fin sk = 203 let (y1, y2) = w64to32 fin in 204 let (k1, k2) = w64to32 sk in 205 let x1 = y1 `xor` (y2 .|. k2) in 206 let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1) in 207 w32to64 (x1, x2) 208 209{- in decrypt mode 0->17 1->16 ... -} 210getKeyK :: Mode -> Camellia -> Int -> Word64 211getKeyK Encrypt key i = k key `arrayRead64` i 212getKeyK Decrypt key i = k key `arrayRead64` (17 - i) 213 214{- in decrypt mode 0->3 1->2 2->1 3->0 -} 215getKeyKe :: Mode -> Camellia -> Int -> Word64 216getKeyKe Encrypt key i = ke key `arrayRead64` i 217getKeyKe Decrypt key i = ke key `arrayRead64` (3 - i) 218 219{- in decrypt mode 0->2 1->3 2->0 3->1 -} 220getKeyKw :: Mode -> Camellia -> Int -> Word64 221getKeyKw Encrypt key i = (kw key) `arrayRead64` i 222getKeyKw Decrypt key i = (kw key) `arrayRead64` ((i + 2) `mod` 4) 223 224{- perform the following 225 D2 = D2 ^ F(D1, k1); // Round 1 226 D1 = D1 ^ F(D2, k2); // Round 2 227 D2 = D2 ^ F(D1, k3); // Round 3 228 D1 = D1 ^ F(D2, k4); // Round 4 229 D2 = D2 ^ F(D1, k5); // Round 5 230 D1 = D1 ^ F(D2, k6); // Round 6 231 -} 232doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64) 233doBlockRound mode key d1 d2 i = 234 let r1 = d2 `xor` feistel d1 (getKeyK mode key (0+i)) in {- Round 1+i -} 235 let r2 = d1 `xor` feistel r1 (getKeyK mode key (1+i)) in {- Round 2+i -} 236 let r3 = r1 `xor` feistel r2 (getKeyK mode key (2+i)) in {- Round 3+i -} 237 let r4 = r2 `xor` feistel r3 (getKeyK mode key (3+i)) in {- Round 4+i -} 238 let r5 = r3 `xor` feistel r4 (getKeyK mode key (4+i)) in {- Round 5+i -} 239 let r6 = r4 `xor` feistel r5 (getKeyK mode key (5+i)) in {- Round 6+i -} 240 (r6, r5) 241 242doBlock :: Mode -> Camellia -> Word128 -> Word128 243doBlock mode key (Word128 d1 d2) = 244 let d1a = d1 `xor` (getKeyKw mode key 0) in {- Prewhitening -} 245 let d2a = d2 `xor` (getKeyKw mode key 1) in 246 247 let (d1b, d2b) = doBlockRound mode key d1a d2a 0 in 248 249 let d1c = fl d1b (getKeyKe mode key 0) in {- FL -} 250 let d2c = flinv d2b (getKeyKe mode key 1) in {- FLINV -} 251 252 let (d1d, d2d) = doBlockRound mode key d1c d2c 6 in 253 254 let d1e = fl d1d (getKeyKe mode key 2) in {- FL -} 255 let d2e = flinv d2d (getKeyKe mode key 3) in {- FLINV -} 256 257 let (d1f, d2f) = doBlockRound mode key d1e d2e 12 in 258 259 let d2g = d2f `xor` (getKeyKw mode key 2) in {- Postwhitening -} 260 let d1g = d1f `xor` (getKeyKw mode key 3) in 261 w64tow128 (d2g, d1g) 262 263{- encryption for 128 bits blocks -} 264encryptBlock :: Camellia -> Word128 -> Word128 265encryptBlock = doBlock Encrypt 266 267{- decryption for 128 bits blocks -} 268decryptBlock :: Camellia -> Word128 -> Word128 269decryptBlock = doBlock Decrypt 270 271-- | Encrypts the given ByteString using the given Key 272encrypt :: ByteArray ba 273 => Camellia -- ^ The key to use 274 -> ba -- ^ The data to encrypt 275 -> ba 276encrypt key = B.mapAsWord128 (encryptBlock key) 277 278-- | Decrypts the given ByteString using the given Key 279decrypt :: ByteArray ba 280 => Camellia -- ^ The key to use 281 -> ba -- ^ The data to decrypt 282 -> ba 283decrypt key = B.mapAsWord128 (decryptBlock key) 284