This commit is contained in:
Vincent Hanquez 2015-04-08 14:12:58 +01:00
parent 72354397e8
commit ca125f3e66
12 changed files with 299 additions and 38 deletions

View File

@ -14,7 +14,6 @@ module Crypto.Cipher.Blowfish
, Blowfish448
) where
import Data.Byteable
import Crypto.Cipher.Types
import Crypto.Cipher.Blowfish.Primitive
@ -36,29 +35,26 @@ newtype Blowfish448 = Blowfish448 Context
instance Cipher Blowfish where
cipherName _ = "blowfish"
cipherKeySize _ = KeySizeRange 6 56
cipherInit k = undefined -- either error Blowfish $ initBlowfish (toBytes k)
cipherInit k = Blowfish `fmap` initBlowfish k
{-
instance BlockCipher Blowfish where
blockSize _ = 8
ecbEncrypt (Blowfish bf) = encrypt bf
ecbDecrypt (Blowfish bf) = decrypt bf
ecbEncrypt (Blowfish bf) = ecbEncryptLegacy encrypt bf
ecbDecrypt (Blowfish bf) = ecbDecryptLegacy decrypt bf
#define INSTANCE_CIPHER(CSTR, NAME, KEYSIZE) \
instance Cipher CSTR where \
{ cipherName _ = NAME \
; cipherKeySize _ = KeySizeFixed KEYSIZE \
; cipherInit k = either error CSTR $ initBlowfish (toBytes k) \
; cipherInit k = CSTR `fmap` initBlowfish k \
}; \
instance BlockCipher CSTR where \
{ blockSize _ = 8 \
; ecbEncrypt (CSTR bf) = encrypt bf \
; ecbDecrypt (CSTR bf) = decrypt bf \
; ecbEncrypt (CSTR bf) = ecbEncryptLegacy encrypt bf \
; ecbDecrypt (CSTR bf) = ecbDecryptLegacy decrypt bf \
};
INSTANCE_CIPHER(Blowfish64, "blowfish64", 8)
INSTANCE_CIPHER(Blowfish128, "blowfish128", 16)
INSTANCE_CIPHER(Blowfish256, "blowfish256", 32)
INSTANCE_CIPHER(Blowfish448, "blowfish448", 56)
-}

View File

@ -22,6 +22,9 @@ import Data.Char
import Data.Word
import qualified Data.ByteString as B
import Crypto.Error
import Crypto.Internal.ByteArray
type Pbox = Vector Word32
type Sbox = Vector Word32
@ -42,16 +45,17 @@ cipher (p, bs) b
| B.length b `mod` 8 /= 0 = error "invalid data length"
| otherwise = B.concat $ doChunks 8 (fromW32Pair . coreCrypto p bs . toW32Pair) b
initBlowfish :: B.ByteString -> Either String Context
initBlowfish b
| B.length b > (448 `div` 8) = fail "key too large"
| B.length b == 0 = keyFromByteString (B.replicate (18*4) 0)
| otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack $ b
initBlowfish :: ByteArray key => key -> CryptoFailable Context
initBlowfish key
| len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid
| len == 0 = keyFromByteString (B.replicate (18*4) 0)
| otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack . byteArrayToBS $ key
where len = byteArrayLength key
keyFromByteString :: B.ByteString -> Either String Context
keyFromByteString :: B.ByteString -> CryptoFailable Context
keyFromByteString k
| B.length k /= (18 * 4) = fail "Incorrect expanded key length."
| otherwise = return . bfMakeKey . (\ws -> V.generate 18 (ws!!)) . w8tow32 . B.unpack $ k
| B.length k /= (18 * 4) = CryptoFailed CryptoError_KeySizeInvalid
| otherwise = CryptoPassed . bfMakeKey . (\ws -> V.generate 18 (ws!!)) . w8tow32 . B.unpack $ k
where
w8tow32 :: [Word8] -> [Word32]
w8tow32 [] = []

View File

