@@ -40,9 +40,7 @@ import Data.FileEmbed (embedFile)
4040import Data.Text (Text)
4141import qualified Data.Text as T
4242
43−import Data.Either (rights)
4443import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
45−import Data.Monoid (First (First, getFirst), mconcat)
4644
4745import WaiAppStatic.Types
4846import Util
@@ -74,38 +72,20 @@ filterButLast f (x:xs)
7472
7573-- | Serve an appropriate response for a folder request.
7674serveFolder :: StaticSettings -> Pieces -> W.Request -> Folder -> IO StaticResponse
77−serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
78− -- first check if there is an index file in this folder
79− case getFirst $ mconcat $ map (findIndex $ rights folderContents) ssIndices of
80− Just index ->
81− let pieces' = setLast pieces index in
82− case () of
83− () | ssRedirectToIndex -> return $ Redirect pieces' Nothing
84− | Just path <- addTrailingSlash req, ssAddTrailingSlash ->
85− return $ RawRedirect path
86− | otherwise ->
87− -- start the checking process over, with a new set
88− checkPieces ss pieces' req
89− Nothing ->
90− case ssListing of
91− Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->
92− return $ RawRedirect path
93− Just listing -> do
94− -- directory listings turned on, display it
95− builder <- listing pieces folder
96− return $ WaiResponse $ W.responseBuilder H.status200
97− [ ("Content-Type", "text/html; charset=utf-8")
98− ] builder
99− Nothing -> return $ WaiResponse $ W.responseLBS H.status403
100− [ ("Content-Type", "text/plain")
101− ] "Directory listings disabled"
75+serveFolder StaticSettings {..} pieces req folder@Folder {..} =
76+ case ssListing of
77+ Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->
78+ return $ RawRedirect path
79+ Just listing -> do
80+ -- directory listings turned on, display it
81+ builder <- listing pieces folder
82+ return $ WaiResponse $ W.responseBuilder H.status200
83+ [ ("Content-Type", "text/html; charset=utf-8")
84+ ] builder
85+ Nothing -> return $ WaiResponse $ W.responseLBS H.status403
86+ [ ("Content-Type", "text/plain")
87+ ] "Directory listings disabled"
10288 where
103− setLast :: Pieces -> Piece -> Pieces
104− setLast [] x = [x]
105− setLast [t] x
106− | fromPiece t == "" = [x]
107− setLast (a:b) x = a : setLast b x
108−
10989 addTrailingSlash :: W.Request -> Maybe ByteString
11090 addTrailingSlash req
11191 | S8.null rp = Just "/"
@@ -114,16 +94,6 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
11494 where
11595 rp = W.rawPathInfo req
11696
117− noTrailingSlash :: Pieces -> Bool
118− noTrailingSlash [] = False
119− noTrailingSlash [x] = fromPiece x /= ""
120− noTrailingSlash (_:xs) = noTrailingSlash xs
121−
122− findIndex :: [File] -> Piece -> First Piece
123− findIndex files index
124− | index `elem` map fileName files = First $ Just index
125− | otherwise = First Nothing
126−
12797checkPieces :: StaticSettings
12898 -> Pieces -- ^ parsed request
12999 -> W.Request
@@ -133,12 +103,17 @@ checkPieces :: StaticSettings
133103checkPieces _ pieces _ | any (T.null . fromPiece) $ safeInit pieces =
134104 return $ Redirect (filterButLast (not . T.null . fromPiece) pieces) Nothing
135105
136−checkPieces ss@StaticSettings {..} pieces req = do
137− res <- ssLookupFile pieces
138− case res of
139− LRNotFound -> return NotFound
140− LRFile file -> serveFile ss req file
141− LRFolder folder -> serveFolder ss pieces req folder
106+checkPieces ss@StaticSettings {..} pieces req =
107+ lookupPieces (map (\ index -> pieces ++ [index]) ssIndices ++ [pieces])
108+ where
109+ lookupPieces :: [Pieces] -> IO StaticResponse
110+ lookupPieces (x : xs) = do
111+ res <- ssLookupFile x
112+ case res of
113+ LRNotFound -> lookupPieces xs
114+ LRFile file -> serveFile ss req file
115+ LRFolder folder -> serveFolder ss x req folder
116+ lookupPieces [] = return NotFound
142117
143118serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse
144119serveFile StaticSettings {..} req file