git.iko.soy/typeable/wai
on master help sign in
Minor code shuffle
b63437cMichael Snoyman
Network/Wai/Application/Static.hs+24−30
compare with master
unifiedsplit
@@ -2,9 +2,14 @@
2{-# LANGUAGE TemplateHaskell, CPP #-}
2{-# LANGUAGE TemplateHaskell, CPP #-}
3-- | Static file serving for WAI.
3-- | Static file serving for WAI.
4module Network.Wai.Application.Static
4module Network.Wai.Application.Static
5+ ( -- * WAI application
6+ staticApp
7+ -- ** Settings
8+ , StaticSettings (..)
9+ , defaultStaticSettings
5− ( -- * Generic, non-WAI code
10+ -- * Generic, non-WAI code
6 -- ** Mime types
11 -- ** Mime types
7− MimeType
12+ , MimeType
8 , defaultMimeType
13 , defaultMimeType
9 -- ** Mime type by file extension
14 -- ** Mime type by file extension
10 , Extension
15 , Extension
@@ -16,25 +21,21 @@ module Network.Wai.Application.Static
16 -- ** Finding files
21 -- ** Finding files
17 , Pieces
22 , Pieces
18 , pathFromPieces
23 , pathFromPieces
24+ , unfixPathName
19 -- ** Directory listings
25 -- ** Directory listings
20 , Listing
26 , Listing
21 , defaultListing
27 , defaultListing
22− , defaultDirListing
28+ -- ** Lookup functions
23− -- * WAI application
24− , staticApp
25− , staticAppPieces
26− -- ** Settings
27− , StaticSettings (..)
28− , defaultStaticSettings
29− -- should be moved to common helper
30− , unfixPathName
31− -- new stuff to be sorted
32 , fileSystemLookup
29 , fileSystemLookup
33 , embeddedLookup
30 , embeddedLookup
31+ -- ** Embedded
32+ , Embedded
33+ , EmbeddedEntry (..)
34+ , toEmbedded
35+ -- ** Redirecting
34 , defaultMkRedirect
36 , defaultMkRedirect
37+ -- * Other data types
35 , File (..)
38 , File (..)
36− , toEmbedded
37− , StaticDirListing (..)
38 , MaxAge (..)
39 , MaxAge (..)
39 ) where
40 ) where
40
41
@@ -311,14 +312,6 @@ checkPieces fileLookup indices pieces req ss
311
312
312type Listing = (Pieces -> Folder -> IO L.ByteString)
313type Listing = (Pieces -> Folder -> IO L.ByteString)
313
314
314−data StaticDirListing = StaticDirListing {
315− ssListing :: Maybe Listing
316− , ssIndices :: [T.Text]
317−}
318−
319−defaultDirListing :: StaticDirListing
320−defaultDirListing = StaticDirListing (Just defaultListing) []
321−
322oneYear :: Int
315oneYear :: Int
323oneYear = 60 * 60 * 24 * 365
316oneYear = 60 * 60 * 24 * 365
324
317
@@ -326,7 +319,7 @@ type FileLookup = Maybe (Either Folder File)
326
319
327data Folder = Folder
320data Folder = Folder
328 { folderName :: T.Text
321 { folderName :: T.Text
329− , folderContents :: [Either Folder File] -- FIXME remove?
322+ , folderContents :: [Either Folder File]
330 }
323 }
331
324
332data File = File
325data File = File
@@ -344,7 +337,8 @@ data StaticSettings = StaticSettings
344 { ssFolder :: Pieces -> IO FileLookup
337 { ssFolder :: Pieces -> IO FileLookup
345 , ssMkRedirect :: Pieces -> ByteString -> ByteString
338 , ssMkRedirect :: Pieces -> ByteString -> ByteString
346 , ssGetMimeType :: File -> IO MimeType
339 , ssGetMimeType :: File -> IO MimeType
347− , ssDirListing :: StaticDirListing
340+ , ssListing :: Maybe Listing
341+ , ssIndices :: [T.Text]
348 , ssMaxAge :: MaxAge
342 , ssMaxAge :: MaxAge
349 }
343 }
350
344
@@ -364,8 +358,9 @@ defaultStaticSettings = StaticSettings
364 { ssFolder = fileSystemLookup "static"
358 { ssFolder = fileSystemLookup "static"
365 , ssMkRedirect = defaultMkRedirect
359 , ssMkRedirect = defaultMkRedirect
366 , ssGetMimeType = return . defaultMimeTypeByExt . T.unpack . fileName
360 , ssGetMimeType = return . defaultMimeTypeByExt . T.unpack . fileName
367− , ssDirListing = defaultDirListing
368 , ssMaxAge = MaxAgeSeconds $ 60 * 60
361 , ssMaxAge = MaxAgeSeconds $ 60 * 60
362+ , ssListing = Just defaultListing
363+ , ssIndices = ["index.html", "index.htm"]
369 }
364 }
370
365
371fileHelper :: FilePath -> T.Text -> IO File
366fileHelper :: FilePath -> T.Text -> IO File
@@ -494,8 +489,7 @@ staticAppPieces _ _ req
494 [("Content-Type", "text/plain")]
489 [("Content-Type", "text/plain")]
495 "Only GET is supported"
490 "Only GET is supported"
496staticAppPieces ss pieces req = liftIO $ do
491staticAppPieces ss pieces req = liftIO $ do
497− let indices = case ssDirListing ss of
492+ let indices = ssIndices ss
498− StaticDirListing _ is -> is
499 cp <- checkPieces (ssFolder ss) indices pieces req ss
493 cp <- checkPieces (ssFolder ss) indices pieces req ss
500 case cp of
494 case cp of
501 FileResponse file ch -> do
495 FileResponse file ch -> do
@@ -510,13 +504,13 @@ staticAppPieces ss pieces req = liftIO $ do
510 [ ("Content-Type", "text/plain")
504 [ ("Content-Type", "text/plain")
511 ] "Not Modified"
505 ] "Not Modified"
512 DirectoryResponse fp ->
506 DirectoryResponse fp ->
513− case ssDirListing ss of
507+ case ssListing ss of
514− StaticDirListing (Just f) _ -> do
508+ (Just f) -> do
515 lbs <- f pieces fp
509 lbs <- f pieces fp
516 return $ W.responseLBS H.status200
510 return $ W.responseLBS H.status200
517 [ ("Content-Type", "text/html; charset=utf-8")
511 [ ("Content-Type", "text/html; charset=utf-8")
518 ] lbs
512 ] lbs
519− StaticDirListing Nothing _ -> return $ W.responseLBS H.status403
513+ Nothing -> return $ W.responseLBS H.status403
520 [ ("Content-Type", "text/plain")
514 [ ("Content-Type", "text/plain")
521 ] "Directory listings disabled"
515 ] "Directory listings disabled"
522 SendContent mt lbs -> do
516 SendContent mt lbs -> do