Doc fix, optimization, and more.

[Lucu.git] / Network / HTTP / Lucu / StaticFile.hs

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index e710fc90ec62beb0e9cf22164a5c65c92d134b9a..12cf78b0729c760c82e6f35faa08909f6d53b876 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,3 +1,4 @@
+-- | Handling static files on the filesystem.
 module Network.HTTP.Lucu.StaticFile
     ( staticFile
     , handleStaticFile
@@ -12,10 +13,10 @@ module Network.HTTP.Lucu.StaticFile
 import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
 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
@@ -23,25 +24,36 @@ import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
 import           System.Directory
 import           System.Posix.Files
-import           Text.Printf
 
 
+-- | @'staticFile' fpath@ is a
+-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
+-- at @fpath@ on the filesystem.
 staticFile :: FilePath -> ResourceDef
 staticFile path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = False
-      , resGet              = Just $ handleStaticFile path
+      , resGet              = Just $! handleStaticFile path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
       , resDelete           = Nothing
       }
 
-
+-- | Computation of @'handleStaticFile' fpath@ serves the file at
+-- @fpath@ on the filesystem. 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.
+--
+-- 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 ()
 handleStaticFile path
-    = do isFile <- liftIO $ doesFileExist path
+    = path `seq`
+      do isFile <- liftIO $ doesFileExist path
          if isFile then
              -- 存在はした。讀めるかどうかは知らない。
              do readable <- liftIO $ fileAccess path True False False
@@ -61,7 +73,7 @@ handleStaticFile path
                   Just mime -> setContentType mime
 
                 -- 實際にファイルを讀んで送る
-                (liftIO $ B.readFile path) >>= outputBS
+                (liftIO $ B.readFile path) >>= outputLBS
            else
              do isDir <- liftIO $ doesDirectoryExist path
                 if isDir then
@@ -69,8 +81,7 @@ handleStaticFile path
                   else
                     foundNoEntity Nothing
 
-
--- |Computation @'generateETagFromFile' fpath@ generates a strong
+-- |Computation of @'generateETagFromFile' fpath@ generates a strong
 -- entity tag from a file. The file doesn't necessarily have to be a
 -- regular file; it may be a FIFO or a device file. The tag is made of
 -- inode ID, size and modification time.
@@ -84,29 +95,48 @@ handleStaticFile path
 -- large (say, 1 TiB).
 generateETagFromFile :: FilePath -> IO ETag
 generateETagFromFile path
-    = do stat <- getFileStatus path
-         let inode   = fromEnum $ fileID   stat
-             size    = fromEnum $ fileSize stat
-             lastmod = fromEnum $ modificationTime stat
-         return $ strongETag $ printf "%x-%x-%x" inode size lastmod
-
-
+    = 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
+
+-- | @'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 path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = True
-      , resGet              = Just $ handleStaticDir path
+      , resGet              = Just $! handleStaticDir path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
       , resDelete           = 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.
+--
+-- 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
+    = basePath `seq`
+      do extraPath <- getPathInfo
          securityCheck extraPath
          let path = basePath ++ "/" ++ joinWith "/" extraPath
 
@@ -114,5 +144,6 @@ handleStaticDir basePath
     where
       securityCheck :: Monad m => [String] -> m ()
       securityCheck pathElems
-          = when (any (== "..") pathElems) $ fail ("security error: "
+          = pathElems `seq`
+            when (any (== "..") pathElems) $ fail ("security error: "
                                                    ++ joinWith "/" pathElems)