Don't use the unix package at all.

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

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index f0e9bd80508d8589eba5121c2d61dec1b09ad1bc..39ff39c41ded5da08304e33b1f5cc97f9651bb5e 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,40 +1,35 @@
 {-# 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
 -- @fpath@ on the filesystem.
@@ -46,30 +41,21 @@ staticFile path
       }
 
 octetStream ∷ MIMEType
-octetStream = mkMIMEType "application" "octet-stream"
+octetStream = [mimeType| application/octet-stream |]
 
 handleStaticFile ∷ Bool → FilePath → Resource ()
 handleStaticFile sendContent path
-    = do exists ← liftIO $ fileExist path
+    = do exists ← liftIO $ doesFileExist path
          unless exists
              foundNoEntity'
 
-         readable ← liftIO $ fileAccess path True False False
-         unless readable
-             $ abort
-             $ mkAbortion Forbidden [] Nothing
-
-         stat ← liftIO $ getFileStatus path
-         when (isDirectory stat)
+         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
@@ -79,33 +65,6 @@ 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
 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.