module Test.Crypto
(
makeBlockCipherPropTests
, makeHashPropTests
, hexStringToBS
, defaultMain
) where
import Test.QuickCheck
import Test.ParseNistKATs
import Crypto.Classes
import Crypto.Modes
import Crypto.Padding
import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B
import Control.Monad (forM)
import qualified Data.Serialize as Ser
import Numeric (readHex)
import Control.Arrow (first,second)
import Test.HUnit.Base (assertEqual)
import Test.Framework (Test, testGroup, defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.Providers.HUnit (testCase)
instance Arbitrary B.ByteString where
arbitrary = do
len <- choose (0,4096) :: Gen Int
words <- forM [0..len] (\_ -> arbitrary)
return $ B.pack words
instance Arbitrary L.ByteString where
arbitrary = do
len <- choose (0,10) :: Gen Int
chunks <- vector len
return $ L.fromChunks chunks
prop_LazyStrictEqual :: Hash c d => d -> L.ByteString -> Bool
prop_LazyStrictEqual d lps =
let strict = B.concat $ L.toChunks lps
f = hashFunc d
f' = hashFunc' d
in f lps == f' strict
prop_DigestLen :: Hash c d => d -> L.ByteString -> Bool
prop_DigestLen d lps =
fromIntegral o == L.length h && o == B.length h'
where f = hashFunc d
f' = hashFunc' d
h = L.fromChunks [Ser.encode $ f lps]
h' = Ser.encode . f' . B.concat . L.toChunks $ lps
o = (outputLength `for` d) `div` 8
prop_GetPutHash :: Hash c d => d -> L.ByteString -> Bool
prop_GetPutHash d lps = Ser.decode (Ser.encode h') == Right h'
where
f = hashFunc d
f' = hashFunc' d
h = f lps
h' = f' . B.concat . L.toChunks $ lps
prop_BlockLengthIsByteAligned :: Hash c d => d -> Bool
prop_BlockLengthIsByteAligned d = blockLength .::. d `rem` 8 == 0
prop_OutputLengthIsByteAligned :: Hash c d => d -> Bool
prop_OutputLengthIsByteAligned d = blockLength .::. d `rem` 8 == 0
makeHashPropTests :: Hash c d => d -> Test
makeHashPropTests d =
testGroup "Cryptographic Digest Property Tests"
[ testProperty "LazyStrictEqual" (prop_LazyStrictEqual d)
, testProperty "DigestLen" (prop_DigestLen d)
, testProperty "GetPutHash" (prop_GetPutHash d)
, testProperty "BlockLengthIsByteAligned"(prop_BlockLengthIsByteAligned d)
, testProperty "OutputLengthIsByteAligned" (prop_OutputLengthIsByteAligned d)
]
goodKey :: BlockCipher k => k -> B.ByteString -> Bool
goodKey k bs =
case (getKey k bs `asTypeOf` Just k) of
Nothing -> False
Just _ -> True
bKey k bs = let Just k' = (getKey k bs `asTypeOf` Just k) in k'
getKey :: BlockCipher k => k -> B.ByteString -> Maybe k
getKey k bs =
let l = (keyLength `for` k) `div` 8
b' = B.take l (B.concat $ replicate l (B.append bs (B.singleton 0)))
in buildKey b'
bIV :: BlockCipher k => k -> B.ByteString -> Either String (IV k)
bIV k bs = Ser.decode bs
isRight (Right _) = True
isRight (Left _) = False
comparePadded :: BlockCipher k => k -> (k -> B.ByteString -> B.ByteString) -> (k -> B.ByteString -> B.ByteString) -> B.ByteString -> Bool
comparePadded k enc dec msg = unpadESP (dec k (enc k (padESPBlockSize k msg))) == Just msg
prop_ECBEncDecID :: BlockCipher k => k -> B.ByteString -> B.ByteString -> Property
prop_ECBEncDecID k kBS msg = goodKey k kBS ==>
let key = bKey k kBS
in comparePadded key ecb' unEcb' msg
prop_BlockMode_EncDec_ID :: BlockCipher k =>
(k -> IV k -> B.ByteString -> (B.ByteString, IV k)) ->
(k -> IV k -> B.ByteString -> (B.ByteString, IV k)) ->
k ->
B.ByteString ->
B.ByteString ->
B.ByteString ->
Property
prop_BlockMode_EncDec_ID enc dec k kBS ivBS msg = goodKey k kBS && isRight (bIV k ivBS) ==>
let key = bKey k kBS
Right iv = bIV k ivBS
msg' = padESPBlockSize key msg
(ct, iv2) = enc key iv msg'
in dec key iv ct == (msg', iv2)
prop_CBCEncDecID = prop_BlockMode_EncDec_ID cbc' unCbc'
prop_CFBEncDecID = prop_BlockMode_EncDec_ID cfb' unCfb'
prop_OFBEncDecID = prop_BlockMode_EncDec_ID ofb' unOfb'
prop_CTREncDecID = prop_BlockMode_EncDec_ID (ctr' incIV) (unCtr' incIV)
takeBlockSize :: BlockCipher k => k -> L.ByteString -> L.ByteString
takeBlockSize k bs = L.take (len (len `rem` bLen)) bs
where
len = L.length bs
bLen = fromIntegral $ blockSizeBytes `for` k
l2b = B.concat . L.toChunks
prop_StrictLazyEq :: BlockCipher k =>
(k -> IV k -> B.ByteString -> (B.ByteString,IV k)) ->
(k -> IV k -> L.ByteString -> (L.ByteString,IV k)) ->
(k -> IV k -> B.ByteString -> (B.ByteString,IV k)) ->
(k -> IV k -> L.ByteString -> (L.ByteString,IV k)) ->
k ->
B.ByteString ->
B.ByteString ->
L.ByteString ->
Property
prop_StrictLazyEq enc' enc dec' dec k kBS ivBS msg = goodKey k kBS &&
isRight (bIV k ivBS) ==>
let key = bKey k kBS
Right iv = bIV k ivBS
msg' = takeBlockSize k msg
ctStrict = enc' key iv (l2b msg')
ctLazy = enc key iv msg'
ptStrict = dec' key iv (l2b msg')
ptLazy = dec key iv msg'
in ctStrict == first l2b ctLazy && ptStrict == first l2b ptLazy
prop_OFBStrictLazyEq = prop_StrictLazyEq ofb' ofb unOfb' unOfb
prop_CBCStrictLazyEq = prop_StrictLazyEq cbc' cbc unCbc' unCbc
prop_CFBStrictLazyEq = prop_StrictLazyEq cfb' cfb unCfb' unCfb
prop_CTRStrictLazyEq = prop_StrictLazyEq (ctr' incIV) (ctr incIV) (unCtr' incIV) (unCtr incIV)
prop_ECBStrictLazyEq :: BlockCipher k => k -> B.ByteString -> L.ByteString -> Property
prop_ECBStrictLazyEq k kBS msg = goodKey k kBS ==>
let key = bKey k kBS
msg' = takeBlockSize k msg
ctStrict = ecb' key (l2b msg')
ctLazy = ecb key msg'
ptStrict = unEcb' key (l2b msg')
ptLazy = unEcb key msg'
in ctStrict == l2b ctLazy && ptStrict == l2b ptLazy
makeBlockCipherPropTests :: BlockCipher k => k -> [Test]
makeBlockCipherPropTests k =
testGroup "Block Cipher tests (ident)"
[ testProperty "ECBEncDecID" (prop_ECBEncDecID k)
, testProperty "CBCEncDecID" (prop_CBCEncDecID k)
, testProperty "CFBEncDecID" (prop_CFBEncDecID k)
, testProperty "OFBEncDecID" (prop_OFBEncDecID k)
, testProperty "CTREncDecID" (prop_CTREncDecID k)] :
testGroup "Block Cipher tests (lazy/string bytestring equality)"
[ testProperty "ECBStringLazyEq" (prop_ECBStrictLazyEq k)
, testProperty "CBCStrictLazyEq" (prop_CBCStrictLazyEq k)
, testProperty "CFBStrictLazyEq" (prop_CFBStrictLazyEq k)
, testProperty "OFBStrictLazyEq" (prop_OFBStrictLazyEq k)
, testProperty "CTRStrictLazyEq" (prop_CTRStrictLazyEq k)] :[]
toD :: Hash c d => d -> String -> d
toD d str = (fromRight . Ser.decode . hexStringToBS $ str) `asTypeOf` d
where
fromRight (Right x) = x
hexStringToBS :: String -> B.ByteString
hexStringToBS [] = B.empty
hexStringToBS (_:[]) = error "Not an even number of hex characters in input to hexStringToBS!"
hexStringToBS (a:b:xs) = B.cons (rHex (a:b:[])) (hexStringToBS xs)
where
rHex = fst . head . readHex