git.iko.soy/typeable/wai
on master help sign in
mime-types (#89)
commit873aea94f84935df62cf915c92aa0255d3d3595b authorMichael Snoyman <michael@snoyman.com> dateTue 10 Jul 2012, 16:21 (14 years ago) parent4bf55db
10 files changed+109−46
compare with master
unifiedsplit
mime-types/LICENSE+20 wai-app-static/WaiAppStatic/Mime.hs → mime-types/Network/Mime.hs+46−8 mime-types/Setup.lhs+7 mime-types/mime-types.cabal+23 sources.txt+1 wai-app-static/Network/Wai/Application/Static.hs+1 wai-app-static/WaiAppStatic/Storage/Filesystem.hs+3−3 wai-app-static/WaiAppStatic/Types.hs+1−28 wai-app-static/test/WaiAppStaticTest.hs+5−6 wai-app-static/wai-app-static.cabal+2−1
mime-types/LICENSEnew file+20
@@ -0,0 +1,20 @@
1+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
2+
3+Permission is hereby granted, free of charge, to any person obtaining
4+a copy of this software and associated documentation files (the
5+"Software"), to deal in the Software without restriction, including
6+without limitation the rights to use, copy, modify, merge, publish,
7+distribute, sublicense, and/or sell copies of the Software, and to
8+permit persons to whom the Software is furnished to do so, subject to
9+the following conditions:
10+
11+The above copyright notice and this permission notice shall be
12+included in all copies or substantial portions of the Software.
13+
14+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
18+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
19+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
20+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
wai-app-static/WaiAppStatic/Mime.hs → mime-types/Network/Mime.hsrenamed+46−8
@@ -1,13 +1,35 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module WaiAppStatic.Mime
3− ( defaultMimeType
4− , defaultMimeMap
5− , mimeByExt
2+module Network.Mime
3+ ( -- * Lookups
4+ mimeByExt
65 , defaultMimeLookup
6+ -- * Defaults
7+ , defaultMimeType
8+ , defaultMimeMap
9+ -- * Utilities
10+ , fileNameExtensions
11+ -- * Types
12+ , FileName
13+ , MimeType
14+ , MimeMap
15+ , Extension
716 ) where
817
18+import Data.Text (Text)
19+import qualified Data.Text as T
20+import Data.ByteString (ByteString)
21+import Data.ByteString.Char8 ()
922import qualified Data.Map as Map
10−import WaiAppStatic.Types
23+
24+-- | Maps extensions to mime types.
25+type MimeMap = Map.Map Extension MimeType
26+
27+-- | The filename component of a filepath, leaving off the directory but
28+-- keeping all extensions.
29+type FileName = Text
30+
31+-- | Individual mime type for be served over the wire.
32+type MimeType = ByteString
1133
1234-- | The default fallback mime type \"application/octet-stream\".
1335defaultMimeType :: MimeType
@@ -85,10 +107,10 @@ defaultMimeMap = Map.fromList [
85107-- | Look up a mime type from the given mime map and default mime type.
86108mimeByExt :: MimeMap
87109 -> MimeType -- ^ default mime type
88− -> Piece
110+ -> FileName
89111 -> MimeType
90112mimeByExt mm def =
91− go . pieceExtensions
113+ go . fileNameExtensions
92114 where
93115 go [] = def
94116 go (e:es) =
@@ -97,5 +119,21 @@ mimeByExt mm def =
97119 Just mt -> mt
98120
99121-- | @mimeByExt@ applied to @defaultMimeType@ and @defaultMimeMap@.
100−defaultMimeLookup :: Piece -> MimeType
122+defaultMimeLookup :: FileName -> MimeType
101123defaultMimeLookup = mimeByExt defaultMimeMap defaultMimeType
124+
125+-- | Get a list of all of the file name extensions from a piece.
126+--
127+-- > pieceExtensions "foo.tar.gz" == ["tar.gz", "gz"]
128+fileNameExtensions :: FileName -> [Extension]
129+fileNameExtensions =
130+ go
131+ where
132+ go t
133+ | T.null e = []
134+ | otherwise = e : go e
135+ where
136+ e = T.drop 1 $ T.dropWhile (/= '.') t
137+
138+-- | Path extension. May include multiple components, e.g. tar.gz
139+type Extension = Text
mime-types/Setup.lhsnew file+7
@@ -0,0 +1,7 @@
1+#!/usr/bin/env runhaskell
2+
3+> module Main where
4+> import Distribution.Simple
5+
6+> main :: IO ()
7+> main = defaultMain
mime-types/mime-types.cabalnew file+23
@@ -0,0 +1,23 @@
1+name: mime-types
2+version: 0.1.0.0
3+synopsis: Basic mime-type handling types and functions
4+description: Basic mime-type handling types and functions
5+homepage: https://github.com/yesodweb/wai
6+license: MIT
7+license-file: LICENSE
8+author: Michael Snoyman
9+maintainer: michael@snoyman.com
10+category: Web
11+build-type: Simple
12+cabal-version: >=1.8
13+
14+library
15+ exposed-modules: Network.Mime
16+ build-depends: base >= 4 && < 5
17+ , containers
18+ , text
19+ , bytestring
20+
21+source-repository head
22+ type: git
23+ location: git://github.com/yesodweb/wai.git
sources.txt+1
@@ -11,4 +11,5 @@
1111./warp-static
1212./wai-websockets
1313./wai-eventsource
14+./mime-types
1415wai-logger
wai-app-static/Network/Wai/Application/Static.hs+1
@@ -46,6 +46,7 @@ import WaiAppStatic.Types
4646import Util
4747import WaiAppStatic.Storage.Filesystem
4848import WaiAppStatic.Storage.Embedded
49+import Network.Mime (MimeType)
4950
5051data StaticResponse =
5152 -- | Just the etag hash or Nothing for no etag hash
wai-app-static/WaiAppStatic/Storage/Filesystem.hs+3−3
@@ -22,7 +22,7 @@ import Data.ByteString (ByteString)
2222import Control.Exception (SomeException, try)
2323import qualified Network.Wai as W
2424import WaiAppStatic.Listing
25−import WaiAppStatic.Mime
25+import Network.Mime
2626import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
2727import Data.Maybe (catMaybes)
2828import qualified Crypto.Conduit
@@ -41,7 +41,7 @@ defaultWebAppSettings :: FilePath -- ^ root folder to serve from
4141defaultWebAppSettings root = StaticSettings
4242 { ssLookupFile = webAppLookup hashFileIfExists root
4343 , ssMkRedirect = defaultMkRedirect
44− , ssGetMimeType = return . defaultMimeLookup . fileName
44+ , ssGetMimeType = return . defaultMimeLookup . fromPiece . fileName
4545 , ssMaxAge = MaxAgeForever
4646 , ssListing = Nothing
4747 , ssIndices = []
@@ -56,7 +56,7 @@ defaultFileServerSettings :: FilePath -- ^ root folder to serve from
5656defaultFileServerSettings root = StaticSettings
5757 { ssLookupFile = fileSystemLookup (fmap Just . hashFile) root
5858 , ssMkRedirect = defaultMkRedirect
59− , ssGetMimeType = return . defaultMimeLookup . fileName
59+ , ssGetMimeType = return . defaultMimeLookup . fromPiece . fileName
6060 , ssMaxAge = MaxAgeSeconds $ 60 * 60
6161 , ssListing = Just defaultListing
6262 , ssIndices = map unsafeToPiece ["index.html", "index.htm"]
wai-app-static/WaiAppStatic/Types.hs+1−28
@@ -7,11 +7,6 @@ module WaiAppStatic.Types
77 , unsafeToPiece
88 , Pieces
99 , toPieces
10− , pieceExtensions
11− -- * Mime
12− , MimeType
13− , Extension
14− , MimeMap
1510 -- * Caching
1611 , MaxAge (..)
1712 -- * File\/folder serving
@@ -30,8 +25,8 @@ import qualified Network.Wai as W
3025import Data.ByteString (ByteString)
3126import System.Posix.Types (EpochTime)
3227import qualified Data.Text as T
33−import qualified Data.Map as Map
3428import Blaze.ByteString.Builder (Builder)
29+import Network.Mime (MimeType)
3530
3631-- | An individual component of a path, or of a filepath.
3732--
@@ -67,19 +62,6 @@ toPieces = mapM toPiece
6762-- | Request coming from a user. Corresponds to @pathInfo@.
6863type Pieces = [Piece]
6964
70−-- | Get a list of all of the file name extensions from a piece.
71−--
72−-- > pieceExtensions (unsafeToPiece "foo.tar.gz") == ["tar.gz", "gz"]
73−pieceExtensions :: Piece -> [Extension]
74−pieceExtensions =
75− go . fromPiece
76− where
77− go t
78− | T.null e = []
79− | otherwise = e : go e
80− where
81− e = T.drop 1 $ T.dropWhile (/= '.') t
82−
8365-- | Values for the max-age component of the cache-control response header.
8466data MaxAge = NoMaxAge -- ^ no cache-control set
8567 | MaxAgeSeconds Int -- ^ set to the given number of seconds
@@ -121,15 +103,6 @@ data LookupResult = LRFile File
121103-- the resulting folder.
122104type Listing = Pieces -> Folder -> IO Builder
123105
124−-- | Individual mime type for be served over the wire.
125−type MimeType = ByteString
126−
127−-- | Path extension. May include multiple components, e.g. tar.gz
128−type Extension = Text
129−
130−-- | Maps extensions to mime types.
131−type MimeMap = Map.Map Extension MimeType
132−
133106-- | All of the settings available to users for tweaking wai-app-static.
134107--
135108-- Note that you should use the settings type approach for modifying values.
wai-app-static/test/WaiAppStaticTest.hs+5−6
@@ -18,8 +18,7 @@ import Network.Wai
1818import Network.Wai.Test
1919
2020import Control.Monad.IO.Class (liftIO)
21−import WaiAppStatic.Types
22−import WaiAppStatic.Mime
21+import Network.Mime
2322
2423defRequest :: Request
2524defRequest = defaultRequest
@@ -34,12 +33,12 @@ specs = do
3433 let statFile = setRawPathInfo defRequest file
3534
3635 describe "mime types" $ do
37− it "pieceExtensions" $
38− pieceExtensions (unsafeToPiece "foo.tar.gz") @?= ["tar.gz", "gz"]
36+ it "fileNameExtensions" $
37+ fileNameExtensions "foo.tar.gz" @?= ["tar.gz", "gz"]
3938 it "handles multi-extensions" $
40− defaultMimeLookup (unsafeToPiece "foo.tar.gz") @?= "application/x-tgz"
39+ defaultMimeLookup "foo.tar.gz" @?= "application/x-tgz"
4140 it "defaults correctly" $
42− defaultMimeLookup (unsafeToPiece "foo.unknown") @?= "application/octet-stream"
41+ defaultMimeLookup "foo.unknown" @?= "application/octet-stream"
4342
4443 describe "webApp" $ do
4544 it "403 for unsafe paths" $ webApp $
wai-app-static/wai-app-static.cabal+2−1
@@ -45,12 +45,12 @@ library
4545 , blaze-markup >= 0.5.1 && < 0.6
4646 , crypto-conduit >= 0.4 && < 0.5
4747 , cereal >= 0.3.5 && < 0.4
48+ , mime-types >= 0.1 && < 0.2
4849
4950 exposed-modules: Network.Wai.Application.Static
5051 WaiAppStatic.Storage.Filesystem
5152 WaiAppStatic.Storage.Embedded
5253 WaiAppStatic.Listing
53− WaiAppStatic.Mime
5454 WaiAppStatic.Types
5555 other-modules: Util
5656 ghc-options: -Wall
@@ -79,6 +79,7 @@ test-suite runtests
7979 , bytestring
8080 , text
8181 , transformers
82+ , mime-types
8283 -- , containers
8384 ghc-options: -Wall
8485