import Control.Monad.Trans
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 System.Directory
import System.FilePath
--- | @'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
, resHead = Just $ handleStaticFile False path
}
octetStream ∷ MIMEType
octetStream = [mimeType| application/octet-stream |]
-handleStaticFile ∷ Bool → FilePath → Resource ()
+handleStaticFile ∷ Bool → FilePath → Rsrc ()
handleStaticFile sendContent path
- = do exists ← liftIO $ doesFileExist path
- unless exists
+ = do isDir ← liftIO $ doesDirectoryExist path
+ when isDir
+ $ abort
+ $ mkAbortion Forbidden [] Nothing
+
+ isFile ← liftIO $ doesFileExist path
+ unless isFile
foundNoEntity'
perms ← liftIO $ getPermissions path
when sendContent
$ liftIO (LBS.readFile path) ≫= putChunks
--- | @'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'.
+-- | @'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 → ResourceDef
+staticDir ∷ FilePath → Resource
staticDir path
- = emptyResource {
- resIsGreedy = True
- , resGet = Just $ handleStaticDir True path
- , resHead = Just $ handleStaticDir False path
+ = (∅) {
+ resGet = Just $ handleStaticDir True path
+ , resHead = Just $ handleStaticDir False path
}
-- TODO: implement directory listing.
-handleStaticDir ∷ Bool → FilePath → Resource ()
+handleStaticDir ∷ Bool → FilePath → Rsrc ()
handleStaticDir sendContent basePath
= do extraPath ← getPathInfo
securityCheck extraPath