Permalink
Browse files

mime-types (#89)

  • Loading branch information...
snoyberg committed Jul 10, 2012
1 parent 4bf55db commit 873aea94f84935df62cf915c92aa0255d3d3595b
View
@@ -0,0 +1,20 @@
+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@@ -1,13 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
-module WaiAppStatic.Mime
- ( defaultMimeType
- , defaultMimeMap
- , mimeByExt
+module Network.Mime
+ ( -- * Lookups
+ mimeByExt
, defaultMimeLookup
+ -- * Defaults
+ , defaultMimeType
+ , defaultMimeMap
+ -- * Utilities
+ , fileNameExtensions
+ -- * Types
+ , FileName
+ , MimeType
+ , MimeMap
+ , Extension
) where
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 ()
import qualified Data.Map as Map
-import WaiAppStatic.Types
+
+-- | Maps extensions to mime types.
+type MimeMap = Map.Map Extension MimeType
+
+-- | The filename component of a filepath, leaving off the directory but
+-- keeping all extensions.
+type FileName = Text
+
+-- | Individual mime type for be served over the wire.
+type MimeType = ByteString
-- | The default fallback mime type \"application/octet-stream\".
defaultMimeType :: MimeType
@@ -85,10 +107,10 @@ defaultMimeMap = Map.fromList [
-- | Look up a mime type from the given mime map and default mime type.
mimeByExt :: MimeMap
-> MimeType -- ^ default mime type
- -> Piece
+ -> FileName
-> MimeType
mimeByExt mm def =
- go . pieceExtensions
+ go . fileNameExtensions
where
go [] = def
go (e:es) =
@@ -97,5 +119,21 @@ mimeByExt mm def =
Just mt -> mt
-- | @mimeByExt@ applied to @defaultMimeType@ and @defaultMimeMap@.
-defaultMimeLookup :: Piece -> MimeType
+defaultMimeLookup :: FileName -> MimeType
defaultMimeLookup = mimeByExt defaultMimeMap defaultMimeType
+
+-- | Get a list of all of the file name extensions from a piece.
+--
+-- > pieceExtensions "foo.tar.gz" == ["tar.gz", "gz"]
+fileNameExtensions :: FileName -> [Extension]
+fileNameExtensions =
+ go
+ where
+ go t
+ | T.null e = []
+ | otherwise = e : go e
+ where
+ e = T.drop 1 $ T.dropWhile (/= '.') t
+
+-- | Path extension. May include multiple components, e.g. tar.gz
+type Extension = Text
View
@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
@@ -0,0 +1,23 @@
+name: mime-types
+version: 0.1.0.0
+synopsis: Basic mime-type handling types and functions
+description: Basic mime-type handling types and functions
+homepage: https://github.com/yesodweb/wai
+license: MIT
+license-file: LICENSE
+author: Michael Snoyman
+maintainer: michael@snoyman.com
+category: Web
+build-type: Simple
+cabal-version: >=1.8
+
+library
+ exposed-modules: Network.Mime
+ build-depends: base >= 4 && < 5
+ , containers
+ , text
+ , bytestring
+
+source-repository head
+ type: git
+ location: git://github.com/yesodweb/wai.git
View
@@ -11,4 +11,5 @@
./warp-static
./wai-websockets
./wai-eventsource
+./mime-types
wai-logger
@@ -46,6 +46,7 @@ import WaiAppStatic.Types
import Util
import WaiAppStatic.Storage.Filesystem
import WaiAppStatic.Storage.Embedded
+import Network.Mime (MimeType)
data StaticResponse =
-- | Just the etag hash or Nothing for no etag hash
@@ -22,7 +22,7 @@ import Data.ByteString (ByteString)
import Control.Exception (SomeException, try)
import qualified Network.Wai as W
import WaiAppStatic.Listing
-import WaiAppStatic.Mime
+import Network.Mime
import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
import Data.Maybe (catMaybes)
import qualified Crypto.Conduit
@@ -41,7 +41,7 @@ defaultWebAppSettings :: FilePath -- ^ root folder to serve from
defaultWebAppSettings root = StaticSettings
{ ssLookupFile = webAppLookup hashFileIfExists root
, ssMkRedirect = defaultMkRedirect
- , ssGetMimeType = return . defaultMimeLookup . fileName
+ , ssGetMimeType = return . defaultMimeLookup . fromPiece . fileName
, ssMaxAge = MaxAgeForever
, ssListing = Nothing
, ssIndices = []
@@ -56,7 +56,7 @@ defaultFileServerSettings :: FilePath -- ^ root folder to serve from
defaultFileServerSettings root = StaticSettings
{ ssLookupFile = fileSystemLookup (fmap Just . hashFile) root
, ssMkRedirect = defaultMkRedirect
- , ssGetMimeType = return . defaultMimeLookup . fileName
+ , ssGetMimeType = return . defaultMimeLookup . fromPiece . fileName
, ssMaxAge = MaxAgeSeconds $ 60 * 60
, ssListing = Just defaultListing
, ssIndices = map unsafeToPiece ["index.html", "index.htm"]
@@ -7,11 +7,6 @@ module WaiAppStatic.Types
, unsafeToPiece
, Pieces
, toPieces
- , pieceExtensions
- -- * Mime
- , MimeType
- , Extension
- , MimeMap
-- * Caching
, MaxAge (..)
-- * File\/folder serving
@@ -30,8 +25,8 @@ import qualified Network.Wai as W
import Data.ByteString (ByteString)
import System.Posix.Types (EpochTime)
import qualified Data.Text as T
-import qualified Data.Map as Map
import Blaze.ByteString.Builder (Builder)
+import Network.Mime (MimeType)
-- | An individual component of a path, or of a filepath.
--
@@ -67,19 +62,6 @@ toPieces = mapM toPiece
-- | Request coming from a user. Corresponds to @pathInfo@.
type Pieces = [Piece]
--- | Get a list of all of the file name extensions from a piece.
---
--- > pieceExtensions (unsafeToPiece "foo.tar.gz") == ["tar.gz", "gz"]
-pieceExtensions :: Piece -> [Extension]
-pieceExtensions =
- go . fromPiece
- where
- go t
- | T.null e = []
- | otherwise = e : go e
- where
- e = T.drop 1 $ T.dropWhile (/= '.') t
-
-- | Values for the max-age component of the cache-control response header.
data MaxAge = NoMaxAge -- ^ no cache-control set
| MaxAgeSeconds Int -- ^ set to the given number of seconds
@@ -121,15 +103,6 @@ data LookupResult = LRFile File
-- the resulting folder.
type Listing = Pieces -> Folder -> IO Builder
--- | Individual mime type for be served over the wire.
-type MimeType = ByteString
-
--- | Path extension. May include multiple components, e.g. tar.gz
-type Extension = Text
-
--- | Maps extensions to mime types.
-type MimeMap = Map.Map Extension MimeType
-
-- | All of the settings available to users for tweaking wai-app-static.
--
-- Note that you should use the settings type approach for modifying values.
@@ -18,8 +18,7 @@ import Network.Wai
import Network.Wai.Test
import Control.Monad.IO.Class (liftIO)
-import WaiAppStatic.Types
-import WaiAppStatic.Mime
+import Network.Mime
defRequest :: Request
defRequest = defaultRequest
@@ -34,12 +33,12 @@ specs = do
let statFile = setRawPathInfo defRequest file
describe "mime types" $ do
- it "pieceExtensions" $
- pieceExtensions (unsafeToPiece "foo.tar.gz") @?= ["tar.gz", "gz"]
+ it "fileNameExtensions" $
+ fileNameExtensions "foo.tar.gz" @?= ["tar.gz", "gz"]
it "handles multi-extensions" $
- defaultMimeLookup (unsafeToPiece "foo.tar.gz") @?= "application/x-tgz"
+ defaultMimeLookup "foo.tar.gz" @?= "application/x-tgz"
it "defaults correctly" $
- defaultMimeLookup (unsafeToPiece "foo.unknown") @?= "application/octet-stream"
+ defaultMimeLookup "foo.unknown" @?= "application/octet-stream"
describe "webApp" $ do
it "403 for unsafe paths" $ webApp $
@@ -45,12 +45,12 @@ library
, blaze-markup >= 0.5.1 && < 0.6
, crypto-conduit >= 0.4 && < 0.5
, cereal >= 0.3.5 && < 0.4
+ , mime-types >= 0.1 && < 0.2
exposed-modules: Network.Wai.Application.Static
WaiAppStatic.Storage.Filesystem
WaiAppStatic.Storage.Embedded
WaiAppStatic.Listing
- WaiAppStatic.Mime
WaiAppStatic.Types
other-modules: Util
ghc-options: -Wall
@@ -79,6 +79,7 @@ test-suite runtests
, bytestring
, text
, transformers
+ , mime-types
-- , containers
ghc-options: -Wall

0 comments on commit 873aea9

Please sign in to comment.