1{-# LANGUAGE CPP #-}
2
3module HPACKSpec where
4
5#if __GLASGOW_HASKELL__ < 709
6import Control.Applicative ((<$>))
7#endif
8import Control.Monad (forM_, filterM)
9import Data.Aeson (eitherDecode)
10import qualified Data.ByteString.Lazy as BL
11import Data.List (isPrefixOf, isSuffixOf)
12import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
13import System.FilePath ((</>))
14import Test.Hspec
15
16import JSON
17import HPACKDecode
18
19testDir :: FilePath
20testDir = "test-hpack/hpack-test-case"
21
22getTestFiles :: FilePath -> IO [FilePath]
23getTestFiles dir = do
24    subdirs0 <- valid <$> getDirectoryContents dir
25    subdirs1 <- filterM doesDirectoryExist subdirs0
26    concat <$> mapM getTestFiles' subdirs1
27  where
28    valid = map (testDir </>) . filter ("raw-data" /=) . filter (not . isPrefixOf ".")
29
30getTestFiles' :: FilePath -> IO [FilePath]
31getTestFiles' subdir = do
32    files0 <- valid <$> getDirectoryContents subdir
33    filterM doesFileExist files0
34  where
35    valid = map (subdir </>) . filter (isSuffixOf ".json")
36
37test :: FilePath -> IO (Maybe String)
38test file = do
39    bs <- BL.readFile file
40    let etc = eitherDecode bs :: Either String Test
41    case etc of
42        Left e   -> return $ Just $ file ++ ": " ++ e
43        Right tc -> do
44            res <- run False tc
45            case res of
46                Pass   -> return Nothing
47                Fail e -> return $ Just $ file ++ ": " ++ e
48
49spec :: Spec
50spec = do
51    describe "decodeRequestHeader" $ do
52        it "decodes headers in request" $ do
53            files <- getTestFiles testDir
54            forM_ files $ \file -> do
55                putStrLn file
56                test file `shouldReturn` Nothing
57