git.iko.soy/typeable/wai
on master help sign in
WAI 0.4
ff83660Michael Snoyman
Network/Wai/Application/Static.hs+18−12
compare with master
unifiedsplit
@@ -31,6 +31,7 @@ module Network.Wai.Application.Static
31 ) where
31 ) where
32
32
33import qualified Network.Wai as W
33import qualified Network.Wai as W
34+import qualified Network.HTTP.Types as H
34import Data.Map (Map)
35import Data.Map (Map)
35import qualified Data.Map as Map
36import qualified Data.Map as Map
36import Data.ByteString (ByteString)
37import Data.ByteString (ByteString)
@@ -38,7 +39,6 @@ import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents
38import qualified Data.ByteString.Char8 as S8
39import qualified Data.ByteString.Char8 as S8
39import qualified Data.ByteString.Lazy as L
40import qualified Data.ByteString.Lazy as L
40import Data.ByteString.Lazy.Char8 ()
41import Data.ByteString.Lazy.Char8 ()
41−import Web.Routes.Base (decodePathInfo, encodePathInfo)
42import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
42import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
43import System.Posix.Types (FileOffset, EpochTime)
43import System.Posix.Types (FileOffset, EpochTime)
44import Control.Monad.IO.Class (liftIO)
44import Control.Monad.IO.Class (liftIO)
@@ -49,6 +49,9 @@ import qualified Text.Blaze.Html5 as H
49import qualified Text.Blaze.Renderer.Utf8 as HU
49import qualified Text.Blaze.Renderer.Utf8 as HU
50import qualified Text.Blaze.Html5.Attributes as A
50import qualified Text.Blaze.Html5.Attributes as A
51
51
52+import Blaze.ByteString.Builder (toByteString, copyByteString)
53+import Data.Monoid (mappend)
54+
52import Data.Time
55import Data.Time
53import Data.Time.Clock.POSIX
56import Data.Time.Clock.POSIX
54import System.Locale (defaultTimeLocale)
57import System.Locale (defaultTimeLocale)
@@ -244,48 +247,51 @@ data StaticSettings = StaticSettings
244
247
245staticApp :: StaticSettings -> W.Application
248staticApp :: StaticSettings -> W.Application
246staticApp set req = do
249staticApp 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
248 staticAppPieces set pieces req
251 staticAppPieces set pieces req
249
252
250staticAppPieces :: StaticSettings -> [String] -> W.Application
253staticAppPieces :: StaticSettings -> [String] -> W.Application
251staticAppPieces _ _ req
254staticAppPieces _ _ req
252 | W.requestMethod req /= "GET" = return $ W.responseLBS
255 | W.requestMethod req /= "GET" = return $ W.responseLBS
253− W.status405
256+ H.status405
254 [("Content-Type", "text/plain")]
257 [("Content-Type", "text/plain")]
255 "Only GET is supported"
258 "Only GET is supported"
256staticAppPieces (StaticSettings folder indices mlisting getmime) pieces _ = liftIO $ do
259staticAppPieces (StaticSettings folder indices mlisting getmime) pieces _ = liftIO $ do
257 cp <- checkPieces folder indices pieces
260 cp <- checkPieces folder indices pieces
258 case cp of
261 case cp of
259 Redirect pieces' -> do
262 Redirect pieces' -> do
260− let loc = S8.pack $ (concatMap (const "../") $ drop 1 pieces) ++ encodePathInfo pieces' []
263+ let loc =
264+ toByteString $
265+ foldr mappend (H.encodePathSegments $ map T.pack pieces') -- FIXME use Text
266+ $ map (const $ copyByteString "../") $ drop 1 pieces
261− return $ W.responseLBS W.status301
267+ return $ W.responseLBS H.status301
262 [ ("Content-Type", "text/plain")
268 [ ("Content-Type", "text/plain")
263 , ("Location", loc)
269 , ("Location", loc)
264 ] "Redirect"
270 ] "Redirect"
265− Forbidden -> return $ W.responseLBS W.status403
271+ Forbidden -> return $ W.responseLBS H.status403
266 [ ("Content-Type", "text/plain")
272 [ ("Content-Type", "text/plain")
267 ] "Forbidden"
273 ] "Forbidden"
268− NotFound -> return $ W.responseLBS W.status404
274+ NotFound -> return $ W.responseLBS H.status404
269 [ ("Content-Type", "text/plain")
275 [ ("Content-Type", "text/plain")
270 ] "File not found"
276 ] "File not found"
271 FileResponse fp -> do
277 FileResponse fp -> do
272 mimetype <- getmime fp
278 mimetype <- getmime fp
273 filesize <- fileSize `fmap` getFileStatus fp
279 filesize <- fileSize `fmap` getFileStatus fp
274− return $ W.ResponseFile W.status200
280+ return $ W.ResponseFile H.status200
275 [ ("Content-Type", mimetype)
281 [ ("Content-Type", mimetype)
276 , ("Content-Length", S8.pack $ show filesize)
282 , ("Content-Length", S8.pack $ show filesize)
277− ] fp
283+ ] fp Nothing
278 DirectoryResponse fp ->
284 DirectoryResponse fp ->
279 case mlisting of
285 case mlisting of
280 Just listing -> do
286 Just listing -> do
281 lbs <- listing pieces fp
287 lbs <- listing pieces fp
282− return $ W.responseLBS W.status200
288+ return $ W.responseLBS H.status200
283 [ ("Content-Type", "text/html; charset=utf-8")
289 [ ("Content-Type", "text/html; charset=utf-8")
284 ] lbs
290 ] lbs
285− Nothing -> return $ W.responseLBS W.status403
291+ Nothing -> return $ W.responseLBS H.status403
286 [ ("Content-Type", "text/plain")
292 [ ("Content-Type", "text/plain")
287 ] "Directory listings disabled"
293 ] "Directory listings disabled"
288− SendContent mt lbs -> return $ W.responseLBS W.status200
294+ SendContent mt lbs -> return $ W.responseLBS H.status200
289 [ ("Content-Type", mt)
295 [ ("Content-Type", mt)
290 ] lbs
296 ] lbs
291
297
wai-app-static.cabal+5−4
@@ -1,5 +1,5 @@
1name: wai-app-static
1name: wai-app-static
2−version: 0.0.1.4
2+version: 0.1.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: Michael Snoyman <michael@snoyman.com>
5author: Michael Snoyman <michael@snoyman.com>
@@ -10,14 +10,14 @@ category: Web, Yesod
10stability: Stable
10stability: Stable
11cabal-version: >= 1.6
11cabal-version: >= 1.6
12build-type: Simple
12build-type: Simple
13−homepage: http://docs.yesodweb.com/
13+homepage: http://www.yesodweb.com/
14Extra-source-files: folder.png, haskell.png
14Extra-source-files: folder.png, haskell.png
15
15
16library
16library
17 build-depends: base >= 4 && < 5
17 build-depends: base >= 4 && < 5
18− , wai >= 0.3 && < 0.4
18+ , wai >= 0.4 && < 0.5
19 , bytestring >= 0.9.1.4 && < 0.10
19 , bytestring >= 0.9.1.4 && < 0.10
20− , web-routes >= 0.23 && < 0.24
20+ , http-types >= 0.6 && < 0.7
21 , transformers >= 0.2.2 && < 0.3
21 , transformers >= 0.2.2 && < 0.3
22 , unix-compat >= 0.2 && < 0.3
22 , unix-compat >= 0.2 && < 0.3
23 , directory >= 1.0 && < 1.2
23 , directory >= 1.0 && < 1.2
@@ -27,6 +27,7 @@ library
27 , old-locale >= 1.0.0.2 && < 1.1
27 , old-locale >= 1.0.0.2 && < 1.1
28 , file-embed >= 0.0.3.1 && < 0.1
28 , file-embed >= 0.0.3.1 && < 0.1
29 , text >= 0.5 && < 1.0
29 , text >= 0.5 && < 1.0
30+ , blaze-builder >= 0.2.1.4 && < 0.4
30 exposed-modules: Network.Wai.Application.Static
31 exposed-modules: Network.Wai.Application.Static
31 ghc-options: -Wall
32 ghc-options: -Wall
32
33