module Test.SHA
( makeSHA1Tests
, makeSHA224Tests
, makeSHA256Tests
, makeSHA384Tests
, makeSHA512Tests
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Maybe (maybeToList)
import Data.List (isPrefixOf)
import Data.Serialize (encode)
import Crypto.Classes
import Control.Monad (filterM, liftM)
import Test.Crypto
import Test.ParseNistKATs
import System.Directory (getDirectoryContents, doesFileExist)
import System.FilePath (takeFileName, combine, (</>))
import Paths_crypto_api_tests
import Test.HUnit.Base (assertEqual)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.Providers.HUnit (testCase)
makeSHA1Tests :: Hash c d => d -> IO [Test]
makeSHA1Tests d = liftM (++ [makeHashPropTests d]) (getTests d "SHA1")
makeSHA224Tests :: Hash c d => d -> IO [Test]
makeSHA224Tests d = liftM (++ [makeHashPropTests d]) (getTests d "SHA224")
makeSHA256Tests :: Hash c d => d -> IO [Test]
makeSHA256Tests d = liftM (++ [makeHashPropTests d]) (getTests d "SHA256")
makeSHA384Tests :: Hash c d => d -> IO [Test]
makeSHA384Tests d = liftM (++ [makeHashPropTests d]) (getTests d "SHA384")
makeSHA512Tests :: Hash c d => d -> IO [Test]
makeSHA512Tests d = liftM (++ [makeHashPropTests d]) (getTests d "SHA512")
getTests :: Hash c d => d -> String -> IO [Test]
getTests d prefix = do
dataDir <- getDataFileName ("Test" </> "KAT_SHA")
filesAndDirs <- getDirectoryContents dataDir
files <- filterM doesFileExist (map (combine dataDir) filesAndDirs)
let interestingFiles = filter ((prefix `isPrefixOf`) . takeFileName) files
recEs <- mapM (liftM (parseCategories "Len") . readFile) interestingFiles
let nistTests = concatMap snd (concat recEs) :: [NistTest]
katPairs = concatMap (maybeToList . hashNistTestToPairs) nistTests
strict = encode . hashFunc' d
lazy = encode . hashFunc d
name i = "Nist" ++ prefix ++ "-" ++ (show i)
chunkify bs = if B.length bs == 0 then [] else let (a,b) = B.splitAt 37 bs in a : chunkify b
toLazy = L.fromChunks . chunkify
tests = [testCase (name cnt) $ assertEqual (name cnt) (strict msg, lazy (toLazy msg)) (md,md) | (msg,md) <- katPairs | cnt <- [1..]]
return tests
hashNistTestToPairs :: NistTest -> Maybe (B.ByteString,B.ByteString)
hashNistTestToPairs nt = do
msg <- lookup "Msg" nt
md <- lookup "MD" nt
len <- liftM (flip div 8 . read) (lookup "Len" nt)
return (B.take len (hexStringToBS msg), hexStringToBS md)