{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables, Rank2Types #-}
-- | Build your own file serving functions
--
-- If the functions in "Happstack.Server.FileServe" do not quite do
-- you want you can roll your own by reusing pieces from this module.
--
-- You will likely want to start by copying the source for a function
-- like, 'serveDirectory' and then modifying it to suit your needs.
--
module Happstack.Server.FileServe.BuildingBlocks
    (
     -- * High-Level
     -- ** Serving files from a directory
     fileServe,
     fileServe',
     fileServeLazy,
     fileServeStrict,
     Browsing(..),
     serveDirectory,
     serveDirectory',
     -- ** Serving a single file
     serveFile,
     serveFileFrom,
     serveFileUsing,
     -- * Low-Level
     sendFileResponse,
     lazyByteStringResponse,
     strictByteStringResponse,
     filePathSendFile,
     filePathLazy,
     filePathStrict,
     -- * Content-Type \/ Mime-Type
     MimeMap,
     mimeTypes,
     asContentType,
     guessContentType,
     guessContentTypeM,
     -- * Directory Browsing
     EntryKind(..),
     browseIndex,
     renderDirectoryContents,
     renderDirectoryContentsTable,
     -- * Other
     blockDotFiles,
     defaultIxFiles,
     combineSafe,
     isSafePath,
     tryIndex,
     doIndex,
     doIndex',
     doIndexLazy,
     doIndexStrict,
     fileNotFound,
     isDot
    ) where

import Control.Exception.Extensible as E (IOException, bracket, catch)
import Control.Monad                (MonadPlus(mzero), msum)
import Control.Monad.Trans          (MonadIO(liftIO))
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Char8 as S
import Data.Data                    (Data, Typeable)
import Data.List                    (sort)
import Data.Maybe                   (fromMaybe)
import           Data.Map           (Map)
import qualified Data.Map           as Map
import Filesystem.Path.CurrentOS    (commonPrefix, encodeString, decodeString, collapse, append)
import Happstack.Server.Monads      (ServerMonad(askRq), FilterMonad, WebMonad)
import Happstack.Server.Response    (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther)
import Happstack.Server.Types       (Length(ContentLength), Request(rqPaths, rqUri), Response(SendFile), RsFlags(rsfLength), nullRsFlags, result, resultBS, setHeader)
import System.Directory             (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime)
import System.FilePath              ((</>), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, takeExtension, isValid)
import System.IO                    (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile)
import System.Log.Logger            (Priority(DEBUG), logM)
import           Text.Blaze.Html             ((!))
import qualified Text.Blaze.Html5            as H
import qualified Text.Blaze.Html5.Attributes as A

#if MIN_VERSION_time(1,5,0)
import Data.Time     (UTCTime, formatTime, defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
import Data.Time     (UTCTime, formatTime)
#endif

-- * Mime-Type / Content-Type

-- |a 'Map' from file extensions to content-types
--
-- example:
--
-- > myMimeMap :: MimeMap
-- > myMimeMap = Map.fromList [("gz","application/x-gzip"), ... ]
--
-- see also: 'mimeTypes'
type MimeMap = Map String String

-- | try to guess the content-type of a file based on its extension
--
-- see also: 'guessContentTypeM'
guessContentType :: MimeMap -> FilePath -> Maybe String
guessContentType :: MimeMap -> String -> Maybe String
guessContentType MimeMap
mimeMap String
filepath =
    case String -> String
getExt String
filepath of
      String
"" -> Maybe String
forall a. Maybe a
Nothing
      String
ext -> String -> MimeMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ext MimeMap
mimeMap

-- | try to guess the content-type of a file based on its extension
--
-- defaults to "application/octet-stream" if no match was found.
--
-- Useful as an argument to 'serveFile'
--
-- see also: 'guessContentType', 'serveFile'
guessContentTypeM :: (Monad m) => MimeMap -> (FilePath -> m String)
guessContentTypeM :: forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeMap String
filePath = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"application/octet-stream" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ MimeMap -> String -> Maybe String
guessContentType MimeMap
mimeMap String
filePath

-- | returns a specific content type, completely ignoring the 'FilePath' argument.
--
-- Use this with 'serveFile' if you want to explicitly specify the
-- content-type.
--
-- see also: 'guessContentTypeM', 'serveFile'
asContentType :: (Monad m) =>
                 String  -- ^ the content-type to return
              -> (FilePath -> m String)
asContentType :: forall (m :: * -> *). Monad m => String -> String -> m String
asContentType = m String -> String -> m String
forall a b. a -> b -> a
const (m String -> String -> m String)
-> (String -> m String) -> String -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | a list of common index files. Specifically: @index.html@, @index.xml@, @index.gif@
--
-- Typically used as an argument to 'serveDiretory'.
defaultIxFiles :: [FilePath]
defaultIxFiles :: [String]
defaultIxFiles= [String
"index.html",String
"index.xml",String
"index.gif"]

-- | return a simple "File not found 404 page."
fileNotFound :: (Monad m, FilterMonad Response m) => FilePath -> m Response
fileNotFound :: forall (m :: * -> *).
(Monad m, FilterMonad Response m) =>
String -> m Response
fileNotFound String
fp = Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Int -> String -> Response
result Int
404 (String -> Response) -> String -> Response
forall a b. (a -> b) -> a -> b
$ String
"File not found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp

-- | Similar to 'takeExtension' but does not include the extension separator char
getExt :: FilePath -> String
getExt :: String -> String
getExt String
fp = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
fp

-- | Prevents files of the form '.foo' or 'bar/.foo' from being served
blockDotFiles :: (Request -> IO Response) -> Request -> IO Response
blockDotFiles :: (Request -> IO Response) -> Request -> IO Response
blockDotFiles Request -> IO Response
fn Request
rq
    | String -> Bool
isDot ([String] -> String
joinPath (Request -> [String]
rqPaths Request
rq)) = Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Int -> String -> Response
result Int
403 String
"Dot files not allowed."
    | Bool
otherwise = Request -> IO Response
fn Request
rq

-- | Returns True if the given String either starts with a . or is of the form
-- "foo/.bar", e.g. the typical *nix convention for hidden files.
isDot :: String -> Bool
isDot :: String -> Bool
isDot = String -> Bool
isD (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
    where
    isD :: String -> Bool
isD (Char
'.':Char
'/':String
_) = Bool
True
    isD [Char
'.']       = Bool
True
    --isD ('/':_)     = False
    isD (Char
_:String
cs)      = String -> Bool
isD String
cs
    isD []          = Bool
False

-- * Low-level functions for generating a Response

-- | Use sendFile to send the contents of a Handle
sendFileResponse :: String  -- ^ content-type string
                 -> FilePath  -- ^ file path for content to send
                 -> Maybe (UTCTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header)
                 -> Integer -- ^ offset into Handle
                 -> Integer -- ^ number of bytes to send
                 -> Response
sendFileResponse :: String
-> String
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
sendFileResponse String
ct String
filePath Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((String -> String -> Response -> Response
forall r. HasHeaders r => String -> String -> r -> r
setHeader String
"Content-Type" String
ct) (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
               (Int
-> Headers
-> RsFlags
-> Maybe (Response -> IO Response)
-> String
-> Integer
-> Integer
-> Response
SendFile Int
200 Headers
forall k a. Map k a
Map.empty (RsFlags
nullRsFlags { rsfLength = ContentLength }) Maybe (Response -> IO Response)
forall a. Maybe a
Nothing String
filePath Integer
offset Integer
count)
              )
    in case Maybe (UTCTime, Request)
mModTime of
         Maybe (UTCTime, Request)
Nothing -> Response
res
         (Just (UTCTime
modTime, Request
request)) -> UTCTime -> Request -> Response -> Response
ifModifiedSince UTCTime
modTime Request
request Response
res

-- | Send the contents of a Lazy ByteString
--
lazyByteStringResponse :: String   -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
                       -> L.ByteString   -- ^ lazy bytestring content to send
                       -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
                       -> Integer -- ^ offset into the bytestring
                       -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
                       -> Response
lazyByteStringResponse :: String
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
lazyByteStringResponse String
ct ByteString
body Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((String -> String -> Response -> Response
forall r. HasHeaders r => String -> String -> r -> r
setHeader String
"Content-Type" String
ct) (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
               Int -> ByteString -> Response
resultBS Int
200 (Int64 -> ByteString -> ByteString
L.take (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
count) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int64 -> ByteString -> ByteString
L.drop (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
offset))  ByteString
body)
              )
    in case Maybe (UTCTime, Request)
mModTime of
         Maybe (UTCTime, Request)
Nothing -> Response
res
         (Just (UTCTime
modTime, Request
request)) -> UTCTime -> Request -> Response -> Response
ifModifiedSince UTCTime
modTime Request
request Response
res

-- | Send the contents of a Lazy ByteString
strictByteStringResponse :: String   -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
                         -> S.ByteString   -- ^ lazy bytestring content to send
                         -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
                         -> Integer -- ^ offset into the bytestring
                         -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
                         -> Response
strictByteStringResponse :: String
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
strictByteStringResponse String
ct ByteString
body Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((String -> String -> Response -> Response
forall r. HasHeaders r => String -> String -> r -> r
setHeader String
"Content-Type" String
ct) (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
               Int -> ByteString -> Response
resultBS Int
200 ([ByteString] -> ByteString
L.fromChunks [Int -> ByteString -> ByteString
S.take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
count) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
offset) ByteString
body])
              )
    in case Maybe (UTCTime, Request)
mModTime of
         Maybe (UTCTime, Request)
Nothing -> Response
res
         (Just (UTCTime
modTime, Request
request)) -> UTCTime -> Request -> Response -> Response
ifModifiedSince UTCTime
modTime Request
request Response
res

-- | Send the specified file with the specified mime-type using sendFile()
--
-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
--
-- WARNING: No security checks are performed.
filePathSendFile :: (ServerMonad m, MonadIO m)
                 => String   -- ^ content-type string
                 -> FilePath -- ^ path to file on disk
                 -> m Response
filePathSendFile :: forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String
contentType String
fp =
    do Integer
count   <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode Handle -> IO Integer
hFileSize -- garbage collection should close this
       UTCTime
modtime <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime String
fp
       Request
rq      <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String
-> String
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
sendFileResponse String
contentType String
fp ((UTCTime, Request) -> Maybe (UTCTime, Request)
forall a. a -> Maybe a
Just (UTCTime
modtime, Request
rq)) Integer
0 Integer
count

-- | Send the specified file with the specified mime-type using lazy ByteStrings
--
-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
--
-- WARNING: No security checks are performed.
filePathLazy :: (ServerMonad m, MonadIO m)
                 => String   -- ^ content-type string
                 -> FilePath -- ^ path to file on disk
                 -> m Response
filePathLazy :: forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathLazy String
contentType String
fp =
    do Handle
handle   <- IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openBinaryFile String
fp IOMode
ReadMode -- garbage collection should close this
       ByteString
contents <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
L.hGetContents Handle
handle
       UTCTime
modtime  <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime String
fp
       Integer
count    <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Handle -> IO Integer
hFileSize Handle
handle
       Request
rq       <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
lazyByteStringResponse String
contentType ByteString
contents ((UTCTime, Request) -> Maybe (UTCTime, Request)
forall a. a -> Maybe a
Just (UTCTime
modtime, Request
rq)) Integer
0 Integer
count

-- | Send the specified file with the specified mime-type using strict ByteStrings
--
-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
--
-- WARNING: No security checks are performed.
filePathStrict :: (ServerMonad m, MonadIO m)
                 => String   -- ^ content-type string
                 -> FilePath -- ^ path to file on disk
                 -> m Response
filePathStrict :: forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathStrict String
contentType String
fp =
    do ByteString
contents <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
S.readFile String
fp
       UTCTime
modtime  <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime String
fp
       Integer
count    <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode Handle -> IO Integer
hFileSize
       Request
rq       <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
strictByteStringResponse String
contentType ByteString
contents ((UTCTime, Request) -> Maybe (UTCTime, Request)
forall a. a -> Maybe a
Just (UTCTime
modtime, Request
rq)) Integer
0 Integer
count

-- * High-level functions for serving files


-- ** Serve a single file

-- | Serve a single, specified file. The name of the file being served is specified explicity. It is not derived automatically from the 'Request' url.
--
-- example 1:
--
--  Serve using sendfile() and the specified content-type
--
-- > serveFileUsing filePathSendFile (asContentType "image/jpeg") "/srv/data/image.jpg"
--
--
-- example 2:
--
--  Serve using a lazy ByteString and the guess the content-type from the extension
--
-- > serveFileUsing filePathLazy (guessContentTypeM mimeTypes) "/srv/data/image.jpg"
--
-- WARNING: No security checks are performed.
serveFileUsing :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
               => (String -> FilePath -> m Response) -- ^ typically 'filePathSendFile', 'filePathLazy', or 'filePathStrict'
               -> (FilePath -> m String)  -- ^ function for determining content-type of file. Typically 'asContentType' or 'guessContentTypeM'
               -> FilePath -- ^ path to the file to serve
               -> m Response
serveFileUsing :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> String -> m Response
serveFileUsing String -> String -> m Response
serveFn String -> m String
mimeFn String
fp =
    do Bool
fe <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
       if Bool
fe
          then do String
mt <- String -> m String
mimeFn String
fp
                  String -> String -> m Response
serveFn String
mt String
fp
          else m Response
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Serve a single, specified file. The name of the file being served is specified explicity. It is not derived automatically from the 'Request' url.
--
-- example 1:
--
--  Serve as a specific content-type:
--
-- > serveFile (asContentType "image/jpeg") "/srv/data/image.jpg"
--
--
-- example 2:
--
--  Serve guessing the content-type from the extension:
--
-- > serveFile (guessContentTypeM mimeTypes) "/srv/data/image.jpg"
--
-- If the specified path does not exist or is not a file, this function will return 'mzero'.
--
-- WARNING: No security checks are performed.
--
-- NOTE: alias for 'serveFileUsing' 'filePathSendFile'
serveFile :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
             (FilePath -> m String)   -- ^ function for determining content-type of file. Typically 'asContentType' or 'guessContentTypeM'
          -> FilePath                 -- ^ path to the file to serve
          -> m Response
serveFile :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> m String) -> String -> m Response
serveFile = (String -> String -> m Response)
-> (String -> m String) -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> String -> m Response
serveFileUsing String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile

-- | Like 'serveFile', but uses 'combineSafe' to prevent directory
-- traversal attacks when the path to the file is supplied by the user.
serveFileFrom :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
                 FilePath                 -- ^ directory wherein served files must be contained
              -> (FilePath -> m String)   -- ^ function for determining content-type of file. Typically 'asContentType' or 'guessContentTypeM'
              -> FilePath                 -- ^ path to the file to serve
              -> m Response
serveFileFrom :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
String -> (String -> m String) -> String -> m Response
serveFileFrom String
root String -> m String
mimeFn String
fp =
    m Response -> (String -> m Response) -> Maybe String -> m Response
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Response
no String -> m Response
yes (Maybe String -> m Response) -> Maybe String -> m Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
combineSafe String
root String
fp
  where
    no :: m Response
no  = Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse String
"Directory traversal forbidden"
    yes :: String -> m Response
yes = (String -> m String) -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> m String) -> String -> m Response
serveFile String -> m String
mimeFn

-- ** Serve files from a directory

-- | Serve files from a directory and its subdirectories (parameterizable version)
--
-- Parameterize this function to create functions like, 'fileServe', 'fileServeLazy', and 'fileServeStrict'
--
-- You supply:
--
--  1. a low-level function which takes a content-type and 'FilePath' and generates a Response
--
--  2. a function which determines the content-type from the 'FilePath'
--
--  3. a list of all the default index files
--
-- NOTE: unlike fileServe, there are no index files by default. See 'defaultIxFiles'.
fileServe' :: ( WebMonad Response m
              , ServerMonad m
              , FilterMonad Response m
              , MonadIO m
              , MonadPlus m
              )
           => (String -> FilePath -> m Response) -- ^ function which takes a content-type and filepath and generates a response (typically 'filePathSendFile', 'filePathLazy', or 'filePathStrict')
           -> (FilePath -> m String) -- ^ function which returns the mime-type for FilePath
