-
-handleStaticFile :: FilePath -> Resource ()
-handleStaticFile path
- = do isFile <- liftIO $ doesFileExist path
- if isFile then
- -- 存在はした。讀めるかどうかは知らない。
- do readable <- liftIO $ fileAccess path True False False
- unless readable
- -- 讀めない
- $ abort Forbidden [] Nothing
-
- -- 讀める
- tag <- liftIO $ generateETagFromFile path
- lastMod <- liftIO $ getModificationTime path
- foundEntity tag lastMod
-
- -- MIME Type を推定
- conf <- getConfig
- case guessTypeByFileName (cnfExtToMIMEType conf) path of
- Nothing -> return ()
- Just mime -> setContentType mime
-
- -- 實際にファイルを讀んで送る
- (liftIO $ B.readFile path) >>= outputBS
- else
- do isDir <- liftIO $ doesDirectoryExist path
- if isDir then
- abort Forbidden [] Nothing
- else
- foundNoEntity Nothing
-
-
--- inode-size-lastmod
-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
-
-
-staticDir :: FilePath -> ResourceDef
+octetStream ∷ MIMEType
+octetStream = [mimeType| application/octet-stream |]
+
+handleStaticFile ∷ Bool → FilePath → Rsrc ()
+handleStaticFile sendContent path
+ = do isDir ← liftIO $ doesDirectoryExist path
+ when isDir
+ $ abort
+ $ mkAbortion Forbidden [] Nothing
+
+ isFile ← liftIO $ doesFileExist path
+ unless isFile
+ foundNoEntity'
+
+ perms ← liftIO $ getPermissions path
+ unless (readable perms)
+ $ abort
+ $ mkAbortion Forbidden [] Nothing
+
+ lastMod ← liftIO $ getLastModified path
+ foundTimeStamp lastMod
+
+ conf ← getConfig
+ case guessTypeByFileName (cnfExtToMIMEType conf) path of
+ Nothing → setContentType octetStream
+ Just mime → setContentType mime
+
+ when sendContent
+ $ liftIO (LBS.readFile path) ≫= putChunks
+
+-- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
+-- and its subdirectories on the filesystem to the resource tree. Thus
+-- having 'Network.HTTP.Lucu.nonGreedy' 'staticDir' in a tree makes no
+-- sense.
+--
+-- 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 → Resource