@ -13,7 +13,6 @@ module Crypto.Cipher.Camellia
import Crypto.Cipher.Camellia.Primitive
import Crypto.Cipher.Types
import Data.Byteable
-- | Camellia block cipher with 128 bit key
newtype Camellia128 = Camellia128 Camellia
@ -25,5 +24,5 @@ instance Cipher Camellia128 where
instance BlockCipher Camellia128 where
blockSize _ = 16
ecbEncrypt (Camellia128 key) ba = encrypt key (byteArrayToBS ba)
ecbDecrypt (Camellia128 key) ba = decrypt key (byteArrayToBS ba)
ecbEncrypt (Camellia128 key) = ecbEncryptLegacy encrypt key
ecbDecrypt (Camellia128 key) = ecbDecryptLegacy decrypt key

View File

@ -22,6 +22,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Crypto.Error
import Crypto.Internal.ByteArray
data Mode = Decrypt | Encrypt
@ -166,12 +167,13 @@ setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)
-- 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
initCamellia :: ByteArray key
=> key -- ^ The key to create the camellia context
-> CryptoFailable Camellia
initCamellia keyseed
| B.length keyseed /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid
| otherwise =
let (kL, _, kA, _) = setKeyInterim keyseed in
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

View File

@ -9,11 +9,11 @@ module Crypto.Cipher.DES
( DES
) where
import Data.Byteable
import Data.Word
import Crypto.Error
import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive
import Crypto.Cipher.DES.Serialization
import Crypto.Internal.ByteArray
-- | DES Context
data DES = DES Word64
@ -31,9 +31,9 @@ instance BlockCipher DES where
ecbDecrypt (DES key) = unblockify . map (decrypt key) . blockify
-}
initDES :: b -> DES
initDES :: ByteArray key => key -> CryptoFailable DES
initDES k
| len == 8 = DES key
| otherwise = error "DES: not a valid key length (valid=8)"
where len = byteableLength k
(Block key) = toW64 $ toBytes k
| len == 8 = CryptoPassed $ DES key
| otherwise = CryptoFailed $ CryptoError_KeySizeInvalid
where len = byteArrayLength k
key = byteArrayToW64BE k 0

View File

@ -19,7 +19,6 @@ import Crypto.Error
import Crypto.Internal.ByteArray
import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive
import Crypto.Cipher.DES.Serialization
-- | 3DES with 3 different keys used all in the same direction
data DES_EEE3 = DES_EEE3 Word64 Word64 Word64

View File

@ -13,6 +13,8 @@ module Crypto.Cipher.Types
-- * Cipher classes
Cipher(..)
, BlockCipher(..)
, ecbEncryptLegacy
, ecbDecryptLegacy
, StreamCipher(..)
, DataUnitOffset
, KeySizeSpecifier(..)

View File

@ -14,6 +14,8 @@ module Crypto.Cipher.Types.Block
(
-- * BlockCipher
BlockCipher(..)
, ecbEncryptLegacy
, ecbDecryptLegacy
-- * initialization vector (IV)
, IV(..)
, makeIV
@ -111,6 +113,18 @@ class Cipher cipher => BlockCipher cipher where
aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
aeadInit _ _ _ = Nothing
ecbEncryptLegacy :: ByteArray ba
=> (cipher -> ByteString -> ByteString)
-> cipher -> ba -> ba
ecbEncryptLegacy f cipher input =
byteArrayFromBS $ f cipher (byteArrayToBS input)
ecbDecryptLegacy :: ByteArray ba
=> (cipher -> ByteString -> ByteString)
-> cipher -> ba -> ba
ecbDecryptLegacy f cipher input =
byteArrayFromBS $ f cipher (byteArrayToBS input)
-- | class of block cipher with a 128 bits block size
class BlockCipher cipher => BlockCipher128 cipher where
-- | encrypt using the XTS mode.

View File

@ -19,6 +19,7 @@ module Crypto.Internal.ByteArray
, byteArrayXor
, byteArrayConcat
, byteArrayToBS
, byteArrayFromBS
, byteArrayToW64BE
) where
@ -114,6 +115,9 @@ byteArrayCopyAndFreeze bs f =
byteArrayToBS :: ByteArray bs => bs -> ByteString
byteArrayToBS bs = byteArrayCopyAndFreeze bs (\_ -> return ())
byteArrayFromBS :: ByteArray bs => ByteString -> bs
byteArrayFromBS bs = byteArrayCopyAndFreeze bs (\_ -> return ())
byteArrayToW64BE :: ByteArray bs => bs -> Int -> Word64
byteArrayToW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromBE64 <$> peek (p `plusPtr` ofs)