--           -> [FilePath]         -- ^ index file names, in case the requested path is a directory
           -> (FilePath -> m Response)
           -> FilePath           -- ^ file/directory to serve
           -> m Response
fileServe' :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
fileServe' String -> String -> m Response
serveFn String -> m String
mimeFn String -> m Response
indexFn String
localPath = do
    Request
rq <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
    if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
isSafePath (Request -> [String]
rqPaths Request
rq))
       then do IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"Happstack.Server.FileServe" Priority
DEBUG (String
"fileServe: unsafe filepath " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Request -> [String]
rqPaths Request
rq))
               m Response
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       else do let fp :: String
fp = [String] -> String
joinPath (String
localPath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Request -> [String]
rqPaths Request
rq)
               Bool
fe <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
               Bool
de <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
fp
               let status :: String
status | Bool
de   = String
"DIR"
                          | Bool
fe   = String
"file"
                          | Bool
True = String
"NOT FOUND"
               IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"Happstack.Server.FileServe" Priority
DEBUG (String
"fileServe: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show String
fpString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" \t"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
status)
               if Bool
de
                  then if String -> Char
forall a. HasCallStack => [a] -> a
last (Request -> String
rqUri Request
rq) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
                          then String -> m Response
indexFn String
fp
                          else do let path' :: String
path' = String -> String
addTrailingPathSeparator (Request -> String
rqUri Request
rq)
                                  String -> Response -> m Response
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther String
path' (String -> Response
forall a. ToMessage a => a -> Response
toResponse String
path')
                  else if Bool
fe
                          then (String -> String -> m Response)
-> (String -> m String) -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> String -> m Response
serveFileUsing String -> String -> m Response
serveFn String -> m String
mimeFn String
fp
                          else m Response
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Combine two 'FilePath's, ensuring that the resulting path leads to
-- a file within the first 'FilePath'.
--
-- >>> combineSafe "/var/uploads/" "etc/passwd"
-- Just "/var/uploads/etc/passwd"
-- >>> combineSafe "/var/uploads/" "/etc/passwd"
-- Nothing
-- >>> combineSafe "/var/uploads/" "../../etc/passwd"
-- Nothing
-- >>> combineSafe "/var/uploads/" "../uploads/home/../etc/passwd"
-- Just "/var/uploads/etc/passwd"
combineSafe :: FilePath -> FilePath -> Maybe FilePath
combineSafe :: String -> String -> Maybe String
combineSafe String
root String
path =
    if [FilePath] -> FilePath
commonPrefix [FilePath
root', FilePath
joined] FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
root'
      then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FilePath -> String
encodeString FilePath
joined
      else Maybe String
forall a. Maybe a
Nothing
  where
    root' :: FilePath
root'  = String -> FilePath
decodeString String
root
    path' :: FilePath
path'  = String -> FilePath
decodeString String
path
    joined :: FilePath
joined = FilePath -> FilePath
collapse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
append FilePath
root' FilePath
path'

isSafePath :: [FilePath] -> Bool
isSafePath :: [String] -> Bool
isSafePath [] = Bool
True
isSafePath (String
s:[String]
ss) =
     String -> Bool
isValid String
s
  Bool -> Bool -> Bool
&& ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPathSeparator) String
s)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
hasDrive String
s)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isParent String
s)
  Bool -> Bool -> Bool
&& [String] -> Bool
isSafePath [String]
ss

-- note: could be different on other OSs
isParent :: FilePath -> Bool
isParent :: String -> Bool
isParent String
".." = Bool
True
isParent String
_    = Bool
False

-- | Serve files from a directory and its subdirectories using 'sendFile'.
--
-- Usage:
--
-- > fileServe ["index.html"] "path/to/files/on/disk"
--
--  'fileServe' does not support directory browsing. See 'serveDirectory'
--
-- DEPRECATED: use 'serveDirectory' instead.
--
-- Note:
--
--  The list of index files @[\"index.html\"]@ is only used to determine what file to show if the user requests a directory. You *do not* need to explicitly list all the files you want to serve.
--
fileServe :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
             [FilePath]         -- ^ index file names, in case the requested path is a directory
          -> FilePath           -- ^ file/directory to serve
          -> m Response
fileServe :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
[String] -> String -> m Response
fileServe [String]
ixFiles String
localPath =
    (String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
fileServe' String -> String -> m Response
serveFn String -> m String
mimeFn String -> m Response
indexFn String
localPath
        where
          serveFn :: String -> String -> m Response
serveFn    = String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile
          mimeFn :: String -> m String
mimeFn     = MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [String]
indexFiles = ([String]
ixFiles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
defaultIxFiles)
          indexFn :: String -> m Response
indexFn    = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String -> m String
mimeFn [String]
indexFiles
--          indexFn    = browseIndex filePathSendFile mimeFn indexFiles
{-# DEPRECATED fileServe "use serveDirectory instead." #-}

-- | Serve files from a directory and its subdirectories (lazy ByteString version).
--
-- WARNING: May leak file handles. You should probably use 'fileServe' instead.
fileServeLazy :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
             [FilePath]         -- ^ index file names, in case the requested path is a directory
          -> FilePath           -- ^ file/directory to serve
          -> m Response
fileServeLazy :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
[String] -> String -> m Response
fileServeLazy [String]
ixFiles String
localPath =
    (String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
fileServe' String -> String -> m Response
serveFn String -> m String
mimeFn String -> m Response
indexFn String
localPath
        where
          serveFn :: String -> String -> m Response
serveFn    = String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathLazy
          mimeFn :: String -> m String
mimeFn     = MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [String]
indexFiles = ([String]
ixFiles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
defaultIxFiles)
          indexFn :: String -> m Response
indexFn    = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String -> m String
mimeFn [String]
indexFiles

-- | Serve files from a directory and its subdirectories (strict ByteString version).
--
-- WARNING: the entire file will be read into RAM before being served. You should probably use 'fileServe' instead.
fileServeStrict :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
             [FilePath]         -- ^ index file names, in case the next argument is a directory
          -> FilePath           -- ^ file/directory to serve
          -> m Response
fileServeStrict :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
[String] -> String -> m Response
fileServeStrict [String]
ixFiles String
localPath =
    (String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
fileServe' String -> String -> m Response
serveFn String -> m String
mimeFn String -> m Response
indexFn String
localPath
        where
          serveFn :: String -> String -> m Response
serveFn    = String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathStrict
          mimeFn :: String -> m String
mimeFn     = MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [String]
indexFiles = ([String]
ixFiles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
defaultIxFiles)
          indexFn :: String -> m Response
indexFn    = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String -> m String
mimeFn [String]
indexFiles

-- * Index

-- | attempt to serve index files
doIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
        => [FilePath] -- ^ list of possible index files (e.g., @index.html@)
        -> MimeMap    -- ^ see also 'mimeTypes'
        -> FilePath   -- ^ directory on disk to search for index files
        -> m Response
doIndex :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
[String] -> MimeMap -> String -> m Response
doIndex [String]
ixFiles MimeMap
mimeMap String
localPath = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile (MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeMap) [String]
ixFiles String
localPath

doIndexLazy :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
        => [String]
        -> MimeMap
        -> FilePath
        -> m Response
doIndexLazy :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
[String] -> MimeMap -> String -> m Response
doIndexLazy [String]
ixFiles MimeMap
mimeMap String
localPath = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathLazy (MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeMap) [String]
ixFiles String
localPath

doIndexStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
        => [String]
        -> MimeMap
        -> FilePath
        -> m Response
doIndexStrict :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
[String] -> MimeMap -> String -> m Response
doIndexStrict [String]
ixFiles MimeMap
mimeMap String
localPath = (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathStrict (MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeMap) [String]
ixFiles String
localPath

doIndex' :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
        => (String -> FilePath -> m Response)
        -> (FilePath -> m String)
        -> [String]
        -> FilePath
        -> m Response
doIndex' :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
doIndex' String -> String -> m Response
serveFn String -> m String
mimeFn [String]
ixFiles String
fp =
    [m Response] -> m Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
tryIndex String -> String -> m Response
serveFn String -> m String
mimeFn [String]
ixFiles String
fp
         , Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse String
"Directory index forbidden"
         ]

-- | try to find an index file, calls mzero on failure
tryIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
        => (String -> FilePath -> m Response) -- ^ usually 'filePathSendFile'
        -> (FilePath -> m String)             -- ^ function to calculate mime type, usually 'guessContentTypeM'
        -> [String]                           -- ^ list of index files. See also 'defaultIxFiles'
        -> FilePath                           -- ^ directory to search in
        -> m Response
tryIndex :: forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
tryIndex String -> String -> m Response
_serveFn String -> m String
_mime  []          String
_fp = m Response
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
tryIndex  String -> String -> m Response
serveFn String -> m String
mimeFn (String
index:[String]
rest) String
fp =
    do let path :: String
path = String
fp String -> String -> String
</> String
index
       Bool
fe <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path
       if Bool
fe
          then (String -> String -> m Response)
-> (String -> m String) -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> String -> m Response
serveFileUsing String -> String -> m Response
serveFn String -> m String
mimeFn String
path
          else (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
tryIndex String -> String -> m Response
serveFn String -> m String
mimeFn [String]
rest String
fp

-- * Directory Browsing

browseIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m, ToMessage b) =>
                (FilePath -> [FilePath] -> m b)
             -> (String -> FilePath -> m Response)
             -> (FilePath -> m String)
             -> [String]
             -> FilePath
             -> m Response
browseIndex :: forall (m :: * -> *) b.
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m,
 ToMessage b) =>
(String -> [String] -> m b)
-> (String -> String -> m Response)
-> (String -> m String)
-> [String]
-> String
-> m Response
browseIndex String -> [String] -> m b
renderFn String -> String -> m Response
_serveFn String -> m String
_mimeFn [String]
_ixFiles String
localPath =
    do [String]
c       <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
localPath
       b
listing <- String -> [String] -> m b
renderFn String
localPath ([String] -> m b) -> [String] -> m b
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".") ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
c)
       Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ b -> Response
forall a. ToMessage a => a -> Response
toResponse (b -> Response) -> b -> Response
forall a b. (a -> b) -> a -> b
$ b
listing

data EntryKind = File | Directory | UnknownKind deriving (EntryKind -> EntryKind -> Bool
(EntryKind -> EntryKind -> Bool)
-> (EntryKind -> EntryKind -> Bool) -> Eq EntryKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntryKind -> EntryKind -> Bool
== :: EntryKind -> EntryKind -> Bool
$c/= :: EntryKind -> EntryKind -> Bool
/= :: EntryKind -> EntryKind -> Bool
Eq, Eq EntryKind
Eq EntryKind =>
(EntryKind -> EntryKind -> Ordering)
-> (EntryKind -> EntryKind -> Bool)
-> (EntryKind -> EntryKind -> Bool)
-> (EntryKind -> EntryKind -> Bool)
-> (EntryKind -> EntryKind -> Bool)
-> (EntryKind -> EntryKind -> EntryKind)
-> (EntryKind -> EntryKind -> EntryKind)
-> Ord EntryKind
EntryKind -> EntryKind -> Bool
EntryKind -> EntryKind -> Ordering
EntryKind -> EntryKind -> EntryKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntryKind -> EntryKind -> Ordering
compare :: EntryKind -> EntryKind -> Ordering
$c< :: EntryKind -> EntryKind -> Bool
< :: EntryKind -> EntryKind -> Bool
$c<= :: EntryKind -> EntryKind -> Bool
<= :: EntryKind -> EntryKind -> Bool
$c> :: EntryKind -> EntryKind -> Bool
> :: EntryKind -> EntryKind -> Bool
$c>= :: EntryKind -> EntryKind -> Bool
>= :: EntryKind -> EntryKind -> Bool
$cmax :: EntryKind -> EntryKind -> EntryKind
max :: EntryKind -> EntryKind -> EntryKind
$cmin :: EntryKind -> EntryKind -> EntryKind
min :: EntryKind -> EntryKind -> EntryKind
Ord, ReadPrec [EntryKind]
ReadPrec EntryKind
Int -> ReadS EntryKind
ReadS [EntryKind]
(Int -> ReadS EntryKind)
-> ReadS [EntryKind]
-> ReadPrec EntryKind
-> ReadPrec [EntryKind]
-> Read EntryKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EntryKind
readsPrec :: Int -> ReadS EntryKind
$creadList :: ReadS [EntryKind]
readList :: ReadS [EntryKind]
$creadPrec :: ReadPrec EntryKind
readPrec :: ReadPrec EntryKind
$creadListPrec :: ReadPrec [EntryKind]
readListPrec :: ReadPrec [EntryKind]
Read, Int -> EntryKind -> String -> String
[EntryKind] -> String -> String
EntryKind -> String
(Int -> EntryKind -> String -> String)
-> (EntryKind -> String)
-> ([EntryKind] -> String -> String)
-> Show EntryKind
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> EntryKind -> String -> String
showsPrec :: Int -> EntryKind -> String -> String
$cshow :: EntryKind -> String
show :: EntryKind -> String
$cshowList :: [EntryKind] -> String -> String
showList :: [EntryKind] -> String -> String
Show, Typeable EntryKind
Typeable EntryKind =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EntryKind -> c EntryKind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EntryKind)
-> (EntryKind -> Constr)
-> (EntryKind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EntryKind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntryKind))
-> ((forall b. Data b => b -> b) -> EntryKind -> EntryKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EntryKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EntryKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> EntryKind -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EntryKind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EntryKind -> m EntryKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntryKind -> m EntryKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntryKind -> m EntryKind)
-> Data EntryKind
EntryKind -> Constr
EntryKind -> DataType
(forall b. Data b => b -> b) -> EntryKind -> EntryKind
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EntryKind -> u
forall u. (forall d. Data d => d -> u) -> EntryKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntryKind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntryKind -> c EntryKind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntryKind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntryKind)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntryKind -> c EntryKind
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntryKind -> c EntryKind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntryKind
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntryKind
$ctoConstr :: EntryKind -> Constr
toConstr :: EntryKind -> Constr
$cdataTypeOf :: EntryKind -> DataType
dataTypeOf :: EntryKind -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntryKind)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntryKind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntryKind)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntryKind)
$cgmapT :: (forall b. Data b => b -> b) -> EntryKind -> EntryKind
gmapT :: (forall b. Data b => b -> b) -> EntryKind -> EntryKind
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntryKind -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EntryKind -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EntryKind -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntryKind -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntryKind -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntryKind -> m EntryKind
Data, Typeable, Int -> EntryKind
EntryKind -> Int
EntryKind -> [EntryKind]
EntryKind -> EntryKind
EntryKind -> EntryKind -> [EntryKind]
EntryKind -> EntryKind -> EntryKind -> [EntryKind]
(EntryKind -> EntryKind)
-> (EntryKind -> EntryKind)
-> (Int -> EntryKind)
-> (EntryKind -> Int)
-> (EntryKind -> [EntryKind])
-> (EntryKind -> EntryKind -> [EntryKind])
-> (EntryKind -> EntryKind -> [EntryKind])
-> (EntryKind -> EntryKind -> EntryKind -> [EntryKind])
-> Enum EntryKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EntryKind -> EntryKind
succ :: EntryKind -> EntryKind
$cpred :: EntryKind -> EntryKind
pred :: EntryKind -> EntryKind
$ctoEnum :: Int -> EntryKind
toEnum :: Int -> EntryKind
$cfromEnum :: EntryKind -> Int
fromEnum :: EntryKind -> Int
$cenumFrom :: EntryKind -> [EntryKind]
enumFrom :: EntryKind -> [EntryKind]
$cenumFromThen :: EntryKind -> EntryKind -> [EntryKind]
enumFromThen :: EntryKind -> EntryKind -> [EntryKind]
$cenumFromTo :: EntryKind -> EntryKind -> [EntryKind]
enumFromTo :: EntryKind -> EntryKind -> [EntryKind]
$cenumFromThenTo :: EntryKind -> EntryKind -> EntryKind -> [EntryKind]
enumFromThenTo :: EntryKind -> EntryKind -> EntryKind -> [EntryKind]
Enum)

