cryptocipher 0.2.4 → 0.2.5

raw patch · 3 files changed

+234/−33 lines, 3 filesdep +cerealdep +taggeddep ~crypto-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal, tagged

Dependency ranges changed: crypto-api

API changes (from Hackage documentation)

Files

• Crypto/Cipher/AES.hs +192/−27
• Tests.hs +38/−4
• cryptocipher.cabal +4/−2

@@ -1,11 +1,26 @@+-- |+-- Module      : Crypto.Cipher.AES+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- 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 =

@@ -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

@@ -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