@@ -31,6 +31,7 @@ module Network.Wai.Application.Static
3131 ) where
3232
3333import qualified Network.Wai as W
34+import qualified Network.HTTP.Types as H
3435import Data.Map (Map)
3536import qualified Data.Map as Map
3637import Data.ByteString (ByteString)
@@ -38,7 +39,6 @@ import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents
3839import qualified Data.ByteString.Char8 as S8
3940import qualified Data.ByteString.Lazy as L
4041import Data.ByteString.Lazy.Char8 ()
41−import Web.Routes.Base (decodePathInfo, encodePathInfo)
4242import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
4343import System.Posix.Types (FileOffset, EpochTime)
4444import Control.Monad.IO.Class (liftIO)
@@ -49,6 +49,9 @@ import qualified Text.Blaze.Html5 as H
4949import qualified Text.Blaze.Renderer.Utf8 as HU
5050import qualified Text.Blaze.Html5.Attributes as A
5151
52+import Blaze.ByteString.Builder (toByteString, copyByteString)
53+import Data.Monoid (mappend)
54+
5255import Data.Time
5356import Data.Time.Clock.POSIX
5457import System.Locale (defaultTimeLocale)
@@ -244,48 +247,51 @@ data StaticSettings = StaticSettings
244247
245248staticApp :: StaticSettings -> W.Application
246249staticApp set req = do
247− let pieces = decodePathInfo $ S8.unpack $ W.pathInfo req
250+ let pieces = map T.unpack $ W.pathInfo req -- FIXME stick with Text
248251 staticAppPieces set pieces req
249252
250253staticAppPieces :: StaticSettings -> [String] -> W.Application
251254staticAppPieces _ _ req
252255 | W.requestMethod req /= "GET" = return $ W.responseLBS
253− W.status405
256+ H.status405
254257 [("Content-Type", "text/plain")]
255258 "Only GET is supported"
256259staticAppPieces (StaticSettings folder indices mlisting getmime) pieces _ = liftIO $ do
257260 cp <- checkPieces folder indices pieces
258261 case cp of
259262 Redirect pieces' -> do
260− let loc = S8.pack $ (concatMap (const "../") $ drop 1 pieces) ++ encodePathInfo pieces' []
261− return $ W.responseLBS W.status301
263+ let loc =
264+ toByteString $
265+ foldr mappend (H.encodePathSegments $ map T.pack pieces') -- FIXME use Text
266+ $ map (const $ copyByteString "../") $ drop 1 pieces
267+ return $ W.responseLBS H.status301
262268 [ ("Content-Type", "text/plain")
263269 , ("Location", loc)
264270 ] "Redirect"
265− Forbidden -> return $ W.responseLBS W.status403
271+ Forbidden -> return $ W.responseLBS H.status403
266272 [ ("Content-Type", "text/plain")
267273 ] "Forbidden"
268− NotFound -> return $ W.responseLBS W.status404
274+ NotFound -> return $ W.responseLBS H.status404
269275 [ ("Content-Type", "text/plain")
270276 ] "File not found"
271277 FileResponse fp -> do
272278 mimetype <- getmime fp
273279 filesize <- fileSize `fmap` getFileStatus fp
274− return $ W.ResponseFile W.status200
280+ return $ W.ResponseFile H.status200
275281 [ ("Content-Type", mimetype)
276282 , ("Content-Length", S8.pack $ show filesize)
277− ] fp
283+ ] fp Nothing
278284 DirectoryResponse fp ->
279285 case mlisting of
280286 Just listing -> do
281287 lbs <- listing pieces fp
282− return $ W.responseLBS W.status200
288+ return $ W.responseLBS H.status200
283289 [ ("Content-Type", "text/html; charset=utf-8")
284290 ] lbs
285− Nothing -> return $ W.responseLBS W.status403
291+ Nothing -> return $ W.responseLBS H.status403
286292 [ ("Content-Type", "text/plain")
287293 ] "Directory listings disabled"
288− SendContent mt lbs -> return $ W.responseLBS W.status200
294+ SendContent mt lbs -> return $ W.responseLBS H.status200
289295 [ ("Content-Type", mt)
290296 ] lbs
291297