wai-extra 0.4.4 → 0.4.5
raw patch · 5 files changed
+32/−452 lines, 5 filesdep ~basedep ~blaze-builderdep ~blaze-builder-enumeratorbinary-addedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, blaze-builder, blaze-builder-enumerator, bytestring, enumerator, hspec, old-locale, text, transformers
API changes (from Hackage documentation)
Files
- runtests.hs +0/−426
- test/dalvik-request binary
- test/requests/dalvik-request binary
- tests.hs +5/−0
- wai-extra.cabal +27/−26
− runtests.hs
@@ -1,426 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-import Test.Hspec-import Test.Hspec.HUnit ()-import Test.HUnit hiding (Test)--import Network.Wai-import Network.Wai.Test-import Network.Wai.Parse-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 Control.Arrow--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.AcceptOverride-import Network.Wai.Middleware.Debug (debugHandle)-import Codec.Compression.GZip (decompress)--import Data.Enumerator (run_, enumList, ($$), Iteratee)-import Data.Enumerator.Binary (enumFile)-import Control.Monad.IO.Class (liftIO)-import Data.Maybe (fromMaybe)-import Network.HTTP.Types (parseSimpleQuery, status200)--main :: IO ()-main = hspecX $ do- describe "Network.Wai.Parse"- [ it "parseQueryString" caseParseQueryString- , it "parseQueryString with question mark" caseParseQueryStringQM- , it "parseHttpAccept" caseParseHttpAccept- , it "parseRequestBody" caseParseRequestBody- {-- , 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 "vhost" caseVhost- , it "autohead" caseAutohead- , it "method override" caseMethodOverride- , it "accept override" caseAcceptOverride- , it "dalvik multipart" caseDalvikMultipart- , 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, text/x-dvi; q=0.8, text/x-c"- expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]- expected @=? parseHttpAccept input--parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString- -> SRequest- -> Iteratee S.ByteString IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)])-parseRequestBody' sink (SRequest req bod) =- enumList 1 (L.toChunks bod) $$ parseRequestBody sink req--caseParseRequestBody :: Assertion-caseParseRequestBody = run_ 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' lbsSink $ 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' lbsSink $ 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' lbsSink $ 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' lbsSink $ toRequest' ctype2 content2- liftIO $ assertEqual "parsing post multipart/form-data 2"- expected2- result2'-- result3' <- parseRequestBody' lbsSink $ toRequest' ctype3 content3- liftIO $ assertEqual "parsing actual post multipart/form-data 2"- expected3- result3'--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 $ const $ return $ 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 True $ const $ return $ responseLBS status200- [("Content-Type", "text/plain")]- "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--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"--vhostApp1, vhostApp2, vhostApp :: Application-vhostApp1 = const $ return $ responseLBS status200 [] "app1"-vhostApp2 = const $ return $ responseLBS status200 [] "app2"-vhostApp = vhost- [ ((== "foo.com") . serverName, vhostApp1)- ]- vhostApp2--caseVhost :: Assertion-caseVhost = flip runSession vhostApp $ do- sres1 <- request defaultRequest- { serverName = "foo.com"- }- assertBody "app1" sres1-- sres2 <- request defaultRequest- { serverName = "bar.com"- }- assertBody "app2" sres2--autoheadApp :: Application-autoheadApp = autohead $ const $ return $ 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 -> return $ 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--aoApp :: Application-aoApp = acceptOverride $ \req -> return $ 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--caseDalvikMultipart :: Assertion-caseDalvikMultipart = do- let headers =- [ ("content-length", "12098")- , ("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", "/")- ]- let request' = defaultRequest- { requestHeaders = headers- }- (params, files) <- run_ $ enumFile "test/dalvik-request" $$ parseRequestBody lbsSink request'- 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 qs) $ 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")]- postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)- getOutput _qs = T.pack $ "GET /location" ++ "\nAccept: \nGET " ++ (show params) -- \nAccept: \n" ++ (show params)-- debugApp output = debugHandle (\t -> liftIO $ assertEqual "debug" output t) $ \_req -> do- return $ responseLBS status200 [ ] ""- {-debugApp = debug $ \req -> do-}- {-return $ responseLBS status200 [ ] ""-}
− test/dalvik-request
binary file changed (12166 → absent bytes)
+ test/requests/dalvik-request view
binary file changed (absent → 12166 bytes)
+ tests.hs view
@@ -0,0 +1,5 @@+import Test.Hspec.Monadic+import qualified WaiExtraTest++main :: IO ()+main = hspecX WaiExtraTest.specs
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name: wai-extra-Version: 0.4.4+Version: 0.4.5 Synopsis: Provides some basic WAI handlers and middleware. Description: The goal here is to provide common features without many dependencies. License: BSD3@@ -12,30 +12,31 @@ Cabal-Version: >=1.8 Stability: Stable extra-source-files:- runtests.hs- test/dalvik-request+ tests.hs+ test/requests/dalvik-request test/json test/test.html test/sample.hs Library- Build-Depends: base >= 3 && < 5,- bytestring >= 0.9 && < 0.10,- wai >= 0.4 && < 0.5,- old-locale >= 1.0 && < 1.1,- time >= 1.1.4 && < 1.4,- network >= 2.2.1.5 && < 2.4,- directory >= 1.0.1 && < 1.2,- zlib-bindings >= 0.0 && < 0.1,- blaze-builder-enumerator >= 0.2 && < 0.3,- transformers >= 0.2 && < 0.3,- enumerator >= 0.4.7 && < 0.5,- blaze-builder >= 0.2.1.3 && < 0.4,- http-types >= 0.6 && < 0.7,- text >= 0.5 && < 1.0,- case-insensitive >= 0.2 && < 0.4,- zlib-enum >= 0.2.1 && < 0.3,- data-default >= 0.3 && < 0.4+ Build-Depends: base >= 4 && < 5+ , bytestring >= 0.9.1.4 && < 0.10+ , wai >= 0.4 && < 0.5+ , old-locale >= 1.0.0.2 && < 1.1+ , time >= 1.1.4 && < 1.4+ , network >= 2.2.1.5 && < 2.4+ , directory >= 1.0.1 && < 1.2+ , zlib-bindings >= 0.0 && < 0.1+ , blaze-builder-enumerator >= 0.2 && < 0.3+ , transformers >= 0.2.2 && < 0.3+ , enumerator >= 0.4.8 && < 0.5+ , blaze-builder >= 0.2.1.4 && < 0.4+ , http-types >= 0.6 && < 0.7+ , text >= 0.7 && < 0.12+ , case-insensitive >= 0.2 && < 0.4+ , zlib-enum >= 0.2.1 && < 0.3+ , data-default >= 0.3 && < 0.4+ Exposed-modules: Network.Wai.Handler.CGI Network.Wai.Middleware.AcceptOverride Network.Wai.Middleware.Autohead@@ -51,15 +52,15 @@ ghc-options: -Wall -test-suite runtests- hs-source-dirs: .- main-is: runtests.hs+test-suite tests+ hs-source-dirs: test+ main-is: ../tests.hs type: exitcode-stdio-1.0 build-depends: base >= 4 && < 5 , wai-extra , wai-test- , hspec >= 0.8 && < 0.9+ , hspec >= 0.8 && < 0.10 , HUnit , wai@@ -71,8 +72,8 @@ , bytestring , directory , zlib-bindings- , blaze-builder-enumerator- , blaze-builder+ , blaze-builder-enumerator >= 0.2 && < 0.3+ , blaze-builder >= 0.2.1.4 && < 0.4 , zlib-enum , data-default