Network/HTTP/Lucu/StaticFile.hs

   1 module Network.HTTP.Lucu.StaticFile
   2     ( staticFile       -- FilePath -> ResourceDef
   3     , handleStaticFile -- FilePath -> Resource ()
   4     )
   5     where
   6
   7 import           Control.Monad
   8 import           Control.Monad.Trans
   9 import qualified Data.ByteString.Lazy.Char8 as B
  10 import           Data.ByteString.Lazy.Char8 (ByteString)
  11 import           Network.HTTP.Lucu.Abortion
  12 import           Network.HTTP.Lucu.Config
  13 import           Network.HTTP.Lucu.ETag
  14 import           Network.HTTP.Lucu.MIMEType.Guess
  15 import           Network.HTTP.Lucu.Resource
  16 import           Network.HTTP.Lucu.Resource.Tree
  17 import           Network.HTTP.Lucu.Response
  18 import           System.Directory
  19 import           System.Posix.Files
  20 import           Text.Printf
  21
  22
  23 staticFile :: FilePath -> ResourceDef
  24 staticFile path
  25     = ResourceDef {
  26         resUsesNativeThread = False
  27       , resIsGreedy         = False
  28       , resGet              = Just $ handleStaticFile path
  29       , resHead             = Nothing
  30       , resPost             = Nothing
  31       , resPut              = Nothing
  32       , resDelete           = Nothing
  33       }
  34
  35
  36 handleStaticFile :: FilePath -> Resource ()
  37 handleStaticFile path
  38     = do exist <- liftIO $ fileExist path
  39          if exist then
  40              -- 存在はした。讀めるかどうかは知らない。
  41              do readable <- liftIO $ fileAccess path True False False
  42                 unless readable
  43                            -- 讀めない
  44                            $ abort Forbidden [] Nothing
  45
  46                 -- 讀める
  47                 tag      <- liftIO $ generateETagFromFile path
  48                 lastMod  <- liftIO $ getModificationTime path
  49                 foundEntity tag lastMod
  50
  51                 -- MIME Type を推定
  52                 conf <- getConfig
  53                 case guessTypeByFileName (cnfExtToMIMEType conf) path of
  54                   Nothing   -> return ()
  55                   Just mime -> setContentType mime
  56
  57                 -- 實際にファイルを讀んで送る
  58                 (liftIO $ B.readFile path) >>= outputBS
  59            else
  60              foundNoEntity Nothing
  61
  62
  63 -- inode-size-lastmod
  64 generateETagFromFile :: FilePath -> IO ETag
  65 generateETagFromFile path
  66     = do stat <- getFileStatus path
  67          let inode   = fromEnum $ fileID   stat
  68              size    = fromEnum $ fileSize stat
  69              lastmod = fromEnum $ modificationTime stat
  70          return $ strongETag $ printf "%x-%x-%x" inode size lastmod