git.iko.soy/typeable/wai
on master help sign in
fileSystemLookupHash
cd502ccMichael Snoyman
wai-app-static/Network/Wai/Application/Static.hs+21−12
compare with master
unifiedsplit
@@ -33,6 +33,7 @@ module Network.Wai.Application.Static
33 , defaultListing
33 , defaultListing
34 -- ** Lookup functions
34 -- ** Lookup functions
35 , fileSystemLookup
35 , fileSystemLookup
36+ , fileSystemLookupHash
36 , embeddedLookup
37 , embeddedLookup
37 -- ** Embedded
38 -- ** Embedded
38 , Embedded
39 , Embedded
@@ -253,7 +254,7 @@ checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
253 -> Pieces -- ^ parsed request
254 -> Pieces -- ^ parsed request
254 -> W.Request
255 -> W.Request
255 -> MaxAge
256 -> MaxAge
256− -> Bool
257+ -> Bool -- ^ use hash?
257 -> IO CheckPieces
258 -> IO CheckPieces
258checkPieces fileLookup indices pieces req maxAge useHash
259checkPieces fileLookup indices pieces req maxAge useHash
259 | any unsafe pieces = return Forbidden
260 | any unsafe pieces = return Forbidden
@@ -421,27 +422,35 @@ defaultFileServerSettings = StaticSettings
421 , ssUseHash = False
422 , ssUseHash = False
422 }
423 }
423
424
425+fileHelper :: (FilePath -> Maybe (IO ByteString)) -- ^ hash function
424−fileHelper :: FilePath -> FilePath -> IO File
426+ -> FilePath -> FilePath -> IO File
425−fileHelper fp name = do
427+fileHelper hashFunc fp name = do
426 fs <- getFileStatus $ fromFilePath fp
428 fs <- getFileStatus $ fromFilePath fp
427 return File
429 return File
428 { fileGetSize = fromIntegral $ fileSize fs
430 { fileGetSize = fromIntegral $ fileSize fs
429 , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing
431 , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing
430 , fileName = name
432 , fileName = name
431− , fileGetHash = Just $ do
433+ , fileGetHash = hashFunc fp
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
436 , fileGetModified = Just $ modificationTime fs
434 , fileGetModified = Just $ modificationTime fs
437 }
435 }
438
436
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+
439fileSystemLookup :: FilePath -> Pieces -> IO FileLookup
444fileSystemLookup :: 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
441 let fp = pathFromPieces prefix pieces
450 let fp = pathFromPieces prefix pieces
442 fe <- doesFileExist $ fromFilePath fp
451 fe <- doesFileExist $ fromFilePath fp
443 if fe
452 if fe
444− then fmap (Just . Right) $ fileHelper fp $ last pieces
453+ then fmap (Just . Right) $ fileHelper hashFunc fp $ last pieces
445 else do
454 else do
446 de <- doesDirectoryExist $ fromFilePath fp
455 de <- doesDirectoryExist $ fromFilePath fp
447 if de
456 if de
@@ -454,9 +463,9 @@ fileSystemLookup prefix pieces = do
454 let fp' = fp </> name
463 let fp' = fp </> name
455 fe' <- doesFileExist $ fromFilePath fp'
464 fe' <- doesFileExist $ fromFilePath fp'
456 if fe'
465 if fe'
457− then fmap Right $ fileHelper fp' name
466+ then fmap Right $ fileHelper hashFunc fp' name
458 else return $ Left $ Folder name [])
467 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
460 else return Nothing
469 else return Nothing
461
470
462type Embedded = Map.Map FilePath EmbeddedEntry
471type Embedded = Map.Map FilePath EmbeddedEntry