wai-app-static 1.1.1 → 1.1.2
raw patch · 2 files changed
+39/−50 lines, 2 files
Files
- Network/Wai/Application/Static.hs +38/−49
- wai-app-static.cabal +1/−1
Network/Wai/Application/Static.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell, CPP #-} -- | Static file serving for WAI. module Network.Wai.Application.Static@@ -15,6 +16,7 @@ , ssListing , ssIndices , ssMaxAge+ , ssRedirectToIndex -- * Generic, non-WAI code -- ** Mime types , MimeType@@ -66,7 +68,8 @@ import System.Posix.Types (EpochTime) import Control.Monad.IO.Class (liftIO) import qualified Crypto.Hash.MD5 as MD5-import Control.Monad (filterM)+import Control.Monad (forM)+import Control.Exception (SomeException, try) import Text.Blaze ((!)) import qualified Text.Blaze.Html5 as H@@ -259,8 +262,9 @@ -> W.Request -> MaxAge -> Bool -- ^ use hash?+ -> Bool -- ^ Redirect to Index? -> IO CheckPieces-checkPieces fileLookup indices pieces req maxAge useHash+checkPieces fileLookup indices pieces req maxAge useHash redirectToIndex | any unsafe pieces = return Forbidden | any nullFilePath $ safeInit pieces = return $ Redirect (filterButLast (not . nullFilePath) pieces) Nothing@@ -279,7 +283,11 @@ (Just Right{}, False) -> return $ Redirect (init pieces) Nothing (Just (Left folder@(Folder _ contents)), _) -> do case checkIndices $ map fileName $ rights contents of- Just index -> return $ Redirect (setLast pieces index) Nothing+ Just index -> + if redirectToIndex then+ return $ Redirect (setLast pieces index) Nothing+ else+ checkPieces fileLookup indices (setLast pieces index) req maxAge useHash redirectToIndex Nothing -> if isFolder then return $ DirectoryResponse folder@@ -390,6 +398,7 @@ , ssGetMimeType :: File -> IO MimeType , ssListing :: Maybe Listing , ssIndices :: [T.Text] -- index.html+ , ssRedirectToIndex :: Bool , ssMaxAge :: MaxAge , ssUseHash :: Bool }@@ -418,6 +427,7 @@ , ssMaxAge = MaxAgeForever , ssListing = Nothing , ssIndices = []+ , ssRedirectToIndex = False , ssUseHash = True } @@ -429,27 +439,30 @@ , ssMaxAge = MaxAgeSeconds $ 60 * 60 , ssListing = Just defaultListing , ssIndices = ["index.html", "index.htm"]+ , ssRedirectToIndex = False , ssUseHash = False } fileHelper :: ETagLookup- -> FilePath -> FilePath -> IO File+ -> FilePath -> FilePath -> IO (Maybe File) fileHelper hashFunc fp name = do- fs <- getFileStatus $ fromFilePath fp- return File- { fileGetSize = fromIntegral $ fileSize fs- , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing- , fileName = name- , fileGetHash = hashFunc fp- , fileGetModified = Just $ modificationTime fs- }+ efs <- try $ getFileStatus $ fromFilePath fp+ case efs of+ Left (_ :: SomeException) -> return Nothing+ Right fs -> return $ Just File+ { fileGetSize = fromIntegral $ fileSize fs+ , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing+ , fileName = name+ , fileGetHash = hashFunc fp+ , fileGetModified = Just $ modificationTime fs+ } type ETagLookup = (FilePath -> IO (Maybe ByteString)) webAppLookup :: ETagLookup -> FilePath -> Pieces -> IO FileLookup webAppLookup cachedLookupHash prefix pieces = do- file <- fileHelper cachedLookupHash fp (last pieces)- return $ Just $ Right $ file+ mfile <- fileHelper cachedLookupHash fp (last pieces)+ return $ fmap Right mfile where fp = pathFromPieces prefix pieces @@ -479,21 +492,22 @@ let fp = pathFromPieces prefix pieces fe <- doesFileExist $ fromFilePath fp if fe- then fmap (Just . Right) $ fileHelper hashFunc fp $ last pieces+ then (fmap . fmap) Right $ fileHelper hashFunc fp $ last pieces else do de <- doesDirectoryExist $ fromFilePath fp if de then do- let isVisible ('.':_) = return False- isVisible "" = return False- isVisible _ = return True- entries <- getDirectoryContents (fromFilePath fp) >>= filterM isVisible >>= mapM (\nameRaw -> do+ let isVisible ('.':_) = False+ isVisible "" = False+ isVisible _ = True+ entries' <- fmap (filter isVisible) $ getDirectoryContents (fromFilePath fp)+ entries <- forM entries' $ \nameRaw -> do let name = toFilePath nameRaw let fp' = fp </> name- fe' <- doesFileExist $ fromFilePath fp'- if fe'- then fmap Right $ fileHelper hashFunc fp' name- else return $ Left $ Folder name [])+ mfile' <- fileHelper hashFunc fp' name+ case mfile' of+ Nothing -> return $ Left $ Folder name []+ Just file' -> return $ Right file' return $ Just $ Left $ Folder (error "Network.Wai.Application.Static.fileSystemLookup") entries else return Nothing @@ -593,7 +607,7 @@ let indices = ssIndices ss case checkSpecialDirListing pieces of Just res -> response res- Nothing -> checkPieces (ssFolder ss) (map FilePath indices) pieces req (ssMaxAge ss) (ssUseHash ss) >>= response+ Nothing -> checkPieces (ssFolder ss) (map FilePath indices) pieces req (ssMaxAge ss) (ssUseHash ss) (ssRedirectToIndex ss) >>= response where response cp = case cp of FileResponse file ch -> do@@ -765,28 +779,3 @@ addCommas s = (++ (' ' : s)) . reverse . addCommas' . reverse . show addCommas' (a:b:c:d:e) = a : b : c : ',' : addCommas' (d : e) addCommas' x = x--{--mdIsFile :: MetaData -> Bool-mdIsFile FileMetaData{} = True-mdIsFile FolderMetaData{} = False---- | look up the meta data associated with a file-getMetaData :: FilePath -- ^ path to directory on disk containing the entry- -> FilePath -- ^ entry in that directory- -> IO (Maybe MetaData)-getMetaData _ ('.':_) = return Nothing-getMetaData localPath fp = do- let fp' = localPath ++ '/' : fp- fe <- doesFileExist fp'- let fpPretty = T.pack $ fixPathName fp- if fe- then do- fs <- getFileStatus fp'- let modTime = modificationTime fs- let count = fileSize fs- return $ Just $ FileMetaData fpPretty (Just modTime) count- else do- de <- doesDirectoryExist fp'- return $ if de then Just (FolderMetaData fpPretty) else Nothing--}
wai-app-static.cabal view
@@ -1,5 +1,5 @@ name: wai-app-static-version: 1.1.1+version: 1.1.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>