diff --git a/test/Network/Wai/ParseSpec.hs b/test/Network/Wai/ParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Wai/ParseSpec.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Wai.ParseSpec (main, spec) where + +import Test.Hspec +import Test.HUnit + +import System.IO +import Data.Monoid +import qualified Data.IORef as I +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as L +import qualified Data.Text as TS +import qualified Data.Text.Encoding as TE +import Control.Monad.Trans.Resource (withInternalState, runResourceT) + +import Network.Wai +import Network.Wai.Test +import Network.Wai.Parse +import WaiExtraSpec (toRequest) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "parseContentType" $ do + let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z) + mapM_ go + [ ("text/plain", "text/plain", []) + , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")]) + , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")]) + ] + it "parseHttpAccept" caseParseHttpAccept + describe "parseRequestBody" $ do + caseParseRequestBody + it "multipart with plus" caseMultipartPlus + it "multipart with multiple attributes" caseMultipartAttrs + it "urlencoded with plus" caseUrlEncPlus + describe "dalvik multipart" $ do + it "non-chunked" $ dalvikHelper True + it "chunked" $ dalvikHelper False + +caseParseHttpAccept :: Assertion +caseParseHttpAccept = do + let input = "text/plain; q=0.5, text/html;charset=utf-8, text/*;q=0.8;ext=blah, text/x-dvi; q=0.8, text/x-c" + expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"] + expected @=? parseHttpAccept input + +parseRequestBody' :: BackEnd file + -> SRequest + -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)]) +parseRequestBody' sink (SRequest req bod) = + case getRequestBodyType req of + Nothing -> return ([], []) + Just rbt -> do + ref <- I.newIORef $ L.toChunks bod + let rb = I.atomicModifyIORef ref $ \chunks -> + case chunks of + [] -> ([], S.empty) + x:y -> (y, x) + sinkRequestBody sink rbt rb + +caseParseRequestBody :: Spec +caseParseRequestBody = do + it "parsing post x-www-form-urlencoded" $ do + let content1 = "foo=bar&baz=bin" + let ctype1 = "application/x-www-form-urlencoded" + result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1 + result1 `shouldBe` ([("foo", "bar"), ("baz", "bin")], []) + + let ctype2 = "multipart/form-data; boundary=AaB03x" + let expectedsmap2 = + [ ("title", "A File") + , ("summary", "This is my file\nfile test") + ] + let textPlain = "text/plain; charset=iso-8859-1" + let expectedfile2 = + [("document", FileInfo "b.txt" textPlain "This is a file.\nIt has two lines.")] + let expected2 = (expectedsmap2, expectedfile2) + + it "parsing post multipart/form-data" $ do + result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2 + result2 `shouldBe` expected2 + + it "parsing post multipart/form-data 2" $ do + result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2 + result2' `shouldBe` expected2 + + + let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh" + let expectedsmap3 = [] + let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")] + let expected3 = (expectedsmap3, expectedfile3) + + it "parsing actual post multipart/form-data" $ do + result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3 + result3 `shouldBe` expected3 + + it "parsing actual post multipart/form-data 2" $ do + result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3 + result3' `shouldBe` expected3 + where + content2 = + "--AaB03x\n" + <> "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" + <> "Content-Type: text/plain; charset=iso-8859-1\n\n" + <> "This is a file.\n" + <> "It has two lines.\n" + <> "--AaB03x\n" + <> "Content-Disposition: form-data; name=\"title\"\n" + <> "Content-Type: text/plain; charset=iso-8859-1\n\n" + <> "A File\n" + <> "--AaB03x\n" + <> "Content-Disposition: form-data; name=\"summary\"\n" + <> "Content-Type: text/plain; charset=iso-8859-1\n\n" + <> "This is my file\n" + <> "file test\n" + <> "--AaB03x--" + content3 = + "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n" + <> "Content-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\n" + <> "Content-Type: application/octet-stream\r\n\r\n" + <> "Photo blog using Hack.\n\r\n" + <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n" + +caseMultipartPlus :: Assertion +caseMultipartPlus = do + result <- parseRequestBody' lbsBackEnd $ toRequest ctype content + result @?= ([("email", "has+plus")], []) + where + content = + "--AaB03x\n" <> + "Content-Disposition: form-data; name=\"email\"\n" <> + "Content-Type: text/plain; charset=iso-8859-1\n\n" <> + "has+plus\n" <> + "--AaB03x--" + ctype = "multipart/form-data; boundary=AaB03x" + +caseMultipartAttrs :: Assertion +caseMultipartAttrs = do + result <- parseRequestBody' lbsBackEnd $ toRequest ctype content + result @?= ([("email", "has+plus")], []) + where + content = + "--AaB03x\n" <> + "Content-Disposition: form-data; name=\"email\"\n" <> + "Content-Type: text/plain; charset=iso-8859-1\n\n" <> + "has+plus\n" <> + "--AaB03x--" + ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x" + +caseUrlEncPlus :: Assertion +caseUrlEncPlus = do + result <- runResourceT $ withInternalState $ \state -> + parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content + result @?= ([("email", "has+plus")], []) + where + content = "email=has%2Bplus" + ctype = "application/x-www-form-urlencoded" + +dalvikHelper :: Bool -> Assertion +dalvikHelper includeLength = do + let headers' = + [ ("content-type", "multipart/form-data;boundary=*****") + , ("GATEWAY_INTERFACE", "CGI/1.1") + , ("PATH_INFO", "/") + , ("QUERY_STRING", "") + , ("REMOTE_ADDR", "192.168.1.115") + , ("REMOTE_HOST", "ganjizza") + , ("REQUEST_URI", "http://192.168.1.115:3000/") + , ("REQUEST_METHOD", "POST") + , ("HTTP_CONNECTION", "Keep-Alive") + , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD") + , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)") + , ("HTTP_HOST", "192.168.1.115:3000") + , ("HTTP_ACCEPT", "*, */*") + , ("HTTP_VERSION", "HTTP/1.1") + , ("REQUEST_PATH", "/") + ] + headers + | includeLength = ("content-length", "12098") : headers' + | otherwise = headers' + let request' = defaultRequest + { requestHeaders = headers + } + (params, files) <- + case getRequestBodyType request' of + Nothing -> return ([], []) + Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h -> + sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048 + lookup "scannedTime" params @?= Just "1.298590056748E9" + lookup "geoLong" params @?= Just "0" + lookup "geoLat" params @?= Just "0" + length files @?= 1 + +toRequest' :: S8.ByteString -> S8.ByteString -> SRequest +toRequest' ctype content = SRequest defaultRequest + { requestHeaders = [("Content-Type", ctype)] + } (L.fromChunks $ map S.singleton $ S.unpack content) diff --git a/test/WaiExtraSpec.hs b/test/WaiExtraSpec.hs new file mode 100644 --- /dev/null +++ b/test/WaiExtraSpec.hs @@ -0,0 +1,421 @@ +{-# LANGUAGE OverloadedStrings #-} +module WaiExtraSpec (spec, toRequest) where + +import Test.Hspec +import Test.HUnit hiding (Test) +import Data.Monoid (mappend, mempty, (<>)) + +import Network.Wai +import Network.Wai.Test +import Network.Wai.UrlMap +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as L +import qualified Data.Text.Lazy as T +import qualified Data.Text as TS +import qualified Data.Text.Encoding as TE +import Control.Applicative + +import Network.Wai.Middleware.Jsonp +import Network.Wai.Middleware.Gzip +import Network.Wai.Middleware.Vhost +import Network.Wai.Middleware.Autohead +import Network.Wai.Middleware.MethodOverride +import Network.Wai.Middleware.MethodOverridePost +import Network.Wai.Middleware.AcceptOverride +import Network.Wai.Middleware.RequestLogger +import Codec.Compression.GZip (decompress) + +import Control.Monad.IO.Class (liftIO) +import Data.Maybe (fromMaybe) +import Network.HTTP.Types (status200) +import System.Log.FastLogger + +import qualified Data.IORef as I + +spec :: Spec +spec = do + describe "Network.Wai.UrlMap" $ do + mapM_ (uncurry it) casesUrlMap + + describe "Network.Wai" $ do + {- + , it "findBound" caseFindBound + , it "sinkTillBound" caseSinkTillBound + , it "killCR" caseKillCR + , it "killCRLF" caseKillCRLF + , it "takeLine" caseTakeLine + -} + it "jsonp" caseJsonp + it "gzip" caseGzip + it "gzip not for MSIE" caseGzipMSIE + it "gzip bypass when precompressed" caseGzipBypassPre + it "defaultCheckMime" caseDefaultCheckMime + it "vhost" caseVhost + it "autohead" caseAutohead + it "method override" caseMethodOverride + it "method override post" caseMethodOverridePost + it "accept override" caseAcceptOverride + it "debug request body" caseDebugRequestBody + +toRequest :: S8.ByteString -> S8.ByteString -> SRequest +toRequest ctype content = SRequest defaultRequest + { requestHeaders = [("Content-Type", ctype)] + , requestMethod = "POST" + , rawPathInfo = "/" + , rawQueryString = "" + , queryString = [] + } (L.fromChunks [content]) + +{- +caseFindBound :: Assertion +caseFindBound = do + findBound "def" "abcdefghi" @?= + FoundBound "abc" "ghi" + findBound "def" "ABC" @?= NoBound + findBound "def" "abcd" @?= PartialBound + findBound "def" "abcdE" @?= NoBound + findBound "def" "abcdEdef" @?= + FoundBound "abcdE" "" + +caseSinkTillBound :: Assertion +caseSinkTillBound = do + let iter () _ = return () + let src = "this is some text" + bound1 = "some" + bound2 = "some!" + let enum = enumList 1 [src] + let helper _ _ = return () + (_, res1) <- run_ $ enum $$ sinkTillBound bound1 helper () + res1 @?= True + (_, res2) <- run_ $ enum $$ sinkTillBound bound2 helper () + res2 @?= False + +caseKillCR :: Assertion +caseKillCR = do + "foo" @=? killCR "foo" + "foo" @=? killCR "foo\r" + "foo\r\n" @=? killCR "foo\r\n" + "foo\r'" @=? killCR "foo\r'" + +caseKillCRLF :: Assertion +caseKillCRLF = do + "foo" @=? killCRLF "foo" + "foo\r" @=? killCRLF "foo\r" + "foo" @=? killCRLF "foo\r\n" + "foo\r'" @=? killCRLF "foo\r'" + "foo" @=? killCRLF "foo\n" + +caseTakeLine :: Assertion +caseTakeLine = do + helper "foo\nbar\nbaz" "foo" + helper "foo\r\nbar\nbaz" "foo" + helper "foo\nbar\r\nbaz" "foo" + helper "foo\rbar\r\nbaz" "foo\rbar" + where + helper haystack needle = do + x <- run_ $ enumList 1 [haystack] $$ takeLine + Just needle @=? x +-} + +jsonpApp :: Application +jsonpApp = jsonp $ \_ f -> f $ responseLBS + status200 + [("Content-Type", "application/json")] + "{\"foo\":\"bar\"}" + +caseJsonp :: Assertion +caseJsonp = flip runSession jsonpApp $ do + sres1 <- request defaultRequest + { queryString = [("callback", Just "test")] + , requestHeaders = [("Accept", "text/javascript")] + } + assertContentType "text/javascript" sres1 + assertBody "test({\"foo\":\"bar\"})" sres1 + + sres2 <- request defaultRequest + { queryString = [("call_back", Just "test")] + , requestHeaders = [("Accept", "text/javascript")] + } + assertContentType "application/json" sres2 + assertBody "{\"foo\":\"bar\"}" sres2 + + sres3 <- request defaultRequest + { queryString = [("callback", Just "test")] + , requestHeaders = [("Accept", "text/html")] + } + assertContentType "application/json" sres3 + assertBody "{\"foo\":\"bar\"}" sres3 + +gzipApp :: Application +gzipApp = gzip def $ \_ f -> f $ responseLBS status200 + [("Content-Type", "text/plain")] + "test" + +-- Lie a little and don't compress the body. This way we test +-- that the compression is skipped based on the presence of +-- the Content-Encoding header. +gzipPrecompressedApp :: Application +gzipPrecompressedApp = gzip def $ \_ f -> f $ responseLBS status200 + [("Content-Type", "text/plain"), ("Content-Encoding", "gzip")] + "test" + +caseGzip :: Assertion +caseGzip = flip runSession gzipApp $ do + sres1 <- request defaultRequest + { requestHeaders = [("Accept-Encoding", "gzip")] + } + assertHeader "Content-Encoding" "gzip" sres1 + liftIO $ decompress (simpleBody sres1) @?= "test" + + sres2 <- request defaultRequest + { requestHeaders = [] + } + assertNoHeader "Content-Encoding" sres2 + assertBody "test" sres2 + +caseDefaultCheckMime :: Assertion +caseDefaultCheckMime = do + let go x y = (x, defaultCheckMime x) `shouldBe` (x, y) + go "application/json" True + go "application/javascript" True + go "application/something" False + go "text/something" True + go "foo/bar" False + go "application/json; charset=utf-8" True + +caseGzipMSIE :: Assertion +caseGzipMSIE = flip runSession gzipApp $ do + sres1 <- request defaultRequest + { requestHeaders = + [ ("Accept-Encoding", "gzip") + , ("User-Agent", "Mozilla/4.0 (Windows; MSIE 6.0; Windows NT 6.0)") + ] + } + assertNoHeader "Content-Encoding" sres1 + liftIO $ simpleBody sres1 @?= "test" + +caseGzipBypassPre :: Assertion +caseGzipBypassPre = flip runSession gzipPrecompressedApp $ do + sres1 <- request defaultRequest + { requestHeaders = [("Accept-Encoding", "gzip")] + } + assertHeader "Content-Encoding" "gzip" sres1 + assertBody "test" sres1 -- the body is not actually compressed + +vhostApp1, vhostApp2, vhostApp :: Application +vhostApp1 _ f = f $ responseLBS status200 [] "app1" +vhostApp2 _ f = f $ responseLBS status200 [] "app2" +vhostApp = vhost + [ ((== Just "foo.com") . lookup "host" . requestHeaders, vhostApp1) + ] + vhostApp2 + +caseVhost :: Assertion +caseVhost = flip runSession vhostApp $ do + sres1 <- request defaultRequest + { requestHeaders = [("Host", "foo.com")] + } + assertBody "app1" sres1 + + sres2 <- request defaultRequest + { requestHeaders = [("Host", "bar.com")] + } + assertBody "app2" sres2 + +autoheadApp :: Application +autoheadApp = autohead $ \_ f -> f $ responseLBS status200 + [("Foo", "Bar")] "body" + +caseAutohead :: Assertion +caseAutohead = flip runSession autoheadApp $ do + sres1 <- request defaultRequest + { requestMethod = "GET" + } + assertHeader "Foo" "Bar" sres1 + assertBody "body" sres1 + + sres2 <- request defaultRequest + { requestMethod = "HEAD" + } + assertHeader "Foo" "Bar" sres2 + assertBody "" sres2 + +moApp :: Application +moApp = methodOverride $ \req f -> f $ responseLBS status200 + [("Method", requestMethod req)] "" + +caseMethodOverride :: Assertion +caseMethodOverride = flip runSession moApp $ do + sres1 <- request defaultRequest + { requestMethod = "GET" + , queryString = [] + } + assertHeader "Method" "GET" sres1 + + sres2 <- request defaultRequest + { requestMethod = "POST" + , queryString = [] + } + assertHeader "Method" "POST" sres2 + + sres3 <- request defaultRequest + { requestMethod = "POST" + , queryString = [("_method", Just "PUT")] + } + assertHeader "Method" "PUT" sres3 + +mopApp :: Application +mopApp = methodOverridePost $ \req f -> f $ responseLBS status200 [("Method", requestMethod req)] "" + +caseMethodOverridePost :: Assertion +caseMethodOverridePost = flip runSession mopApp $ do + + -- Get Request are unmodified + sres1 <- let r = toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" + s = simpleRequest r + m = s { requestMethod = "GET" } + b = r { simpleRequest = m } + in srequest b + assertHeader "Method" "GET" sres1 + + -- Post requests are modified if _method comes first + sres2 <- srequest $ toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" + assertHeader "Method" "PUT" sres2 + + -- Post requests are unmodified if _method doesn't come first + sres3 <- srequest $ toRequest "application/x-www-form-urlencoded" "foo=bar&_method=PUT&baz=bin" + assertHeader "Method" "POST" sres3 + + -- Post requests are unmodified if Content-Type header isn't set to "application/x-www-form-urlencoded" + sres4 <- srequest $ toRequest "text/html; charset=utf-8" "foo=bar&_method=PUT&baz=bin" + assertHeader "Method" "POST" sres4 + +aoApp :: Application +aoApp = acceptOverride $ \req f -> f $ responseLBS status200 + [("Accept", fromMaybe "" $ lookup "Accept" $ requestHeaders req)] "" + +caseAcceptOverride :: Assertion +caseAcceptOverride = flip runSession aoApp $ do + sres1 <- request defaultRequest + { queryString = [] + , requestHeaders = [("Accept", "foo")] + } + assertHeader "Accept" "foo" sres1 + + sres2 <- request defaultRequest + { queryString = [] + , requestHeaders = [("Accept", "bar")] + } + assertHeader "Accept" "bar" sres2 + + sres3 <- request defaultRequest + { queryString = [("_accept", Just "baz")] + , requestHeaders = [("Accept", "bar")] + } + assertHeader "Accept" "baz" sres3 + +caseDebugRequestBody :: Assertion +caseDebugRequestBody = do + flip runSession (debugApp postOutput) $ do + let req = toRequest "application/x-www-form-urlencoded" "foo=bar&baz=bin" + res <- srequest req + assertStatus 200 res + + let qs = "?foo=bar&baz=bin" + flip runSession (debugApp $ getOutput params) $ do + assertStatus 200 =<< request defaultRequest + { requestMethod = "GET" + , queryString = map (\(k,v) -> (k, Just v)) params + , rawQueryString = qs + , requestHeaders = [] + , rawPathInfo = "/location" + } + where + params = [("foo", "bar"), ("baz", "bin")] + -- FIXME change back once we include post parameter output in logging + -- postOutput = T.pack $ "POST \nAccept: \n Params: " ++ (show params) + -- the time cannot be known, so match around it + postOutput = ("POST /\n Accept: \n Status: 200 OK 0", "s\n") + getOutput params' = ("GET /location\n Params: " <> T.pack (show params') <> "\n Accept: \n Status: 200 OK 0", "s\n") + + debugApp (beginning, ending) req send = do + iactual <- I.newIORef mempty + middleware <- mkRequestLogger def + { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs) + , outputFormat = Detailed False + } + res <- middleware (\_req f -> f $ responseLBS status200 [ ] "") req send + actual <- logToBs <$> I.readIORef iactual + actual `shouldSatisfy` S.isPrefixOf begin + actual `shouldSatisfy` S.isSuffixOf end + + return res + where + begin = TE.encodeUtf8 $ T.toStrict beginning + end = TE.encodeUtf8 $ T.toStrict ending + + logToBs = fromLogStr + + {-debugApp = debug $ \req -> do-} + {-return $ responseLBS status200 [ ] ""-} + +urlMapTestApp :: Application +urlMapTestApp = mapUrls $ + mount "bugs" bugsApp + <|> mount "helpdesk" helpdeskApp + <|> mount "api" + ( mount "v1" apiV1 + <|> mount "v2" apiV2 + ) + <|> mountRoot mainApp + + where + trivialApp :: S.ByteString -> Application + trivialApp name req f = + f $ + responseLBS + status200 + [ ("content-type", "text/plain") + , ("X-pathInfo", S8.pack . show . pathInfo $ req) + , ("X-rawPathInfo", rawPathInfo req) + , ("X-appName", name) + ] + "" + + bugsApp = trivialApp "bugs" + helpdeskApp = trivialApp "helpdesk" + apiV1 = trivialApp "apiv1" + apiV2 = trivialApp "apiv2" + mainApp = trivialApp "main" + +casesUrlMap :: [(String, Assertion)] +casesUrlMap = [pair1, pair2, pair3, pair4] + where + makePair name session = (name, runSession session urlMapTestApp) + get reqPath = request $ setPath defaultRequest reqPath + s = S8.pack . show :: [TS.Text] -> S.ByteString + + pair1 = makePair "should mount root" $ do + res1 <- get "/" + assertStatus 200 res1 + assertHeader "X-rawPathInfo" "/" res1 + assertHeader "X-pathInfo" (s []) res1 + assertHeader "X-appName" "main" res1 + + pair2 = makePair "should mount apps" $ do + res2 <- get "/bugs" + assertStatus 200 res2 + assertHeader "X-rawPathInfo" "/" res2 + assertHeader "X-pathInfo" (s []) res2 + assertHeader "X-appName" "bugs" res2 + + pair3 = makePair "should preserve extra path info" $ do + res3 <- get "/helpdesk/issues/11" + assertStatus 200 res3 + assertHeader "X-rawPathInfo" "/issues/11" res3 + assertHeader "X-pathInfo" (s ["issues", "11"]) res3 + + pair4 = makePair "should 404 if none match" $ do + res4 <- get "/api/v3" + assertStatus 404 res4 diff --git a/test/WaiExtraTest.hs b/test/WaiExtraTest.hs deleted file mode 100644 --- a/test/WaiExtraTest.hs +++ /dev/null @@ -1,635 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module WaiExtraTest (specs) where - -import Test.Hspec -import Test.HUnit hiding (Test) -import Data.Monoid (mappend, mempty, (<>)) - -import Network.Wai -import Network.Wai.Test -import Network.Wai.Parse -import Network.Wai.UrlMap -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 -import qualified Data.ByteString.Lazy.Char8 as L8 -import qualified Data.ByteString.Lazy as L -import qualified Data.Text.Lazy as T -import qualified Data.Text as TS -import qualified Data.Text.Encoding as TE -import Control.Arrow -import Control.Applicative -import Control.Monad.Trans.Resource (withInternalState, runResourceT) - -import Network.Wai.Middleware.Jsonp -import Network.Wai.Middleware.Gzip -import Network.Wai.Middleware.Vhost -import Network.Wai.Middleware.Autohead -import Network.Wai.Middleware.MethodOverride -import Network.Wai.Middleware.MethodOverridePost -import Network.Wai.Middleware.AcceptOverride -import Network.Wai.Middleware.RequestLogger -import Codec.Compression.GZip (decompress) - -import Control.Monad.IO.Class (liftIO) -import Data.Maybe (fromMaybe) -import Network.HTTP.Types (parseSimpleQuery, status200) -import System.Log.FastLogger -import System.IO (withFile, IOMode (ReadMode)) - -import qualified Data.IORef as I - -specs :: Spec -specs = do - describe "Network.Wai.UrlMap" $ do - mapM_ (uncurry it) casesUrlMap - - describe "Network.Wai.Parse" $ do - describe "parseContentType" $ do - let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z) - mapM_ go - [ ("text/plain", "text/plain", []) - , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")]) - , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")]) - ] - it "parseQueryString" caseParseQueryString - it "parseQueryString with question mark" caseParseQueryStringQM - it "parseHttpAccept" caseParseHttpAccept - it "parseRequestBody" caseParseRequestBody - it "multipart with plus" caseMultipartPlus - it "multipart with multiple attributes" caseMultipartAttrs - it "urlencoded with plus" caseUrlEncPlus - {- - , it "findBound" caseFindBound - , it "sinkTillBound" caseSinkTillBound - , it "killCR" caseKillCR - , it "killCRLF" caseKillCRLF - , it "takeLine" caseTakeLine - -} - it "jsonp" caseJsonp - it "gzip" caseGzip - it "gzip not for MSIE" caseGzipMSIE - it "gzip bypass when precompressed" caseGzipBypassPre - it "defaultCheckMime" caseDefaultCheckMime - it "vhost" caseVhost - it "autohead" caseAutohead - it "method override" caseMethodOverride - it "method override post" caseMethodOverridePost - it "accept override" caseAcceptOverride - describe "dalvik multipart" $ do - it "non-chunked" $ dalvikHelper True - it "chunked" $ dalvikHelper False - it "debug request body" caseDebugRequestBody - -caseParseQueryString :: Assertion -caseParseQueryString = do - let go l r = - map (S8.pack *** S8.pack) l @=? parseSimpleQuery (S8.pack r) - - go [] "" - go [("foo", "")] "foo" - go [("foo", "bar")] "foo=bar" - go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin" - go [("%Q", "")] "%Q" - go [("%1Q", "")] "%1Q" - go [("%1", "")] "%1" - go [("/", "")] "%2F" - go [("/", "")] "%2f" - go [("foo bar", "")] "foo+bar" - -caseParseQueryStringQM :: Assertion -caseParseQueryStringQM = do - let go l r = - map (S8.pack *** S8.pack) l - @=? parseSimpleQuery (S8.pack $ '?' : r) - - go [] "" - go [("foo", "")] "foo" - go [("foo", "bar")] "foo=bar" - go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin" - go [("%Q", "")] "%Q" - go [("%1Q", "")] "%1Q" - go [("%1", "")] "%1" - go [("/", "")] "%2F" - go [("/", "")] "%2f" - go [("foo bar", "")] "foo+bar" - -caseParseHttpAccept :: Assertion -caseParseHttpAccept = do - let input = "text/plain; q=0.5, text/html;charset=utf-8, text/*;q=0.8;ext=blah, text/x-dvi; q=0.8, text/x-c" - expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"] - expected @=? parseHttpAccept input - -parseRequestBody' :: BackEnd file - -> SRequest - -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)]) -parseRequestBody' sink (SRequest req bod) = - case getRequestBodyType req of - Nothing -> return ([], []) - Just rbt -> do - ref <- I.newIORef $ L.toChunks bod - let rb = I.atomicModifyIORef ref $ \chunks -> - case chunks of - [] -> ([], S.empty) - x:y -> (y, x) - sinkRequestBody sink rbt rb - -caseParseRequestBody :: Assertion -caseParseRequestBody = - t - where - content2 = S8.pack $ - "--AaB03x\n" ++ - "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++ - "Content-Type: text/plain; charset=iso-8859-1\n\n" ++ - "This is a file.\n" ++ - "It has two lines.\n" ++ - "--AaB03x\n" ++ - "Content-Disposition: form-data; name=\"title\"\n" ++ - "Content-Type: text/plain; charset=iso-8859-1\n\n" ++ - "A File\n" ++ - "--AaB03x\n" ++ - "Content-Disposition: form-data; name=\"summary\"\n" ++ - "Content-Type: text/plain; charset=iso-8859-1\n\n" ++ - "This is my file\n" ++ - "file test\n" ++ - "--AaB03x--" - content3 = S8.pack "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n" - t = do - let content1 = "foo=bar&baz=bin" - let ctype1 = "application/x-www-form-urlencoded" - result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1 - liftIO $ assertEqual "parsing post x-www-form-urlencoded" - (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], []) - result1 - - let ctype2 = "multipart/form-data; boundary=AaB03x" - result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2 - let expectedsmap2 = - [ ("title", "A File") - , ("summary", "This is my file\nfile test") - ] - let textPlain = S8.pack $ "text/plain; charset=iso-8859-1" - let expectedfile2 = - [(S8.pack "document", FileInfo (S8.pack "b.txt") textPlain $ L8.pack - "This is a file.\nIt has two lines.")] - let expected2 = (map (S8.pack *** S8.pack) expectedsmap2, expectedfile2) - liftIO $ assertEqual "parsing post multipart/form-data" - expected2 - result2 - - let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh" - result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3 - let expectedsmap3 = [] - let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $ - L8.pack "Photo blog using Hack.\n")] - let expected3 = (expectedsmap3, expectedfile3) - liftIO $ assertEqual "parsing actual post multipart/form-data" - expected3 - result3 - - result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2 - liftIO $ assertEqual "parsing post multipart/form-data 2" - expected2 - result2' - - result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3 - liftIO $ assertEqual "parsing actual post multipart/form-data 2" - expected3 - result3' - -caseMultipartPlus :: Assertion -caseMultipartPlus = do - result <- parseRequestBody' lbsBackEnd $ toRequest ctype content - liftIO $ result @?= ([("email", "has+plus")], []) - where - content = S8.pack $ - "--AaB03x\n" ++ - "Content-Disposition: form-data; name=\"email\"\n" ++ - "Content-Type: text/plain; charset=iso-8859-1\n\n" ++ - "has+plus\n" ++ - "--AaB03x--" - ctype = "multipart/form-data; boundary=AaB03x" - -caseMultipartAttrs :: Assertion -caseMultipartAttrs = do - result <- parseRequestBody' lbsBackEnd $ toRequest ctype content - liftIO $ result @?= ([("email", "has+plus")], []) - where - content = S8.pack $ - "--AaB03x\n" ++ - "Content-Disposition: form-data; name=\"email\"\n" ++ - "Content-Type: text/plain; charset=iso-8859-1\n\n" ++ - "has+plus\n" ++ - "--AaB03x--" - ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x" - -caseUrlEncPlus :: Assertion -caseUrlEncPlus = do - result <- runResourceT $ withInternalState $ \state -> - parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content - liftIO $ result @?= ([("email", "has+plus")], []) - where - content = S8.pack $ "email=has%2Bplus" - ctype = "application/x-www-form-urlencoded" - -toRequest :: S8.ByteString -> S8.ByteString -> SRequest -toRequest ctype content = SRequest defaultRequest - { requestHeaders = [("Content-Type", ctype)] - , requestMethod = "POST" - , rawPathInfo = "/" - , rawQueryString = "" - , queryString = [] - } (L.fromChunks [content]) - -toRequest' :: S8.ByteString -> S8.ByteString -> SRequest -toRequest' ctype content = SRequest defaultRequest - { requestHeaders = [("Content-Type", ctype)] - } (L.fromChunks $ map S.singleton $ S.unpack content) - -{- -caseFindBound :: Assertion -caseFindBound = do - findBound (S8.pack "def") (S8.pack "abcdefghi") @?= - FoundBound (S8.pack "abc") (S8.pack "ghi") - findBound (S8.pack "def") (S8.pack "ABC") @?= NoBound - findBound (S8.pack "def") (S8.pack "abcd") @?= PartialBound - findBound (S8.pack "def") (S8.pack "abcdE") @?= NoBound - findBound (S8.pack "def") (S8.pack "abcdEdef") @?= - FoundBound (S8.pack "abcdE") (S8.pack "") - -caseSinkTillBound :: Assertion -caseSinkTillBound = do - let iter () _ = return () - let src = S8.pack "this is some text" - bound1 = S8.pack "some" - bound2 = S8.pack "some!" - let enum = enumList 1 [src] - let helper _ _ = return () - (_, res1) <- run_ $ enum $$ sinkTillBound bound1 helper () - res1 @?= True - (_, res2) <- run_ $ enum $$ sinkTillBound bound2 helper () - res2 @?= False - -caseKillCR :: Assertion -caseKillCR = do - "foo" @=? killCR "foo" - "foo" @=? killCR "foo\r" - "foo\r\n" @=? killCR "foo\r\n" - "foo\r'" @=? killCR "foo\r'" - -caseKillCRLF :: Assertion -caseKillCRLF = do - "foo" @=? killCRLF "foo" - "foo\r" @=? killCRLF "foo\r" - "foo" @=? killCRLF "foo\r\n" - "foo\r'" @=? killCRLF "foo\r'" - "foo" @=? killCRLF "foo\n" - -caseTakeLine :: Assertion -caseTakeLine = do - helper "foo\nbar\nbaz" "foo" - helper "foo\r\nbar\nbaz" "foo" - helper "foo\nbar\r\nbaz" "foo" - helper "foo\rbar\r\nbaz" "foo\rbar" - where - helper haystack needle = do - x <- run_ $ enumList 1 [haystack] $$ takeLine - Just needle @=? x --} - -jsonpApp :: Application -jsonpApp = jsonp $ \_ f -> f $ responseLBS - status200 - [("Content-Type", "application/json")] - "{\"foo\":\"bar\"}" - -caseJsonp :: Assertion -caseJsonp = flip runSession jsonpApp $ do - sres1 <- request defaultRequest - { queryString = [("callback", Just "test")] - , requestHeaders = [("Accept", "text/javascript")] - } - assertContentType "text/javascript" sres1 - assertBody "test({\"foo\":\"bar\"})" sres1 - - sres2 <- request defaultRequest - { queryString = [("call_back", Just "test")] - , requestHeaders = [("Accept", "text/javascript")] - } - assertContentType "application/json" sres2 - assertBody "{\"foo\":\"bar\"}" sres2 - - sres3 <- request defaultRequest - { queryString = [("callback", Just "test")] - , requestHeaders = [("Accept", "text/html")] - } - assertContentType "application/json" sres3 - assertBody "{\"foo\":\"bar\"}" sres3 - -gzipApp :: Application -gzipApp = gzip def $ \_ f -> f $ responseLBS status200 - [("Content-Type", "text/plain")] - "test" - --- Lie a little and don't compress the body. This way we test --- that the compression is skipped based on the presence of --- the Content-Encoding header. -gzipPrecompressedApp :: Application -gzipPrecompressedApp = gzip def $ \_ f -> f $ responseLBS status200 - [("Content-Type", "text/plain"), ("Content-Encoding", "gzip")] - "test" - -caseGzip :: Assertion -caseGzip = flip runSession gzipApp $ do - sres1 <- request defaultRequest - { requestHeaders = [("Accept-Encoding", "gzip")] - } - assertHeader "Content-Encoding" "gzip" sres1 - liftIO $ decompress (simpleBody sres1) @?= "test" - - sres2 <- request defaultRequest - { requestHeaders = [] - } - assertNoHeader "Content-Encoding" sres2 - assertBody "test" sres2 - -caseDefaultCheckMime :: Assertion -caseDefaultCheckMime = do - let go x y = (x, defaultCheckMime x) `shouldBe` (x, y) - go "application/json" True - go "application/javascript" True - go "application/something" False - go "text/something" True - go "foo/bar" False - go "application/json; charset=utf-8" True - -caseGzipMSIE :: Assertion -caseGzipMSIE = flip runSession gzipApp $ do - sres1 <- request defaultRequest - { requestHeaders = - [ ("Accept-Encoding", "gzip") - , ("User-Agent", "Mozilla/4.0 (Windows; MSIE 6.0; Windows NT 6.0)") - ] - } - assertNoHeader "Content-Encoding" sres1 - liftIO $ simpleBody sres1 @?= "test" - -caseGzipBypassPre :: Assertion -caseGzipBypassPre = flip runSession gzipPrecompressedApp $ do - sres1 <- request defaultRequest - { requestHeaders = [("Accept-Encoding", "gzip")] - } - assertHeader "Content-Encoding" "gzip" sres1 - assertBody "test" sres1 -- the body is not actually compressed - -vhostApp1, vhostApp2, vhostApp :: Application -vhostApp1 _ f = f $ responseLBS status200 [] "app1" -vhostApp2 _ f = f $ responseLBS status200 [] "app2" -vhostApp = vhost - [ ((== Just "foo.com") . lookup "host" . requestHeaders, vhostApp1) - ] - vhostApp2 - -caseVhost :: Assertion -caseVhost = flip runSession vhostApp $ do - sres1 <- request defaultRequest - { requestHeaders = [("Host", "foo.com")] - } - assertBody "app1" sres1 - - sres2 <- request defaultRequest - { requestHeaders = [("Host", "bar.com")] - } - assertBody "app2" sres2 - -autoheadApp :: Application -autoheadApp = autohead $ \_ f -> f $ responseLBS status200 - [("Foo", "Bar")] "body" - -caseAutohead :: Assertion -caseAutohead = flip runSession autoheadApp $ do - sres1 <- request defaultRequest - { requestMethod = "GET" - } - assertHeader "Foo" "Bar" sres1 - assertBody "body" sres1 - - sres2 <- request defaultRequest - { requestMethod = "HEAD" - } - assertHeader "Foo" "Bar" sres2 - assertBody "" sres2 - -moApp :: Application -moApp = methodOverride $ \req f -> f $ responseLBS status200 - [("Method", requestMethod req)] "" - -caseMethodOverride :: Assertion -caseMethodOverride = flip runSession moApp $ do - sres1 <- request defaultRequest - { requestMethod = "GET" - , queryString = [] - } - assertHeader "Method" "GET" sres1 - - sres2 <- request defaultRequest - { requestMethod = "POST" - , queryString = [] - } - assertHeader "Method" "POST" sres2 - - sres3 <- request defaultRequest - { requestMethod = "POST" - , queryString = [("_method", Just "PUT")] - } - assertHeader "Method" "PUT" sres3 - -mopApp :: Application -mopApp = methodOverridePost $ \req f -> f $ responseLBS status200 [("Method", requestMethod req)] "" - -caseMethodOverridePost :: Assertion -caseMethodOverridePost = flip runSession mopApp $ do - - -- Get Request are unmodified - sres1 <- let r = toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" - s = simpleRequest r - m = s { requestMethod = "GET" } - b = r { simpleRequest = m } - in srequest b - assertHeader "Method" "GET" sres1 - - -- Post requests are modified if _method comes first - sres2 <- srequest $ toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" - assertHeader "Method" "PUT" sres2 - - -- Post requests are unmodified if _method doesn't come first - sres3 <- srequest $ toRequest "application/x-www-form-urlencoded" "foo=bar&_method=PUT&baz=bin" - assertHeader "Method" "POST" sres3 - - -- Post requests are unmodified if Content-Type header isn't set to "application/x-www-form-urlencoded" - sres4 <- srequest $ toRequest "text/html; charset=utf-8" "foo=bar&_method=PUT&baz=bin" - assertHeader "Method" "POST" sres4 - -aoApp :: Application -aoApp = acceptOverride $ \req f -> f $ responseLBS status200 - [("Accept", fromMaybe "" $ lookup "Accept" $ requestHeaders req)] "" - -caseAcceptOverride :: Assertion -caseAcceptOverride = flip runSession aoApp $ do - sres1 <- request defaultRequest - { queryString = [] - , requestHeaders = [("Accept", "foo")] - } - assertHeader "Accept" "foo" sres1 - - sres2 <- request defaultRequest - { queryString = [] - , requestHeaders = [("Accept", "bar")] - } - assertHeader "Accept" "bar" sres2 - - sres3 <- request defaultRequest - { queryString = [("_accept", Just "baz")] - , requestHeaders = [("Accept", "bar")] - } - assertHeader "Accept" "baz" sres3 - -dalvikHelper :: Bool -> Assertion -dalvikHelper includeLength = do - let headers' = - [ ("content-type", "multipart/form-data;boundary=*****") - , ("GATEWAY_INTERFACE", "CGI/1.1") - , ("PATH_INFO", "/") - , ("QUERY_STRING", "") - , ("REMOTE_ADDR", "192.168.1.115") - , ("REMOTE_HOST", "ganjizza") - , ("REQUEST_URI", "http://192.168.1.115:3000/") - , ("REQUEST_METHOD", "POST") - , ("HTTP_CONNECTION", "Keep-Alive") - , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD") - , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)") - , ("HTTP_HOST", "192.168.1.115:3000") - , ("HTTP_ACCEPT", "*, */*") - , ("HTTP_VERSION", "HTTP/1.1") - , ("REQUEST_PATH", "/") - ] - headers - | includeLength = ("content-length", "12098") : headers' - | otherwise = headers' - let request' = defaultRequest - { requestHeaders = headers - } - (params, files) <- - case getRequestBodyType request' of - Nothing -> return ([], []) - Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h -> - sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048 - lookup "scannedTime" params @?= Just "1.298590056748E9" - lookup "geoLong" params @?= Just "0" - lookup "geoLat" params @?= Just "0" - length files @?= 1 - -caseDebugRequestBody :: Assertion -caseDebugRequestBody = do - flip runSession (debugApp postOutput) $ do - let req = toRequest "application/x-www-form-urlencoded" "foo=bar&baz=bin" - res <- srequest req - assertStatus 200 res - - let qs = "?foo=bar&baz=bin" - flip runSession (debugApp $ getOutput params) $ do - assertStatus 200 =<< request defaultRequest - { requestMethod = "GET" - , queryString = map (\(k,v) -> (k, Just v)) params - , rawQueryString = qs - , requestHeaders = [] - , rawPathInfo = "/location" - } - where - params = [("foo", "bar"), ("baz", "bin")] - -- FIXME change back once we include post parameter output in logging - -- postOutput = T.pack $ "POST \nAccept: \n Params: " ++ (show params) - -- the time cannot be known, so match around it - postOutput = ("POST /\n Accept: \n Status: 200 OK 0", "s\n") - getOutput params' = ("GET /location\n Params: " <> T.pack (show params') <> "\n Accept: \n Status: 200 OK 0", "s\n") - - debugApp (beginning, ending) req send = do - iactual <- I.newIORef mempty - middleware <- mkRequestLogger def - { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs) - , outputFormat = Detailed False - } - res <- middleware (\_req f -> f $ responseLBS status200 [ ] "") req send - actual <- logToBs <$> I.readIORef iactual - actual `shouldSatisfy` S.isPrefixOf begin - actual `shouldSatisfy` S.isSuffixOf end - - return res - where - begin = TE.encodeUtf8 $ T.toStrict beginning - end = TE.encodeUtf8 $ T.toStrict ending - - logToBs = fromLogStr - - {-debugApp = debug $ \req -> do-} - {-return $ responseLBS status200 [ ] ""-} - -urlMapTestApp :: Application -urlMapTestApp = mapUrls $ - mount "bugs" bugsApp - <|> mount "helpdesk" helpdeskApp - <|> mount "api" - ( mount "v1" apiV1 - <|> mount "v2" apiV2 - ) - <|> mountRoot mainApp - - where - trivialApp :: S.ByteString -> Application - trivialApp name req f = - f $ - responseLBS - status200 - [ ("content-type", "text/plain") - , ("X-pathInfo", S8.pack . show . pathInfo $ req) - , ("X-rawPathInfo", rawPathInfo req) - , ("X-appName", name) - ] - "" - - bugsApp = trivialApp "bugs" - helpdeskApp = trivialApp "helpdesk" - apiV1 = trivialApp "apiv1" - apiV2 = trivialApp "apiv2" - mainApp = trivialApp "main" - -casesUrlMap :: [(String, Assertion)] -casesUrlMap = [pair1, pair2, pair3, pair4] - where - makePair name session = (name, runSession session urlMapTestApp) - get reqPath = request $ setPath defaultRequest reqPath - s = S8.pack . show :: [TS.Text] -> S.ByteString - - pair1 = makePair "should mount root" $ do - res1 <- get "/" - assertStatus 200 res1 - assertHeader "X-rawPathInfo" "/" res1 - assertHeader "X-pathInfo" (s []) res1 - assertHeader "X-appName" "main" res1 - - pair2 = makePair "should mount apps" $ do - res2 <- get "/bugs" - assertStatus 200 res2 - assertHeader "X-rawPathInfo" "/" res2 - assertHeader "X-pathInfo" (s []) res2 - assertHeader "X-appName" "bugs" res2 - - pair3 = makePair "should preserve extra path info" $ do - res3 <- get "/helpdesk/issues/11" - assertStatus 200 res3 - assertHeader "X-rawPathInfo" "/issues/11" res3 - assertHeader "X-pathInfo" (s ["issues", "11"]) res3 - - pair4 = makePair "should 404 if none match" $ do - res4 <- get "/api/v3" - assertStatus 404 res4 diff --git a/tests.hs b/tests.hs deleted file mode 100644 --- a/tests.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Test.Hspec -import qualified WaiExtraTest - -main :: IO () -main = hspec WaiExtraTest.specs diff --git a/wai-extra.cabal b/wai-extra.cabal --- a/wai-extra.cabal +++ b/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.0.2.1 +Version: 3.0.2.2 Synopsis: Provides some basic WAI handlers and middleware. Description: The goal here is to provide common features without many dependencies. License: MIT @@ -12,12 +12,10 @@ Cabal-Version: >=1.8 Stability: Stable extra-source-files: - tests.hs test/requests/dalvik-request test/json test/test.html test/sample.hs - test/WaiExtraTest.hs Library Build-Depends: base >= 4 && < 5 @@ -73,39 +71,25 @@ other-modules: Network.Wai.Middleware.RequestLogger.Internal ghc-options: -Wall - -test-suite tests - hs-source-dirs: test - main-is: ../tests.hs - type: exitcode-stdio-1.0 - - build-depends: base >= 4 && < 5 - , wai-extra - , hspec >= 1.3 - , HUnit - - , wai - , http-types - , transformers - , zlib - , text - , bytestring - , directory - , blaze-builder >= 0.2.1.4 && < 0.4 - , data-default - , fast-logger >= 2.1 - , resourcet - ghc-options: -Wall - test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: Network.Wai.TestSpec + Network.Wai.ParseSpec + WaiExtraSpec build-depends: base >= 4 && < 5 , wai-extra , wai , hspec >= 1.3 + , transformers + , fast-logger + , http-types + , zlib + , text + , resourcet + , bytestring + , HUnit ghc-options: -Wall -Werror source-repository head