diff --git a/Test/AES.hs b/Test/AES.hs --- a/Test/AES.hs +++ b/Test/AES.hs @@ -5,7 +5,8 @@ import Control.Monad (forM, liftM, filterM) import Crypto.Classes -import Crypto.Modes +import Crypto.Types +import qualified Crypto.Modes as M import qualified Data.ByteString as B import qualified Data.Serialize as Ser import Data.List (isInfixOf) @@ -102,12 +103,12 @@ funcAndBool x = (sigToF x, isEnc x) where sigToF :: BlockCipher k => String -> Maybe (k -> IV k -> B.ByteString -> (B.ByteString, IV k)) - sigToF "CBCe" = Just cbc' - sigToF "CBCd" = Just unCbc' - sigToF "OFBe" = Just ofb' - sigToF "OFBd" = Just unOfb' - sigToF "CFBe" = Just cfb' - sigToF "CFBd" = Just unCfb' + sigToF "CBCe" = Just cbc + sigToF "CBCd" = Just unCbc + sigToF "OFBe" = Just ofb + sigToF "OFBd" = Just unOfb + sigToF "CFBe" = Just cfb + sigToF "CFBd" = Just unCfb sigToF _ = Nothing diff --git a/Test/Crypto.hs b/Test/Crypto.hs --- a/Test/Crypto.hs +++ b/Test/Crypto.hs @@ -20,21 +20,22 @@ algorithms. -} module Test.Crypto - ( - -- * Block Cipher KATs - makeBlockCipherPropTests - -- * Hash property tests - , makeHashPropTests - -- * Utils - , hexStringToBS - -- * Re-exported + ( + -- * Block Cipher KATs + makeBlockCipherPropTests + -- * Hash property tests + , makeHashPropTests + -- * Utils + , hexStringToBS + -- * Re-exported , defaultMain - ) where + ) where import Test.QuickCheck import Test.ParseNistKATs import Crypto.Classes -import Crypto.Modes +import Crypto.Types +import qualified Crypto.Modes as M import Crypto.Padding import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Lazy as L @@ -66,20 +67,20 @@ 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 + f = hashFunc d + f' = hashFunc' d in f lps == f' strict -- |Verify the Serialize and Binary instances result -- in bytestrings of the correct length for a given digest prop_DigestLen :: Hash c d => d -> L.ByteString -> Bool prop_DigestLen d lps = - fromIntegral o == L.length h && o == B.length h' + 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 + 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 -- |Verify the Serilize and Binary (decode . encode = id) prop_GetPutHash :: Hash c d => d -> L.ByteString -> Bool @@ -116,30 +117,30 @@ -- * The digest (output) length is byte aligned (also needed by 'crypto-api') 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) - ] + 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) + ] -- |some generic blockcipher tests goodKey :: BlockCipher k => k -> B.ByteString -> Bool goodKey k bs = - case (getKey k bs `asTypeOf` Just k) of - Nothing -> False - Just _ -> True + 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' -- Pad out (or trim) material to correct length (for testing only!) 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' + 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 @@ -152,8 +153,8 @@ 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 + 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)) -> -- enc mode @@ -164,16 +165,16 @@ B.ByteString -> -- The message Property prop_BlockMode_EncDec_ID enc dec k kBS ivBS msg = goodKey k kBS && isRight (bIV k ivBS) ==> - let key = bKey k kBS + 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) +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 unCtr -- FIXME siv tests @@ -190,37 +191,37 @@ (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 -> + 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 + 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_OFBStrictLazyEq = prop_StrictLazyEq ofb M.ofb unOfb M.unOfb +prop_CBCStrictLazyEq = prop_StrictLazyEq cbc M.cbc unCbc M.unCbc +prop_CFBStrictLazyEq = prop_StrictLazyEq cfb M.cfb unCfb M.unCfb +prop_CTRStrictLazyEq = prop_StrictLazyEq ctr (M.ctr incIV) unCtr (M.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 + let key = bKey k kBS + msg' = takeBlockSize k msg + ctStrict = ecb key (l2b msg') + ctLazy = M.ecb key msg' + ptStrict = unEcb key (l2b msg') + ptLazy = M.unEcb key msg' + in ctStrict == l2b ctLazy && ptStrict == l2b ptLazy -- | Build test groups for encrypt/decrypt identity and -- equality of operations on strict and lazy ByteStrings. @@ -230,17 +231,17 @@ -- but more testing isn't exactly a bad thing. 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) + 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)] :[] -- *Known Answer Tests diff --git a/Test/ParseNistKATs.hs b/Test/ParseNistKATs.hs --- a/Test/ParseNistKATs.hs +++ b/Test/ParseNistKATs.hs @@ -6,40 +6,40 @@ -- -- NIST KAT files are composed of properties, such as: -- --- > [SHA-1] --- > [PredictionResistance = True] --- > [EntropyInputSize = 128] +-- > [SHA-1] +-- > [PredictionResistance = True] +-- > [EntropyInputSize = 128] -- -- and individual known answer tests using these properties, ex: -- --- > COUNT = 0 --- > EntropyInput = 7 --- > PersonalizationString = --- > Result = 8 +-- > COUNT = 0 +-- > EntropyInput = 7 +-- > PersonalizationString = +-- > Result = 8 -- > --- > COUNT = 1 --- > EntropyInput = 4 --- > PersonalizationString = --- > Result = 2 +-- > COUNT = 1 +-- > EntropyInput = 4 +-- > PersonalizationString = +-- > Result = 2 -- -- Using 'many parseCategory' this input would be converted to a -- single element list of 'TestCategory': -- --- > [([("SHA-1",""), ("PredictionResistance", "True"), ("EntropyInputSize", "128")], --- > [ [("COUNT", "0"), ("EntropyInput", "7"), ("PersonalizationString", ""), ("Result", "8")], --- > , [("COUNT", "1"), ("EntropyInput", "4"), ("PersonalizationString", ""), ("Result", "2")]])] +-- > [([("SHA-1",""), ("PredictionResistance", "True"), ("EntropyInputSize", "128")], +-- > [ [("COUNT", "0"), ("EntropyInput", "7"), ("PersonalizationString", ""), ("Result", "8")], +-- > , [("COUNT", "1"), ("EntropyInput", "4"), ("PersonalizationString", ""), ("Result", "2")]])] -- -- that is, a list of tuples, the first element is a list of properties (key/value pairs) and -- the second element is a list of tests. Each test is itself a list of records (key/value pairs). -- Properties apply to all tests contained in the second element of the tuple. module Test.ParseNistKATs - ( parseCategories --, parseCategory, parseProperty - , Properties, Record, NistTest, TypedTest, TestCategory - ) where + ( parseCategories --, parseCategory, parseProperty + , Properties, Record, NistTest, TypedTest, TestCategory + ) where import Data.Char (isSpace) import Data.Maybe (listToMaybe) -import Control.Arrow (second) +import Control.Arrow (first, second) type Properties = [(String, String)] type Record = (String, String) @@ -50,30 +50,32 @@ parseCategories :: String -> String -> [(Properties, [NistTest])] parseCategories delim file = - getCategories delim . elimWhite . elimComments . lines $ file + getCategories delim . elimWhite . elimComments . lines $ file elimComments = filter ((/= Just '#') . listToMaybe) elimWhite = map (filter (/= '\r')) . filter (notNull . filter (not . isSpace)) getCategories :: String -> [String] -> [(Properties, [NistTest])] getCategories _ [] = [] getCategories delim ls = - let (tt, rest) = getCategory delim ls - in tt : getCategories delim rest + let (tt, rest) = getCategory delim ls + in tt : getCategories delim rest getCategory delim ls = - let (props,rest1) = break ((/= Just '[') . listToMaybe) ls - (tests,rest2) = break ((== Just '[') . listToMaybe) rest1 - in ((map parseProp props, parseTests delim tests), rest2) -parseProp = second (drop 1) . break (== '=') . filter (`notElem` "[]") + let (props,rest1) = break ((/= Just '[') . listToMaybe) ls + (tests,rest2) = break ((== Just '[') . listToMaybe) rest1 + in ((map parseProp props, parseTests delim tests), rest2) +parseProp = first trim . second trim . second (drop 1) . break (== '=') . filter (`notElem` "[]") parseTests :: String -> [String] -> [NistTest] parseTests delim = filter notNull . chunk ((== delim) . fst) . map parseRecord parseRecord = second (drop 1) . break (== '=') . filter (not . isSpace) notNull = not . null +trim :: String -> String +trim = dropWhile isSpace . (reverse . dropWhile isSpace . reverse) chunk :: (a -> Bool) -> [a] -> [[a]] chunk f xs = snd (go xs) where go [] = ([],[]) go (a:as) = if f a - then let (t,ts) = go as in ([], (a:t):ts) - else let (t, ts) = go as - in (a:t, ts) + then let (t,ts) = go as in ([], (a:t):ts) + else let (t, ts) = go as + in (a:t, ts) diff --git a/Test/TwoFish.hs b/Test/TwoFish.hs --- a/Test/TwoFish.hs +++ b/Test/TwoFish.hs @@ -6,7 +6,7 @@ import Data.Maybe (maybeToList) import qualified Data.ByteString as B import Crypto.Classes -import Crypto.Modes +import Crypto.Types import qualified Data.Serialize as Ser import Test.Crypto import Control.Monad (forM, liftM, filterM) @@ -45,7 +45,7 @@ i <- lookup "I" rs let k' = toKey k u name = "CBC-D-" ++ i - return $ testCase name $ assertEqual name (fst (unCbc' k' iv ct)) pt + return $ testCase name $ assertEqual name (fst (unCbc k' iv ct)) pt buildTestFunc u "CBC_E_M" (_,rs) = do k <- lookupB "KEY" rs Right iv <- liftM Ser.decode (lookupB "IV" rs) @@ -54,10 +54,10 @@ i <- lookup "I" rs let k' = toKey k u name = "CBC-E-" ++ i - return $ testCase name $ assertEqual name (fst (cbc' k' iv pt)) ct -buildTestFunc u "ECB_D_M" (_,rs) = buildTestBasic u "ECB-D" rs False unEcb' -buildTestFunc u "ECB_E_M" (_,rs) = buildTestBasic u "ECB-E" rs True ecb' -buildTestFunc u "ECB_TLB" (_,rs) = (buildTestBasic u "ECB-TLB-E" rs True ecb') + return $ testCase name $ assertEqual name (fst (cbc k' iv pt)) ct +buildTestFunc u "ECB_D_M" (_,rs) = buildTestBasic u "ECB-D" rs False unEcb +buildTestFunc u "ECB_E_M" (_,rs) = buildTestBasic u "ECB-E" rs True ecb +buildTestFunc u "ECB_TLB" (_,rs) = (buildTestBasic u "ECB-TLB-E" rs True ecb) buildTestFunc u "ECB_VK" (ps,rs) = do pt <- lookupB "PT" ps k <- lookupB "KEY" rs @@ -65,7 +65,7 @@ i <- lookup "I" rs let k' = toKey k u name = "ECB-E-VK" ++ i - return $ testCase name $ assertEqual name (ecb' k' pt) ct + return $ testCase name $ assertEqual name (ecb k' pt) ct buildTestFunc u "ECB_VT" (ps,rs) = do k <- lookupB "KEY" ps pt <- lookupB "PT" rs @@ -73,7 +73,7 @@ i <- lookup "I" rs let k' = toKey k u name = "ECB-E-VT-" ++ i - return $ testCase name $ assertEqual name (ecb' k' pt) ct + return $ testCase name $ assertEqual name (ecb k' pt) ct buildTestBasic :: BlockCipher k => k -> String -> [Record] -> Bool -> (k -> B.ByteString -> B.ByteString) -> Maybe Test buildTestBasic u name rs b func = do diff --git a/crypto-api-tests.cabal b/crypto-api-tests.cabal --- a/crypto-api-tests.cabal +++ b/crypto-api-tests.cabal @@ -1,5 +1,5 @@ name: crypto-api-tests -version: 0.1 +version: 0.2 license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson @@ -31,8 +31,8 @@ Library - build-depends: base >= 4 && < 5, test-framework-quickcheck2 >= 0.2, - directory >= 1.0.1.0 && < 1.2, filepath, crypto-api >= 0.7, + build-depends: base >= 4 && < 5, test-framework-quickcheck2 >= 0.3, + directory >= 1.0.1.0, filepath, crypto-api, cereal, bytestring, test-framework >= 0.4, test-framework-hunit >= 0.2, HUnit, QuickCheck >= 2.4 ghc-options: