wai-app-static 3.1.1 → 3.1.2

raw patch · 6 files changed

+84/−51 lines, 6 filesdep +temporaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: temporary

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/Wai/Application/Static.hs +33/−44
• test/EmbeddedTestEntries.hs +5/−0
• test/WaiAppEmbeddedTest.hs +12/−5
• test/WaiAppStaticTest.hs +27/−1
• wai-app-static.cabal +3/−1

@@ -1,3 +1,7 @@+## 3.1.2++* Honor ssIndices when used with defaultWebAppSettings [#460](https://github.com/yesodweb/wai/pull/460)+ ## 3.1.1  * Make adding a trailing slash optional [#327](https://github.com/yesodweb/wai/issues/327) [yesod#988](https://github.com/yesodweb/yesod/issues/988)

@@ -40,9 +40,7 @@ import Data.Text (Text) import qualified Data.Text as T -import Data.Either (rights) import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)-import Data.Monoid (First (First, getFirst), mconcat)  import WaiAppStatic.Types import Util@@ -74,38 +72,20 @@  -- | Serve an appropriate response for a folder request. serveFolder :: StaticSettings -> Pieces -> W.Request -> Folder -> IO StaticResponse-serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =-    -- first check if there is an index file in this folder-    case getFirst $ mconcat $ map (findIndex $ rights folderContents) ssIndices of-        Just index ->-            let pieces' = setLast pieces index in-            case () of-              () | ssRedirectToIndex -> return $ Redirect pieces' Nothing-                 | Just path <- addTrailingSlash req, ssAddTrailingSlash ->-                    return $ RawRedirect path-                 | otherwise ->-                    -- start the checking process over, with a new set-                    checkPieces ss pieces' req-        Nothing ->-            case ssListing of-                Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->-                    return $ RawRedirect path-                Just listing -> do-                    -- directory listings turned on, display it-                    builder <- listing pieces folder-                    return $ WaiResponse $ W.responseBuilder H.status200-                        [ ("Content-Type", "text/html; charset=utf-8")-                        ] builder-                Nothing -> return $ WaiResponse $ W.responseLBS H.status403-                    [ ("Content-Type", "text/plain")-                    ] "Directory listings disabled"+serveFolder StaticSettings {..} pieces req folder@Folder {..} =+    case ssListing of+        Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->+            return $ RawRedirect path+        Just listing -> do+            -- directory listings turned on, display it+            builder <- listing pieces folder+            return $ WaiResponse $ W.responseBuilder H.status200+                [ ("Content-Type", "text/html; charset=utf-8")+                ] builder+        Nothing -> return $ WaiResponse $ W.responseLBS H.status403+            [ ("Content-Type", "text/plain")+            ] "Directory listings disabled"   where-    setLast :: Pieces -> Piece -> Pieces-    setLast [] x = [x]-    setLast [t] x-        | fromPiece t == "" = [x]-    setLast (a:b) x = a : setLast b x-     addTrailingSlash :: W.Request -> Maybe ByteString     addTrailingSlash req         | S8.null rp = Just "/"@@ -114,16 +94,6 @@       where         rp = W.rawPathInfo req -    noTrailingSlash :: Pieces -> Bool-    noTrailingSlash [] = False-    noTrailingSlash [x] = fromPiece x /= ""-    noTrailingSlash (_:xs) = noTrailingSlash xs--    findIndex :: [File] -> Piece -> First Piece-    findIndex files index-        | index `elem` map fileName files = First $ Just index-        | otherwise = First Nothing- checkPieces :: StaticSettings             -> Pieces                    -- ^ parsed request             -> W.Request@@ -134,11 +104,30 @@     return $ Redirect (filterButLast (not . T.null . fromPiece) pieces) Nothing  checkPieces ss@StaticSettings {..} pieces req = do-    res <- ssLookupFile pieces+    res <- lookupResult     case res of         LRNotFound -> return NotFound         LRFile file -> serveFile ss req file         LRFolder folder -> serveFolder ss pieces req folder+  where+    lookupResult :: IO LookupResult+    lookupResult = do+      nonIndexResult <- ssLookupFile pieces+      case nonIndexResult of+          LRFile{} -> return nonIndexResult+          _ -> do+              indexResult <- lookupIndices (map (\ index -> pieces ++ [index]) ssIndices)+              return $ case indexResult of+                  LRNotFound -> nonIndexResult+                  _ -> indexResult++    lookupIndices :: [Pieces] -> IO LookupResult+    lookupIndices (x : xs) = do+        res <- ssLookupFile x+        case res of+            LRNotFound -> lookupIndices xs+            _ -> return res+    lookupIndices [] = return LRNotFound  serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse serveFile StaticSettings {..} req file

@@ -42,4 +42,9 @@   , EmbeddableEntry "e6.txt"                     "text/plain"                     (Right [| return ("" :: T.Text, body 1000 'W') |] )++    -- An index file+  , EmbeddableEntry "index.html"+                    "text/html"+                    (Right [| return ("" :: T.Text, "index file") |] )   ]

@@ -8,16 +8,15 @@ import Network.Wai.Test import Test.Hspec import WaiAppStatic.Storage.Embedded--embApp :: Application-embApp = staticApp $(mkSettings mkEntries)+import WaiAppStatic.Types  defRequest :: Request defRequest = defaultRequest  embSpec :: Spec embSpec = do-    let embed = flip runSession embApp+    let embedSettings settings = flip runSession (staticApp settings)+    let embed = embedSettings $(mkSettings mkEntries)     describe "embedded, compressed entry" $ do         it "served correctly" $ embed $ do             req <- request (setRawPathInfo defRequest "e1.txt")@@ -33,6 +32,15 @@                              { requestHeaders = [("If-None-Match", "Etag 1")] }             assertStatus 304 req +        it "ssIndices works" $ do+            let testSettings = $(mkSettings mkEntries){+                    ssIndices = [unsafeToPiece "index.html"]+                }+            embedSettings testSettings $ do+              req <- request defRequest+              assertStatus 200 req+              assertBody "index file" req+     describe "embedded, uncompressed entry" $ do         it "too short" $ embed $ do             req <- request (setRawPathInfo defRequest "e2.txt")@@ -75,4 +83,3 @@             assertNoHeader "Content-Encoding" req             assertNoHeader "ETag" req             assertBody (body 1000 'W') req-

@@ -2,11 +2,14 @@ module WaiAppStaticTest (spec) where  import Network.Wai.Application.Static+import WaiAppStatic.Types  import Test.Hspec import qualified Data.ByteString.Char8 as S8 -- import qualified Data.ByteString.Lazy.Char8 as L8 import System.PosixCompat.Files (getFileStatus, modificationTime)+import System.FilePath+import System.IO.Temp  import Network.HTTP.Date import Network.HTTP.Types (status500)@@ -25,7 +28,8 @@ spec :: Spec spec = do   let webApp = flip runSession $ staticApp $ defaultWebAppSettings "test"-  let fileServerApp = flip runSession $ staticApp (defaultFileServerSettings "test")+  let fileServerAppWithSettings settings = flip runSession $ staticApp settings+  let fileServerApp = fileServerAppWithSettings (defaultFileServerSettings "test")         { ssAddTrailingSlash = True         } @@ -145,3 +149,25 @@         req <- request (setRawPathInfo defRequest "/subPath")         assertStatus 301 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

@@ -1,5 +1,5 @@ name:            wai-app-static-version:         3.1.1+version:         3.1.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -102,6 +102,8 @@                    , transformers                    , mime-types                    , zlib+                   , filepath+                   , temporary                    -- , containers   ghc-options:   -Wall