diff --git a/Crypto/Cipher/AES.hs b/Crypto/Cipher/AES.hs --- a/Crypto/Cipher/AES.hs +++ b/Crypto/Cipher/AES.hs @@ -1,11 +1,26 @@ +-- | +-- Module : Crypto.Cipher.AES +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good + module Crypto.Cipher.AES ( Key + -- * Basic encryption and decryption , encrypt , decrypt + -- * CBC encryption and decryption + , encryptCBC + , decryptCBC + -- * key building mechanism , initKey128 - -- * those key sizes are not actually working right now. , initKey192 , initKey256 + -- * Wrappers for "crypto-api" instances + , AES128 + , AES192 + , AES256 ) where import Data.Word @@ -17,22 +32,109 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B -newtype Key = Key (Vector Word8) +import Data.Tagged (Tagged(..)) +import Crypto.Classes (BlockCipher(..)) +import Data.Serialize (Serialize(..), getByteString, putByteString) + +newtype AES128 = A128 { unA128 :: Key } +newtype AES192 = A192 { unA192 :: Key } +newtype AES256 = A256 { unA256 :: Key } + +instance BlockCipher AES128 where + blockSize = Tagged 128 + encryptBlock = encrypt . unA128 + decryptBlock = decrypt . unA128 + buildKey b = either (const Nothing) (Just . A128) $ initKey128 b + keyLength = Tagged 128 + +instance BlockCipher AES192 where + blockSize = Tagged 128 + encryptBlock = encrypt . unA192 + decryptBlock = decrypt . unA192 + buildKey b = either (const Nothing) (Just . A192) $ initKey192 b + keyLength = Tagged 192 + +instance BlockCipher AES256 where + blockSize = Tagged 128 + encryptBlock = encrypt . unA256 + decryptBlock = decrypt . unA256 + buildKey b = either (const Nothing) (Just . A256) $ initKey256 b + keyLength = Tagged 256 + +serializeKey :: Key -> ByteString +serializeKey (Key v) + | V.length v == 176 = B.pack $ map (V.unsafeIndex v) [0..15] + | V.length v == 208 = B.pack $ map (V.unsafeIndex v) [0..23] + | otherwise = B.pack $ map (V.unsafeIndex v) [0..31] + +instance Serialize AES128 where + put = putByteString . serializeKey . unA128 + get = do + raw <- getByteString (128 `div` 8) + case buildKey raw of + Nothing -> fail "Invalid raw key material." + Just k -> return k + +instance Serialize AES192 where + put = putByteString . serializeKey . unA192 + get = do + raw <- getByteString (192 `div` 8) + case buildKey raw of + Nothing -> fail "Invalid raw key material." + Just k -> return k + +instance Serialize AES256 where + put = putByteString . serializeKey . unA256 + get = do + raw <- getByteString (256 `div` 8) + case buildKey raw of + Nothing -> fail "Invalid raw key material." + Just k -> return k + +data Key = Key (Vector Word8) deriving (Show,Eq) +type IV = B.ByteString + type AESState = Vector Word8 -{- | encrypt with the key a bytestring and returns the encrypted bytestring -} +{- | encrypt using CBC mode + - IV need to be 16 bytes and the data to encrypt a multiple of 16 bytes -} +encryptCBC :: Key -> IV -> B.ByteString -> B.ByteString +encryptCBC key iv b + | B.length iv /= 16 = error "invalid IV length" + | B.length b `mod` 16 /= 0 = error "invalid data length" + | otherwise = B.concat $ encryptIter iv (makeChunks b) + where + encryptIter _ [] = [] + encryptIter iv' (x:xs) = + let r = coreEncrypt key $ B.pack $ B.zipWith xor iv' x in + r : encryptIter r xs + +{- | encrypt using simple EBC mode -} encrypt :: Key -> B.ByteString -> B.ByteString encrypt key b | B.length b `mod` 16 == 0 = B.concat $ doChunks (coreEncrypt key) b - | otherwise = error "wrong length" + | otherwise = error "invalid data length" -{- | decrypt with the key a bytestring and returns the encrypted bytestring -} +{- | decrypt using CBC mode + - IV need to be 16 bytes and the data to decrypt a multiple of 16 bytes -} +decryptCBC :: Key -> IV -> B.ByteString -> B.ByteString +decryptCBC key iv b + | B.length iv /= 16 = error "invalid IV length" + | B.length b `mod` 16 /= 0 = error "invalid data length" + | otherwise = B.concat $ decryptIter iv (makeChunks b) + where + decryptIter _ [] = [] + decryptIter iv' (x:xs) = + let r = B.pack $ B.zipWith xor iv' $ coreDecrypt key x in + r : decryptIter x xs + +{- | decrypt using simple EBC mode -} decrypt :: Key -> B.ByteString -> B.ByteString decrypt key b | B.length b `mod` 16 == 0 = B.concat $ doChunks (coreDecrypt key) b - | otherwise = error "wrong length" + | otherwise = error "invalid data length" doChunks :: (B.ByteString -> B.ByteString) -> B.ByteString -> [B.ByteString] doChunks f b = @@ -41,24 +143,33 @@ then f x : doChunks f rest else [ f x ] +makeChunks :: B.ByteString -> [B.ByteString] +makeChunks = doChunks id + coreEncrypt :: Key -> ByteString -> ByteString -coreEncrypt key input = swapBlockInv $ aesMain 10 key $ swapBlock input +coreEncrypt key input = swapBlockInv $ aesMain (getNbr key) key $ swapBlock input coreDecrypt :: Key -> ByteString -> ByteString -coreDecrypt key input = swapBlockInv $ aesMainInv 10 key $ swapBlock input +coreDecrypt key input = swapBlockInv $ aesMainInv (getNbr key) key $ swapBlock input +getNbr :: Key -> Int +getNbr (Key v) + | V.length v == 176 = 10 + | V.length v == 208 = 12 + | otherwise = 14 + initKey128 :: ByteString -> Either String Key -initKey128 = initKey 16 10 +initKey128 = initKey 16 initKey192 :: ByteString -> Either String Key -initKey192 = initKey 24 12 +initKey192 = initKey 24 initKey256 :: ByteString -> Either String Key -initKey256 = initKey 32 14 +initKey256 = initKey 32 -initKey :: Int -> Int -> ByteString -> Either String Key -initKey sz nbr b - | B.length b == sz = Right $ coreExpandKey nbr (V.generate sz $ B.unsafeIndex b) +initKey :: Int -> ByteString -> Either String Key +initKey sz b + | B.length b == sz = Right $ coreExpandKey (V.generate sz $ B.unsafeIndex b) | otherwise = Left "wrong key size" aesMain :: Int -> Key -> AESState -> AESState @@ -79,29 +190,83 @@ swapIndex :: Int -> Int swapIndex i = V.unsafeIndex swapIndexes i -coreExpandKey :: Int -> Vector Word8 -> Key -coreExpandKey nbr vkey = Key (V.concat (ek0 : ekN)) +coreExpandKey :: Vector Word8 -> Key +coreExpandKey vkey + | V.length vkey == 16 = Key (V.concat (ek0 : ekN16)) + | V.length vkey == 24 = Key (V.concat (ek0 : ekN24)) + | V.length vkey == 32 = Key (V.concat (ek0 : ekN32)) + | otherwise = Key (V.empty) where ek0 = vkey - ekN = reverse $ snd $ foldl generateFold (ek0, []) [1..nbr] + ekN16 = reverse $ snd $ foldl (generateFold generate16) (ek0, []) [1..10] - generateFold (prevk, accK) it = let nk = generate prevk it in (nk, nk : accK) - generate prevk it = - let v0 = cR0 it (V.unsafeIndex prevk 12) - (V.unsafeIndex prevk 13) - (V.unsafeIndex prevk 14) - (V.unsafeIndex prevk 15) in - let (e0,e1,e2,e3) = xorVector prevk 0 v0 in - let (e4,e5,e6,e7) = xorVector prevk 4 (e0,e1,e2,e3) in - let (e8,e9,e10,e11) = xorVector prevk 8 (e4,e5,e6,e7) in - let (e12,e13,e14,e15) = xorVector prevk 12 (e8,e9,e10,e11) in + ekN24 = + let (lk, acc) = foldl (generateFold generate24) (ek0, []) [1..7] in + let nk = generate16 lk 8 in + reverse (nk : acc) + + ekN32 = + let (lk, acc) = foldl (generateFold generate32) (ek0, []) [1..6] in + let nk = generate16 lk 7 in + reverse (nk : acc) + + generateFold gen (prevk, accK) it = let nk = gen prevk it in (nk, nk : accK) + + generate16 prevk it = + let len = V.length prevk in + let v0 = cR0 it (V.unsafeIndex prevk $ len - 4) + (V.unsafeIndex prevk $ len - 3) + (V.unsafeIndex prevk $ len - 2) + (V.unsafeIndex prevk $ len - 1) in + let eg0@(e0,e1,e2,e3) = xorVector prevk 0 v0 in + let eg1@(e4,e5,e6,e7) = xorVector prevk 4 eg0 in + let eg2@(e8,e9,e10,e11) = xorVector prevk 8 eg1 in + let (e12,e13,e14,e15) = xorVector prevk 12 eg2 in V.fromList [e0,e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15] + generate24 prevk it = + let len = V.length prevk in + let v0 = cR0 it (V.unsafeIndex prevk $ len - 4) + (V.unsafeIndex prevk $ len - 3) + (V.unsafeIndex prevk $ len - 2) + (V.unsafeIndex prevk $ len - 1) in + let eg0@(e0,e1,e2,e3) = xorVector prevk 0 v0 in + let eg1@(e4,e5,e6,e7) = xorVector prevk 4 eg0 in + let eg2@(e8,e9,e10,e11) = xorVector prevk 8 eg1 in + let eg3@(e12,e13,e14,e15) = xorVector prevk 12 eg2 in + let eg4@(e16,e17,e18,e19) = xorVector prevk 16 eg3 in + let (e20,e21,e22,e23) = xorVector prevk 20 eg4 in + V.fromList [e0,e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15,e16,e17,e18,e19,e20,e21,e22,e23] + + generate32 prevk it = + let len = V.length prevk in + let v0 = cR0 it (V.unsafeIndex prevk $ len - 4) + (V.unsafeIndex prevk $ len - 3) + (V.unsafeIndex prevk $ len - 2) + (V.unsafeIndex prevk $ len - 1) in + let eg0@(e0,e1,e2,e3) = xorVector prevk 0 v0 in + let eg1@(e4,e5,e6,e7) = xorVector prevk 4 eg0 in + let eg2@(e8,e9,e10,e11) = xorVector prevk 8 eg1 in + let eg3@(e12,e13,e14,e15) = xorVector prevk 12 eg2 in + let eg4@(e16,e17,e18,e19) = xorSboxVector prevk 16 eg3 in + let eg5@(e20,e21,e22,e23) = xorVector prevk 20 eg4 in + let eg6@(e24,e25,e26,e27) = xorVector prevk 24 eg5 in + let (e28,e29,e30,e31) = xorVector prevk 28 eg6 in + V.fromList [e0,e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15,e16 + ,e17,e18,e19,e20,e21,e22,e23,e24,e25,e26,e27,e28,e29,e30,e31] + xorVector k i (t0,t1,t2,t3) = ( V.unsafeIndex k (i+0) `xor` t0 , V.unsafeIndex k (i+1) `xor` t1 , V.unsafeIndex k (i+2) `xor` t2 , V.unsafeIndex k (i+3) `xor` t3 + ) + + xorSboxVector k i (t0,t1,t2,t3) = + ( V.unsafeIndex k (i+0) `xor` mSbox t0 + , V.unsafeIndex k (i+1) `xor` mSbox t1 + , V.unsafeIndex k (i+2) `xor` mSbox t2 + , V.unsafeIndex k (i+3) `xor` mSbox t3 ) cR0 it r0 r1 r2 r3 = diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -93,8 +93,32 @@ ) ] +vectors_aes256 = + [ ( replicate 32 0 + , B.replicate 16 0 + , [0xdc,0x95,0xc0,0x78,0xa2,0x40,0x89,0x89,0xad,0x48,0xa2,0x14,0x92,0x84,0x20,0x87] + ) + , ( replicate 32 0 + , B.replicate 16 1 + , [0x7b,0xc3,0x02,0x6c,0xd7,0x37,0x10,0x3e,0x62,0x90,0x2b,0xcd,0x18,0xfb,0x01,0x63] + ) + , ( replicate 32 1 + , B.replicate 16 2 + , [0x62,0xae,0x12,0xf3,0x24,0xbf,0xea,0x08,0xd5,0xf6,0x75,0xb5,0x13,0x02,0x6b,0xbf] + ) + , ( replicate 32 2 + , B.replicate 16 1 + , [0x00,0xf9,0xc7,0x44,0x4b,0xb0,0xcc,0x80,0x6c,0x7c,0x39,0xee,0x22,0x11,0xf1,0x46] + ) + , ( replicate 32 3 + , B.replicate 16 2 + , [0xb4,0x05,0x87,0x3e,0xa0,0x76,0x1b,0x9c,0xa9,0x9f,0x70,0xb0,0x16,0x16,0xce,0xb1] + ) + ] + aes128InitKey = AES.initKey128 . B.pack aes192InitKey = AES.initKey192 . B.pack +aes256InitKey = AES.initKey256 . B.pack vectors_rc4 = [ (wordify "Key", "Plaintext", [ 0xBB,0xF3,0x16,0xE8,0xD9,0x40,0xAF,0x0A,0xD3 ]) @@ -135,6 +159,7 @@ [ ("RC4", vectors_rc4, encryptStream RC4.initCtx RC4.encrypt) , ("AES128", vectors_aes128, encryptBlock aes128InitKey AES.encrypt) , ("AES192", vectors_aes192, encryptBlock aes192InitKey AES.encrypt) + , ("AES256", vectors_aes256, encryptBlock aes256InitKey AES.encrypt) , ("Camellia", vectors_camellia128, encryptBlock Camellia.initKey Camellia.encrypt) ] @@ -262,20 +287,28 @@ {-----------------------------------------------------------------------------------------------} {- testing AES -} {-----------------------------------------------------------------------------------------------} -data AES128Message = AES128Message B.ByteString B.ByteString deriving (Show, Eq) +data AES128Message = AES128Message B.ByteString B.ByteString B.ByteString deriving (Show, Eq) instance Arbitrary AES128Message where arbitrary = do sz <- choose (1, 12) ws <- replicateM (sz*16) (choose (0,255) :: Gen Int) key <- replicateM 16 (choose (0,255) :: Gen Int) - return $ AES128Message (B.pack $ map fromIntegral key) (B.pack $ map fromIntegral ws) + iv <- replicateM 16 (choose (0,255) :: Gen Int) + return $ AES128Message (B.pack $ map fromIntegral key) + (B.pack $ map fromIntegral iv) + (B.pack $ map fromIntegral ws) -prop_aes128_valid (AES128Message key msg) = +prop_aes128_ecb_valid (AES128Message key _ msg) = let (Right k) = AES.initKey128 key in let emsg = AES.encrypt k msg in AES.decrypt k emsg == msg +prop_aes128_cbc_valid (AES128Message key iv msg) = + let (Right k) = AES.initKey128 key in + let emsg = AES.encryptCBC k iv msg in + AES.decryptCBC k iv emsg == msg + {-----------------------------------------------------------------------------------------------} {- main -} {-----------------------------------------------------------------------------------------------} @@ -304,4 +337,5 @@ run_test "DSA verify . sign = true" prop_dsa_valid - run_test "AES128 decrypt.encrypt = id" prop_aes128_valid + run_test "AES128 (ECB) decrypt.encrypt = id" prop_aes128_ecb_valid + run_test "AES128 (CBC) decrypt.encrypt = id" prop_aes128_cbc_valid diff --git a/cryptocipher.cabal b/cryptocipher.cabal --- a/cryptocipher.cabal +++ b/cryptocipher.cabal @@ -1,5 +1,5 @@ Name: cryptocipher -Version: 0.2.4 +Version: 0.2.5 Description: Symmetrical Block, Stream and PubKey Ciphers License: BSD3 License-file: LICENSE @@ -20,7 +20,9 @@ Build-Depends: base >= 4 && < 5 , bytestring , vector - , crypto-api >= 0.2 + , crypto-api >= 0.5 + , tagged + , cereal Exposed-modules: Crypto.Cipher.RC4 Crypto.Cipher.AES Crypto.Cipher.Camellia