wai-app-static-3.2.1: test/WaiAppStaticTest.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module WaiAppStaticTest (spec) where
import Network.Wai.Application.Static
import WaiAppStatic.Types
import qualified Data.ByteString.Char8 as S8
import Test.Hspec
import Test.Mockery.Directory
-- import qualified Data.ByteString.Lazy.Char8 as L8
import System.FilePath
import System.IO.Temp
import System.PosixCompat.Files (getFileStatus, modificationTime)
import Network.HTTP.Date
import Network.HTTP.Types (status500)
{-import System.Locale (defaultTimeLocale)-}
{-import Data.Time.Format (formatTime)-}
import Network.Wai
import Network.Wai.Test
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import Network.Mime
defRequest :: Request
defRequest = defaultRequest
spec :: Spec
spec = do
let webApp = flip runSession $ staticApp $ defaultWebAppSettings "test"
let fileServerAppWithSettings settings = flip runSession $ staticApp settings
let fileServerApp =
fileServerAppWithSettings
(defaultFileServerSettings "test")
{ ssAddTrailingSlash = True
}
let etag = "1B2M2Y8AsgTpgAmY7PhCfg=="
let file = "a/b"
let statFile = setRawPathInfo defRequest file
describe "mime types" $ do
it "fileNameExtensions" $
fileNameExtensions "foo.tar.gz" `shouldBe` ["tar.gz", "gz"]
it "handles multi-extensions" $
defaultMimeLookup "foo.tar.gz" `shouldBe` "application/x-tgz"
it "defaults correctly" $
defaultMimeLookup "foo.unknown" `shouldBe` "application/octet-stream"
describe "webApp" $ do
it "403 for unsafe paths" $
webApp $
forM_ ["..", "."] $ \path ->
assertStatus 403
=<< request (setRawPathInfo defRequest path)
it "200 for hidden paths" $
webApp $
forM_ [".hidden/folder.png", ".hidden/haskell.png"] $ \path ->
assertStatus 200
=<< request (setRawPathInfo defRequest path)
it "404 for non-existent files" $
webApp $
assertStatus 404
=<< request (setRawPathInfo defRequest "doesNotExist")
it "302 redirect when multiple slashes" $ webApp $ do
req <- request (setRawPathInfo defRequest "a//b/c")
assertStatus 302 req
assertHeader "Location" "../../a/b/c" req
let absoluteApp =
flip runSession $
staticApp $
(defaultWebAppSettings "test")
{ ssMkRedirect = \_ u -> S8.append "http://www.example.com" u
}
it "302 redirect when multiple slashes" $
absoluteApp $
forM_ ["/a//b/c", "a//b/c"] $ \path -> do
req <- request (setRawPathInfo defRequest path)
assertStatus 302 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
assertHeader "ETag" etag 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" "public, max-age=31536000" req
assertNoHeader "Last-Modified" req
it "200 when invalid in-none-match sent" $
webApp $
forM_ ["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
forM_ ["123", ""] $ \badDate -> do
req <-
request
statFile
{ requestHeaders = [("If-Modified-Since", badDate)]
}
assertStatus 200 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
context "302 redirect to add a trailing slash on directories if missing" $ do
it "works at the root" $ fileServerApp $ do
req <- request (setRawPathInfo defRequest "/a")
assertStatus 302 req
assertHeader "Location" "/a/" req
it "works when an index.html is delivered" $ do
let settings =
(defaultFileServerSettings ".")
{ ssAddTrailingSlash = True
}
inTempDirectory $ fileServerAppWithSettings settings $ do
liftIO $ touch "foo/index.html"
req <- request (setRawPathInfo defRequest "/foo")
assertStatus 302 req
assertHeader "Location" "/foo/" req
let urlMapApp = flip runSession $ \req send ->
case pathInfo req of
"subPath" : rest ->
let req' = req{pathInfo = rest}
in ( staticApp
(defaultFileServerSettings "test")
{ ssAddTrailingSlash = True
}
)
req'
send
_ ->
send $
responseLBS
status500
[]
"urlMapApp: only works at subPath"
it "works with subpath at the root of the file server" $ urlMapApp $ do
req <- request (setRawPathInfo defRequest "/subPath")
assertStatus 302 req
assertHeader "Location" "/subPath/" req
context "with defaultWebAppSettings" $ do
it "ssIndices works" $ do
withSystemTempDirectory "wai-app-static-test" $ \dir -> do
writeFile (dir </> "index.html") "foo"
let testSettings =
(defaultWebAppSettings dir)
{ ssIndices = [unsafeToPiece "index.html"]
}
fileServerAppWithSettings testSettings $ do
resp <- request (setRawPathInfo defRequest "/")
assertStatus 200 resp
assertBody "foo" resp
context "with defaultFileServerSettings" $ do
it "prefers ssIndices over ssListing" $ do
withSystemTempDirectory "wai-app-static-test" $ \dir -> do
writeFile (dir </> "index.html") "foo"
let testSettings = defaultFileServerSettings dir
fileServerAppWithSettings testSettings $ do
resp <- request (setRawPathInfo defRequest "/")
assertStatus 200 resp
assertBody "foo" resp