module Hack.Contrib.Middleware.File (file) where
import Hack
import Hack.Contrib.Utils
import Hack.Contrib.Response
import Hack.Contrib.Constants
import Hack.Contrib.Mime
import MPSUTF8
import Prelude hiding ((.), (^), (>), (+), (/), readFile)
import Data.Default
import Data.Maybe
import Data.List (isInfixOf)
import System.Directory
import System.FilePath
import qualified Data.ByteString.Lazy.Char8 as B
file :: Maybe String -> Middleware
file root _ = \env -> do
let path = env.path_info .unescape_uri
if ".." `isInfixOf` path
then forbidden
else path.serve root
serve :: Maybe String -> String -> IO Response
serve root fname = do
cwd <- getCurrentDirectory
let my_root = root.fromMaybe cwd
let path = my_root / makeRelative "/" fname
exist <- doesFileExist path
if not exist
then path.not_found
else
do
can_read <- path.getPermissions ^ readable
if not can_read
then path.no_permission
else path.serving
where
serving path = do
content <- path.B.readFile
size <- path.b2u.file_size ^ from_i
mtime_str <- path.b2u.file_mtime ^ httpdate
let default_content_type = "application/octet-stream"
let safe_lookup = lookup_mime_type > fromMaybe default_content_type
let content_type = path.takeExtension.safe_lookup
return $
def
.set_body content
.set_content_length size
.set_content_type content_type
.set_last_modified mtime_str
.set_status 200
no_permission :: String -> IO Response
no_permission path = return $
def
.set_status 404
.set_content_type _TextPlain
.set_content_length (msg.length)
.set_body (B.pack msg)
where msg = "No permission: " ++ path ++ "\n"
not_found :: String -> IO Response
not_found path = return $
def
.set_status 404
.set_content_type _TextPlain
.set_content_length (msg.length)
.set_body (B.pack msg)
where msg = "File not found: " ++ path ++ "\n"
forbidden :: IO Response
forbidden = return $
def
.set_status 403
.set_content_type _TextPlain
.set_content_length (msg.length)
.set_body (B.pack msg)
where msg = "Forbidden\n"