X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=5289f5fdb8cd374c88a594e30ce0c6542e633d5a;hb=0ff0346;hp=7c2ce5c4d455602c133cdfcc4669f937532f6674;hpb=3d017dd65ddede9a11c5b7a34a91e04340e67bc4;p=Lucu.git

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 7c2ce5c..5289f5f 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 -- | Handling static files on the filesystem.
 module Network.HTTP.Lucu.StaticFile
     ( staticFile
@@ -9,7 +13,6 @@ module Network.HTTP.Lucu.StaticFile
     , generateETagFromFile
     )
     where
-
 import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Lazy.Char8 as B
@@ -23,12 +26,11 @@ 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
 
-
--- | @'staticFile' fpath@ is a
--- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
--- at @fpath@ on the filesystem.
+-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
+-- @fpath@ on the filesystem.
 staticFile :: FilePath -> ResourceDef
 staticFile path
     = ResourceDef {
@@ -64,7 +66,7 @@ handleStaticFile path
                            $ abort Forbidden [] Nothing
                        -- 讀める
                        tag     <- liftIO $ generateETagFromFile path
-                       lastMod <- return $ posixSecondsToUTCTime $ toEnum $ fromEnum $ modificationTime stat
+                       let lastMod = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
                        foundEntity tag lastMod
 
                        -- MIME Type を推定
@@ -74,7 +76,7 @@ handleStaticFile path
                          Just mime -> setContentType mime
 
                        -- 實際にファイルを讀んで送る
-                       (liftIO $ B.readFile path) >>= outputLBS
+                       liftIO (B.readFile path) >>= outputLBS
                   else
                     abort Forbidden [] Nothing
            else
@@ -134,16 +136,15 @@ staticDir path
 -- '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.