@@ -6,6 +6,7 @@ module Network.Wai.Application.Static
66 staticApp
77 -- ** Settings
88 , defaultWebAppSettings
9+ , webAppSettingsWithLookup
910 , defaultFileServerSettings
1011 , StaticSettings
1112 , ssFolder
@@ -307,30 +308,31 @@ checkPieces fileLookup indices pieces req maxAge useHash
307308 handleCache file =
308309 if not useHash then lastModifiedCache file
309310 else do
310− let mGetHash = fileGetHash file
311311 let etagParam = lookup "etag" queryString
312312
313− case (etagParam, mGetHash) of
314− (Just mEtag, Just getHash) -> do
315− hash <- getHash
316− if isJust mEtag && hash == fromJust mEtag
317− then return $ FileResponse file $ ("ETag", hash):cacheControl
318− else return $ Redirect pieces (Just hash)
319− -- a file used to have an etag parameter, but no longer does
320− (Just _, Nothing) -> return $ Redirect pieces Nothing
321−
322− _ ->
323− case (lookup "if-none-match" headers, mGetHash) of
324− -- etag
325− (mLastHash, Just getHash) -> do
326− hash <- getHash
327− case mLastHash of
328− Just lastHash ->
329− if hash == lastHash
330− then return NotModified
331− else return $ FileResponse file $ [("ETag", hash)]
332− Nothing -> return $ FileResponse file $ [("ETag", hash)]
333− (_, Nothing) -> lastModifiedCache file
313+ case etagParam of
314+ Nothing -> do -- no query parameter. Set appropriate ETag headers
315+ mHash <- fileGetHash file
316+ case mHash of
317+ Nothing -> lastModifiedCache file
318+ Just hash ->
319+ case lookup "if-none-match" headers of
320+ Just lastHash ->
321+ if hash == lastHash
322+ then return NotModified
323+ else return $ FileResponse file $ [("ETag", hash)]
324+ Nothing -> return $ FileResponse file $ [("ETag", hash)]
325+
326+ Just mEtag -> do
327+ mHash <- fileGetHash file
328+ case mHash of
329+ -- a file used to have an etag parameter, but no longer does
330+ Nothing -> return $ Redirect pieces Nothing
331+ Just hash ->
332+ if isJust mEtag && hash == fromJust mEtag
333+ then return $ FileResponse file $ ("ETag", hash):cacheControl
334+ else return $ Redirect pieces (Just hash)
335+
334336
335337 lastModifiedCache file =
336338 case (lookup "if-modified-since" headers >>= parseHTTPDate, fileGetModified file) of
@@ -378,12 +380,12 @@ data File = File
378380 { fileGetSize :: Int
379381 , fileToResponse :: H.Status -> H.ResponseHeaders -> W.Response
380382 , fileName :: FilePath
381− , fileGetHash :: Maybe (IO ByteString)
383+ , fileGetHash :: IO (Maybe ByteString)
382384 , fileGetModified :: Maybe EpochTime
383385 }
384386
385387data StaticSettings = StaticSettings
386− { ssFolder :: Pieces -> IO FileLookup
388+ { ssFolder :: Pieces -> IO FileLookup -- TODO: not a folder, so rename
387389 , ssMkRedirect :: Pieces -> ByteString -> ByteString
388390 , ssGetMimeType :: File -> IO MimeType
389391 , ssListing :: Maybe Listing
@@ -403,9 +405,14 @@ defaultMkRedirect pieces newPath
403405 where
404406 relDir = TE.encodeUtf8 (relativeDirFromPieces pieces)
405407
408+webAppSettingsWithLookup :: ETagLookup -> StaticSettings
409+webAppSettingsWithLookup etagLookup =
410+ defaultWebAppSettings { ssFolder = webAppLookup etagLookup "static"}
411+
412+
406413defaultWebAppSettings :: StaticSettings
407414defaultWebAppSettings = StaticSettings
408− { ssFolder = fileSystemLookup "static"
415+ { ssFolder = webAppLookup hashFileIfExists "static"
409416 , ssMkRedirect = defaultMkRedirect
410417 , ssGetMimeType = return . defaultMimeTypeByExt . fileName
411418 , ssMaxAge = MaxAgeForever
@@ -425,7 +432,6 @@ defaultFileServerSettings = StaticSettings
425432 , ssUseHash = False
426433 }
427434
428−type ETagLookup = (FilePath -> Maybe (IO ByteString))
429435fileHelper :: ETagLookup
430436 -> FilePath -> FilePath -> IO File
431437fileHelper hashFunc fp name = do
@@ -438,17 +444,36 @@ fileHelper hashFunc fp name = do
438444 , fileGetModified = Just $ modificationTime fs
439445 }
440446
441−defaultFileSystemHash :: FilePath -> Maybe (IO ByteString)
442−defaultFileSystemHash fp = Just $ do
443− -- FIXME replace lazy IO with enumerators
444− -- FIXME let's use a dictionary to cache these values?
447+type ETagLookup = (FilePath -> IO (Maybe ByteString))
448+
449+webAppLookup :: ETagLookup -> FilePath -> Pieces -> IO FileLookup
450+webAppLookup cachedLookupHash prefix pieces = do
451+ file <- fileHelper cachedLookupHash fp (last pieces)
452+ return $ Just $ Right $ file
453+ where
454+ fp = pathFromPieces prefix pieces
455+
456+defaultFileSystemHash :: ETagLookup
457+defaultFileSystemHash fp = fmap Just $ hashFile fp
458+
459+-- FIXME replace lazy IO with enumerators
460+-- FIXME let's use a dictionary to cache these values?
461+hashFile :: FilePath -> IO ByteString
462+hashFile fp = do
445463 l <- L.readFile $ fromFilePath fp
446464 return $ runHashL l
447465
466+hashFileIfExists :: ETagLookup
467+hashFileIfExists fp = do
468+ fe <- doesFileExist $ fromFilePath fp
469+ if fe
470+ then return Nothing
471+ else defaultFileSystemHash fp
472+
448473fileSystemLookup :: FilePath -> Pieces -> IO FileLookup
449474fileSystemLookup = fileSystemLookupHash defaultFileSystemHash
450475
451−fileSystemLookupHash :: (FilePath -> Maybe (IO ByteString)) -- ^ hash function
476+fileSystemLookupHash :: ETagLookup
452477 -> FilePath -> Pieces -> IO FileLookup
453478fileSystemLookupHash hashFunc prefix pieces = do
454479 let fp = pathFromPieces prefix pieces
@@ -498,7 +523,7 @@ toEntry (name, EEFile bs) = Right $ File
498523 { fileGetSize = S8.length bs
499524 , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs
500525 , fileName = name
501− , fileGetHash = Just $ return $ runHash bs
526+ , fileGetHash = return $ Just $ runHash bs
502527 , fileGetModified = Nothing
503528 }
504529
@@ -529,7 +554,7 @@ bsToFile name bs = File
529554 { fileGetSize = S8.length bs
530555 , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs
531556 , fileName = name
532− , fileGetHash = Just $ return $ runHash bs
557+ , fileGetHash = return $ Just $ runHash bs
533558 , fileGetModified = Nothing
534559 }
535560