-- | a function to generate an HTML page showing the contents of a directory on the disk
--
-- see also: 'browseIndex', 'renderDirectoryContentsTable'
renderDirectoryContents :: (MonadIO m) =>
                           FilePath    -- ^ path to directory on disk
                        -> [FilePath]  -- ^ list of entries in that path
                        -> m H.Html
renderDirectoryContents :: forall (m :: * -> *). MonadIO m => String -> [String] -> m Html
renderDirectoryContents String
localPath [String]
fps =
    do [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
fps' <- IO [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
-> m [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
 -> m [(String, Maybe UTCTime, Maybe Integer, EntryKind)])
-> IO [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
-> m [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
forall a b. (a -> b) -> a -> b
$ (String -> IO (String, Maybe UTCTime, Maybe Integer, EntryKind))
-> [String]
-> IO [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String
-> String -> IO (String, Maybe UTCTime, Maybe Integer, EntryKind)
getMetaData String
localPath) [String]
fps
       Html -> m Html
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
         Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
           Html -> Html
H.title (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"Directory Listing"
           Html
H.meta  Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.httpEquiv (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
"Content-Type") Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.content (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
"text/html;charset=utf-8")
           Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"table { margin: 0 auto; width: 760px; border-collapse: collapse; font-family: 'sans-serif'; }"
                                        , String
"table, th, td { border: 1px solid #353948; }"
                                        , String
"td.size { text-align: right; font-size: 0.7em; width: 50px }"
                                        , String
"td.date { text-align: right; font-size: 0.7em; width: 130px }"
                                        , String
"td { padding-right: 1em; padding-left: 1em; }"
                                        , String
"th.first { background-color: white; width: 24px }"
                                        , String
"td.first { padding-right: 0; padding-left: 0; text-align: center }"
                                        , String
"tr { background-color: white; }"
                                        , String
"tr.alt { background-color: #A3B5BA}"
                                        , String
"th { background-color: #3C4569; color: white; font-size: 1em; }"
                                        , String
"h1 { width: 760px; margin: 1em auto; font-size: 1em }"
                                        , String
"img { width: 20px }"
                                        , String
"a { text-decoration: none }"
                                        ]
         Html -> Html
H.body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
           Html -> Html
H.h1 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"Directory Listing"
           [(String, Maybe UTCTime, Maybe Integer, EntryKind)] -> Html
renderDirectoryContentsTable [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
fps'

-- | a function to generate an HTML table showing the contents of a directory on the disk
--
-- This function generates most of the content of the
-- 'renderDirectoryContents' page. If you want to style the page
-- differently, or add google analytics code, etc, you can just create
-- a new page template to wrap around this HTML.
--
-- see also: 'getMetaData', 'renderDirectoryContents'
renderDirectoryContentsTable :: [(FilePath, Maybe UTCTime, Maybe Integer, EntryKind)] -- ^ list of files+meta data, see 'getMetaData'
                             -> H.Html
renderDirectoryContentsTable :: [(String, Maybe UTCTime, Maybe Integer, EntryKind)] -> Html
renderDirectoryContentsTable [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
fps =
           Html -> Html
H.table (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html -> Html
H.thead (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html -> Html
H.th (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
""
                                     Html -> Html
H.th (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"Name"
                                     Html -> Html
H.th (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"Last modified"
                                     Html -> Html
H.th (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"Size"
                        Html -> Html
H.tbody (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> Html)
-> [((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool)]
-> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> Html
mkRow ([(String, Maybe UTCTime, Maybe Integer, EntryKind)]
-> [Bool]
-> [((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Maybe UTCTime, Maybe Integer, EntryKind)]
fps ([Bool]
 -> [((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool)])
-> [Bool]
-> [((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool)]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
forall a. HasCallStack => [a] -> [a]
cycle [Bool
False, Bool
True])
    where
      mkRow :: ((FilePath, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> H.Html
      mkRow :: ((String, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> Html
mkRow ((String
fp, Maybe UTCTime
modTime, Maybe Integer
count, EntryKind
kind), Bool
alt) =
          (if Bool
alt then (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
"alt")) else Html -> Html
forall a. a -> a
id) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          Html -> Html
H.tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                   Html -> Html
H.td (EntryKind -> Html
mkKind EntryKind
kind)
                   Html -> Html
H.td (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
fp)  (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
fp)
                   Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
"date") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String -> (UTCTime -> String) -> Maybe UTCTime -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%d-%b-%Y %X %Z") Maybe UTCTime
modTime)
                   ((Html -> Html)
-> (Integer -> Html -> Html) -> Maybe Integer -> Html -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html -> Html
forall a. a -> a
id (\Integer
c -> (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue (Integer -> String
forall a. Show a => a -> String
show Integer
c)))) Maybe Integer
count)  (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue String
"size") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String -> (Integer -> String) -> Maybe Integer -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" Integer -> String
forall {a}. (Show a, Integral a) => a -> String
prettyShow Maybe Integer
count))
      mkKind :: EntryKind -> H.Html
      mkKind :: EntryKind -> Html
mkKind EntryKind
File        = () -> Html
forall a. a -> MarkupM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      mkKind EntryKind
Directory   = String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
"➦"
      mkKind EntryKind
UnknownKind = () -> Html
forall a. a -> MarkupM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      prettyShow :: a -> String
prettyShow a
x
        | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1024 = a -> String
forall {a}. (Show a, Integral a) => a -> String
prettyShowK (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1024
        | Bool
otherwise = String -> a -> String
forall {a}. Show a => String -> a -> String
addCommas String
"B" a
x
      prettyShowK :: a -> String
prettyShowK a
x
        | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1024 = a -> String
forall {a}. (Show a, Integral a) => a -> String
prettyShowM (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1024
        | Bool
otherwise = String -> a -> String
forall {a}. Show a => String -> a -> String
addCommas String
"KB" a
x
      prettyShowM :: a -> String
prettyShowM a
x
        | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1024 = a -> String
forall a. Show a => a -> String
prettyShowG (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1024
        | Bool
otherwise = String -> a -> String
forall {a}. Show a => String -> a -> String
addCommas String
"MB" a
x
      prettyShowG :: a -> String
prettyShowG a
x = String -> a -> String
forall {a}. Show a => String -> a -> String
addCommas String
"GB" a
x
      addCommas :: String -> a -> String
addCommas String
s = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s)) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addCommas' (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
      addCommas' :: String -> String
addCommas' (Char
a:Char
b:Char
c:Char
d:String
e) = Char
a Char -> String -> String
forall a. a -> [a] -> [a]
: Char
b Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
',' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
addCommas' (Char
d Char -> String -> String
forall a. a -> [a] -> [a]
: String
e)
      addCommas' String
x = String
x


-- | look up the meta data associated with a file
getMetaData :: FilePath -- ^ path to directory on disk containing the entry
            -> FilePath -- ^ entry in that directory
            -> IO (FilePath, Maybe UTCTime, Maybe Integer, EntryKind)
getMetaData :: String
-> String -> IO (String, Maybe UTCTime, Maybe Integer, EntryKind)
getMetaData String
localPath String
fp =
     do let localFp :: String
localFp = String
localPath String -> String -> String
</> String
fp
        Maybe UTCTime
modTime <- (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
localFp) IO (Maybe UTCTime)
-> (IOException -> IO (Maybe UTCTime)) -> IO (Maybe UTCTime)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
                   (\(IOException
_ :: IOException) -> Maybe UTCTime -> IO (Maybe UTCTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
Nothing)
        Maybe Integer
count <- do Bool
de <- String -> IO Bool
doesDirectoryExist String
localFp
                    if Bool
de
                      then do Maybe Integer -> IO (Maybe Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
                      else do IO Handle
-> (Handle -> IO ())
-> (Handle -> IO (Maybe Integer))
-> IO (Maybe Integer)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> IO Handle
openBinaryFile String
localFp IOMode
ReadMode) Handle -> IO ()
hClose ((Integer -> Maybe Integer) -> IO Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Maybe Integer
forall a. a -> Maybe a
Just (IO Integer -> IO (Maybe Integer))
-> (Handle -> IO Integer) -> Handle -> IO (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Integer
hFileSize)
                                          IO (Maybe Integer)
-> (IOException -> IO (Maybe Integer)) -> IO (Maybe Integer)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(IOException
_e :: IOException) -> Maybe Integer -> IO (Maybe Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing)
        EntryKind
kind <- do Bool
fe <- String -> IO Bool
doesFileExist String
localFp
                   if Bool
fe
                      then EntryKind -> IO EntryKind
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntryKind
File
                      else do Bool
de <- String -> IO Bool
doesDirectoryExist String
localFp
                              if Bool
de
                                 then EntryKind -> IO EntryKind
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntryKind
Directory
                                 else EntryKind -> IO EntryKind
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntryKind
UnknownKind
        (String, Maybe UTCTime, Maybe Integer, EntryKind)
-> IO (String, Maybe UTCTime, Maybe Integer, EntryKind)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if EntryKind
kind EntryKind -> EntryKind -> Bool
forall a. Eq a => a -> a -> Bool
== EntryKind
Directory then (String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") else String
fp, Maybe UTCTime
modTime, Maybe Integer
count, EntryKind
kind)

-- | see 'serveDirectory'
data Browsing
    = EnableBrowsing | DisableBrowsing
      deriving (Browsing -> Browsing -> Bool
(Browsing -> Browsing -> Bool)
-> (Browsing -> Browsing -> Bool) -> Eq Browsing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Browsing -> Browsing -> Bool
== :: Browsing -> Browsing -> Bool
$c/= :: Browsing -> Browsing -> Bool
/= :: Browsing -> Browsing -> Bool
Eq, Int -> Browsing
Browsing -> Int
Browsing -> [Browsing]
Browsing -> Browsing
Browsing -> Browsing -> [Browsing]
Browsing -> Browsing -> Browsing -> [Browsing]
(Browsing -> Browsing)
-> (Browsing -> Browsing)
-> (Int -> Browsing)
-> (Browsing -> Int)
-> (Browsing -> [Browsing])
-> (Browsing -> Browsing -> [Browsing])
-> (Browsing -> Browsing -> [Browsing])
-> (Browsing -> Browsing -> Browsing -> [Browsing])
-> Enum Browsing
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Browsing -> Browsing
succ :: Browsing -> Browsing
$cpred :: Browsing -> Browsing
pred :: Browsing -> Browsing
$ctoEnum :: Int -> Browsing
toEnum :: Int -> Browsing
$cfromEnum :: Browsing -> Int
fromEnum :: Browsing -> Int
$cenumFrom :: Browsing -> [Browsing]
enumFrom :: Browsing -> [Browsing]
$cenumFromThen :: Browsing -> Browsing -> [Browsing]
enumFromThen :: Browsing -> Browsing -> [Browsing]
$cenumFromTo :: Browsing -> Browsing -> [Browsing]
enumFromTo :: Browsing -> Browsing -> [Browsing]
$cenumFromThenTo :: Browsing -> Browsing -> Browsing -> [Browsing]
enumFromThenTo :: Browsing -> Browsing -> Browsing -> [Browsing]
Enum, Eq Browsing
Eq Browsing =>
(Browsing -> Browsing -> Ordering)
-> (Browsing -> Browsing -> Bool)
-> (Browsing -> Browsing -> Bool)
-> (Browsing -> Browsing -> Bool)
-> (Browsing -> Browsing -> Bool)
-> (Browsing -> Browsing -> Browsing)
-> (Browsing -> Browsing -> Browsing)
-> Ord Browsing
Browsing -> Browsing -> Bool
Browsing -> Browsing -> Ordering
Browsing -> Browsing -> Browsing
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Browsing -> Browsing -> Ordering
compare :: Browsing -> Browsing -> Ordering
$c< :: Browsing -> Browsing -> Bool
< :: Browsing -> Browsing -> Bool
$c<= :: Browsing -> Browsing -> Bool
<= :: Browsing -> Browsing -> Bool
$c> :: Browsing -> Browsing -> Bool
> :: Browsing -> Browsing -> Bool
$c>= :: Browsing -> Browsing -> Bool
>= :: Browsing -> Browsing -> Bool
$cmax :: Browsing -> Browsing -> Browsing
max :: Browsing -> Browsing -> Browsing
$cmin :: Browsing -> Browsing -> Browsing
min :: Browsing -> Browsing -> Browsing
Ord, ReadPrec [Browsing]
ReadPrec Browsing
Int -> ReadS Browsing
ReadS [Browsing]
(Int -> ReadS Browsing)
-> ReadS [Browsing]
-> ReadPrec Browsing
-> ReadPrec [Browsing]
-> Read Browsing
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Browsing
readsPrec :: Int -> ReadS Browsing
$creadList :: ReadS [Browsing]
readList :: ReadS [Browsing]
$creadPrec :: ReadPrec Browsing
readPrec :: ReadPrec Browsing
$creadListPrec :: ReadPrec [Browsing]
readListPrec :: ReadPrec [Browsing]
Read, Int -> Browsing -> String -> String
[Browsing] -> String -> String
Browsing -> String
(Int -> Browsing -> String -> String)
-> (Browsing -> String)
-> ([Browsing] -> String -> String)
-> Show Browsing
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Browsing -> String -> String
showsPrec :: Int -> Browsing -> String -> String
$cshow :: Browsing -> String
show :: Browsing -> String
$cshowList :: [Browsing] -> String -> String
showList :: [Browsing] -> String -> String
Show, Typeable Browsing
Typeable Browsing =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Browsing -> c Browsing)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Browsing)
-> (Browsing -> Constr)
-> (Browsing -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Browsing))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Browsing))
-> ((forall b. Data b => b -> b) -> Browsing -> Browsing)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Browsing -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Browsing -> r)
-> (forall u. (forall d. Data d => d -> u) -> Browsing -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Browsing -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Browsing -> m Browsing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Browsing -> m Browsing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Browsing -> m Browsing)
-> Data Browsing
Browsing -> Constr
Browsing -> DataType
(forall b. Data b => b -> b) -> Browsing -> Browsing
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Browsing -> u
forall u. (forall d. Data d => d -> u) -> Browsing -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Browsing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Browsing -> c Browsing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Browsing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Browsing)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Browsing -> c Browsing
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Browsing -> c Browsing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Browsing
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Browsing
$ctoConstr :: Browsing -> Constr
toConstr :: Browsing -> Constr
$cdataTypeOf :: Browsing -> DataType
dataTypeOf :: Browsing -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Browsing)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Browsing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Browsing)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Browsing)
$cgmapT :: (forall b. Data b => b -> b) -> Browsing -> Browsing
gmapT :: (forall b. Data b => b -> b) -> Browsing -> Browsing
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Browsing -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Browsing -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Browsing -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Browsing -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Browsing -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Browsing -> m Browsing
Data, Typeable)

-- | Serve files and directories from a directory and its subdirectories using 'sendFile'.
--
-- Usage:
--
-- > serveDirectory EnableBrowsing ["index.html"] "path/to/files/on/disk"
--
-- If the requested path does not match a file or directory on the
-- disk, then 'serveDirectory' calls 'mzero'.
--
-- If the requested path is a file then the file is served normally.
--
-- If the requested path is a directory, then the result depends on
-- what the first two arguments to the function are.
--
-- The first argument controls whether directory browsing is
-- enabled.
--
-- The second argument is a list of index files (such as
-- index.html).
--
-- When a directory is requested, 'serveDirectory' will first try to
-- find one of the index files (in the order they are listed). If that
-- fails, it will show a directory listing if 'EnableBrowsing' is set,
-- otherwise it will return @forbidden \"Directory index forbidden\"@.
--
-- Here is an explicit list of all the possible outcomes when the
-- argument is a (valid) directory:
--
-- [@'DisableBrowsing', empty index file list@]
--
--  This will always return, forbidden \"Directory index forbidden\"
--
-- [@'DisableBrowsing', non-empty index file list@]
--
-- 1. If an index file is found it will be shown.
--
-- 2. Otherwise returns, forbidden \"Directory index forbidden\"
--
-- [@'EnableBrowsing', empty index file list@]
--
-- Always shows a directory index.
--
-- [@'EnableBrowsing', non-empty index file list@]
--
-- 1. If an index file is found it will be shown
--
-- 2. Otherwise shows a directory index
--
-- see also: 'defaultIxFiles', 'serveFile'
serveDirectory :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
                  Browsing    -- ^ allow directory browsing
               -> [FilePath]  -- ^ index file names, in case the requested path is a directory
               -> FilePath    -- ^ file/directory to serve
               -> m Response
serveDirectory :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
Browsing -> [String] -> String -> m Response
serveDirectory Browsing
browsing [String]
ixFiles String
localPath =
    Browsing
-> [String] -> (String -> m String) -> String -> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
Browsing
-> [String] -> (String -> m String) -> String -> m Response
serveDirectory' Browsing
browsing [String]
ixFiles String -> m String
mimeFn String
localPath
        where
          mimeFn :: String -> m String
mimeFn  = MimeMap -> String -> m String
forall (m :: * -> *). Monad m => MimeMap -> String -> m String
guessContentTypeM MimeMap
mimeTypes


-- | like 'serveDirectory' but with custom mimeTypes
serveDirectory' :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m)
                => Browsing    -- ^ allow directory browsing
                -> [FilePath]  -- ^ index file names, in case the requested path is a directory
                -> (FilePath -> m String) -- ^ function which returns the mime-type for FilePath
                -> FilePath    -- ^ file/directory to serve
                -> m Response
serveDirectory' :: forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
Browsing
-> [String] -> (String -> m String) -> String -> m Response
serveDirectory' Browsing
browsing [String]
ixFiles String -> m String
mimeFn String
localPath =
    (String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String)
-> (String -> m Response)
-> String
-> m Response
fileServe' String -> String -> m Response
serveFn String -> m String
mimeFn String -> m Response
indexFn String
localPath
        where
          serveFn :: String -> String -> m Response
serveFn = String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile
          indexFn :: String -> m Response
indexFn String
fp =
              [m Response] -> m Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(String -> String -> m Response)
-> (String -> m String) -> [String] -> String -> m Response
tryIndex String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String -> m String
mimeFn [String]
ixFiles String
fp
                   , if Browsing
browsing Browsing -> Browsing -> Bool
forall a. Eq a => a -> a -> Bool
== Browsing
EnableBrowsing
                        then (String -> [String] -> m Html)
-> (String -> String -> m Response)
-> (String -> m String)
-> [String]
-> String
-> m Response
forall (m :: * -> *) b.
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m,
 ToMessage b) =>
(String -> [String] -> m b)
-> (String -> String -> m Response)
-> (String -> m String)
-> [String]
-> String
-> m Response
browseIndex String -> [String] -> m Html
forall (m :: * -> *). MonadIO m => String -> [String] -> m Html
renderDirectoryContents String -> String -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
String -> String -> m Response
filePathSendFile String -> m String
mimeFn [String]
ixFiles String
fp
                        else Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse String
"Directory index forbidden"
                   ]



-- | Ready collection of common mime types.
-- Except for the first two entries, the mappings come from http://svn.apache.org/viewvc/httpd/httpd/branches/2.4.x/docs/conf/mime.types?view=co
mimeTypes :: MimeMap
mimeTypes :: MimeMap
mimeTypes = [(String, String)] -> MimeMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"gz",String
"application/x-gzip"),(String
"cabal",String
"text/x-cabal"),(String
"ez",String
"application/andrew-inset"),(String
"aw",String
"application/applixware"),(String
"atom",String
"application/atom+xml"),(String
"atomcat",String
"application/atomcat+xml"),(String
"atomsvc",String
"application/atomsvc+xml"),(String
"ccxml",String
"application/ccxml+xml"),(String
"cdmia",String
"application/cdmi-capability"),(String
"cdmic",String
"application/cdmi-container"),(String
"cdmid",String
"application/cdmi-domain"),(String
"cdmio",String
"application/cdmi-object"),(String
"cdmiq",String
"application/cdmi-queue"),(String
"cu",String
"application/cu-seeme"),(String
"davmount",String
"application/davmount+xml"),(String
"dbk",String
"application/docbook+xml"),(String
"dssc",String
"application/dssc+der"),(String
"xdssc",String
"application/dssc+xml"),(String
"ecma",String
"application/ecmascript"),(String
"emma",String
"application/emma+xml"),(String
"epub",String
"application/epub+zip"),(String
"exi",String
"application/exi"),(String
"pfr",String
"application/font-tdpfr"),(String
"gml",String
"application/gml+xml"),(String
"gpx",String
"application/gpx+xml"),(String
"gxf",String
"application/gxf"),(String
"stk",String
"application/hyperstudio"),(String
"ink",String
"application/inkml+xml"),(String
"inkml",String
"application/inkml+xml"),(String
"ipfix",String
"application/ipfix"),(String
"jar",String
"application/java-archive"),(String
"ser",String
"application/java-serialized-object"),(String
"class",String
"application/java-vm"),(String
"js",String
"application/javascript"),(String
"json",String
"application/json"),(String
"jsonml",String
"application/jsonml+json"),(String
"lostxml",String
"application/lost+xml"),(String
"hqx",String
"application/mac-binhex40"),(String
"cpt",String
"application/mac-compactpro"),(String
"mads",String
"application/mads+xml"),(String
"mrc",String
"application/marc"),(String
"mrcx",String
"application/marcxml+xml"),(String
"ma",String
"application/mathematica"),(String
"nb",String
"application/mathematica"),(String
"mb",String
"application/mathematica"),(String
"mathml",String
"application/mathml+xml"),(String
"mbox",String
"application/mbox"),(String
"mscml",String
"application/mediaservercontrol+xml"),(String
"metalink",String
"application/metalink+xml"),(String
"meta4",String
"application/metalink4+xml"),(String
"mets",String
"application/mets+xml"),(String
"mods",String
"application/mods+xml"),(String
"m21",String
"application/mp21"),(String
"mp21",String
"application/mp21"),(String
"mp4s",String
"application/mp4"),(String
"doc",String
"application/msword"),(String
"dot",String
"application/msword"),(String
"mxf",String
"application/mxf"),(String
"bin",String
"application/octet-stream"),(String
"dms",String
"application/octet-stream"),(String
"lrf",String
"application/octet-stream"),(String
"mar",String
"application/octet-stream"),(String
"so",String
"application/octet-stream"),(String
"dist",String
"application/octet-stream"),(String
"distz",String
"application/octet-stream"),(String
"pkg",String
"application/octet-stream"),(String
"bpk",String
"application/octet-stream"),(String
"dump",String
"application/octet-stream"),(String
"elc",String
"application/octet-stream"),(String
"deploy",String
"application/octet-stream"),(String
"oda",String
"application/oda"),(String
"opf",String
"application/oebps-package+xml"),(String
"ogx",String
"application/ogg"),(String
"omdoc",String
"application/omdoc+xml"),(String
"onetoc",String
"application/onenote"),(String
"onetoc2",String
"application/onenote"),(String
"onetmp",String
"application/onenote"),(String
"onepkg",String
"application/onenote"),(String
"oxps",String
"application/oxps"),(String
"xer",String
"application/patch-ops-error+xml"),(String
"pdf",String
"application/pdf"),(String
"pgp",String
"application/pgp-encrypted"),(String
"asc",String
"application/pgp-signature"),(String
"sig",String
"application/pgp-signature"),(String
"prf",String
"application/pics-rules"),(String
"p10",String
"application/pkcs10"),(String
"p7m",String
"application/pkcs7-mime"),(String
"p7c",String
"application/pkcs7-mime"),(String
"p7s",String
"application/pkcs7-signature"),(String
"p8",String
"application/pkcs8"),(String
"ac",String
"application/pkix-attr-cert"),(String
"cer",String
"application/pkix-cert"),(String
"crl",String
"application/pkix-crl"),(String
"pkipath",String
"application/pkix-pkipath"),(String
"pki",String
"application/pkixcmp"),(String
"pls",String
"application/pls+xml"),(String
"ai",String
"application/postscript"),(String
"eps",String
"application/postscript"),(String
"ps",String
"application/postscript"),(String
"cww",String
"application/prs.cww"),(String
"pskcxml",String
"application/pskc+xml"),(String
"rdf",String
"application/rdf+xml"),(String
"rif",String
"application/reginfo+xml"),(String
"rnc",String
"application/relax-ng-compact-syntax"),(String
"rl",String
"application/resource-lists+xml"),(String
"rld",String
"application/resource-lists-diff+xml"),(String
"rs",String
"application/rls-services+xml"),(String
"gbr",String
"application/rpki-ghostbusters"),(String
"mft",String
"application/rpki-manifest"),(String
"roa",String
"application/rpki-roa"),(String
"rsd",String
"application/rsd+xml"),(String
"rss",String
"application/rss+xml"),(String
"rtf",String
"application/rtf"),(String
"sbml",String
"application/sbml+xml"),(String
"scq",String
"application/scvp-cv-request"),(String
"scs",String
"application/scvp-cv-response"),(String
"spq",String
"application/scvp-vp-request"),(String
"spp",String
"application/scvp-vp-response"),(String
"sdp",String
"application/sdp"),(String
"setpay",String
"application/set-payment-initiation"),(String
"setreg",String
"application/set-registration-initiation"),(String
"shf",String
"application/shf+xml"),(String
"smi",String
"application/smil+xml"),(String
"smil",String
"application/smil+xml"),(String
"rq",String
"application/sparql-query"),(String
"srx",String
"application/sparql-results+xml"),(String
"gram",String
"application/srgs"),(String
"grxml",String
"application/srgs+xml"),(String
"sru",String
"application/sru+xml"),(String
"ssdl",String
"application/ssdl+xml"),(String
"ssml",String
"application/ssml+xml"),(String
"tei",String
"application/tei+xml"),(String
"teicorpus",String
"application/tei+xml"),(String
"tfi",String
"application/thraud+xml"),(String
"tsd",String
"application/timestamped-data"),(String
"plb",String
"application/vnd.3gpp.pic-bw-large"),(String
"psb",String
"application/vnd.3gpp.pic-bw-small"),(String
"pvb",String
"application/vnd.3gpp.pic-bw-var"),(String
"tcap",String
"application/vnd.3gpp2.tcap"),(String
"pwn",String
"application/vnd.3m.post-it-notes"),(String
"aso",String
"application/vnd.accpac.simply.aso"),(String
"imp",String
"application/vnd.accpac.simply.imp"),(String
"acu",String
"application/vnd.acucobol"),(String
"atc",String
"application/vnd.acucorp"),(String
"acutc",String
"application/vnd.acucorp"),(String
"air",String
"application/vnd.adobe.air-application-installer-package+zip"),(String
"fcdt",String
"application/vnd.adobe.formscentral.fcdt"),(String
"fxp",String
"application/vnd.adobe.fxp"),(String
"fxpl",String
"application/vnd.adobe.fxp"),(String
"xdp",String
"application/vnd.adobe.xdp+xml"),(String
"xfdf",String
"application/vnd.adobe.xfdf"),(String
"ahead",String
"application/vnd.ahead.space"),(String
"azf",String
"application/vnd.airzip.filesecure.azf"),(String
"azs",String
"application/vnd.airzip.filesecure.azs"),(String
"azw",String
"application/vnd.amazon.ebook"),(String
"acc",String
"application/vnd.americandynamics.acc"),(String
"ami",String
"application/vnd.amiga.ami"),(String
"apk",String
"application/vnd.android.package-archive"),(String
"cii",String
"application/vnd.anser-web-certificate-issue-initiation"),(String
"fti",String
"application/vnd.anser-web-funds-transfer-initiation"),(String
"atx",String
"application/vnd.antix.game-component"),(String
"mpkg",String
"application/vnd.apple.installer+xml"),(String
"m3u8",String
"application/vnd.apple.mpegurl"),(String
"swi",String
"application/vnd.aristanetworks.swi"),(String
"iota",String
"application/vnd.astraea-software.iota"),(String
"aep",String
"application/vnd.audiograph"),(String
"mpm",String
"application/vnd.blueice.multipass"),(String
"bmi",String
"application/vnd.bmi"),(String
"rep",String
"application/vnd.businessobjects"),(String
"cdxml",String
"application/vnd.chemdraw+xml"),(String
"mmd",String
"application/vnd.chipnuts.karaoke-mmd"),(String
"cdy",String
"application/vnd.cinderella"),(String
"cla",String
"application/vnd.claymore"),(String
"rp9",String
"application/vnd.cloanto.rp9"),(String
"c4g",String
"application/vnd.clonk.c4group"),(String
"c4d",String
"application/vnd.clonk.c4group"),(String
"c4f",String
"application/vnd.clonk.c4group"),(String
"c4p",String
"application/vnd.clonk.c4group"),(String
"c4u",String
"application/vnd.clonk.c4group"),(String
"c11amc",String
"application/vnd.cluetrust.cartomobile-config"),(String
"c11amz",String
"application/vnd.cluetrust.cartomobile-config-pkg"),(String
"csp",String
"application/vnd.commonspace"),(String
"cdbcmsg",String
"application/vnd.contact.cmsg"),(String
"cmc",String
"application/vnd.cosmocaller"),(String
"clkx",String
"application/vnd.crick.clicker"),(String
"clkk",String
"application/vnd.crick.clicker.keyboard"),(String
"clkp",String
"application/vnd.crick.clicker.palette"),(String
"clkt",String
"application/vnd.crick.clicker.template"),(String
"clkw",String
"application/vnd.crick.clicker.wordbank"),(String
"wbs",String
"application/vnd.criticaltools.wbs+xml"),(String
"pml",String
"application/vnd.ctc-posml"),(String
"ppd",String
"application/vnd.cups-ppd"),(String
"car",String
"application/vnd.curl.car"),(String
"pcurl",String
"application/vnd.curl.pcurl"),(String
"dart",String
"application/vnd.dart"),(String
"rdz",String
"application/vnd.data-vision.rdz"),(String
"uvf",String
"application/vnd.dece.data"),(String
"uvvf",String
"application/vnd.dece.data"),(String
"uvd",String
"application/vnd.dece.data"),(String
"uvvd",String
"application/vnd.dece.data"),(String
"uvt",String
"application/vnd.dece.ttml+xml"),(String
"uvvt",String
"application/vnd.dece.ttml+xml"),(String
"uvx",String
"application/vnd.dece.unspecified"),(String
"uvvx",String
"application/vnd.dece.unspecified"),(String
"uvz",String
"application/vnd.dece.zip"),(String
"uvvz",String
"application/vnd.dece.zip"),(String
"fe_launch",String
"application/vnd.denovo.fcselayout-link"),(String
"dna",String
"application/vnd.dna"),(String
"mlp",String
"application/vnd.dolby.mlp"),(String
"dpg",String
"application/vnd.dpgraph"),(String
"dfac",String
"application/vnd.dreamfactory"),(String
"kpxx",String
"application/vnd.ds-keypoint"),(String
"ait",String
"application/vnd.dvb.ait"),(String
"svc",String
"application/vnd.dvb.service"),(String
"geo",String
"application/vnd.dynageo"),(String
"mag",String
"application/vnd.ecowin.chart"),(String
"nml",String
"application/vnd.enliven"),(String
"esf",String
"application/vnd.epson.esf"),(String
"msf",String
"application/vnd.epson.msf"),(String
"qam",String
"application/vnd.epson.quickanime"),(String
"slt",String
"application/vnd.epson.salt"),(String
"ssf",String
"application/vnd.epson.ssf"),(String
"es3",String
"application/vnd.eszigno3+xml"),(String
"et3",String
"application/vnd.eszigno3+xml"),(String
"ez2",String
"application/vnd.ezpix-album"),(String
"ez3",String
"application/vnd.ezpix-package"),(String
"fdf",String
"application/vnd.fdf"),(String
"mseed",String
"application/vnd.fdsn.mseed"),(String
"seed",String
"application/vnd.fdsn.seed"),(String
"dataless",String
"application/vnd.fdsn.seed"),(String
"gph",String
"application/vnd.flographit"),(String
"ftc",String
"application/vnd.fluxtime.clip"),(String
"fm",String
"application/vnd.framemaker"),(String
"frame",String
"application/vnd.framemaker"),(String
"maker",String
"application/vnd.framemaker"),(String
"book",String
"application/vnd.framemaker"),(String
"fnc",String
"application/vnd.frogans.fnc"),(String
"ltf",String
"application/vnd.frogans.ltf"),(String
"fsc",String
"application/vnd.fsc.weblaunch"),(String
"oas",String
"application/vnd.fujitsu.oasys"),(String
"oa2",String
"application/vnd.fujitsu.oasys2"),(String
"oa3",String
"application/vnd.fujitsu.oasys3"),(String
"fg5",String
"application/vnd.fujitsu.oasysgp"),(String
"bh2",String
"application/vnd.fujitsu.oasysprs"),(String
"ddd",String
"application/vnd.fujixerox.ddd"),(String
"xdw",String
"application/vnd.fujixerox.docuworks"),(String
"xbd",String
"application/vnd.fujixerox.docuworks.binder"),(String
"fzs",String
"application/vnd.fuzzysheet"),(String
"txd",String
"application/vnd.genomatix.tuxedo"),(String
"ggb",String
"application/vnd.geogebra.file"),(String
"ggt",String
"application/vnd.geogebra.tool"),(String
"gex",String
"application/vnd.geometry-explorer"),(String
"gre",String
"application/vnd.geometry-explorer"),(String
"gxt",String
"application/vnd.geonext"),(String
"g2w",String
"application/vnd.geoplan"),(String
"g3w",String
"application/vnd.geospace"),(String
"gmx",String
"application/vnd.gmx"),(String
"kml",String
"application/vnd.google-earth.kml+xml"),(String
"kmz",String
"application/vnd.google-earth.kmz"),(String
"gqf",String
"application/vnd.grafeq"),(String
"gqs",String
"application/vnd.grafeq"),(String
"gac",String
"application/vnd.groove-account"),(String
"ghf",String
"application/vnd.groove-help"),(String
"gim",String
"application/vnd.groove-identity-message"),(String
"grv",String
"application/vnd.groove-injector"),(String
"gtm",String
"application/vnd.groove-tool-message"),(String
"tpl",String
"application/vnd.groove-tool-template"),(String
"vcg",String
"application/vnd.groove-vcard"),(String
"hal",String
"application/vnd.hal+xml"),(String
"zmm",String
"application/vnd.handheld-entertainment+xml"),(String
"hbci",String
"application/vnd.hbci"),(String
"les",String
"application/vnd.hhe.lesson-player"),(String
"hpgl",String
"application/vnd.hp-hpgl"),(String
"hpid",String
"application/vnd.hp-hpid"),(String
"hps",String
"application/vnd.hp-hps"),(String
"jlt",String
"application/vnd.hp-jlyt"),(String
"pcl",String
"application/vnd.hp-pcl"),(String
"pclxl",String
"application/vnd.hp-pclxl"),(String
"sfd-hdstx",String
"application/vnd.hydrostatix.sof-data"),(String
"mpy",String
"application/vnd.ibm.minipay"),(String
"afp",String
"application/vnd.ibm.modcap"),(String
"listafp",String
"application/vnd.ibm.modcap"),(String
"list3820",String
"application/vnd.ibm.modcap"),(String
"irm",String
"application/vnd.ibm.rights-management"),(String
"sc",String
"application/vnd.ibm.secure-container"),(String
"icc",String
"application/vnd.iccprofile"),(String
"icm",String
"application/vnd.iccprofile"),(String
"igl",String
"application/vnd.igloader"),(String
"ivp",String
"application/vnd.immervision-ivp"),(String
"ivu",String
"application/vnd.immervision-ivu"),(String
"igm",String
"application/vnd.insors.igm"),(String
"xpw",String
"application/vnd.intercon.formnet"),(String
"xpx",String
"application/vnd.intercon.formnet"),(String
"i2g",String
"application/vnd.intergeo"),(String
"qbo",String
"application/vnd.intu.qbo"),(String
"qfx",String
"application/vnd.intu.qfx"),(String
"rcprofile",String
"application/vnd.ipunplugged.rcprofile"),(String
"irp",String
"application/vnd.irepository.package+xml"),(String
"xpr",String
"application/vnd.is-xpr"),(String
"fcs",String
"application/vnd.isac.fcs"),(String
"jam",String
"application/vnd.jam"),(String
"rms",String
"application/vnd.jcp.javame.midlet-rms"),(String
"jisp",String
"application/vnd.jisp"),(String
"joda",String
"application/vnd.joost.joda-archive"),(String
"ktz",String
"application/vnd.kahootz"),(String
"ktr",String
"application/vnd.kahootz"),(String
"karbon",String
"application/vnd.kde.karbon"),(String
"chrt",String
"application/vnd.kde.kchart"),(String
"kfo",String
"application/vnd.kde.kformula"),(String
"flw",String
"application/vnd.kde.kivio"),(String
"kon",String
"application/vnd.kde.kontour"),(String
"kpr",String
"application/vnd.kde.kpresenter"),(String
"kpt",String
"application/vnd.kde.kpresenter"),(String
"ksp",String
"application/vnd.kde.kspread"),(String
"kwd",String
"application/vnd.kde.kword"),(String
"kwt",String
"application/vnd.kde.kword"),(String
"htke",String
"application/vnd.kenameaapp"),(String
"kia",String
"application/vnd.kidspiration"),(String
"kne",String
"application/vnd.kinar"),(String
"knp",String
"application/vnd.kinar"),(String
"skp",String
"application/vnd.koan"),(String
"skd",String
"application/vnd.koan"),(String
"skt",String
"application/vnd.koan"),(String
"skm",String
"application/vnd.koan"),(String
"sse",String
"application/vnd.kodak-descriptor"),(String
"lasxml",String
"application/vnd.las.las+xml"),(String
"lbd",String
"application/vnd.llamagraphics.life-balance.desktop"),(String
"lbe",String
"application/vnd.llamagraphics.life-balance.exchange+xml"),(String
"123",String
"application/vnd.lotus-1-2-3"),(String
"apr",String
"application/vnd.lotus-approach"),(String
"pre",String
"application/vnd.lotus-freelance"),(String
"nsf",String
"application/vnd.lotus-notes"),(String
"org",String
"application/vnd.lotus-organizer"),(String
"scm",String
"application/vnd.lotus-screencam"),(String
"lwp",String
"application/vnd.lotus-wordpro"),(String
"portpkg",String
"application/vnd.macports.portpkg"),(String
"mcd",String
"application/vnd.mcd"),(String
"mc1",String
"application/vnd.medcalcdata"),(String
"cdkey",String
"application/vnd.mediastation.cdkey"),(String
"mwf",String
"application/vnd.mfer"),(String
"mfm",String
"application/vnd.mfmp"),(String
"flo",String
"application/vnd.micrografx.flo"),(String
"igx",String
"application/vnd.micrografx.igx"),(String
"mif",String
"application/vnd.mif"),(String
"daf",String
"application/vnd.mobius.daf"),(String
"dis",String
"application/vnd.mobius.dis"),(String
"mbk",String
"application/vnd.mobius.mbk"),(String
"mqy",String
"application/vnd.mobius.mqy"),(String
"msl",String
"application/vnd.mobius.msl"),(String
"plc",String
"application/vnd.mobius.plc"),(String
"txf",String
"application/vnd.mobius.txf"),(String
"mpn",String
"application/vnd.mophun.application"),(String
"mpc",String
"application/vnd.mophun.certificate"),(String
"xul",String
"application/vnd.mozilla.xul+xml"),(String
"cil",String
"application/vnd.ms-artgalry"),(String
"cab",String
"application/vnd.ms-cab-compressed"),(String
"xls",String
"application/vnd.ms-excel"),(String
"xlm",String
"application/vnd.ms-excel"),(String
"xla",String
"application/vnd.ms-excel"),(String
"xlc",String
"application/vnd.ms-excel"),(String
"xlt",String
"application/vnd.ms-excel"),(String
"xlw",String
"application/vnd.ms-excel"),(String
"xlam",String
"application/vnd.ms-excel.addin.macroenabled.12"),(String
"xlsb",String
"application/vnd.ms-excel.sheet.binary.macroenabled.12"),(String
"xlsm",String
"application/vnd.ms-excel.sheet.macroenabled.12"),(String
"xltm",String
"application/vnd.ms-excel.template.macroenabled.12"),(String
"eot",String
"application/vnd.ms-fontobject"),(String
"chm",String
"application/vnd.ms-htmlhelp"),(String
"ims",String
"application/vnd.ms-ims"),(String
"lrm",String
"application/vnd.ms-lrm"),(String
"thmx",String
"application/vnd.ms-officetheme"),(String
"cat",String
"application/vnd.ms-pki.seccat"),(String
"stl",String
"application/vnd.ms-pki.stl"),(String
"ppt",String
"application/vnd.ms-powerpoint"),(String
"pps",String
"application/vnd.ms-powerpoint"),(String
"pot",String
"application/vnd.ms-powerpoint"),(String
"ppam",String
"application/vnd.ms-powerpoint.addin.macroenabled.12"),(String
"pptm",String
"application/vnd.ms-powerpoint.presentation.macroenabled.12"),(String
"sldm",String
"application/vnd.ms-powerpoint.slide.macroenabled.12"),(String
"ppsm",String
"application/vnd.ms-powerpoint.slideshow.macroenabled.12"),(String
"potm",String
"application/vnd.ms-powerpoint.template.macroenabled.12"),(String
"mpp",String
"application/vnd.ms-project"),(String
"mpt",String
"application/vnd.ms-project"),(String
"docm",String
"application/vnd.ms-word.document.macroenabled.12"),(String
"dotm",String
"application/vnd.ms-word.template.macroenabled.12"),(String
"wps",String
"application/vnd.ms-works"),(String
"wks",String
"application/vnd.ms-works"),(String
"wcm",String
"application/vnd.ms-works"),(String
"wdb",String
"application/vnd.ms-works"),(String
"wpl",String
"application/vnd.ms-wpl"),(String
"xps",String
"application/vnd.ms-xpsdocument"),(String
"mseq",String
"application/vnd.mseq"),(String
"mus",String
"application/vnd.musician"),(String
"msty",String
"application/vnd.muvee.style"),(String
"taglet",String
"application/vnd.mynfc"),(String
"nlu",String
"application/vnd.neurolanguage.nlu"),(String
"ntf",String
"application/vnd.nitf"),(String
"nitf",String
"application/vnd.nitf"),(String
"nnd",String
"application/vnd.noblenet-directory"),(String
"nns",String
"application/vnd.noblenet-sealer"),(String
"nnw",String
"application/vnd.noblenet-web"),(String
"ngdat",String
"application/vnd.nokia.n-gage.data"),(String
"n-gage",String
"application/vnd.nokia.n-gage.symbian.install"),(String
"rpst",String
"application/vnd.nokia.radio-preset"),(String
"rpss",String
"application/vnd.nokia.radio-presets"),(String
"edm",String
"application/vnd.novadigm.edm"),(String
"edx",String
"application/vnd.novadigm.edx"),(String
"ext",String
"application/vnd.novadigm.ext"),(String
"odc",String
"application/vnd.oasis.opendocument.chart"),(String
"otc",String
"application/vnd.oasis.opendocument.chart-template"),(String
"odb",String
"application/vnd.oasis.opendocument.database"),(String
"odf",String
"application/vnd.oasis.opendocument.formula"),(String
"odft",String
"application/vnd.oasis.opendocument.formula-template"),(String
"odg",String
"application/vnd.oasis.opendocument.graphics"),(String
"otg",String
"application/vnd.oasis.opendocument.graphics-template"),(String
"odi",String
"application/vnd.oasis.opendocument.image"),(String
"oti",String
"application/vnd.oasis.opendocument.image-template"),(String
"odp",String
"application/vnd.oasis.opendocument.presentation"),(String
"otp",String
"application/vnd.oasis.opendocument.presentation-template"),(String
"ods",String
"application/vnd.oasis.opendocument.spreadsheet"),(String
"ots",String
"application/vnd.oasis.opendocument.spreadsheet-template"),(String
"odt",String
"application/vnd.oasis.opendocument.text"),(String
"odm",String
"application/vnd.oasis.opendocument.text-master"),(String
"ott",String
"application/vnd.oasis.opendocument.text-template"),(String
"oth",String
"application/vnd.oasis.opendocument.text-web"),(String
"xo",String
"application/vnd.olpc-sugar"),(String
"dd2",String
"application/vnd.oma.dd2+xml"),(String
"oxt",String
"application/vnd.openofficeorg.extension"),(String
"pptx",String
"application/vnd.openxmlformats-officedocument.presentationml.presentation"),(String
"sldx",String
"application/vnd.openxmlformats-officedocument.presentationml.slide"),(String
"ppsx",String
"application/vnd.openxmlformats-officedocument.presentationml.slideshow"),(String
"potx",String
"application/vnd.openxmlformats-officedocument.presentationml.template"),(String
"xlsx",String
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"),(String
"xltx",String
"application/vnd.openxmlformats-officedocument.spreadsheetml.template"),(String
"docx",String
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"),(String
"dotx",String
"application/vnd.openxmlformats-officedocument.wordprocessingml.template"),(String
"mgp",String
"application/vnd.osgeo.mapguide.package"),(String
"dp",String
"application/vnd.osgi.dp"),(String
"esa",String
"application/vnd.osgi.subsystem"),(String
"pdb",String
"application/vnd.palm"),(String
"pqa",String
"application/vnd.palm"),(String
"oprc",String
"application/vnd.palm"),(String
"paw",String
"application/vnd.pawaafile"),(String
"str",String
"application/vnd.pg.format"),(String
"ei6",String
"application/vnd.pg.osasli"),(String
"efif",String
"application/vnd.picsel"),(String
"wg",String
"application/vnd.pmi.widget"),(String
"plf",String
"application/vnd.pocketlearn"),(String
"pbd",String
"application/vnd.powerbuilder6"),(String
"box",String
"application/vnd.previewsystems.box"),(String
"mgz",String
"application/vnd.proteus.magazine"),(String
"qps",String
"application/vnd.publishare-delta-tree"),(String
"ptid",String
"application/vnd.pvi.ptid1"),(String
"qxd",String
"application/vnd.quark.quarkxpress"),(String
"qxt",String
"application/vnd.quark.quarkxpress"),(String
"qwd",String
"application/vnd.quark.quarkxpress"),(String
"qwt",String
"application/vnd.quark.quarkxpress"),(String
"qxl",String
"application/vnd.quark.quarkxpress"),(String
"qxb",String
"application/vnd.quark.quarkxpress"),(String
"bed",String
"application/vnd.realvnc.bed"),(String
"mxl",String
"application/vnd.recordare.musicxml"),(String
"musicxml",String
"application/vnd.recordare.musicxml+xml"),(String
"cryptonote",String
"application/vnd.rig.cryptonote"),(String
"cod",String
"application/vnd.rim.cod"),(String
"rm",String
"application/vnd.rn-realmedia"),(String
"rmvb",String
"application/vnd.rn-realmedia-vbr"),(String
"link66",String
"application/vnd.route66.link66+xml"),(String
"st",String
"application/vnd.sailingtracker.track"),(String
"see",String
"application/vnd.seemail"),(String
"sema",String
"application/vnd.sema"),(String
"semd",String
"application/vnd.semd"),(String
"semf",String
"application/vnd.semf"),(String
"ifm",String
"application/vnd.shana.informed.formdata"),(String
"itp",String
"application/vnd.shana.informed.formtemplate"),(String
"iif",String
"application/vnd.shana.informed.interchange"),(String
"ipk",String
"application/vnd.shana.informed.package"),(String
"twd",String
"application/vnd.simtech-mindmapper"),(String
"twds",String
"application/vnd.simtech-mindmapper"),(String
"mmf",String
"application/vnd.smaf"),(String
"teacher",String
"application/vnd.smart.teacher"),(String
"sdkm",String
"application/vnd.solent.sdkm+xml"),(String
"sdkd",String
"application/vnd.solent.sdkm+xml"),(String
"dxp",String
"application/vnd.spotfire.dxp"),(String
"sfs",String
"application/vnd.spotfire.sfs"),(String
"sdc",String
"application/vnd.stardivision.calc"),(String
"sda",String
"application/vnd.stardivision.draw"),(String
"sdd",String
"application/vnd.stardivision.impress"),(String
"smf",String
"application/vnd.stardivision.math"),(String
"sdw",String
"application/vnd.stardivision.writer"),(String
"vor",String
"application/vnd.stardivision.writer"),(String
"sgl",String
"application/vnd.stardivision.writer-global"),(String
"smzip",String
"application/vnd.stepmania.package"),(String
"sm",String
"application/vnd.stepmania.stepchart"),(String
"sxc",String
"application/vnd.sun.xml.calc"),(String
"stc",String
"application/vnd.sun.xml.calc.template"),(String
"sxd",String
"application/vnd.sun.xml.draw"),(String
"std",String
"application/vnd.sun.xml.draw.template"),(String
"sxi",String
"application/vnd.sun.xml.impress"),(String
"sti",String
"application/vnd.sun.xml.impress.template"),(String
"sxm",String
"application/vnd.sun.xml.math"),(String
"sxw",String
"application/vnd.sun.xml.writer"),(String
"sxg",String
"application/vnd.sun.xml.writer.global"),(String
"stw",String
"application/vnd.sun.xml.writer.template"),(String
"sus",String
"application/vnd.sus-calendar"),(String
"susp",String
"application/vnd.sus-calendar"),(String
"svd",String
"application/vnd.svd"),(String
"sis",String
"application/vnd.symbian.install"),(String
"sisx",String
"application/vnd.symbian.install"),(String
"xsm",String
"application/vnd.syncml+xml"),(String
"bdm",String
"application/vnd.syncml.dm+wbxml"),(String
"xdm",String
"application/vnd.syncml.dm+xml"),(String
"tao",String
"application/vnd.tao.intent-module-archive"),(String
"pcap",String
"application/vnd.tcpdump.pcap"),(String
"cap",String
"application/vnd.tcpdump.pcap"),(String
"dmp",String
"application/vnd.tcpdump.pcap"),(String
"tmo",String
"application/vnd.tmobile-livetv"),(String
"tpt",String
"application/vnd.trid.tpt"),(String
"mxs",String
"application/vnd.triscape.mxs"),(String
"tra",String
"application/vnd.trueapp"),(String
"ufd",String
"application/vnd.ufdl"),(String
"ufdl",String
"application/vnd.ufdl"),(String
"utz",String
"application/vnd.uiq.theme"),(String
"umj",String
"application/vnd.umajin"),(String
"unityweb",String
"application/vnd.unity"),(String
"uoml",String
"application/vnd.uoml+xml"),(String
"vcx",String
"application/vnd.vcx"),(String
"vsd",String
"application/vnd.visio"),(String
"vst",String
"application/vnd.visio"),(String
"vss",String
"application/vnd.visio"),(String
"vsw",String
"application/vnd.visio"),(String
"vis",String
"application/vnd.visionary"),(String
"vsf",String
"application/vnd.vsf"),(String
"wbxml",String
"application/vnd.wap.wbxml"),(String
"wmlc",String
"application/vnd.wap.wmlc"),(String
"wmlsc",String
"application/vnd.wap.wmlscriptc"),(String
"wtb",String
"application/vnd.webturbo"),(String
"nbp",String
"application/vnd.wolfram.player"),(String
"wpd",String
"application/vnd.wordperfect"),(String
"wqd",String
"application/vnd.wqd"),(String
"stf",String
"application/vnd.wt.stf"),(String
"xar",String
"application/vnd.xara"),(String
"xfdl",String
"application/vnd.xfdl"),(String
"hvd",String
"application/vnd.yamaha.hv-dic"),(String
"hvs",String
"application/vnd.yamaha.hv-script"),(String
"hvp",String
"application/vnd.yamaha.hv-voice"),(String
"osf",String
"application/vnd.yamaha.openscoreformat"),(String
"osfpvg",String
"application/vnd.yamaha.openscoreformat.osfpvg+xml"),(String
"saf",String
"application/vnd.yamaha.smaf-audio"),(String
"spf",String
"application/vnd.yamaha.smaf-phrase"),(String
"cmp",String
"application/vnd.yellowriver-custom-menu"),(String
"zir",String
"application/vnd.zul"),(String
"zirz",String
"application/vnd.zul"),(String
"zaz",String
"application/vnd.zzazz.deck+xml"),(String
"vxml",String
"application/voicexml+xml"),(String
"wgt",String
"application/widget"),(String
"hlp",String
"application/winhlp"),(String
"wsdl",String
"application/wsdl+xml"),(String
"wspolicy",String
"application/wspolicy+xml"),(String
"7z",String
"application/x-7z-compressed"),(String
"abw",String
"application/x-abiword"),(String
"ace",String
"application/x-ace-compressed"),(String
"dmg",String
"application/x-apple-diskimage"),(String
"aab",String
"application/x-authorware-bin"),(String
"x32",String
"application/x-authorware-bin"),(String
"u32",String
"application/x-authorware-bin"),(String
"vox",String
"application/x-authorware-bin"),(String
"aam",String
"application/x-authorware-map"),(String
"aas",String
"application/x-authorware-seg"),(String
"bcpio",String
"application/x-bcpio"),(String
"torrent",String
"application/x-bittorrent"),(String
"blb",String
"application/x-blorb"),(String
"blorb",String
"application/x-blorb"),(String
"bz",String
"application/x-bzip"),(String
"bz2",String
"application/x-bzip2"),(String
"boz",String
"application/x-bzip2"),(String
"cbr",String
"application/x-cbr"),(String
"cba",String
"application/x-cbr"),(String
"cbt",String
"application/x-cbr"),(String
"cbz",String
"application/x-cbr"),(String
"cb7",String
"application/x-cbr"),(String
"vcd",String
"application/x-cdlink"),(String
"cfs",String
"application/x-cfs-compressed"),(String
"chat",String
"application/x-chat"),(String
"pgn",String
"application/x-chess-pgn"),(String
"nsc",String
"application/x-conference"),(String
"cpio",String
"application/x-cpio"),(String
"csh",String
"application/x-csh"),(String
"deb",String
"application/x-debian-package"),(String
"udeb",String
"application/x-debian-package"),(String
"dgc",String
"application/x-dgc-compressed"),(String
"dir",String
"application/x-director"),(String
"dcr",String
"application/x-director"),(String
"dxr",String
"application/x-director"),(String
"cst",String
"application/x-director"),(String
"cct",String
"application/x-director"),(String
"cxt",String
"application/x-director"),(String
"w3d",String
"application/x-director"),(String
"fgd",String
"application/x-director"),(String
"swa",String
"application/x-director"),(String
"wad",String
"application/x-doom"),(String
"ncx",String
"application/x-dtbncx+xml"),(String
"dtb",String
"application/x-dtbook+xml"),(String
"res",String
"application/x-dtbresource+xml"),(String
"dvi",String
"application/x-dvi"),(String
"evy",String
"application/x-envoy"),(String
"eva",String
"application/x-eva"),(String
"bdf",String
"application/x-font-bdf"),(String
"gsf",String
"application/x-font-ghostscript"),(String
"psf",String
"application/x-font-linux-psf"),(String
"pcf",String
"application/x-font-pcf"),(String
"snf",String
"application/x-font-snf"),(String
"pfa",String
"application/x-font-type1"),(String
"pfb",String
"application/x-font-type1"),(String
"pfm",String
"application/x-font-type1"),(String
"afm",String
"application/x-font-type1"),(String
"arc",String
"application/x-freearc"),(String
"spl",String
"application/x-futuresplash"),(String
"gca",String
"application/x-gca-compressed"),(String
"ulx",String
"application/x-glulx"),(String
"gnumeric",String
"application/x-gnumeric"),(String
"gramps",String
"application/x-gramps-xml"),(String
"gtar",String
"application/x-gtar"),(String
"hdf",String
"application/x-hdf"),(String
"install",String
"application/x-install-instructions"),(String
"iso",String
"application/x-iso9660-image"),(String
"jnlp",String
"application/x-java-jnlp-file"),(String
"latex",String
"application/x-latex"),(String
"lzh",String
"application/x-lzh-compressed"),(String
"lha",String
"application/x-lzh-compressed"),(String
"mie",String
"application/x-mie"),(String
"prc",String
"application/x-mobipocket-ebook"),(String
"mobi",String
"application/x-mobipocket-ebook"),(String
"application",String
"application/x-ms-application"),(String
"lnk",String
"application/x-ms-shortcut"),(String
"wmd",String
"application/x-ms-wmd"),(String
"wmz",String
"application/x-ms-wmz"),(String
"xbap",String
"application/x-ms-xbap"),(String
"mdb",String
"application/x-msaccess"),(String
"obd",String
"application/x-msbinder"),(String
"crd",String
"application/x-mscardfile"),(String
"clp",String
"application/x-msclip"),(String
"exe",String
"application/x-msdownload"),(String
"dll",String
"application/x-msdownload"),(String
"com",String
"application/x-msdownload"),(String
"bat",String
"application/x-msdownload"),(String
"msi",String
"application/x-msdownload"),(String
"mvb",String
"application/x-msmediaview"),(String
"m13",String
"application/x-msmediaview"),(String
"m14",String
"application/x-msmediaview"),(String
"wmf",String
"application/x-msmetafile"),(String
"wmz",String
"application/x-msmetafile"),(String
"emf",String
"application/x-msmetafile"),(String
"emz",String
"application/x-msmetafile"),(String
"mny",String
"application/x-msmoney"),(String
"pub",String
"application/x-mspublisher"),(String
"scd",String
"application/x-msschedule"),(String
"trm",String
"application/x-msterminal"),(String
"wri",String
"application/x-mswrite"),(String
"nc",String
"application/x-netcdf"),(String
"cdf",String
"application/x-netcdf"),(String
"nzb",String
"application/x-nzb"),(String
"p12",String
"application/x-pkcs12"),(String
"pfx",String
"application/x-pkcs12"),(String
"p7b",String
"application/x-pkcs7-certificates"),(String
"spc",String
"application/x-pkcs7-certificates"),(String
"p7r",String
"application/x-pkcs7-certreqresp"),(String
"rar",String
"application/x-rar-compressed"),(String
"ris",String
"application/x-research-info-systems"),(String
"sh",String
"application/x-sh"),(String
"shar",String
"application/x-shar"),(String
"swf",String
"application/x-shockwave-flash"),(String
"xap",String
"application/x-silverlight-app"),(String
"sql",String
"application/x-sql"),(String
"sit",String
"application/x-stuffit"),(String
"sitx",String
"application/x-stuffitx"),(String
"srt",String
"application/x-subrip"),(String
"sv4cpio",String
"application/x-sv4cpio"),(String
"sv4crc",String
"application/x-sv4crc"),(String
"t3",String
"application/x-t3vm-image"),(String
"gam",String
"application/x-tads"),(String
"tar",String
"application/x-tar"),(String
"tcl",String
"application/x-tcl"),(String
"tex",String
"application/x-tex"),(String
"tfm",String
"application/x-tex-tfm"),(String
"texinfo",String
"application/x-texinfo"),(String
"texi",String
"application/x-texinfo"),(String
"obj",String
"application/x-tgif"),(String
"ustar",String
"application/x-ustar"),(String
"src",String
"application/x-wais-source"),(String
"der",String
"application/x-x509-ca-cert"),(String
"crt",String
"application/x-x509-ca-cert"),(String
"fig",String
"application/x-xfig"),(String
"xlf",String
"application/x-xliff+xml"),(String
"xpi",String
"application/x-xpinstall"),(String
"xz",String
"application/x-xz"),(String
"z1",String
"application/x-zmachine"),(String
"z2",String
"application/x-zmachine"),(String
"z3",String
"application/x-zmachine"),(String
"z4",String
"application/x-zmachine"),(String
"z5",String
"application/x-zmachine"),(String
"z6",String
"application/x-zmachine"),(String
"z7",String
"application/x-zmachine"),(String
"z8",String
"application/x-zmachine"),(String
"xaml",String
"application/xaml+xml"),(String
"xdf",String
"application/xcap-diff+xml"),(String
"xenc",String
"application/xenc+xml"),(String
"xhtml",String
"application/xhtml+xml"),(String
"xht",String
"application/xhtml+xml"),(String
"xml",String
"application/xml"),(String
"xsl",String
"application/xml"),(String
"dtd",String
"application/xml-dtd"),(String
"xop",String
"application/xop+xml"),(String
"xpl",String
"application/xproc+xml"),(String
"xslt",String
"application/xslt+xml"),(String
"xspf",String
"application/xspf+xml"),(String
"mxml",String
"application/xv+xml"),(String
"xhvml",String
"application/xv+xml"),(String
"xvml",String
"application/xv+xml"),(String
"xvm",String
"application/xv+xml"),(String
"yang",String
"application/yang"),(String
"yin",String
"application/yin+xml"),(String
"zip",String
"application/zip"),(String
"adp",String
"audio/adpcm"),(String
"au",String
"audio/basic"),(String
"snd",String
"audio/basic"),(String
"mid",String
"audio/midi"),(String
"midi",String
"audio/midi"),(String
"kar",String
"audio/midi"),(String
"rmi",String
"audio/midi"),(String
"m4a",String
"audio/mp4"),(String
"mp4a",String
"audio/mp4"),(String
"mpga",String
"audio/mpeg"),(String
"mp2",String
"audio/mpeg"),(String
"mp2a",String
"audio/mpeg"),(String
"mp3",String
"audio/mpeg"),(String
"m2a",String
"audio/mpeg"),(String
"m3a",String
"audio/mpeg"),(String
"oga",String
"audio/ogg"),(String
"ogg",String
"audio/ogg"),(String
"spx",String
"audio/ogg"),(String
"s3m",String
"audio/s3m"),(String
"sil",String
"audio/silk"),(String
"uva",String
"audio/vnd.dece.audio"),(String
"uvva",String
"audio/vnd.dece.audio"),(String
"eol",String
"audio/vnd.digital-winds"),(String
"dra",String
"audio/vnd.dra"),(String
"dts",String
"audio/vnd.dts"),(String
"dtshd",String
"audio/vnd.dts.hd"),(String
"lvp",String
"audio/vnd.lucent.voice"),(String
"pya",String
"audio/vnd.ms-playready.media.pya"),(String
"ecelp4800",String
"audio/vnd.nuera.ecelp4800"),(String
"ecelp7470",String
"audio/vnd.nuera.ecelp7470"),(String
"ecelp9600",String
"audio/vnd.nuera.ecelp9600"),(String
"rip",String
"audio/vnd.rip"),(String
"weba",String
"audio/webm"),(String
"aac",String
"audio/x-aac"),(String
"aif",String
"audio/x-aiff"),(String
"aiff",String
"audio/x-aiff"),(String
"aifc",String
"audio/x-aiff"),(String
"caf",String
"audio/x-caf"),(String
"flac",String
"audio/x-flac"),(String
"mka",String
"audio/x-matroska"),(String
"m3u",String
"audio/x-mpegurl"),(String
"wax",String
"audio/x-ms-wax"),(String
"wma",String
"audio/x-ms-wma"),(String
"ram",String
"audio/x-pn-realaudio"),(String
"ra",String
"audio/x-pn-realaudio"),(String
"rmp",String
"audio/x-pn-realaudio-plugin"),(String
"wav",String
"audio/x-wav"),(String
"xm",String
"audio/xm"),(String
"cdx",String
"chemical/x-cdx"),(String
"cif",String
"chemical/x-cif"),(String
"cmdf",String
"chemical/x-cmdf"),(String
"cml",String
"chemical/x-cml"),(String
"csml",String
"chemical/x-csml"),(String
"xyz",String
"chemical/x-xyz"),(String
"ttc",String
"font/collection"),(String
"otf",String
"font/otf"),(String
"ttf",String
"font/ttf"),(String
"woff",String
"font/woff"),(String
"woff2",String
"font/woff2"),(String
"bmp",String
"image/bmp"),(String
"cgm",String
"image/cgm"),(String
"g3",String
"image/g3fax"),(String
"gif",String
"image/gif"),(String
"ief",String
"image/ief"),(String
"jpeg",String
"image/jpeg"),(String
"jpg",String
"image/jpeg"),(String
"jpe",String
"image/jpeg"),(String
"ktx",String
"image/ktx"),(String
"png",String
"image/png"),(String
"btif",String
"image/prs.btif"),(String
"sgi",String
"image/sgi"),(String
"svg",String
"image/svg+xml"),(String
"svgz",String
"image/svg+xml"),(String
"tiff",String
"image/tiff"),(String
"tif",String
"image/tiff"),(String
"psd",String
"image/vnd.adobe.photoshop"),(String
"uvi",String
"image/vnd.dece.graphic"),(String
"uvvi",String
"image/vnd.dece.graphic"),(String
"uvg",String
"image/vnd.dece.graphic"),(String
"uvvg",String
"image/vnd.dece.graphic"),(String
"djvu",String
"image/vnd.djvu"),(String
"djv",String
"image/vnd.djvu"),(String
"sub",String
"image/vnd.dvb.subtitle"),(String
"dwg",String
"image/vnd.dwg"),(String
"dxf",String
"image/vnd.dxf"),(String
"fbs",String
"image/vnd.fastbidsheet"),(String
"fpx",String
"image/vnd.fpx"),(String
"fst",String
"image/vnd.fst"),(String
"mmr",String
"image/vnd.fujixerox.edmics-mmr"),(String
"rlc",String
"image/vnd.fujixerox.edmics-rlc"),(String
"mdi",String
"image/vnd.ms-modi"),(String
"wdp",String
"image/vnd.ms-photo"),(String
"npx",String
"image/vnd.net-fpx"),(String
"wbmp",String
"image/vnd.wap.wbmp"),(String
"xif",String
"image/vnd.xiff"),(String
"webp",String
"image/webp"),(String
"3ds",String
"image/x-3ds"),(String
"ras",String
"image/x-cmu-raster"),(String
"cmx",String
"image/x-cmx"),(String
"fh",String
"image/x-freehand"),(String
"fhc",String
"image/x-freehand"),(String
"fh4",String
"image/x-freehand"),(String
"fh5",String
"image/x-freehand"),(String
"fh7",String
"image/x-freehand"),(String
"ico",String
"image/x-icon"),(String
"sid",String
"image/x-mrsid-image"),(String
"pcx",String
"image/x-pcx"),(String
"pic",String
"image/x-pict"),(String
"pct",String
"image/x-pict"),(String
"pnm",String
"image/x-portable-anymap"),(String
"pbm",String
"image/x-portable-bitmap"),(String
"pgm",String
"image/x-portable-graymap"),(String
"ppm",String
"image/x-portable-pixmap"),(String
"rgb",String
"image/x-rgb"),(String
"tga",String
"image/x-tga"),(String
"xbm",String
"image/x-xbitmap"),(String
"xpm",String
"image/x-xpixmap"),(String
"xwd",String
"image/x-xwindowdump"),(String
"eml",String
"message/rfc822"),(String
"mime",String
"message/rfc822"),(String
"igs",String
"model/iges"),(String
"iges",String
"model/iges"),(String
"msh",String
"model/mesh"),(String
"mesh",String
"model/mesh"),(String
"silo",String
"model/mesh"),(String
"dae",String
"model/vnd.collada+xml"),(String
"dwf",String
"model/vnd.dwf"),(String
"gdl",String
"model/vnd.gdl"),(String
"gtw",String
"model/vnd.gtw"),(String
"mts",String
"model/vnd.mts"),(String
"vtu",String
"model/vnd.vtu"),(String
"wrl",String
"model/vrml"),(String
"vrml",String
"model/vrml"),(String
"x3db",String
"model/x3d+binary"),(String
"x3dbz",String
"model/x3d+binary"),(String
"x3dv",String
"model/x3d+vrml"),(String
"x3dvz",String
"model/x3d+vrml"),(String
"x3d",String
"model/x3d+xml"),(String
"x3dz",String
"model/x3d+xml"),(String
"appcache",String
"text/cache-manifest"),(String
"ics",String
"text/calendar"),(String
"ifb",String
"text/calendar"),(String
"css",String
"text/css"),(String
"csv",String
"text/csv"),(String
"html",String
"text/html"),(String
"htm",String
"text/html"),(String
"n3",String
"text/n3"),(String
"txt",String
"text/plain"),(String
"text",String
"text/plain"),(String
"conf",String
"text/plain"),(String
"def",String
"text/plain"),(String
"list",String
"text/plain"),(String
"log",String
"text/plain"),(String
"in",String
"text/plain"),(String
"dsc",String
"text/prs.lines.tag"),(String
"rtx",String
"text/richtext"),(String
"sgml",String
"text/sgml"),(String
"sgm",String
"text/sgml"),(String
"tsv",String
"text/tab-separated-values"),(String
"t",String
"text/troff"),(String
"tr",String
"text/troff"),(String
"roff",String
"text/troff"),(String
"man",String
"text/troff"),(String
"me",String
"text/troff"),(String
"ms",String
"text/troff"),(String
"ttl",String
"text/turtle"),(String
"uri",String
"text/uri-list"),(String
"uris",String
"text/uri-list"),(String
"urls",String
"text/uri-list"),(String
"vcard",String
"text/vcard"),(String
"curl",String
"text/vnd.curl"),(String
"dcurl",String
"text/vnd.curl.dcurl"),(String
"mcurl",String
"text/vnd.curl.mcurl"),(String
"scurl",String
"text/vnd.curl.scurl"),(String
"sub",String
"text/vnd.dvb.subtitle"),(String
"fly",String
"text/vnd.fly"),(String
"flx",String
"text/vnd.fmi.flexstor"),(String
"gv",String
"text/vnd.graphviz"),(String
"3dml",String
"text/vnd.in3d.3dml"),(String
"spot",String
"text/vnd.in3d.spot"),(String
"jad",String
"text/vnd.sun.j2me.app-descriptor"),(String
"wml",String
"text/vnd.wap.wml"),(String
"wmls",String
"text/vnd.wap.wmlscript"),(String
"s",String
"text/x-asm"),(String
"asm",String
"text/x-asm"),(String
"c",String
"text/x-c"),(String
"cc",String
"text/x-c"),(String
"cxx",String
"text/x-c"),(String
"cpp",String
"text/x-c"),(String
"h",String
"text/x-c"),(String
"hh",String
"text/x-c"),(String
"dic",String
"text/x-c"),(String
"f",String
"text/x-fortran"),(String
"for",String
"text/x-fortran"),(String
"f77",String
"text/x-fortran"),(String
"f90",String
"text/x-fortran"),(String
"java",String
"text/x-java-source"),(String
"nfo",String
"text/x-nfo"),(String
"opml",String
"text/x-opml"),(String
"p",String
"text/x-pascal"),(String
"pas",String
"text/x-pascal"),(String
"etx",String
"text/x-setext"),(String
"sfv",String
"text/x-sfv"),(String
"uu",String
"text/x-uuencode"),(String
"vcs",String
"text/x-vcalendar"),(String
"vcf",String
"text/x-vcard"),(String
"3gp",String
"video/3gpp"),(String
"3g2",String
"video/3gpp2"),(String
"h261",String
"video/h261"),(String
"h263",String
"video/h263"),(String
"h264",String
"video/h264"),(String
"jpgv",String
"video/jpeg"),(String
"jpm",String
"video/jpm"),(String
"jpgm",String
"video/jpm"),(String
"mj2",String
"video/mj2"),(String
"mjp2",String
"video/mj2"),(String
"mp4",String
"video/mp4"),(String
"mp4v",String
"video/mp4"),(String
"mpg4",String
"video/mp4"),(String
"mpeg",String
"video/mpeg"),(String
"mpg",String
"video/mpeg"),(String
"mpe",String
"video/mpeg"),(String
"m1v",String
"video/mpeg"),(String
"m2v",String
"video/mpeg"),(String
"ogv",String
"video/ogg"),(String
"qt",String
"video/quicktime"),(String
"mov",String
"video/quicktime"),(String
"uvh",String
"video/vnd.dece.hd"),(String
"uvvh",String
"video/vnd.dece.hd"),(String
"uvm",String
"video/vnd.dece.mobile"),(String
"uvvm",String
"video/vnd.dece.mobile"),(String
"uvp",String
"video/vnd.dece.pd"),(String
"uvvp",String
"video/vnd.dece.pd"),(String
"uvs",String
"video/vnd.dece.sd"),(String
"uvvs",String
"video/vnd.dece.sd"),(String
"uvv",String
"video/vnd.dece.video"),(String
"uvvv",String
"video/vnd.dece.video"),(String
"dvb",String
"video/vnd.dvb.file"),(String
"fvt",String
"video/vnd.fvt"),(String
"mxu",String
"video/vnd.mpegurl"),(String
"m4u",String
"video/vnd.mpegurl"),(String
"pyv",String
"video/vnd.ms-playready.media.pyv"),(String
"uvu",String
"video/vnd.uvvu.mp4"),(String
"uvvu",String
"video/vnd.uvvu.mp4"),(String
"viv",String
"video/vnd.vivo"),(String
"webm",String
"video/webm"),(String
"f4v",String
"video/x-f4v"),(String
"fli",String
"video/x-fli"),(String
"flv",String
"video/x-flv"),(String
"m4v",String
"video/x-m4v"),(String
"mkv",String
"video/x-matroska"),(String
"mk3d",String
"video/x-matroska"),(String
"mks",String
"video/x-matroska"),(String
"mng",String
"video/x-mng"),(String
"asf",String
"video/x-ms-asf"),(String
"asx",String
"video/x-ms-asf"),(String
"vob",String
"video/x-ms-vob"),(String
"wm",String
"video/x-ms-wm"),(String
"wmv",String
"video/x-ms-wmv"),(String
"wmx",String
"video/x-ms-wmx"),(String
"wvx",String
"video/x-ms-wvx"),(String
"avi",String
"video/x-msvideo"),(String
"movie",String
"video/x-sgi-movie"),(String
"smv",String
"video/x-smv"),(String
"ice",String
"x-conference/x-cooltalk")]