wai-app-static 0.3.4 → 0.3.5
raw patch · 11 files changed
+187/−187 lines, 11 filesdep −Cabaldep ~directorydep ~hspecdep ~textbinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies removed: Cabal
Dependency ranges changed: directory, hspec, text, unix-compat
API changes (from Hackage documentation)
Files
- Network/Wai/Application/Static.hs +10/−12
- folder.png binary
- haskell.png binary
- images/folder.png binary
- images/haskell.png binary
- test/WaiAppStaticTest.hs +159/−0
- test/a/b +0/−0
- tests.hs +5/−0
- tests/a/b +0/−0
- tests/runtests.hs +0/−162
- wai-app-static.cabal +13/−13
Network/Wai/Application/Static.hs view
@@ -248,9 +248,9 @@ checkSpecialDirListing :: Pieces -> Maybe CheckPieces checkSpecialDirListing [".hidden", "folder.png"] =- Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "folder.png")]+ Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "images/folder.png")] checkSpecialDirListing [".hidden", "haskell.png"] =- Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "haskell.png")]+ Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "images/haskell.png")] checkSpecialDirListing _ = Nothing checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function@@ -641,16 +641,14 @@ [ ("Content-Type", "text/plain") ] "File not found" -{--The problem is that the System.Directory functions are a lie: they-claim to be using String, but it's really just a raw byte sequence.-We're assuming that non-Windows systems use UTF-8 encoding (there was-a discussion regarding this, it wasn't an arbitrary decision). So we-need to encode/decode the byte sequence to/from UTF8. That's the use-case for fixPathName/unfixPathName. I'm starting to use John-Millikin's system-filepath package for some stuff with work, and might-consider migrating over to it for this in the future.--}+-- | System.Directory functions are a lie:+-- they claim to be using String, but it's really just a raw byte sequence.+-- We're assuming that non-Windows systems use UTF-8 encoding (there was+-- a discussion regarding this, it wasn't an arbitrary decision). So we+-- need to encode/decode the byte sequence to/from UTF8. That's the use+-- case for fixPathName/unfixPathName. I'm starting to use John+-- Millikin's system-filepath package for some stuff with work, and might+-- consider migrating over to it for this in the future. toFilePath :: Prelude.FilePath -> FilePath #if defined(mingw32_HOST_OS) toFilePath = FilePath . T.pack
− folder.png
binary file changed (891 → absent bytes)
− haskell.png
binary file changed (683 → absent bytes)
+ images/folder.png view
binary file changed (absent → 891 bytes)
+ images/haskell.png view
binary file changed (absent → 683 bytes)
+ test/WaiAppStaticTest.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}+module WaiAppStaticTest (specs) where ++import Network.Wai.Application.Static++import Test.Hspec.Monadic+import Test.Hspec.QuickCheck+import Test.Hspec.HUnit ()+import Test.HUnit ((@?=))+import Data.List (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 }++specs :: Specs+specs = do+ let webApp = flip runSession $ staticApp defaultWebAppSettings {ssFolder = fileSystemLookup "test"}+ let fileServerApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "test"}++ 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 "test", 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 $ "test/" ++ file+ return $ formatHTTPDate . epochTimeToHTTPDate $ modificationTime stat++ it "directory listing for index" $ fileServerApp $ do+ resp <- request (setRawPathInfo defRequest "a/")+ assertStatus 200 resp+ -- note the unclosed img tags so both /> and > will pass+ assertBodyContains "<img src=\"../.hidden/haskell.png\"" resp+ assertBodyContains "<img src=\"../.hidden/folder.png\" alt=\"Folder\"" resp+ assertBodyContains "<a href=\"b\">b</a>" resp++ 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+
+ test/a/b view
+ tests.hs view
@@ -0,0 +1,5 @@+import WaiAppStaticTest (specs)+import Test.Hspec.Monadic++main :: IO a+main = hspecX specs
− tests/a/b
− tests/runtests.hs
@@ -1,162 +0,0 @@-{-# 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.4+version: 0.3.5 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -12,10 +12,11 @@ build-type: Simple homepage: http://www.yesodweb.com/book/wai Extra-source-files:- folder.png- haskell.png- tests/runtests.hs- tests/a/b+ images/folder.png+ images/haskell.png+ test/WaiAppStaticTest.hs+ test/a/b+ tests.hs Flag print Description: print debug info@@ -27,14 +28,14 @@ , bytestring >= 0.9.1.4 && < 0.10 , http-types >= 0.6 && < 0.7 , transformers >= 0.2.2 && < 0.3- , unix-compat >= 0.2 && < 0.3- , directory >= 1.0 && < 1.2+ , unix-compat >= 0.2+ , directory >= 1.0.1 && < 1.2 , containers >= 0.2 && < 0.5 , blaze-html >= 0.4 && < 0.5 , time >= 1.1.4 && < 1.4 , old-locale >= 1.0.0.2 && < 1.1 , file-embed >= 0.0.3.1 && < 0.1- , text >= 0.5 && < 1.0+ , text >= 0.7 && < 0.12 , blaze-builder >= 0.2.1.4 && < 0.4 , base64-bytestring >= 0.1 && < 0.2 , cryptohash >= 0.7 && < 0.8@@ -47,18 +48,17 @@ cpp-options: -DPRINT test-suite runtests- hs-source-dirs: tests- main-is: runtests.hs+ hs-source-dirs: test+ main-is: ../tests.hs type: exitcode-stdio-1.0 build-depends: base >= 4 && < 5- , hspec >= 0.8 && < 0.9+ , hspec >= 0.8 && < 0.10 , HUnit- , unix-compat >= 0.2 && < 0.3+ , unix-compat >= 0.2 , time >= 1.1.4 && < 1.4 , old-locale >= 1.0.0.2 && < 1.1 , http-date- , Cabal , wai-app-static >= 0.3 , wai-test , wai