{-# LANGUAGE
- BangPatterns
+ OverloadedStrings
, UnicodeSyntax
#-}
-- | Handling static files on the filesystem.
, generateETagFromFile
)
where
-import Control.Monad
-import Control.Monad.Trans
+import qualified Blaze.ByteString.Builder.ByteString as BB
+import qualified Blaze.Text.Int as BT
+import Control.Monad
+import Control.Monad.Unicode
+import Control.Monad.Trans
+import qualified Data.Ascii as A
import qualified Data.ByteString.Lazy.Char8 as B
-import Data.Time.Clock.POSIX
-import Network.HTTP.Lucu.Abortion
-import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.ETag
-import Network.HTTP.Lucu.Format
-import Network.HTTP.Lucu.MIMEType.Guess
-import Network.HTTP.Lucu.Resource
-import Network.HTTP.Lucu.Resource.Tree
-import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.Utils
-import System.FilePath.Posix
-import System.Posix.Files
+import Data.Monoid.Unicode
+import qualified Data.Text as T
+import Data.Time.Clock.POSIX
+import Network.HTTP.Lucu.Abortion
+import Network.HTTP.Lucu.Config
+import Network.HTTP.Lucu.ETag
+import Network.HTTP.Lucu.MIMEType.Guess
+import Network.HTTP.Lucu.Resource
+import Network.HTTP.Lucu.Resource.Tree
+import Network.HTTP.Lucu.Response
+import Prelude.Unicode
+import System.FilePath
+import System.Posix.Files
-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
-- @fpath@ on the filesystem.
-staticFile :: FilePath -> ResourceDef
+staticFile ∷ FilePath → ResourceDef
staticFile path
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = False
- , resGet = Just $! handleStaticFile path
+ , resGet = Just $ handleStaticFile path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
}
-- | Computation of @'handleStaticFile' fpath@ serves the file at
--- @fpath@ on the filesystem. The
--- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
+-- @fpath@ on the filesystem. The 'Resource' must be in the /Examining
-- Request/ state before the computation. It will be in the /Done/
-- state after the computation.
--
--- If you just want to place a static file on the
--- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
--- 'staticFile' instead of this.
-handleStaticFile :: FilePath -> Resource ()
+-- If you just want to place a static file on the 'ResTree', you had
+-- better use 'staticFile' rather than this.
+handleStaticFile ∷ FilePath → Resource ()
handleStaticFile path
- = path `seq`
- do exists <- liftIO $ fileExist path
+ = do exists ← liftIO $ fileExist path
if exists then
-- 存在はした。讀めるかどうかは知らない。
- do stat <- liftIO $ getFileStatus path
+ do stat ← liftIO $ getFileStatus path
if isRegularFile stat then
- do readable <- liftIO $ fileAccess path True False False
+ do readable ← liftIO $ fileAccess path True False False
unless readable
-- 讀めない
$ abort Forbidden [] Nothing
-- 讀める
- tag <- liftIO $ generateETagFromFile path
- let lastMod = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
+ tag ← liftIO $ generateETagFromFile path
+ let lastMod = posixSecondsToUTCTime
+ $ fromRational
+ $ toRational
+ $ modificationTime stat
foundEntity tag lastMod
-- MIME Type を推定
- conf <- getConfig
+ conf ← getConfig
case guessTypeByFileName (cnfExtToMIMEType conf) path of
- Nothing -> return ()
- Just mime -> setContentType mime
+ Nothing → return ()
+ Just mime → setContentType mime
-- 實際にファイルを讀んで送る
- liftIO (B.readFile path) >>= outputLBS
+ liftIO (B.readFile path) ≫= output
else
abort Forbidden [] Nothing
else
-- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
-- increase strictness, but it's too inefficient if the file is really
-- large (say, 1 TiB).
-generateETagFromFile :: FilePath -> IO ETag
+generateETagFromFile ∷ FilePath → IO ETag
generateETagFromFile path
- = path `seq`
- do stat <- getFileStatus path
- let inode = fromEnum $! fileID stat
- size = fromEnum $! fileSize stat
- lastMod = fromEnum $! modificationTime stat
- tag = fmtHex False 0 inode
- ++ "-" ++
- fmtHex False 0 size
- ++ "-" ++
- fmtHex False 0 lastMod
- return $! strongETag tag
+ = do stat ← getFileStatus path
+ let inode = fileID stat
+ size = fileSize stat
+ lastMod = fromEnum $ modificationTime stat
+ tag = A.fromAsciiBuilder
+ $ A.unsafeFromBuilder
+ $ BT.integral inode
+ ⊕ BB.fromByteString "-"
+ ⊕ BT.integral size
+ ⊕ BB.fromByteString "-"
+ ⊕ BT.integral lastMod
+ return $ strongETag tag
--- | @'staticDir' dir@ is a
--- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which maps all files
--- in @dir@ and its subdirectories on the filesystem to the
--- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
-staticDir :: FilePath -> ResourceDef
+-- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
+-- @dir@ and its subdirectories on the filesystem to the 'ResTree'.
+staticDir ∷ FilePath → ResourceDef
staticDir path
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = True
- , resGet = Just $! handleStaticDir path
+ , resGet = Just $ handleStaticDir path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
}
-- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
--- and its subdirectories on the filesystem to the
--- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The
--- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
--- Request/ state before the computation. It will be in the /Done/
--- state after the computation.
+-- and its subdirectories on the filesystem to the 'ResTree'. The
+-- 'Resource' must be in the /Examining Request/ state before the
+-- computation. It will be in the /Done/ state after the computation.
--
--- If you just want to place a static directory tree on the
--- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
--- 'staticDir' instead of this.
-handleStaticDir :: FilePath -> Resource ()
-handleStaticDir !basePath
- = do extraPath <- getPathInfo
+-- If you just want to place a static directory tree on the 'ResTree',
+-- you had better use 'staticDir' rather than this.
+handleStaticDir ∷ FilePath → Resource ()
+handleStaticDir basePath
+ = do extraPath ← getPathInfo
securityCheck extraPath
- let path = basePath </> joinPath extraPath
+ let path = basePath </> joinPath (map T.unpack extraPath)
handleStaticFile path
where
- securityCheck :: Monad m => [String] -> m ()
- securityCheck !pathElems
- = when (any (== "..") pathElems) $ fail ("security error: "
- ++ joinWith "/" pathElems)
+ securityCheck pathElems
+ = when (any (≡ "..") pathElems)
+ $ fail ("security error: " ⧺ show pathElems)
-- TODO: implement directory listing.
projects / Lucu.git / commitdiff