View File

@ -5,7 +5,7 @@
{ "path": "cbits" },
{ "path": "tests", "file_exclude_patterns": ["*.html"] },
{ "path": "benchs" },
{ "path": "gen" },
{ "path": "gen" }
],
"settings":
{

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ViewPatterns #-}
module BlockCipher
( KAT_ECB(..)
, KAT_CBC(..)
@ -15,6 +16,13 @@ module BlockCipher
) where
import Imports
import Data.Maybe
import Crypto.Cipher.Types
import qualified Data.ByteString as B
------------------------------------------------------------------------
-- KAT
------------------------------------------------------------------------
type BlockSize = Int
type KeySize = Int
@ -71,6 +79,19 @@ data KAT_AEAD = KAT_AEAD
, aeadTag :: ByteString -- ^ expected tag
} deriving (Show,Eq)
-- | all the KATs. use defaultKATs to prevent compilation error
-- from future expansion of this data structure
data KATs = KATs
{ kat_ECB :: [KAT_ECB]
, kat_CBC :: [KAT_CBC]
, kat_CFB :: [KAT_CFB]
, kat_CTR :: [KAT_CTR]
, kat_XTS :: [KAT_XTS]
, kat_AEAD :: [KAT_AEAD]
} deriving (Show,Eq)
defaultKATs = KATs [] [] [] [] [] []
testECB (_, _, cipherInit) ecbEncrypt ecbDecrypt kats =
testGroup "ECB" (concatMap katTest (zip is kats) {- ++ propTests-})
where katTest (i,d) =
@ -125,5 +146,227 @@ testKatAEAD cipherInit aeadInit aeadAppendHeader aeadEncrypt aeadDecrypt aeadFin
etag = aeadFinalize aeadEFinal (aeadTaglen d)
dtag = aeadFinalize aeadDFinal (aeadTaglen d)
------------------------------------------------------------------------
-- Properties
------------------------------------------------------------------------
-- | any sized bytestring
newtype Plaintext a = Plaintext { unPlaintext :: B.ByteString }
deriving (Show,Eq)
-- | A multiple of blocksize bytestring
newtype PlaintextBS a = PlaintextBS { unPlaintextBS :: B.ByteString }
deriving (Show,Eq)
type Key a = ByteString
-- | a ECB unit test
data ECBUnit a = ECBUnit (Key a) (PlaintextBS a)
deriving (Eq)
-- | a CBC unit test
data CBCUnit a = CBCUnit (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a CBC unit test
data CFBUnit a = CFBUnit (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a CFB unit test
data CFB8Unit a = CFB8Unit (Key a) (IV a) (Plaintext a)
deriving (Eq)
-- | a CTR unit test
data CTRUnit a = CTRUnit (Key a) (IV a) (Plaintext a)
deriving (Eq)
-- | a XTS unit test
data XTSUnit a = XTSUnit (Key a) (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a AEAD unit test
data AEADUnit a = AEADUnit (Key a) B.ByteString (Plaintext a) (Plaintext a)
deriving (Eq)
-- | Stream cipher unit test
data StreamUnit a = StreamUnit (Key a) (Plaintext a)
deriving (Eq)
instance Show (ECBUnit a) where
show (ECBUnit key b) = "ECB(key=" ++ show key ++ ",input=" ++ show b ++ ")"
instance Show (CBCUnit a) where
show (CBCUnit key iv b) = "CBC(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")"
instance Show (CFBUnit a) where
show (CFBUnit key iv b) = "CFB(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")"
instance Show (CFB8Unit a) where
show (CFB8Unit key iv b) = "CFB8(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")"
instance Show (CTRUnit a) where
show (CTRUnit key iv b) = "CTR(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")"
instance Show (XTSUnit a) where
show (XTSUnit key1 key2 iv b) = "XTS(key1=" ++ show (toBytes key1) ++ ",key2=" ++ show (toBytes key2) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")"
instance Show (AEADUnit a) where
show (AEADUnit key iv aad b) = "AEAD(key=" ++ show (toBytes key) ++ ",iv=" ++ show iv ++ ",aad=" ++ show (toBytes aad) ++ ",input=" ++ show b ++ ")"
instance Show (StreamUnit a) where
show (StreamUnit key b) = "Stream(key=" ++ show (toBytes key) ++ ",input=" ++ show b ++ ")"
-- | Generate an arbitrary valid key for a specific block cipher
generateKey :: Cipher a => Gen (Key a)
generateKey = keyFromCipher undefined
where keyFromCipher :: Cipher a => a -> Gen (Key a)
keyFromCipher cipher = do
sz <- case cipherKeySize cipher of
KeySizeRange low high -> choose (low, high)
KeySizeFixed v -> return v
KeySizeEnum l -> elements l
B.pack <$> replicateM sz arbitrary
-- | Generate an arbitrary valid IV for a specific block cipher
generateIv :: BlockCipher a => Gen (IV a)
generateIv = ivFromCipher undefined
where ivFromCipher :: BlockCipher a => a -> Gen (IV a)
ivFromCipher cipher = fromJust . makeIV . B.pack <$> replicateM (blockSize cipher) arbitrary
-- | Generate an arbitrary valid IV for AEAD for a specific block cipher
generateIvAEAD :: Gen B.ByteString
generateIvAEAD = choose (12,90) >>= \sz -> (B.pack <$> replicateM sz arbitrary)
-- | Generate a plaintext multiple of blocksize bytes
generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS = choose (1,128) >>= \size -> replicateM (size * 16) arbitrary >>= return . PlaintextBS . B.pack
-- | Generate any sized plaintext
generatePlaintext :: Gen (Plaintext a)
generatePlaintext = choose (0,324) >>= \size -> replicateM size arbitrary >>= return . Plaintext . B.pack
instance BlockCipher a => Arbitrary (ECBUnit a) where
arbitrary = ECBUnit <$> generateKey
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CBCUnit a) where
arbitrary = CBCUnit <$> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CFBUnit a) where
arbitrary = CFBUnit <$> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CFB8Unit a) where
arbitrary = CFB8Unit <$> generateKey <*> generateIv <*> generatePlaintext
instance BlockCipher a => Arbitrary (CTRUnit a) where
arbitrary = CTRUnit <$> generateKey
<*> generateIv
<*> generatePlaintext
instance BlockCipher a => Arbitrary (XTSUnit a) where
arbitrary = XTSUnit <$> generateKey
<*> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (AEADUnit a) where
arbitrary = AEADUnit <$> generateKey
<*> generateIvAEAD
<*> generatePlaintext
<*> generatePlaintext
instance StreamCipher a => Arbitrary (StreamUnit a) where
arbitrary = StreamUnit <$> generateKey
<*> generatePlaintext
testBlockCipherBasic :: BlockCipher a => a -> [TestTree]
testBlockCipherBasic cipher = [ testProperty "ECB" ecbProp ]
where ecbProp = toTests cipher
toTests :: BlockCipher a => a -> (ECBUnit a -> Bool)
toTests _ = testProperty_ECB
testProperty_ECB (ECBUnit (cipherInit -> ctx) (toBytes -> plaintext)) =
plaintext `assertEq` ecbDecrypt ctx (ecbEncrypt ctx plaintext)
testBlockCipherModes :: BlockCipher a => a -> [TestTree]
testBlockCipherModes cipher =
[ testProperty "CBC" cbcProp
, testProperty "CFB" cfbProp
, testProperty "CFB8" cfb8Prop
, testProperty "CTR" ctrProp
]
where (cbcProp,cfbProp,cfb8Prop,ctrProp) = toTests cipher
toTests :: BlockCipher a
=> a
-> ((CBCUnit a -> Bool), (CFBUnit a -> Bool), (CFB8Unit a -> Bool), (CTRUnit a -> Bool))
toTests _ = (testProperty_CBC
,testProperty_CFB
--,testProperty_CFB8
,testProperty_CTR
)
testProperty_CBC (CBCUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) =
plaintext `assertEq` cbcDecrypt ctx testIV (cbcEncrypt ctx testIV plaintext)
testProperty_CFB (CFBUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) =
plaintext `assertEq` cfbDecrypt ctx testIV (cfbEncrypt ctx testIV plaintext)
{-
testProperty_CFB8 (CFB8Unit (cipherInit -> ctx) testIV (toBytes -> plaintext)) =
plaintext `assertEq` cfb8Decrypt ctx testIV (cfb8Encrypt ctx testIV plaintext)
-}
testProperty_CTR (CTRUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) =
plaintext `assertEq` ctrCombine ctx testIV (ctrCombine ctx testIV plaintext)
testBlockCipherAEAD :: BlockCipher a => a -> [TestTree]
testBlockCipherAEAD cipher =
[ testProperty "OCB" (aeadProp AEAD_OCB)
, testProperty "CCM" (aeadProp AEAD_CCM)
, testProperty "EAX" (aeadProp AEAD_EAX)
, testProperty "CWC" (aeadProp AEAD_CWC)
, testProperty "GCM" (aeadProp AEAD_GCM)
]
where aeadProp = toTests cipher
toTests :: BlockCipher a => a -> (AEADMode -> AEADUnit a -> Bool)
toTests _ = testProperty_AEAD
testProperty_AEAD mode (AEADUnit (cipherInit -> ctx) testIV (toBytes -> aad) (toBytes -> plaintext)) =
case aeadInit mode ctx testIV of
Just iniAead ->
let aead = aeadAppendHeader iniAead aad
(eText, aeadE) = aeadEncrypt aead plaintext
(dText, aeadD) = aeadDecrypt aead eText
eTag = aeadFinalize aeadE (blockSize ctx)
dTag = aeadFinalize aeadD (blockSize ctx)
in (plaintext `assertEq` dText) && (toBytes eTag `assertEq` toBytes dTag)
Nothing -> True
{-
testBlockCipherXTS :: BlockCipher a => a -> [TestTree]
testBlockCipherXTS cipher = [testProperty "XTS" xtsProp]
where xtsProp = toTests cipher
toTests :: BlockCipher a => a -> (XTSUnit a -> Bool)
toTests _ = testProperty_XTS
testProperty_XTS (XTSUnit (cipherInit -> ctx1) (cipherInit -> ctx2) testIV (toBytes -> plaintext))
| blockSize ctx1 == 16 = plaintext `assertEq` xtsDecrypt (ctx1, ctx2) testIV 0 (xtsEncrypt (ctx1, ctx2) testIV 0 plaintext)
| otherwise = True
-}
testBlockCipherXTS = []
-- | Test a generic block cipher for properties
-- related to block cipher modes.
testModes :: BlockCipher a => a -> [TestTree]
testModes cipher =
[ testGroup "decrypt.encrypt==id"
(testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher ++ testBlockCipherXTS cipher)
]
-- | Return tests for a specific blockcipher and a list of KATs
testBlockCipher :: BlockCipher a => KATs -> a -> TestTree
testBlockCipher kats cipher = testGroup (cipherName cipher)
( (if kats == defaultKATs then [] else [testKATs kats cipher])
++ testModes cipher
)
assertEq :: ByteString -> ByteString -> Bool
assertEq b1 b2 | b1 /= b2 = error ("b1: " ++ show b1 ++ " b2: " ++ show b2)
| otherwise = True
is :: [Int]
is = [1..]

View File

@ -1,8 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module KAT_Blowfish where
--import Crypto.Cipher.Blowfish
--import Data.ByteString.Char8 () -- orphan IsString for older bytestring versions
import Crypto.Cipher.Blowfish
import Imports
import BlockCipher
@ -44,7 +43,6 @@ vectors_ecb = -- key plaintext cipher
]
{-
kats = defaultKATs { kat_ECB = vectors_ecb }
main = defaultMain
[ testBlockCipher kats (undefined :: Blowfish64)