X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=7d2ff79ac260a843673e40b2064208f5819d42b0;hb=90fca0675b1694e69b8e431c989343855cbd125d;hp=39ff39c41ded5da08304e33b1f5cc97f9651bb5e;hpb=46ea3a688edea377e83794d1387f3f2d203bb0c6;p=Lucu.git

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 39ff39c..7d2ff79 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -15,14 +15,15 @@ import Control.Monad.Unicode
 import Control.Monad.Trans
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
+import Data.Monoid.Unicode
 import Data.String
-import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.MIMEType hiding (mimeType)
+import Network.HTTP.Lucu.MIMEType
 import Network.HTTP.Lucu.MIMEType.Guess
-import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Resource
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
@@ -31,11 +32,11 @@ import Prelude.Unicode
 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
       }
@@ -43,10 +44,15 @@ staticFile 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
@@ -65,23 +71,23 @@ handleStaticFile sendContent 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
@@ -89,7 +95,7 @@ handleStaticDir sendContent basePath
          handleStaticFile sendContent path
     where
       dec8 ∷ ByteString → String
-      dec8 = T.unpack ∘ T.decodeUtf8
+      dec8 = cs ∘ T.decodeUtf8
 
 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
 securityCheck pathElems