crypto-api-tests 0.1 → 0.2
raw patch · 5 files changed
+118/−114 lines, 5 filesdep ~crypto-apidep ~directorydep ~test-framework-quickcheck2PVP ok
version bump matches the API change (PVP)
Dependency ranges changed: crypto-api, directory, test-framework-quickcheck2
API changes (from Hackage documentation)
Files
- Test/AES.hs +8/−7
- Test/Crypto.hs +69/−68
- Test/ParseNistKATs.hs +30/−28
- Test/TwoFish.hs +8/−8
- crypto-api-tests.cabal +3/−3
Test/AES.hs view
@@ -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
Test/Crypto.hs view
@@ -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
Test/ParseNistKATs.hs view
@@ -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)
Test/TwoFish.hs view
@@ -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
crypto-api-tests.cabal view
@@ -1,5 +1,5 @@ name: crypto-api-tests-version: 0.1+version: 0.2 license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -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: