Rename: Resource --> Rsrc; ResourceDef --> Resource

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

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 39ff39c41ded5da08304e33b1f5cc97f9651bb5e..5b5eb9734e3a68441516f36a86ada99269ea7888 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -31,9 +31,9 @@ import Prelude.Unicode
 import System.Directory
 import System.FilePath
 
 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.
 -- @fpath@ on the filesystem.

-staticFile ∷ FilePath → ResourceDef
+staticFile ∷ FilePath → Resource

 staticFile path
     = emptyResource {
         resGet  = Just $ handleStaticFile True  path
 staticFile path
     = emptyResource {
         resGet  = Just $ handleStaticFile True  path


@@ -43,10 +43,15 @@ staticFile path
 octetStream ∷ MIMEType
 octetStream = [mimeType| application/octet-stream |]
 
 octetStream ∷ MIMEType
 octetStream = [mimeType| application/octet-stream |]
 

-handleStaticFile ∷ Bool → FilePath → Resource ()
+handleStaticFile ∷ Bool → FilePath → Rsrc ()

 handleStaticFile sendContent path
 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
              foundNoEntity'
 
          perms ← liftIO $ getPermissions path


@@ -65,14 +70,14 @@ handleStaticFile sendContent path
          when sendContent
              $ liftIO (LBS.readFile path) ≫= putChunks
 
          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
+-- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
+-- and its subdirectories on the filesystem to the

 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
 --
 -- 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/.
 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
 --
 -- 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
 staticDir path
     = emptyResource {
         resIsGreedy = True


@@ -81,7 +86,7 @@ staticDir path
       }
 
 -- TODO: implement directory listing.
       }
 
 -- TODO: implement directory listing.

-handleStaticDir ∷ Bool → FilePath → Resource ()
+handleStaticDir ∷ Bool → FilePath → Rsrc ()

 handleStaticDir sendContent basePath
     = do extraPath ← getPathInfo
          securityCheck extraPath
 handleStaticDir sendContent basePath
     = do extraPath ← getPathInfo
          securityCheck extraPath