wai-app-static 3.1.5 → 3.1.6
raw patch · 7 files changed
+76/−34 lines, 7 filesdep +mockeryPVP ok
version bump matches the API change (PVP)
Dependencies added: mockery
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- Network/Wai/Application/Static.hs +36/−32
- Util.hs +8/−1
- test/EmbeddedTestEntries.hs +5/−0
- test/WaiAppEmbeddedTest.hs +9/−0
- test/WaiAppStaticTest.hs +11/−0
- wai-app-static.cabal +2/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 3.1.6++* Make ssAddTrailingSlash work in combination with ssIndices [#569](https://github.com/yesodweb/wai/pull/569)+* Make ssIndices work with ssLookupFile and trailing slashes [#570](https://github.com/yesodweb/wai/pull/570)+ ## 3.1.5 * Switch to cryponite
Network/Wai/Application/Static.hs view
@@ -87,14 +87,14 @@ Nothing -> return $ WaiResponse $ W.responseLBS H.status403 [ ("Content-Type", "text/plain") ] "Directory listings disabled"++addTrailingSlash :: W.Request -> Maybe ByteString+addTrailingSlash req+ | S8.null rp = Just "/"+ | S8.last rp == '/' = Nothing+ | otherwise = Just $ S8.snoc rp '/' where- addTrailingSlash :: W.Request -> Maybe ByteString- addTrailingSlash req- | S8.null rp = Just "/"- | S8.last rp == '/' = Nothing- | otherwise = Just $ S8.snoc rp '/'- where- rp = W.rawPathInfo req+ rp = W.rawPathInfo req checkPieces :: StaticSettings -> Pieces -- ^ parsed request@@ -108,45 +108,49 @@ checkPieces ss@StaticSettings {..} pieces req = do res <- lookupResult case res of- Left location -> return $ RawRedirect $ TE.encodeUtf8 location+ Left location -> return $ RawRedirect location Right LRNotFound -> return NotFound Right (LRFile file) -> serveFile ss req file Right (LRFolder folder) -> serveFolder ss pieces req folder where- lookupResult :: IO (Either Text LookupResult)+ lookupResult :: IO (Either ByteString LookupResult) lookupResult = do nonIndexResult <- ssLookupFile pieces case nonIndexResult of LRFile{} -> return $ Right nonIndexResult _ -> do- indexResult <- lookupIndices (map (\ index -> pieces ++ [index]) ssIndices)- return $ case indexResult of- LRNotFound -> Right nonIndexResult- LRFile file | ssRedirectToIndex ->- let relPath =- case reverse pieces of- -- Served at root- [] -> fromPiece $ fileName file- lastSegment:_ ->- case fromPiece lastSegment of- -- Ends with a trailing slash- "" -> fromPiece $ fileName file- -- Lacks a trailing slash- lastSegment' -> T.concat- [ lastSegment'- , "/"- , fromPiece $ fileName file- ]- in Left relPath- _ -> Right indexResult+ eIndexResult <- lookupIndices (map (\ index -> dropLastIfNull pieces ++ [index]) ssIndices)+ return $ case eIndexResult of+ Left redirect -> Left redirect+ Right indexResult -> case indexResult of+ LRNotFound -> Right nonIndexResult+ LRFile file | ssRedirectToIndex ->+ let relPath =+ case reverse pieces of+ -- Served at root+ [] -> fromPiece $ fileName file+ lastSegment:_ ->+ case fromPiece lastSegment of+ -- Ends with a trailing slash+ "" -> fromPiece $ fileName file+ -- Lacks a trailing slash+ lastSegment' -> T.concat+ [ lastSegment'+ , "/"+ , fromPiece $ fileName file+ ]+ in Left $ TE.encodeUtf8 relPath+ _ -> Right indexResult - lookupIndices :: [Pieces] -> IO LookupResult+ lookupIndices :: [Pieces] -> IO (Either ByteString LookupResult) lookupIndices (x : xs) = do res <- ssLookupFile x case res of LRNotFound -> lookupIndices xs- _ -> return res- lookupIndices [] = return LRNotFound+ _ -> return $ case (ssAddTrailingSlash, addTrailingSlash req) of+ (True, Just redirect) -> Left redirect+ _ -> Right res+ lookupIndices [] = return $ Right LRNotFound serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse serveFile StaticSettings {..} req file
Util.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ViewPatterns #-} module Util ( relativeDirFromPieces , defaultMkRedirect , replace , remove+ , dropLastIfNull ) where import WaiAppStatic.Types@@ -36,3 +37,9 @@ | otherwise = relDir `S8.append` S8.tail newPath where relDir = TE.encodeUtf8 (relativeDirFromPieces pieces)++dropLastIfNull :: [Piece] -> [Piece]+dropLastIfNull pieces = case pieces of+ [fromPiece -> ""] -> []+ (a : r) -> a : dropLastIfNull r+ [] -> []
test/EmbeddedTestEntries.hs view
@@ -47,4 +47,9 @@ , EmbeddableEntry "index.html" "text/html" (Right [| return ("" :: T.Text, "index file") |] )++ -- An index file in a subdir+ , EmbeddableEntry "foo/index.html"+ "text/html"+ (Right [| return ("" :: T.Text, "index file in subdir") |] ) ]
test/WaiAppEmbeddedTest.hs view
@@ -41,6 +41,15 @@ assertStatus 200 req assertBody "index file" req + it "ssIndices works with trailing slashes" $ do+ let testSettings = $(mkSettings mkEntries){+ ssIndices = [unsafeToPiece "index.html"]+ }+ embedSettings testSettings $ do+ req <- request (setRawPathInfo defRequest "/foo/")+ assertStatus 200 req+ assertBody "index file in subdir" req+ describe "embedded, uncompressed entry" $ do it "too short" $ embed $ do req <- request (setRawPathInfo defRequest "e2.txt")
test/WaiAppStaticTest.hs view
@@ -5,6 +5,7 @@ import WaiAppStatic.Types import Test.Hspec+import Test.Mockery.Directory import qualified Data.ByteString.Char8 as S8 -- import qualified Data.ByteString.Lazy.Char8 as L8 import System.PosixCompat.Files (getFileStatus, modificationTime)@@ -135,6 +136,16 @@ req <- request (setRawPathInfo defRequest "/a") assertStatus 301 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 301 req+ assertHeader "Location" "/foo/" req let urlMapApp = flip runSession $ \req send -> case pathInfo req of
wai-app-static.cabal view
@@ -1,5 +1,5 @@ name: wai-app-static-version: 3.1.5+version: 3.1.6 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -101,6 +101,7 @@ , zlib , filepath , temporary+ , mockery -- , containers ghc-options: -Wall