@@ -153,9 +153,10 @@ stripTrailingSlash "" = ""
153153stripTrailingSlash (x:xs) = x : stripTrailingSlash xs
154154
155155checkPieces :: FilePath -- ^ static file prefix
156+ -> [FilePath] -- ^ List of default index files. Cannot contain slashes.
156157 -> [String] -- ^ parsed request
157158 -> IO CheckPieces
158−checkPieces prefix pieces
159+checkPieces prefix indices pieces
159160 | any unsafe pieces = return Forbidden
160161 | anyButLast null pieces =
161162 return $ Redirect $ filterButLast (not . null) pieces
@@ -173,10 +174,27 @@ checkPieces prefix pieces
173174 (True, False) -> return $ Redirect $ init pieces
174175 (False, _) -> do
175176 de <- doesDirectoryExist fp
176− case (de, isFolder) of
177− (True, True) -> return $ DirectoryResponse fp
178− (True, False) -> return $ Redirect $ pieces ++ [""]
179− (False, _) -> return NotFound
177+ if de
178+ then do
179+ x <- checkIndices fp indices
180+ case x of
181+ Just index -> return $ Redirect $ setLast pieces index
182+ Nothing ->
183+ if isFolder
184+ then return $ DirectoryResponse fp
185+ else return $ Redirect $ pieces ++ [""]
186+ else return NotFound
187+ where
188+ setLast [] x = [x]
189+ setLast [""] x = [x]
190+ setLast (a:b) x = a : setLast b x
191+ checkIndices _ [] = return Nothing
192+ checkIndices fp (i:is) = do
193+ let fp' = fp ++ '/' : i
194+ fe <- doesFileExist fp'
195+ if fe
196+ then return $ Just i
197+ else checkIndices fp is
180198
181199type Listing = FilePath -> IO L.ByteString
182200
@@ -190,7 +208,7 @@ data StaticSettings = StaticSettings
190208staticApp :: StaticSettings -> W.Application
191209staticApp (StaticSettings folder indices mlisting getmime) req = liftIO $ do
192210 let pieces = decodePathInfo $ S8.unpack $ W.pathInfo req
193− cp <- checkPieces folder pieces
211+ cp <- checkPieces folder indices pieces
194212 case cp of
195213 Redirect pieces' -> do
196214 let loc = S8.pack $ '/' : encodePathInfo pieces' []
@@ -204,29 +222,20 @@ staticApp (StaticSettings folder indices mlisting getmime) req = liftIO $ do
204222 NotFound -> return $ W.responseLBS W.status404
205223 [ ("Content-Type", "text/plain")
206224 ] "File not found"
207− FileResponse fp -> sendfile fp
208− DirectoryResponse fp -> sendfolder fp indices
209− where
210− sendfolder fp (i:is) = do
211− let fp' = fp ++ '/' : i
212− fe <- doesFileExist fp'
213− if fe
214− then sendfile fp'
215− else sendfolder fp is
216− sendfolder fp [] =
217− case mlisting of
218− Just listing -> do
219− lbs <- listing fp
220− return $ W.responseLBS W.status200
221− [ ("Content-Type", "text/html")
222− ] lbs
223− Nothing -> return $ W.responseLBS W.status403
224− [ ("Content-Type", "text/plain")
225− ] "Directory listings disabled"
226− sendfile fp = do
227− mimetype <- getmime fp
228− filesize <- fileSize `fmap` getFileStatus fp
229− return $ W.ResponseFile W.status200
230− [ ("Content-Type", mimetype)
231− , ("Content-Length", S8.pack $ show filesize)
232− ] fp
225+ FileResponse fp -> do
226+ mimetype <- getmime fp
227+ filesize <- fileSize `fmap` getFileStatus fp
228+ return $ W.ResponseFile W.status200
229+ [ ("Content-Type", mimetype)
230+ , ("Content-Length", S8.pack $ show filesize)
231+ ] fp
232+ DirectoryResponse fp ->
233+ case mlisting of
234+ Just listing -> do
235+ lbs <- listing fp
236+ return $ W.responseLBS W.status200
237+ [ ("Content-Type", "text/html")
238+ ] lbs
239+ Nothing -> return $ W.responseLBS W.status403
240+ [ ("Content-Type", "text/plain")
241+ ] "Directory listings disabled"