From 1c3e02a2cd927036dade2af84b53b2d025770616 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 24 Jan 2010 01:14:35 +0200
Subject: [PATCH] Cleaned up some FIXMEs

---
 Yesod/Definitions.hs    |  6 +++---
 Yesod/Helpers/Auth.hs   |  7 +++----
 Yesod/Helpers/Static.hs | 19 +++++++++++++++----
 Yesod/Resource.hs       |  2 +-
 Yesod/Response.hs       |  3 +--
 5 files changed, 23 insertions(+), 14 deletions(-)

diff --git a/Yesod/Definitions.hs b/Yesod/Definitions.hs
index b3ff2d8d..8ad89f93 100644
--- a/Yesod/Definitions.hs
+++ b/Yesod/Definitions.hs
@@ -17,7 +17,7 @@
 module Yesod.Definitions
     ( Verb (..)
     , Resource
-    , Approot (..)
+    , Approot
     , Language
     , Location (..)
     , showLocation
@@ -55,7 +55,7 @@ type Resource = [String]
 -- | An absolute URL to the base of this application. This can almost be done
 -- programatically, but due to ambiguities in different ways of doing URL
 -- rewriting for (fast)cgi applications, it should be supplied by the user.
-newtype Approot = Approot { unApproot :: String } -- FIXME make type syn?
+type Approot = String
 
 type Language = String
 
@@ -66,6 +66,6 @@ data Location = AbsLoc String | RelLoc String
 -- | Display a 'Location' in absolute form.
 showLocation :: Approot -> Location -> String
 showLocation _ (AbsLoc s) = s
-showLocation (Approot ar) (RelLoc s) = ar ++ s
+showLocation ar (RelLoc s) = ar ++ s
 
 type PathInfo = [String]
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index be5914eb..43341b03 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -49,7 +49,7 @@ class YesodApproot a => YesodAuth a where
 getFullAuthRoot :: YesodAuth y => Handler y String
 getFullAuthRoot = do
     y <- getYesod
-    let (Approot ar) = approot y
+    ar <- getApproot
     return $ ar ++ authRoot y
 
 data AuthResource =
@@ -168,15 +168,14 @@ authCheck = do
 authLogout :: YesodAuth y => Handler y HtmlObject
 authLogout = do
     deleteCookie authCookieName
-    y <- getYesod
-    let (Approot ar) = approot y
+    ar <- getApproot
     redirect ar
     -- FIXME check the DEST information
 
 authIdentifier :: YesodAuth y => Handler y String
 authIdentifier = do
     mi <- identifier
-    Approot ar <- getApproot
+    ar <- getApproot
     case mi of
         Nothing -> do
             rp <- requestPath
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
index 2b8ba726..61461248 100644
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -25,19 +25,25 @@ module Yesod.Helpers.Static
 import qualified Data.ByteString.Lazy as B
 import System.Directory (doesFileExist)
 import Control.Applicative ((<$>))
+import Control.Monad
 
 import Yesod
 import Data.List (intercalate)
 
 type FileLookup = FilePath -> IO (Maybe B.ByteString)
 
--- | A 'FileLookup' for files in a directory.
+-- | A 'FileLookup' for files in a directory. Note that this function does not
+-- check if the requested path does unsafe things, eg expose hidden files. You
+-- should provide this checking elsewhere.
+--
+-- If you are just using this in combination with serveStatic, serveStatic
+-- provides this checking.
 fileLookupDir :: FilePath -> FileLookup
 fileLookupDir dir fp = do
-    let fp' = dir ++ '/' : fp -- FIXME incredibly insecure...
+    let fp' = dir ++ '/' : fp
     exists <- doesFileExist fp'
     if exists
-        then Just <$> B.readFile fp'
+        then Just <$> B.readFile fp' -- FIXME replace lazy I/O when possible
         else return Nothing
 
 serveStatic :: FileLookup -> Verb -> [String]
@@ -47,11 +53,16 @@ serveStatic _ _ _ = notFound
 
 getStatic :: FileLookup -> [String] -> Handler y [(ContentType, Content)]
 getStatic fl fp' = do
-    let fp = intercalate "/" fp' -- FIXME check for . or ..
+    when (any isUnsafe fp') $ notFound
+    let fp = intercalate "/" fp'
     content <- liftIO $ fl fp
     case content of
         Nothing -> notFound
         Just bs -> return [(mimeType $ ext fp, Content bs)]
+      where
+        isUnsafe [] = True
+        isUnsafe ('.':_) = True
+        isUnsafe _ = False
 
 mimeType :: String -> ContentType
 mimeType "jpg" = TypeJpeg
diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs
index ad28b3cf..581bfdad 100644
--- a/Yesod/Resource.hs
+++ b/Yesod/Resource.hs
@@ -244,7 +244,7 @@ checkRPNodes :: (MonadFailure OverlappingPatterns m,
              => [RPNode]
              -> m [RPNode]
 checkRPNodes nodes = do
-    _ <- checkPatterns $ map (\(RPNode r _) -> cs r) nodes -- FIXME ugly
+    _ <- checkPatterns $ map (\(RPNode r _) -> cs r) nodes
     mapM_ (\(RPNode _ v) -> checkVerbMap v) nodes
     return nodes
         where
diff --git a/Yesod/Response.hs b/Yesod/Response.hs
index 6dc61c1c..b226684e 100644
--- a/Yesod/Response.hs
+++ b/Yesod/Response.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeSynonymInstances #-} -- FIXME remove
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE CPP #-}
@@ -97,7 +97,6 @@ toPair (DeleteCookie key) = return
      key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
 toPair (Header key value) = return (key, value)
 
--- FIXME add test
 responseToHackResponse :: [String] -- ^ language list
                        -> Response -> IO Hack.Response
 responseToHackResponse _FIXMEls (Response sc hs ct c) = do