@@ -68,7 +68,6 @@ import Data.Time
68import Data.Time.Clock.POSIX
68import Data.Time.Clock.POSIX
69import System.Locale (defaultTimeLocale)
69import System.Locale (defaultTimeLocale)
71−import Data.List (sortBy)
72import Data.FileEmbed (embedFile)
71import Data.FileEmbed (embedFile)
74import qualified Data.Text as T
73import qualified Data.Text as T
@@ -252,39 +251,33 @@ checkPieces fileLookup indices pieces cache req
252 | T.null $ piecePretty (last pieces) -> (False, True)
251 | T.null $ piecePretty (last pieces) -> (False, True)
253 | otherwise -> (True, False)
252 | otherwise -> (True, False)
255− if not isFile then uncached isFile isFolder
254+ fl <- fileLookup pieces
256− else
255+ case (fl, isFile) of
257− case cache of
256+ (FLDoesNotExist, _) -> return NotFound
258− ETag ioLookup -> do
257+ (FLFile file, True) -> handleCache file cache
259− -- No support for If-Match
258+ (FLFile{}, False) -> return $ Redirect $ init pieces
260− let mlastEtag = lookup "If-None-Match" (W.requestHeaders req)
259+ (FLFolder folder@(Folder contents), _) -> do
261− metag <- ioLookup fp
260+ case checkIndices $ map feName $ filter feIsFile contents of
262− case debug (metag, mlastEtag) of
261+ Just index -> return $ Redirect $ setLast pieces $ Piece (T.unpack index) index
263− (Just hash, Just lastHash) | hash == lastHash -> return NotModified
262+ Nothing ->
264− _ -> trace "ETAG: no cache match" uncached isFile isFolder
263+ if isFolder
265− Forever isStaticFile ->
264+ then return $ DirectoryResponse folder
266− if isStaticFile fp (S8.drop 1 $ W.rawQueryString req) &&
265+ else return $ Redirect $ pieces ++ [Piece "" ""]
267− (isJust $ lookup "If-Modified-Since" (W.requestHeaders req)) &&
268− (isNothing $ lookup "If-Unmodified-Since" (W.requestHeaders req))
269− then return NotModified
270− else trace "Static: no cache match" uncached isFile isFolder
271− NoCache -> trace "NoCache" uncached isFile isFolder
275− uncached isFile isFolder = do
267+ handleCache file NoCache = trace "NoCache" $ return (FileResponse file)
276− fl <- fileLookup pieces
268+ handleCache file (ETag ioLookup) = do
277− case (fl, isFile) of
269+ -- No support for If-Match
278− (FLDoesNotExist, _) -> return NotFound
270+ let mlastEtag = lookup "If-None-Match" (W.requestHeaders req)
279− (FLFile file, True) -> return $ FileResponse file
271+ metag <- ioLookup file
280− (FLFile{}, False) -> return $ Redirect $ init pieces
272+ case debug (metag, mlastEtag) of
281− (FLFolder folder@(Folder contents), _) -> do
273+ (Just hash, Just lastHash) | hash == lastHash -> return NotModified
282− case checkIndices $ map feName $ filter feIsFile contents of
274+ _ -> trace "ETAG: no cache match" (return $ FileResponse file)
283− Just index -> return $ Redirect $ setLast pieces $ Piece (T.unpack index) index
275+ handleCache file (Forever isStaticFile) = do
284− Nothing ->
276+ if isStaticFile file (S8.drop 1 $ W.rawQueryString req) &&
285− if isFolder
277+ (isJust $ lookup "If-Modified-Since" (W.requestHeaders req)) &&
286− then return $ DirectoryResponse folder
278+ (isNothing $ lookup "If-Unmodified-Since" (W.requestHeaders req))
287− else return $ Redirect $ pieces ++ [Piece "" ""]
279+ then return NotModified
280+ else trace "Static: no cache match" (return $ FileResponse file)
289 setLast [] x = [x]
282 setLast [] x = [x]
290 setLast [Piece "" ""] x = [x]
283 setLast [Piece "" ""] x = [x]
@@ -517,12 +510,14 @@ staticAppPieces ss@StaticSettings{} pieces req = liftIO $ do
517 Redirect pieces' -> do
510 Redirect pieces' -> do
518 let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')
511 let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')
513+ {- FIXME seems unnecessary
520 let loc' =
514 let loc' =
521 -- relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
515 -- relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
522 -- (ssMkRedirect ss) pieces' $ encodePathInfo pieces' []
516 -- (ssMkRedirect ss) pieces' $ encodePathInfo pieces' []
523 toByteString $
517 toByteString $
524 foldr mappend (H.encodePathSegments $ map piecePretty pieces') -- FIXME is this correct?
518 foldr mappend (H.encodePathSegments $ map piecePretty pieces') -- FIXME is this correct?
525 $ map (const $ copyByteString "../") $ drop 1 pieces
519 $ map (const $ copyByteString "../") $ drop 1 pieces
526 return $ W.responseLBS H.status301
521 return $ W.responseLBS H.status301
527 [ ("Content-Type", "text/plain")
522 [ ("Content-Type", "text/plain")
528 , ("Location", loc)
523 , ("Location", loc)