wai-app-static 0.3.3 → 0.3.4
raw patch · 3 files changed
+169/−3 lines, 3 filesdep ~hspecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec
API changes (from Hackage documentation)
Files
- tests/a/b +0/−0
- tests/runtests.hs +162/−0
- wai-app-static.cabal +7/−3
+ tests/a/b view
+ tests/runtests.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}+import Network.Wai.Application.Static++import Test.Hspec.Monadic+import Test.Hspec.QuickCheck+import Test.Hspec.HUnit ()+import Test.HUnit ((@?=), assert)+import Distribution.Simple.Utils (isInfixOf)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import System.PosixCompat.Files (getFileStatus, modificationTime)++import Network.HTTP.Date+{-import System.Locale (defaultTimeLocale)-}+{-import Data.Time.Format (formatTime)-}++import Network.Wai+import Network.Wai.Test++import Network.Socket.Internal as Sock+import qualified Network.HTTP.Types as H+import Control.Monad.IO.Class (liftIO)++defRequest :: Request+defRequest = Request {+ rawQueryString = ""+, queryString = []+, requestMethod = "GET"+, rawPathInfo = ""+, pathInfo = []+, requestHeaders = []+, serverName = "wai-test"+, httpVersion = H.http11+, serverPort = 80+, isSecure = False+, remoteHost = Sock.SockAddrInet 1 2+}++setRawPathInfo :: Request -> S8.ByteString -> Request+setRawPathInfo r rawPinfo = + let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo+ in r { rawPathInfo = rawPinfo, pathInfo = pInfo }+++main :: IO a+main = hspecX $ do+ let must = liftIO . assert++ let webApp = flip runSession $ staticApp defaultWebAppSettings {ssFolder = fileSystemLookup "tests"}+ let fileServerApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}++ let etag = "1B2M2Y8AsgTpgAmY7PhCfg=="+ let file = "a/b"+ let statFile = setRawPathInfo defRequest file+++ describe "Pieces: pathFromPieces" $ do+ it "converts to a file path" $+ (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"++ prop "each piece is in file path" $ \piecesS ->+ let pieces = map (FilePath . T.pack) piecesS+ in all (\p -> ("/" ++ p) `isInfixOf` (T.unpack $ unFilePath $ pathFromPieces "root" $ pieces)) piecesS++ describe "webApp" $ do+ it "403 for unsafe paths" $ webApp $+ flip mapM_ ["..", "."] $ \path ->+ assertStatus 403 =<<+ request (setRawPathInfo defRequest path)++ it "200 for hidden paths" $ webApp $+ flip mapM_ [".hidden/folder.png", ".hidden/haskell.png"] $ \path ->+ assertStatus 200 =<<+ request (setRawPathInfo defRequest path)++ it "404 for non-existant files" $ webApp $+ assertStatus 404 =<<+ request (setRawPathInfo defRequest "doesNotExist")++ it "301 redirect when multiple slashes" $ webApp $ do+ req <- request (setRawPathInfo defRequest "a//b/c")+ assertStatus 301 req+ assertHeader "Location" "../../a/b/c" req++ let absoluteApp = flip runSession $ staticApp $ defaultWebAppSettings {+ ssFolder = fileSystemLookup "tests", ssMkRedirect = \_ u -> S8.append "http://www.example.com" u+ }+ it "301 redirect when multiple slashes" $ absoluteApp $+ flip mapM_ ["/a//b/c", "a//b/c"] $ \path -> do+ req <- request (setRawPathInfo defRequest path)+ assertStatus 301 req+ assertHeader "Location" "http://www.example.com/a/b/c" req++ describe "webApp when requesting a static asset" $ do+ it "200 and etag when no etag query parameters" $ webApp $ do+ req <- request statFile+ assertStatus 200 req+ assertNoHeader "Cache-Control" req+ assertHeader "ETag" etag req+ assertNoHeader "Last-Modified" req++ it "200 when no cache headers and bad cache query string" $ webApp $ do+ flip mapM_ [Just "cached", Nothing] $ \badETag -> do+ req <- request statFile { queryString = [("etag", badETag)] }+ assertStatus 301 req+ assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req+ assertNoHeader "Cache-Control" req+ assertNoHeader "Last-Modified" req++ it "Cache-Control set when etag parameter is correct" $ webApp $ do+ req <- request statFile { queryString = [("etag", Just etag)] }+ assertStatus 200 req+ assertHeader "Cache-Control" "max-age=31536000" req+ assertNoHeader "Last-Modified" req++ it "200 when invalid in-none-match sent" $ webApp $+ flip mapM_ ["cached", ""] $ \badETag -> do+ req <- request statFile { requestHeaders = [("If-None-Match", badETag)] }+ assertStatus 200 req+ assertHeader "ETag" etag req+ assertNoHeader "Last-Modified" req++ it "304 when valid if-none-match sent" $ webApp $ do+ req <- request statFile { requestHeaders = [("If-None-Match", etag)] }+ assertStatus 304 req+ assertNoHeader "Etag" req+ assertNoHeader "Last-Modified" req++ describe "fileServerApp" $ do+ let fileDate = do+ stat <- liftIO $ getFileStatus $ "tests/" ++ file+ return $ formatHTTPDate . epochTimeToHTTPDate $ modificationTime stat++ it "directory listing for index" $ fileServerApp $ do+ resp <- request (setRawPathInfo defRequest "a/")+ assertStatus 200 resp+ let body = simpleBody resp+ let contains a b = isInfixOf b (L8.unpack a)+ must $ body `contains` "<img src=\"../.hidden/haskell.png\" />"+ must $ body `contains` "<img src=\"../.hidden/folder.png\" alt=\"Folder\" />"+ must $ body `contains` "<a href=\"b\">b</a>"++ it "200 when invalid if-modified-since header" $ fileServerApp $ do+ flip mapM_ ["123", ""] $ \badDate -> do+ req <- request statFile {+ requestHeaders = [("If-Modified-Since", badDate)]+ }+ assertStatus 200 req+ assertNoHeader "Cache-Control" req+ fdate <- fileDate+ assertHeader "Last-Modified" fdate req++ it "304 when if-modified-since matches" $ fileServerApp $ do+ fdate <- fileDate+ req <- request statFile {+ requestHeaders = [("If-Modified-Since", fdate)]+ }+ assertStatus 304 req+ assertNoHeader "Cache-Control" req+
wai-app-static.cabal view
@@ -1,5 +1,5 @@ name: wai-app-static-version: 0.3.3+version: 0.3.4 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -11,7 +11,11 @@ cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/wai-Extra-source-files: folder.png, haskell.png+Extra-source-files:+ folder.png+ haskell.png+ tests/runtests.hs+ tests/a/b Flag print Description: print debug info@@ -48,7 +52,7 @@ type: exitcode-stdio-1.0 build-depends: base >= 4 && < 5- , hspec >= 0.6.1 && < 0.7+ , hspec >= 0.8 && < 0.9 , HUnit , unix-compat >= 0.2 && < 0.3 , time >= 1.1.4 && < 1.4