X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=5b5eb9734e3a68441516f36a86ada99269ea7888;hp=4f669314aee7e599703e999433a63713fe1b4a6f;hb=1ead053df6a792edafa9d714c4c038a8a9c3ad16;hpb=3eb69879d3b336c7c3e613c0ce4bfb3c67989ff3

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 4f66931..5b5eb97 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,44 +1,39 @@
 {-# LANGUAGE
     DoAndIfThenElse
   , OverloadedStrings
+  , QuasiQuotes
   , UnicodeSyntax
   #-}
 -- | Handling static files on the filesystem.
 module Network.HTTP.Lucu.StaticFile
     ( staticFile
     , staticDir
-
-    , generateETagFromFile
     )
     where
-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 Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LBS
-import Data.Monoid.Unicode
 import Data.String
 import qualified Data.Text as T
 import qualified Data.Text.Encoding 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
+import Network.HTTP.Lucu.MIMEType hiding (mimeType)
 import Network.HTTP.Lucu.MIMEType.Guess
+import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Resource
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
+import System.Directory
 import System.FilePath
-import System.Posix.Files
 
--- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
+-- | @'staticFile' fpath@ is a 'Resource' which serves the file at
 -- @fpath@ on the filesystem.
-staticFile ∷ FilePath → ResourceDef
+staticFile ∷ FilePath → Resource
 staticFile path
     = emptyResource {
         resGet  = Just $ handleStaticFile True  path
@@ -46,31 +41,26 @@ staticFile path
       }
 
 octetStream ∷ MIMEType
-{-# NOINLINE octetStream #-}
-octetStream = parseMIMEType "application/octet-stream"
+octetStream = [mimeType| application/octet-stream |]
 
-handleStaticFile ∷ Bool → FilePath → Resource ()
+handleStaticFile ∷ Bool → FilePath → Rsrc ()
 handleStaticFile sendContent path
-    = do exists ← liftIO $ fileExist path
-         unless exists
-             foundNoEntity'
-
-         readable ← liftIO $ fileAccess path True False False
-         unless readable
+    = do isDir ← liftIO $ doesDirectoryExist path
+         when isDir
              $ abort
              $ mkAbortion Forbidden [] Nothing
 
-         stat ← liftIO $ getFileStatus path
-         when (isDirectory stat)
+         isFile ← liftIO $ doesFileExist path
+         unless isFile
+             foundNoEntity'
+
+         perms ← liftIO $ getPermissions path
+         unless (readable perms)
              $ abort
              $ mkAbortion Forbidden [] Nothing
 
-         tag  ← liftIO $ generateETagFromFile path
-         let lastMod = posixSecondsToUTCTime
-                       $ fromRational
-                       $ toRational
-                       $ modificationTime stat
-         foundEntity tag lastMod
+         lastMod ← liftIO $ getLastModified path
+         foundTimeStamp lastMod
 
          conf ← getConfig
          case guessTypeByFileName (cnfExtToMIMEType conf) path of
@@ -80,41 +70,14 @@ handleStaticFile sendContent path
          when sendContent
              $ liftIO (LBS.readFile path) ≫= putChunks
 
--- |@'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.
---
--- Note that the tag is not strictly strong because the file could be
--- modified twice at a second without changing inode ID or size, but
--- it's not really possible to generate a strictly strong ETag from a
--- file as we don't want to simply grab the entire file and use it 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 path
-    = 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 'ResourceDef' which maps all files in
--- @dir@ and its subdirectories on the filesystem to the
+-- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
+-- and its subdirectories on the filesystem to the
 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
 --
 -- Note that 'staticDir' currently doesn't have a directory-listing
 -- capability. Requesting the content of a directory will end up being
 -- replied with /403 Forbidden/.
-staticDir ∷ FilePath → ResourceDef
+staticDir ∷ FilePath → Resource
 staticDir path
     = emptyResource {
         resIsGreedy = True
@@ -123,7 +86,7 @@ staticDir path
       }
 
 -- TODO: implement directory listing.
-handleStaticDir ∷ Bool → FilePath → Resource ()
+handleStaticDir ∷ Bool → FilePath → Rsrc ()
 handleStaticDir sendContent basePath
     = do extraPath ← getPathInfo
          securityCheck extraPath