+{-# LANGUAGE
+ BangPatterns
+ , UnicodeSyntax
+ #-}
-- | Handling static files on the filesystem.
module Network.HTTP.Lucu.StaticFile
( staticFile
import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.Response
import Network.HTTP.Lucu.Utils
+import System.FilePath.Posix
import System.Posix.Files
$ abort Forbidden [] Nothing
-- 讀める
tag <- liftIO $ generateETagFromFile path
- lastMod <- return $ posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
+ let lastMod = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
foundEntity tag lastMod
-- MIME Type を推定
Just mime -> setContentType mime
-- 實際にファイルを讀んで送る
- (liftIO $ B.readFile path) >>= outputLBS
+ liftIO (B.readFile path) >>= outputLBS
else
abort Forbidden [] Nothing
else
-- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
-- 'staticDir' instead of this.
handleStaticDir :: FilePath -> Resource ()
-handleStaticDir basePath
- = basePath `seq`
- do extraPath <- getPathInfo
+handleStaticDir !basePath
+ = do extraPath <- getPathInfo
securityCheck extraPath
- let path = basePath ++ "/" ++ joinWith "/" extraPath
+ let path = basePath </> joinPath extraPath
handleStaticFile path
where
securityCheck :: Monad m => [String] -> m ()
- securityCheck pathElems
- = pathElems `seq`
- when (any (== "..") pathElems) $ fail ("security error: "
+ securityCheck !pathElems
+ = when (any (== "..") pathElems) $ fail ("security error: "
++ joinWith "/" pathElems)
+-- TODO: implement directory listing.