on master help sign in
fileSystemLookupHash
commitcd502cccdde7fb3e701d6de6185170caca0ada06 authorMichael Snoyman <michael@snoyman.com> dateThu 18 Aug 2011, 07:46 (15 years ago) parentd1fbe73
1 file changed+21−12
wai-app-static/Network/Wai/Application/Static.hs+21−12
wai-app-static/Network/Wai/Application/Static.hs+21−12
@@ -33,6 +33,7 @@ module Network.Wai.Application.Static
3333 , defaultListing
3434 -- ** Lookup functions
3535 , fileSystemLookup
36+ , fileSystemLookupHash
3637 , embeddedLookup
3738 -- ** Embedded
3839 , Embedded
@@ -253,7 +254,7 @@ checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
253254 -> Pieces -- ^ parsed request
254255 -> W.Request
255256 -> MaxAge
256− -> Bool
257+ -> Bool -- ^ use hash?
257258 -> IO CheckPieces
258259checkPieces fileLookup indices pieces req maxAge useHash
259260 | any unsafe pieces = return Forbidden
@@ -421,27 +422,35 @@ defaultFileServerSettings = StaticSettings
421422 , ssUseHash = False
422423 }
423424
424−fileHelper :: FilePath -> FilePath -> IO File
425−fileHelper fp name = do
425+fileHelper :: (FilePath -> Maybe (IO ByteString)) -- ^ hash function
426+ -> FilePath -> FilePath -> IO File
427+fileHelper hashFunc fp name = do
426428 fs <- getFileStatus $ fromFilePath fp
427429 return File
428430 { fileGetSize = fromIntegral $ fileSize fs
429431 , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing
430432 , fileName = name
431− , fileGetHash = Just $ do
432− -- FIXME replace lazy IO with enumerators
433− -- FIXME let's use a dictionary to cache these values?
434− l <- L.readFile $ fromFilePath fp
435− return $ runHashL l
433+ , fileGetHash = hashFunc fp
436434 , fileGetModified = Just $ modificationTime fs
437435 }
438436
437+defaultFileSystemHash :: FilePath -> Maybe (IO ByteString)
438+defaultFileSystemHash fp = Just $ do
439+ -- FIXME replace lazy IO with enumerators
440+ -- FIXME let's use a dictionary to cache these values?
441+ l <- L.readFile $ fromFilePath fp
442+ return $ runHashL l
443+
439444fileSystemLookup :: FilePath -> Pieces -> IO FileLookup
440−fileSystemLookup prefix pieces = do
445+fileSystemLookup = fileSystemLookupHash defaultFileSystemHash
446+
447+fileSystemLookupHash :: (FilePath -> Maybe (IO ByteString)) -- ^ hash function
448+ -> FilePath -> Pieces -> IO FileLookup
449+fileSystemLookupHash hashFunc prefix pieces = do
441450 let fp = pathFromPieces prefix pieces
442451 fe <- doesFileExist $ fromFilePath fp
443452 if fe
444− then fmap (Just . Right) $ fileHelper fp $ last pieces
453+ then fmap (Just . Right) $ fileHelper hashFunc fp $ last pieces
445454 else do
446455 de <- doesDirectoryExist $ fromFilePath fp
447456 if de
@@ -454,9 +463,9 @@ fileSystemLookup prefix pieces = do
454463 let fp' = fp </> name
455464 fe' <- doesFileExist $ fromFilePath fp'
456465 if fe'
457− then fmap Right $ fileHelper fp' name
466+ then fmap Right $ fileHelper hashFunc fp' name
458467 else return $ Left $ Folder name [])
459− return $ Just $ Left $ Folder (error "413") entries
468+ return $ Just $ Left $ Folder (error "Network.Wai.Application.Static.fileSystemLookup") entries
460469 else return Nothing
461470
462471type Embedded = Map.Map FilePath EmbeddedEntry