{-# 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 -> FilePath -> Maybe FilePath
guessContentType MimeMap
mimeMap FilePath
filepath =
    case FilePath -> FilePath
getExt FilePath
filepath of
      FilePath
"" -> Maybe FilePath
forall a. Maybe a
Nothing
      FilePath
ext -> FilePath -> MimeMap -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
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 :: MimeMap -> FilePath -> m FilePath
guessContentTypeM MimeMap
mimeMap FilePath
filePath = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"application/octet-stream" (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ MimeMap -> FilePath -> Maybe FilePath
guessContentType MimeMap
mimeMap FilePath
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 :: FilePath -> FilePath -> m FilePath
asContentType = m FilePath -> FilePath -> m FilePath
forall a b. a -> b -> a
const (m FilePath -> FilePath -> m FilePath)
-> (FilePath -> m FilePath) -> FilePath -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m FilePath
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 :: [FilePath]
defaultIxFiles= [FilePath
"index.html",FilePath
"index.xml",FilePath
"index.gif"]

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

-- | Similar to 'takeExtension' but does not include the extension separator char
getExt :: FilePath -> String
getExt :: FilePath -> FilePath
getExt FilePath
fp = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeExtension FilePath
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
    | FilePath -> Bool
isDot ([FilePath] -> FilePath
joinPath (Request -> [FilePath]
rqPaths Request
rq)) = Response -> IO Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> Response
result Int
403 FilePath
"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 :: FilePath -> Bool
isDot = FilePath -> Bool
isD (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse
    where
    isD :: FilePath -> Bool
isD (Char
'.':Char
'/':FilePath
_) = Bool
True
    isD [Char
'.']       = Bool
True
    --isD ('/':_)     = False
    isD (Char
_:FilePath
cs)      = FilePath -> Bool
isD FilePath
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 :: FilePath
-> FilePath
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
sendFileResponse FilePath
ct FilePath
filePath Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((FilePath -> FilePath -> Response -> Response
forall r. HasHeaders r => FilePath -> FilePath -> r -> r
setHeader FilePath
"Content-Type" FilePath
ct) (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
               (Int
-> Headers
-> RsFlags
-> Maybe (Response -> IO Response)
-> FilePath
-> Integer
-> Integer
-> Response
SendFile Int
200 Headers
forall k a. Map k a
Map.empty (RsFlags
nullRsFlags { rsfLength :: Length
rsfLength = Length
ContentLength }) Maybe (Response -> IO Response)
forall a. Maybe a
Nothing FilePath
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 :: FilePath
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
lazyByteStringResponse FilePath
ct ByteString
body Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((FilePath -> FilePath -> Response -> Response
forall r. HasHeaders r => FilePath -> FilePath -> r -> r
setHeader FilePath
"Content-Type" FilePath
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 :: FilePath
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
strictByteStringResponse FilePath
ct ByteString
body Maybe (UTCTime, Request)
mModTime Integer
offset Integer
count =
    let res :: Response
res = ((FilePath -> FilePath -> Response -> Response
forall r. HasHeaders r => FilePath -> FilePath -> r -> r
setHeader FilePath
"Content-Type" FilePath
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 :: FilePath -> FilePath -> m Response
filePathSendFile FilePath
contentType FilePath
fp =
    do Integer
count   <- IO Integer -> m Integer
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
$ FilePath -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
ReadMode Handle -> IO Integer
hFileSize -- garbage collection should close this
       UTCTime
modtime <- IO UTCTime -> m UTCTime
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
$ FilePath -> IO UTCTime
getModificationTime FilePath
fp
       Request
rq      <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
sendFileResponse FilePath
contentType FilePath
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 :: FilePath -> FilePath -> m Response
filePathLazy FilePath
contentType FilePath
fp =
    do Handle
handle   <- IO Handle -> m Handle
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
$ FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
ReadMode -- garbage collection should close this
       ByteString
contents <- IO ByteString -> m ByteString
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ FilePath -> IO UTCTime
getModificationTime FilePath
fp
       Integer
count    <- IO Integer -> m Integer
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 (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ FilePath
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
lazyByteStringResponse FilePath
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 :: FilePath -> FilePath -> m Response
filePathStrict FilePath
contentType FilePath
fp =
    do ByteString
contents <- IO ByteString -> m ByteString
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
$ FilePath -> IO ByteString
S.readFile FilePath
fp
       UTCTime
modtime  <- IO UTCTime -> m UTCTime
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
$ FilePath -> IO UTCTime
getModificationTime FilePath
fp
       Integer
count    <- IO Integer -> m Integer
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
$ FilePath -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
ReadMode Handle -> IO Integer
hFileSize
       Request
rq       <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ FilePath
-> ByteString
-> Maybe (UTCTime, Request)
-> Integer
-> Integer
-> Response
strictByteStringResponse FilePath
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 :: (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> FilePath -> m Response
serveFileUsing FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath
fp =
    do Bool
fe <- IO Bool -> m Bool
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
$ FilePath -> IO Bool
doesFileExist FilePath
fp
       if Bool
fe
          then do FilePath
mt <- FilePath -> m FilePath
mimeFn FilePath
fp
                  FilePath -> FilePath -> m Response
serveFn FilePath
mt FilePath
fp
          else m Response
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 :: (FilePath -> m FilePath) -> FilePath -> m Response
serveFile = (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> FilePath -> m Response
serveFileUsing FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> 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 :: FilePath -> (FilePath -> m FilePath) -> FilePath -> m Response
serveFileFrom FilePath
root FilePath -> m FilePath
mimeFn FilePath
fp =
    m Response
-> (FilePath -> m Response) -> Maybe FilePath -> m Response
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Response
no FilePath -> m Response
yes (Maybe FilePath -> m Response) -> Maybe FilePath -> m Response
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Maybe FilePath
combineSafe FilePath
root FilePath
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
$ FilePath -> Response
forall a. ToMessage a => a -> Response
toResponse FilePath
"Directory traversal forbidden"
    yes :: FilePath -> m Response
yes = (FilePath -> m FilePath) -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> m FilePath) -> FilePath -> m Response
serveFile FilePath -> m FilePath
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' :: (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
fileServe' FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath -> m Response
indexFn FilePath
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
$ [FilePath] -> Bool
isSafePath (Request -> [FilePath]
rqPaths Request
rq))
       then do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Priority -> FilePath -> IO ()
logM FilePath
"Happstack.Server.FileServe" Priority
DEBUG (FilePath
"fileServe: unsafe filepath " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show (Request -> [FilePath]
rqPaths Request
rq))
               m Response
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       else do let fp :: FilePath
fp = [FilePath] -> FilePath
joinPath (FilePath
localPath FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Request -> [FilePath]
rqPaths Request
rq)
               Bool
fe <- IO Bool -> m Bool
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
$ FilePath -> IO Bool
doesFileExist FilePath
fp
               Bool
de <- IO Bool -> m Bool
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
$ FilePath -> IO Bool
doesDirectoryExist FilePath
fp
               let status :: FilePath
status | Bool
de   = FilePath
"DIR"
                          | Bool
fe   = FilePath
"file"
                          | Bool
True = FilePath
"NOT FOUND"
               IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Priority -> FilePath -> IO ()
logM FilePath
"Happstack.Server.FileServe" Priority
DEBUG (FilePath
"fileServe: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fpFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
" \t"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
status)
               if Bool
de
                  then if FilePath -> Char
forall a. [a] -> a
last (Request -> FilePath
rqUri Request
rq) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
                          then FilePath -> m Response
indexFn FilePath
fp
                          else do let path' :: FilePath
path' = FilePath -> FilePath
addTrailingPathSeparator (Request -> FilePath
rqUri Request
rq)
                                  FilePath -> Response -> m Response
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther FilePath
path' (FilePath -> Response
forall a. ToMessage a => a -> Response
toResponse FilePath
path')
                  else if Bool
fe
                          then (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> FilePath -> m Response
serveFileUsing FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath
fp
                          else m Response
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 :: FilePath -> FilePath -> Maybe FilePath
combineSafe FilePath
root FilePath
path =
    if [FilePath] -> FilePath
commonPrefix [FilePath
root', FilePath
joined] FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
root'
      then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
encodeString FilePath
joined
      else Maybe FilePath
forall a. Maybe a
Nothing
  where
    root' :: FilePath
root'  = FilePath -> FilePath
decodeString FilePath
root
    path' :: FilePath
path'  = FilePath -> FilePath
decodeString FilePath
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 :: [FilePath] -> Bool
isSafePath [] = Bool
True
isSafePath (FilePath
s:[FilePath]
ss) =
     FilePath -> Bool
isValid FilePath
s
  Bool -> Bool -> Bool
&& ((Char -> Bool) -> FilePath -> 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) FilePath
s)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasDrive FilePath
s)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
isParent FilePath
s)
  Bool -> Bool -> Bool
&& [FilePath] -> Bool
isSafePath [FilePath]
ss

-- note: could be different on other OSs
isParent :: FilePath -> Bool
isParent :: FilePath -> Bool
isParent FilePath
".." = Bool
True
isParent FilePath
_    = 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 :: [FilePath] -> FilePath -> m Response
fileServe [FilePath]
ixFiles FilePath
localPath =
    (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
fileServe' FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath -> m Response
indexFn FilePath
localPath
        where
          serveFn :: FilePath -> FilePath -> m Response
serveFn    = FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathSendFile
          mimeFn :: FilePath -> m FilePath
mimeFn     = MimeMap -> FilePath -> m FilePath
forall (m :: * -> *). Monad m => MimeMap -> FilePath -> m FilePath
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [FilePath]
indexFiles = ([FilePath]
ixFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
defaultIxFiles)
          indexFn :: FilePath -> m Response
indexFn    = (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
doIndex' FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathSendFile FilePath -> m FilePath
mimeFn [FilePath]
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 :: [FilePath] -> FilePath -> m Response
fileServeLazy [FilePath]
ixFiles FilePath
localPath =
    (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
fileServe' FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath -> m Response
indexFn FilePath
localPath
        where
          serveFn :: FilePath -> FilePath -> m Response
serveFn    = FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathLazy
          mimeFn :: FilePath -> m FilePath
mimeFn     = MimeMap -> FilePath -> m FilePath
forall (m :: * -> *). Monad m => MimeMap -> FilePath -> m FilePath
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [FilePath]
indexFiles = ([FilePath]
ixFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
defaultIxFiles)
          indexFn :: FilePath -> m Response
indexFn    = (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
doIndex' FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathSendFile FilePath -> m FilePath
mimeFn [FilePath]
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 :: [FilePath] -> FilePath -> m Response
fileServeStrict [FilePath]
ixFiles FilePath
localPath =
    (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
 MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath)
-> (FilePath -> m Response)
-> FilePath
-> m Response
fileServe' FilePath -> FilePath -> m Response
serveFn FilePath -> m FilePath
mimeFn FilePath -> m Response
indexFn FilePath
localPath
        where
          serveFn :: FilePath -> FilePath -> m Response
serveFn    = FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathStrict
          mimeFn :: FilePath -> m FilePath
mimeFn     = MimeMap -> FilePath -> m FilePath
forall (m :: * -> *). Monad m => MimeMap -> FilePath -> m FilePath
guessContentTypeM MimeMap
mimeTypes
          indexFiles :: [FilePath]
indexFiles = ([FilePath]
ixFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
defaultIxFiles)
          indexFn :: FilePath -> m Response
indexFn    = (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
doIndex' FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathSendFile FilePath -> m FilePath
mimeFn [FilePath]
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 :: [FilePath] -> MimeMap -> FilePath -> m Response
doIndex [FilePath]
ixFiles MimeMap
mimeMap FilePath
localPath = (FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> FilePath -> m Response)
-> (FilePath -> m FilePath) -> [FilePath] -> FilePath -> m Response
doIndex' FilePath -> FilePath -> m Response
forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
FilePath -> FilePath -> m Response
filePathSendFile (MimeMap -> FilePath -> m FilePath
forall (m :: * -> *). Monad m => MimeMap -> FilePath -> m FilePath
guessContentTypeM MimeMap
mimeMap) [FilePath]
ixFiles FilePath
localPath

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

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

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