    {-# LANGUAGE BangPatterns        #-}
    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- | Contains web handlers to serve files from a directory.
    module Snap.Internal.Util.FileServe
      ( -- * Helper functions
        getSafePath
        -- * Configuration for directory serving
      , MimeMap
      , HandlerMap
      , DirectoryConfig(..)
      , simpleDirectoryConfig
      , defaultDirectoryConfig
      , fancyDirectoryConfig
      , defaultIndexGenerator
      , defaultMimeTypes
      , fileType
        -- * File servers
      , serveDirectory
      , serveDirectoryWith
      , serveFile
      , serveFileAs
        -- * Internal functions
      , decodeFilePath
      , checkRangeReq
      ) where

    ------------------------------------------------------------------------------
    import           Control.Applicative              (Alternative ((<|>)), Applicative ((*>), (<*)), (<$>))
    import           Control.Exception.Lifted         (SomeException, catch, evaluate)
    import           Control.Monad                    (Monad ((>>), (>>=), return), filterM, forM_, liftM, unless, void, when, (=<<))
    import           Control.Monad.IO.Class           (MonadIO (..))
    import           Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, option, string)
    import           Data.ByteString.Builder          (Builder, byteString, char8, stringUtf8, toLazyByteString)
    import           Data.ByteString.Char8            (ByteString)
    import qualified Data.ByteString.Char8            as S (append, concat, intercalate, isSuffixOf, null, pack, takeWhile)
    import qualified Data.ByteString.Lazy.Char8       as L
    import           Data.HashMap.Strict              (HashMap)
    import qualified Data.HashMap.Strict              as Map (empty, fromList, lookup)
    import           Data.List                        (drop, dropWhile, elem, filter, foldl', null, sort, (++))
    import           Data.Maybe                       (fromMaybe, isNothing)
    import           Data.Monoid                      (Monoid (mappend, mconcat))
    import qualified Data.Text                        as T (Text, pack, unpack)
    import qualified Data.Text.Encoding               as T (decodeUtf8, encodeUtf8)
    import           Data.Word                        (Word64)
    import           Prelude                          (Bool (..), Eq (..), FilePath, IO, Maybe (Just, Nothing), Num (..), Ord (..), Show (show), String, const, either, flip, fromIntegral, id, maybe, not, ($), ($!), (.), (||))
    import qualified Prelude
    import           Snap.Core                        (MonadSnap (..), Request (rqPathInfo, rqQueryString, rqURI), deleteHeader, emptyResponse, finishWith, formatHttpTime, getHeader, getRequest, modifyResponse, parseHttpTime, pass, redirect, sendFile, sendFilePartial, setContentLength, setContentType, setHeader, setResponseBody, setResponseCode, urlDecode, writeBS)
    import           Snap.Internal.Debug              (debug)
    import           Snap.Internal.Parsing            (fullyParse, parseNum)
    import           System.Directory                 (doesDirectoryExist, doesFileExist, getDirectoryContents)
    import           System.FilePath                  (isRelative, joinPath, splitDirectories, takeExtensions, takeFileName, (</>))
    import           System.PosixCompat.Files         (fileSize, getFileStatus, modificationTime)

    ------------------------------------------------------------------------------
    -- | Gets a path from the 'Request' using 'rqPathInfo' and makes sure it is
    -- safe to use for opening files.  A path is safe if it is a relative path
    -- and has no ".." elements to escape the intended directory structure.
    --
    -- Example:
    --
    -- @
    -- ghci> :set -XOverloadedStrings
    -- ghci> import qualified "Data.Map" as M
    -- ghci> import qualified "Snap.Test" as T
    -- ghci> import qualified "Data.ByteString.Char8" as B8
    -- ghci> T.runHandler (T.get \"\/foo\/bar\" M.empty) ('getSafePath' >>= 'writeBS' . B8.pack)
    -- HTTP\/1.1 200 OK
    -- server: Snap\/test
    -- date: Fri, 08 Aug 2014 16:13:20 GMT
    --
    -- foo\/bar
    -- ghci> T.runHandler (T.get \"\/foo\/..\/bar\" M.empty) ('getSafePath' >>= 'writeBS' . B8.pack)
    -- HTTP\/1.1 404 Not Found
    -- ...
    -- @
    getSafePath :: MonadSnap m => m FilePath
    getSafePath :: forall (m :: * -> *). MonadSnap m => m FilePath
    getSafePath = do
        req <- m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
        let mp = ByteString -> Maybe ByteString
    urlDecode (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString
    rqPathInfo Request
    req

        p <- maybe pass (return . T.unpack . T.decodeUtf8) mp

        -- relative paths only!
        when (not $ isRelative p) pass

        -- check that we don't have any sneaky .. paths
        let dirs = FilePath -> [FilePath]
    splitDirectories FilePath
    p
        when (elem ".." dirs) pass

        return $! joinPath dirs

    ------------------------------------------------------------------------------
    -- | A type alias for dynamic handlers
    type HandlerMap m = HashMap FilePath (FilePath -> m ())

    ------------------------------------------------------------------------------
    -- | A type alias for MIME type
    type MimeMap = HashMap FilePath ByteString

    ------------------------------------------------------------------------------
    -- | The default set of mime type mappings we use when serving files. Its
    -- value:
    --
    -- > Map.fromList [
    -- >   ( ".asc"     , "text/plain"                                             ),
    -- >   ( ".asf"     , "video/x-ms-asf"                                         ),
    -- >   ( ".asx"     , "video/x-ms-asf"                                         ),
    -- >   ( ".au"      , "audio/basic"                                            ),
    -- >   ( ".avi"     , "video/x-msvideo"                                        ),
    -- >   ( ".bmp"     , "image/bmp"                                              ),
    -- >   ( ".bz2"     , "application/x-bzip"                                     ),
    -- >   ( ".c"       , "text/plain"                                             ),
    -- >   ( ".class"   , "application/octet-stream"                               ),
    -- >   ( ".conf"    , "text/plain"                                             ),
    -- >   ( ".cpp"     , "text/plain"                                             ),
    -- >   ( ".css"     , "text/css"                                               ),
    -- >   ( ".csv"     , "text/csv"                                               ),
    -- >   ( ".cxx"     , "text/plain"                                             ),
    -- >   ( ".doc"     , "application/msword"                                     ),
    -- >   ( ".docx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".wordprocessingml.document"                    ),
    -- >   ( ".dotx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".wordprocessingml.template"                    ),
    -- >   ( ".dtd"     , "application/xml-dtd"                                    ),
    -- >   ( ".dvi"     , "application/x-dvi"                                      ),
    -- >   ( ".exe"     , "application/octet-stream"                               ),
    -- >   ( ".flv"     , "video/x-flv"                                            ),
    -- >   ( ".gif"     , "image/gif"                                              ),
    -- >   ( ".gz"      , "application/x-gzip"                                     ),
    -- >   ( ".hs"      , "text/plain"                                             ),
    -- >   ( ".htm"     , "text/html"                                              ),
    -- >   ( ".html"    , "text/html"                                              ),
    -- >   ( ".ico"     , "image/x-icon"                                           ),
    -- >   ( ".jar"     , "application/x-java-archive"                             ),
    -- >   ( ".jpeg"    , "image/jpeg"                                             ),
    -- >   ( ".jpg"     , "image/jpeg"                                             ),
    -- >   ( ".js"      , "text/javascript"                                        ),
    -- >   ( ".json"    , "application/json"                                       ),
    -- >   ( ".log"     , "text/plain"                                             ),
    -- >   ( ".m3u"     , "audio/x-mpegurl"                                        ),
    -- >   ( ".m3u8"    , "application/x-mpegURL"                                  ),
    -- >   ( ".mka"     , "audio/x-matroska"                                       ),
    -- >   ( ".mk3d"    , "video/x-matroska"                                       ),
    -- >   ( ".mkv"     , "video/x-matroska"                                       ),
    -- >   ( ".mov"     , "video/quicktime"                                        ),
    -- >   ( ".mp3"     , "audio/mpeg"                                             ),
    -- >   ( ".mp4"     , "video/mp4"                                              ),
    -- >   ( ".mpeg"    , "video/mpeg"                                             ),
    -- >   ( ".mpg"     , "video/mpeg"                                             ),
    -- >   ( ".ogg"     , "application/ogg"                                        ),
    -- >   ( ".pac"     , "application/x-ns-proxy-autoconfig"                      ),
    -- >   ( ".pdf"     , "application/pdf"                                        ),
    -- >   ( ".png"     , "image/png"                                              ),
    -- >   ( ".potx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".presentationml.template"                      ),
    -- >   ( ".ppsx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".presentationml.slideshow"                     ),
    -- >   ( ".ppt"     , "application/vnd.ms-powerpoint"                          ),
    -- >   ( ".pptx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".presentationml.presentation"                  ),
    -- >   ( ".ps"      , "application/postscript"                                 ),
    -- >   ( ".qt"      , "video/quicktime"                                        ),
    -- >   ( ".rtf"     , "text/rtf"                                               ),
    -- >   ( ".sig"     , "application/pgp-signature"                              ),
    -- >   ( ".sldx"    , S.append "application/vnd.openxmlformats-officedocument"
    -- >                           ".presentationml.slide"                         ),
    -- >   ( ".spl"     , "application/futuresplash"                               ),
    -- >   ( ".svg"     , "image/svg+xml"                                          ),
    -- >   ( ".swf"     , "application/x-shockwave-flash"                          ),
    -- >   ( ".tar"     , "application/x-tar"                                      ),
    -- >   ( ".tar.bz2" , "application/x-bzip-compressed-tar"                      ),
    -- >   ( ".tar.gz"  , "application/x-tgz"                                      ),
    -- >   ( ".tbz"     , "application/x-bzip-compressed-tar"                      ),
    -- >   ( ".text"    , "text/plain"                                             ),
    -- >   ( ".tgz"     , "application/x-tgz"                                      ),
    -- >   ( ".tif"     , "image/tiff"                                             ),
    -- >   ( ".tiff"    , "image/tiff"                                             ),
    -- >   ( ".torrent" , "application/x-bittorrent"                               ),
    -- >   ( ".ts"      , "video/mp2t"                                             ),
    -- >   ( ".txt"     , "text/plain"                                             ),
    -- >   ( ".wav"     , "audio/x-wav"                                            ),
    -- >   ( ".wax"     , "audio/x-ms-wax"                                         ),
    -- >   ( ".webm"    , "video/webm"                                             ),
    -- >   ( ".wma"     , "audio/x-ms-wma"                                         ),
    -- >   ( ".wmv"     , "video/x-ms-wmv"                                         ),
    -- >   ( ".xbm"     , "image/x-xbitmap"                                        ),
    -- >   ( ".xlam"    , "application/vnd.ms-excel.addin.macroEnabled.12"         ),
    -- >   ( ".xls"     , "application/vnd.ms-excel"                               ),
    -- >   ( ".xlsb"    , "application/vnd.ms-excel.sheet.binary.macroEnabled.12"  ),
    -- >   ( ".xlsx"    , S.append "application/vnd.openxmlformats-officedocument."
    -- >                           "spreadsheetml.sheet"                           ),
    -- >   ( ".xltx"    , S.append "application/vnd.openxmlformats-officedocument."
    -- >                           "spreadsheetml.template"                        ),
    -- >   ( ".xml"     , "text/xml"                                               ),
    -- >   ( ".xpm"     , "image/x-xpixmap"                                        ),
    -- >   ( ".xwd"     , "image/x-xwindowdump"                                    ),
    -- >   ( ".zip"     , "application/zip"                                        ) ]

    defaultMimeTypes :: MimeMap
    defaultMimeTypes :: MimeMap
    defaultMimeTypes =
      [(FilePath, ByteString)] -> MimeMap
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList [
        ( FilePath
    ".asc"     , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".asf"     , ByteString
    "video/x-ms-asf"                                         ),
        ( FilePath
    ".asx"     , ByteString
    "video/x-ms-asf"                                         ),
        ( FilePath
    ".au"      , ByteString
    "audio/basic"                                            ),
        ( FilePath
    ".avi"     , ByteString
    "video/x-msvideo"                                        ),
        ( FilePath
    ".bmp"     , ByteString
    "image/bmp"                                              ),
        ( FilePath
    ".bz2"     , ByteString
    "application/x-bzip"                                     ),
        ( FilePath
    ".c"       , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".class"   , ByteString
    "application/octet-stream"                               ),
        ( FilePath
    ".conf"    , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".cpp"     , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".css"     , ByteString
    "text/css"                                               ),
        ( FilePath
    ".csv"     , ByteString
    "text/csv"                                               ),
        ( FilePath
    ".cxx"     , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".doc"     , ByteString
    "application/msword"                                     ),
        ( FilePath
    ".docx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".wordprocessingml.document"                    ),
        ( FilePath
    ".dotx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".wordprocessingml.template"                    ),
        ( FilePath
    ".dtd"     , ByteString
    "application/xml-dtd"                                    ),
        ( FilePath
    ".dvi"     , ByteString
    "application/x-dvi"                                      ),
        ( FilePath
    ".exe"     , ByteString
    "application/octet-stream"                               ),
        ( FilePath
    ".flv"     , ByteString
    "video/x-flv"                                            ),
        ( FilePath
    ".gif"     , ByteString
    "image/gif"                                              ),
        ( FilePath
    ".gz"      , ByteString
    "application/x-gzip"                                     ),
        ( FilePath
    ".hs"      , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".htm"     , ByteString
    "text/html"                                              ),
        ( FilePath
    ".html"    , ByteString
    "text/html"                                              ),
        ( FilePath
    ".ico"     , ByteString
    "image/x-icon"                                           ),
        ( FilePath
    ".jar"     , ByteString
    "application/x-java-archive"                             ),
        ( FilePath
    ".jpeg"    , ByteString
    "image/jpeg"                                             ),
        ( FilePath
    ".jpg"     , ByteString
    "image/jpeg"                                             ),
        ( FilePath
    ".js"      , ByteString
    "text/javascript"                                        ),
        ( FilePath
    ".json"    , ByteString
    "application/json"                                       ),
        ( FilePath
    ".log"     , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".m3u"     , ByteString
    "audio/x-mpegurl"                                        ),
        ( FilePath
    ".m3u8"    , ByteString
    "application/x-mpegURL"                                  ),
        ( FilePath
    ".mka"     , ByteString
    "audio/x-matroska"                                       ),
        ( FilePath
    ".mk3d"    , ByteString
    "video/x-matroska"                                       ),
        ( FilePath
    ".mkv"     , ByteString
    "video/x-matroska"                                       ),
        ( FilePath
    ".mov"     , ByteString
    "video/quicktime"                                        ),
        ( FilePath
    ".mp3"     , ByteString
    "audio/mpeg"                                             ),
        ( FilePath
    ".mp4"     , ByteString
    "video/mp4"                                              ),
        ( FilePath
    ".mpeg"    , ByteString
    "video/mpeg"                                             ),
        ( FilePath
    ".mpg"     , ByteString
    "video/mpeg"                                             ),
        ( FilePath
    ".ogg"     , ByteString
    "application/ogg"                                        ),
        ( FilePath
    ".pac"     , ByteString
    "application/x-ns-proxy-autoconfig"                      ),
        ( FilePath
    ".pdf"     , ByteString
    "application/pdf"                                        ),
        ( FilePath
    ".png"     , ByteString
    "image/png"                                              ),
        ( FilePath
    ".potx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".presentationml.template"                      ),
        ( FilePath
    ".ppsx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".presentationml.slideshow"                     ),
        ( FilePath
    ".ppt"     , ByteString
    "application/vnd.ms-powerpoint"                          ),
        ( FilePath
    ".pptx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".presentationml.presentation"                  ),
        ( FilePath
    ".ps"      , ByteString
    "application/postscript"                                 ),
        ( FilePath
    ".qt"      , ByteString
    "video/quicktime"                                        ),
        ( FilePath
    ".rtf"     , ByteString
    "text/rtf"                                               ),
        ( FilePath
    ".sig"     , ByteString
    "application/pgp-signature"                              ),
        ( FilePath
    ".sldx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument"
                                ByteString
    ".presentationml.slide"                         ),
        ( FilePath
    ".spl"     , ByteString
    "application/futuresplash"                               ),
        ( FilePath
    ".svg"     , ByteString
    "image/svg+xml"                                          ),
        ( FilePath
    ".swf"     , ByteString
    "application/x-shockwave-flash"                          ),
        ( FilePath
    ".tar"     , ByteString
    "application/x-tar"                                      ),
        ( FilePath
    ".tar.bz2" , ByteString
    "application/x-bzip-compressed-tar"                      ),
        ( FilePath
    ".tar.gz"  , ByteString
    "application/x-tgz"                                      ),
        ( FilePath
    ".tbz"     , ByteString
    "application/x-bzip-compressed-tar"                      ),
        ( FilePath
    ".text"    , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".tgz"     , ByteString
    "application/x-tgz"                                      ),
        ( FilePath
    ".tiff"    , ByteString
    "image/tiff"                                             ),
        ( FilePath
    ".tif"     , ByteString
    "image/tiff"                                             ),
        ( FilePath
    ".torrent" , ByteString
    "application/x-bittorrent"                               ),
        ( FilePath
    ".ts"      , ByteString
    "video/mp2t"                                             ),
        ( FilePath
    ".ttf"     , ByteString
    "font/ttf"                                               ),
        ( FilePath
    ".txt"     , ByteString
    "text/plain"                                             ),
        ( FilePath
    ".wav"     , ByteString
    "audio/x-wav"                                            ),
        ( FilePath
    ".wax"     , ByteString
    "audio/x-ms-wax"                                         ),
        ( FilePath
    ".webm"    , ByteString
    "video/webm"                                             ),
        ( FilePath
    ".wma"     , ByteString
    "audio/x-ms-wma"                                         ),
        ( FilePath
    ".wmv"     , ByteString
    "video/x-ms-wmv"                                         ),
        ( FilePath
    ".xbm"     , ByteString
    "image/x-xbitmap"                                        ),
        ( FilePath
    ".xlam"    , ByteString
    "application/vnd.ms-excel.addin.macroEnabled.12"         ),
        ( FilePath
    ".xls"     , ByteString
    "application/vnd.ms-excel"                               ),
        ( FilePath
    ".xlsb"    , ByteString
    "application/vnd.ms-excel.sheet.binary.macroEnabled.12"  ),
        ( FilePath
    ".xlsx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument."
                                ByteString
    "spreadsheetml.sheet"                           ),
        ( FilePath
    ".xltx"    , ByteString -> ByteString -> ByteString
    S.append ByteString
    "application/vnd.openxmlformats-officedocument."
                                ByteString
    "spreadsheetml.template"                        ),
        ( FilePath
    ".xml"     , ByteString
    "text/xml"                                               ),
        ( FilePath
    ".xpm"     , ByteString
    "image/x-xpixmap"                                        ),
        ( FilePath
    ".xwd"     , ByteString
    "image/x-xwindowdump"                                    ),
        ( FilePath
    ".zip"     , ByteString
    "application/zip"                                        ) ]

    ------------------------------------------------------------------------------
    -- | A collection of options for serving static files out of a directory.
    data DirectoryConfig m = DirectoryConfig {
        -- | Files to look for when a directory is requested (e.g., index.html)
        forall (m :: * -> *). DirectoryConfig m -> [FilePath]
    indexFiles      :: [FilePath],

        -- | Handler to generate a directory listing if there is no index.
        forall (m :: * -> *). DirectoryConfig m -> FilePath -> m ()
    indexGenerator  :: FilePath -> m (),

        -- | Map of extensions to pass to dynamic file handlers.  This could be
        -- used, for example, to implement CGI dispatch, pretty printing of source
        -- code, etc.
        forall (m :: * -> *). DirectoryConfig m -> HandlerMap m
    dynamicHandlers :: HandlerMap m,

        -- | MIME type map to look up content types.
        forall (m :: * -> *). DirectoryConfig m -> MimeMap
    mimeTypes       :: MimeMap,

        -- | Handler that is called before a file is served.  It will only be
        -- called when a file is actually found, not for generated index pages.
        forall (m :: * -> *). DirectoryConfig m -> FilePath -> m ()
    preServeHook    :: FilePath -> m ()
        }

    ------------------------------------------------------------------------------
    -- | Style information for the default directory index generator.
    snapIndexStyles :: ByteString
    snapIndexStyles :: ByteString
    snapIndexStyles =
        ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "\n"
            [ ByteString
    "body { margin: 0px 0px 0px 0px; font-family: sans-serif }"
            , ByteString
    "div.header {"
            ,     ByteString
    "padding: 40px 40px 0px 40px; height:35px;"
            ,     ByteString
    "background:rgb(25,50,87);"
            ,     ByteString
    "background-image:-webkit-gradient("
            ,         ByteString
    "linear,left bottom,left top,"
            ,         ByteString
    "color-stop(0.00, rgb(31,62,108)),"
            ,         ByteString
    "color-stop(1.00, rgb(19,38,66)));"
            ,     ByteString
    "background-image:-moz-linear-gradient("
            ,         ByteString
    "center bottom,rgb(31,62,108) 0%,rgb(19,38,66) 100%);"
            ,     ByteString
    "text-shadow:-1px 3px 1px rgb(16,33,57);"
            ,     ByteString
    "font-size:16pt; letter-spacing: 2pt; color:white;"
            ,     ByteString
    "border-bottom:10px solid rgb(46,93,156) }"
            , ByteString
    "div.content {"
            ,     ByteString
    "background:rgb(255,255,255);"
            ,     ByteString
    "background-image:-webkit-gradient("
            ,         ByteString
    "linear,left bottom, left top,"
            ,         ByteString
    "color-stop(0.50, rgb(255,255,255)),"
            ,         ByteString
    "color-stop(1.00, rgb(224,234,247)));"
            ,     ByteString
    "background-image:-moz-linear-gradient("
            ,         ByteString
    "center bottom, white 50%, rgb(224,234,247) 100%);"
            ,     ByteString
    "padding: 40px 40px 40px 40px }"
            , ByteString
    "div.footer {"
            ,     ByteString
    "padding: 16px 0px 10px 10px; height:31px;"
            ,     ByteString
    "border-top: 1px solid rgb(194,209,225);"
            ,     ByteString
    "color: rgb(160,172,186); font-size:10pt;"
            ,     ByteString
    "background: rgb(245,249,255) }"
            , ByteString
    "table { max-width:100%; margin: 0 auto;" ByteString -> ByteString -> ByteString
    `S.append`
              ByteString
    " border-collapse: collapse; }"
            , ByteString
    "tr:hover { background:rgb(256,256,224) }"
            , ByteString
    "td { border:0; font-family:monospace; padding: 2px 0; }"
            , ByteString
    "td.filename, td.type { padding-right: 2em; }"
            , ByteString
    "th { border:0; background:rgb(28,56,97);"
            ,      ByteString
    "text-shadow:-1px 3px 1px rgb(16,33,57); color: white}"
            ]

    ------------------------------------------------------------------------------
    -- | An automatic index generator, which is fairly small and does not rely on
    -- any external files (which may not be there depending on external request
    -- routing).
    --
    -- A 'MimeMap' is passed in to display the types of files in the directory
    -- listing based on their extension.  Preferably, this is the same as the map
    -- in the 'DirectoryConfig'
    --
    -- The styles parameter allows you to apply styles to the directory listing.
    -- The listing itself consists of a table, containing a header row using
    -- th elements, and one row per file using td elements, so styles for those
    -- pieces may be attached to the appropriate tags.
    defaultIndexGenerator :: MonadSnap m
                          => MimeMap    -- ^ MIME type mapping for reporting types
                          -> ByteString -- ^ Style info to insert in header
                          -> FilePath   -- ^ Directory to generate index for
                          -> m ()
    defaultIndexGenerator :: forall (m :: * -> *).
    MonadSnap m =>
    MimeMap -> ByteString -> FilePath -> m ()
    defaultIndexGenerator MimeMap
    mm ByteString
    styles FilePath
    d = do
        (Response -> Response) -> m ()
    forall (m :: * -> *). MonadSnap m => (Response -> Response) -> m ()
    modifyResponse ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Response -> Response
    setContentType ByteString
    "text/html; charset=utf-8"
        rq      <- m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest

        let uri   = Request -> ByteString
    uriWithoutQueryString Request
    rq
        let pInfo = Request -> ByteString
    rqPathInfo Request
    rq

        writeBS "<!DOCTYPE html>\n<html>\n<head>"
        writeBS "<title>Directory Listing: "
        writeBS uri
        writeBS "</title>"
        writeBS "<style type='text/css'>"
        writeBS styles
        writeBS "</style></head><body>"
        writeBS "<div class=\"header\">Directory Listing: "
        writeBS uri
        writeBS "</div><div class=\"content\">"
        writeBS "<table><tr><th>File Name</th><th>Type</th><th>Last Modified"
        writeBS "</th></tr>"

        when (pInfo /= "") $
            writeBS "<tr><td><a href='../'>..</a></td><td colspan=2>DIR</td></tr>"

        entries <- liftIO $ getDirectoryContents d
        dirs    <- liftIO $ filterM (doesDirectoryExist . (d </>)) entries
        files   <- liftIO $ filterM (doesFileExist . (d </>)) entries

        forM_ (sort $ filter (not . (`elem` ["..", "."])) dirs) $ \FilePath
    f0 -> do
            f <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ (Text -> ByteString) -> IO Text -> IO ByteString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\Text
    s -> Text -> ByteString
    T.encodeUtf8 Text
    s ByteString -> ByteString -> ByteString
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString
    "/")
                        (IO Text -> IO ByteString) -> IO Text -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Text
    decodeFilePath FilePath
    f0
            writeBS "<tr><td class='filename'><a href='"
            writeBS f
            writeBS "'>"
            writeBS f
            writeBS "</a></td><td class='type' colspan=2>DIR</td></tr>"

        forM_ (sort files) $ \FilePath
    f0 -> do
            f <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ (Text -> ByteString) -> IO Text -> IO ByteString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Text -> ByteString
    T.encodeUtf8 (IO Text -> IO ByteString) -> IO Text -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Text
    decodeFilePath FilePath
    f0
            stat <- liftIO $ getFileStatus (d </> f0)
            tm   <- liftIO $ formatHttpTime (modificationTime stat)
            writeBS "<tr><td class='filename'><a href='"
            writeBS f
            writeBS "'>"
            writeBS f
            writeBS "</a></td><td class='type'>"
            writeBS (fileType mm f0)
            writeBS "</td><td>"
            writeBS tm
            writeBS "</tr>"

        writeBS "</table></div><div class=\"footer\">Powered by "
        writeBS "<b><a href=\"http://snapframework.com/\">Snap</a></b></div>"
        writeBS "</body>"

    ------------------------------------------------------------------------------
    decodeFilePath :: FilePath -> IO T.Text
    decodeFilePath :: FilePath -> IO Text
    decodeFilePath FilePath
    fp = do
        Text -> IO Text
    forall (m :: * -> *) a. MonadBase IO m => a -> m a
    evaluate (ByteString -> Text
    T.decodeUtf8 ByteString
    bs) IO Text -> (SomeException -> IO Text) -> IO Text
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    `catch`
            (\(SomeException
    _::SomeException) -> Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath -> Text
    T.pack FilePath
    fp))
      where
        bs :: ByteString
    bs = FilePath -> ByteString
    S.pack FilePath
    fp

    ------------------------------------------------------------------------------
    -- | A very simple configuration for directory serving.  This configuration
    -- uses built-in MIME types from 'defaultMimeTypes', and has no index files,
    -- index generator, dynamic file handlers, or 'preServeHook'.
    simpleDirectoryConfig :: MonadSnap m => DirectoryConfig m
    simpleDirectoryConfig :: forall (m :: * -> *). MonadSnap m => DirectoryConfig m
    simpleDirectoryConfig = DirectoryConfig {
        indexFiles :: [FilePath]
    indexFiles      = [],
        indexGenerator :: FilePath -> m ()
    indexGenerator  = m () -> FilePath -> m ()
    forall a b. a -> b -> a
    const m ()
    forall (m :: * -> *) a. MonadSnap m => m a
    pass,
        dynamicHandlers :: HandlerMap m
    dynamicHandlers = HandlerMap m
    forall k v. HashMap k v
    Map.empty,
        mimeTypes :: MimeMap
    mimeTypes       = MimeMap
    defaultMimeTypes,
        preServeHook :: FilePath -> m ()
    preServeHook    = m () -> FilePath -> m ()
    forall a b. a -> b -> a
    const (m () -> FilePath -> m ()) -> m () -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> m ()) -> () -> m ()
    forall a b. (a -> b) -> a -> b
    $! ()
        }

    ------------------------------------------------------------------------------
    -- | A reasonable default configuration for directory serving.  This
    -- configuration uses built-in MIME types from 'defaultMimeTypes', serves
    -- common index files @index.html@ and @index.htm@, but does not autogenerate
    -- directory indexes, nor have any dynamic file handlers. The 'preServeHook'
    -- will not do anything.
    defaultDirectoryConfig :: MonadSnap m => DirectoryConfig m
    defaultDirectoryConfig :: forall (m :: * -> *). MonadSnap m => DirectoryConfig m
    defaultDirectoryConfig = DirectoryConfig {
        indexFiles :: [FilePath]
    indexFiles      = [FilePath
    "index.html", FilePath
    "index.htm"],
        indexGenerator :: FilePath -> m ()
    indexGenerator  = m () -> FilePath -> m ()
    forall a b. a -> b -> a
    const m ()
    forall (m :: * -> *) a. MonadSnap m => m a
    pass,
        dynamicHandlers :: HandlerMap m
    dynamicHandlers = HandlerMap m
    forall k v. HashMap k v
    Map.empty,
        mimeTypes :: MimeMap
    mimeTypes       = MimeMap
    defaultMimeTypes,
        preServeHook :: FilePath -> m ()
    preServeHook    = m () -> FilePath -> m ()
    forall a b. a -> b -> a
    const (m () -> FilePath -> m ()) -> m () -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> m ()) -> () -> m ()
    forall a b. (a -> b) -> a -> b
    $! ()
        }

    ------------------------------------------------------------------------------
    -- | A more elaborate configuration for file serving.  This configuration
    -- uses built-in MIME types from 'defaultMimeTypes', serves common index files
    -- @index.html@ and @index.htm@, and autogenerates directory indexes with a
    -- Snap-like feel.  It still has no dynamic file handlers, nor 'preServeHook',
    -- which should be added as needed.
    --
    -- Files recognized as indexes include @index.html@, @index.htm@,
    -- @default.html@, @default.htm@, @home.html@
    --
    -- Example of how the autogenerated directory index looks like:
    --
    -- <<data:image/png;base64, >>

    fancyDirectoryConfig :: MonadSnap m => DirectoryConfig m
    fancyDirectoryConfig :: forall (m :: * -> *). MonadSnap m => DirectoryConfig m
    fancyDirectoryConfig = DirectoryConfig {
        indexFiles :: [FilePath]
    indexFiles      = [FilePath
    "index.html", FilePath
    "index.htm"],
        indexGenerator :: FilePath -> m ()
    indexGenerator  = MimeMap -> ByteString -> FilePath -> m ()
    forall (m :: * -> *).
    MonadSnap m =>
    MimeMap -> ByteString -> FilePath -> m ()
    defaultIndexGenerator MimeMap
    defaultMimeTypes ByteString
    snapIndexStyles,
        dynamicHandlers :: HandlerMap m
    dynamicHandlers = HandlerMap m
    forall k v. HashMap k v
    Map.empty,
        mimeTypes :: MimeMap
    mimeTypes       = MimeMap
    defaultMimeTypes,
        preServeHook :: FilePath -> m ()
    preServeHook    = m () -> FilePath -> m ()
    forall a b. a -> b -> a
    const (m () -> FilePath -> m ()) -> m () -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> m ()) -> () -> m ()
    forall a b. (a -> b) -> a -> b
    $! ()
        }

    ------------------------------------------------------------------------------
    -- | Serves static files from a directory using the default configuration
    -- as given in 'defaultDirectoryConfig'.
    serveDirectory :: MonadSnap m
                   => FilePath           -- ^ Directory to serve from
                   -> m ()
    serveDirectory :: forall (m :: * -> *). MonadSnap m => FilePath -> m ()
    serveDirectory = DirectoryConfig m -> FilePath -> m ()
    forall (m :: * -> *).
    MonadSnap m =>
    DirectoryConfig m -> FilePath -> m ()
    serveDirectoryWith DirectoryConfig m
    forall (m :: * -> *). MonadSnap m => DirectoryConfig m
    defaultDirectoryConfig
    {-# INLINE serveDirectory #-}

    ------------------------------------------------------------------------------
    -- | Serves static files from a directory.  Configuration options are
    -- passed in a 'DirectoryConfig' that captures various choices about desired
    -- behavior.  The relative path given in 'rqPathInfo' is searched for a
    -- requested file, and the file is served with the appropriate mime type if it
    -- is found. Absolute paths and \"@..@\" are prohibited to prevent files from
    -- being served from outside the sandbox.
    serveDirectoryWith :: MonadSnap m
                       => DirectoryConfig m  -- ^ Configuration options
                       -> FilePath           -- ^ Directory to serve from
                       -> m ()
    serveDirectoryWith :: forall (m :: * -> *).
    MonadSnap m =>
    DirectoryConfig m -> FilePath -> m ()
    serveDirectoryWith DirectoryConfig m
    cfg FilePath
    base = do
        b <- m Bool
    directory m Bool -> m Bool -> m Bool
    forall a. m a -> m a -> m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> m Bool
    file m Bool -> m Bool -> m Bool
    forall a. m a -> m a -> m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> m Bool
    forall {b}. m b
    redir
        when (not b) pass

      where
        idxs :: [FilePath]
    idxs     = DirectoryConfig m -> [FilePath]
    forall (m :: * -> *). DirectoryConfig m -> [FilePath]
    indexFiles DirectoryConfig m
    cfg
        generate :: FilePath -> m ()
    generate = DirectoryConfig m -> FilePath -> m ()
    forall (m :: * -> *). DirectoryConfig m -> FilePath -> m ()
    indexGenerator DirectoryConfig m
    cfg
        mimes :: MimeMap
    mimes    = DirectoryConfig m -> MimeMap
    forall (m :: * -> *). DirectoryConfig m -> MimeMap
    mimeTypes DirectoryConfig m
    cfg
        dyns :: HandlerMap m
    dyns     = DirectoryConfig m -> HandlerMap m
    forall (m :: * -> *). DirectoryConfig m -> HandlerMap m
    dynamicHandlers DirectoryConfig m
    cfg
        pshook :: FilePath -> m ()
    pshook   = DirectoryConfig m -> FilePath -> m ()
    forall (m :: * -> *). DirectoryConfig m -> FilePath -> m ()
    preServeHook DirectoryConfig m
    cfg

        -- Serves a file if it exists; passes if not
        serve :: FilePath -> m Bool
    serve FilePath
    f = do
            IO Bool -> m Bool
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FilePath -> IO Bool
    doesFileExist FilePath
    f) m Bool -> (Bool -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> m () -> m ()) -> m () -> Bool -> m ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless m ()
    forall (m :: * -> *) a. MonadSnap m => m a
    pass
            let fname :: FilePath
    fname          = FilePath -> FilePath
    takeFileName FilePath
    f
            let staticServe :: FilePath -> m ()
    staticServe FilePath
    f' = FilePath -> m ()
    pshook FilePath
    f m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> FilePath -> m ()
    forall (m :: * -> *). MonadSnap m => ByteString -> FilePath -> m ()
    serveFileAs (MimeMap -> FilePath -> ByteString
    fileType MimeMap
    mimes FilePath
    fname) FilePath
    f'
            (FilePath -> m ()) -> HandlerMap m -> FilePath -> FilePath -> m ()
    forall a. a -> HashMap FilePath a -> FilePath -> a
    lookupExt FilePath -> m ()
    staticServe HandlerMap m
    dyns FilePath
    fname FilePath
    f m () -> m Bool -> m Bool
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

        -- Serves a directory via indices if available.  Returns True on success,
        -- False on failure to find an index.  Passes /only/ if the request was
        -- not for a directory (no trailing slash).
        directory :: m Bool
    directory = do
            rq  <- m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
            let uri = Request -> ByteString
    uriWithoutQueryString Request
    rq
            unless ("/" `S.isSuffixOf` uri) pass
            rel <- (base </>) <$> getSafePath
            b   <- liftIO $ doesDirectoryExist rel
            if b then do let serveRel FilePath
    f = FilePath -> m Bool
    serve (FilePath
    rel FilePath -> FilePath -> FilePath
    </> FilePath
    f)
                         foldl' (<|>) pass (Prelude.map serveRel idxs)
                             <|> (generate rel >> return True)
                             <|> return False
                 else return False

        -- Serves a file requested by name.  Passes if the file doesn't exist.
        file :: m Bool
    file = FilePath -> m Bool
    serve (FilePath -> m Bool) -> m FilePath -> m Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ((FilePath
    base FilePath -> FilePath -> FilePath
    </>) (FilePath -> FilePath) -> m FilePath -> m FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m FilePath
    forall (m :: * -> *). MonadSnap m => m FilePath
    getSafePath)

        -- If the request is for a directory but lacks a trailing slash, redirects
        -- to the directory name with a trailing slash.
        redir :: m b
    redir = do
            rel <- (FilePath
    base FilePath -> FilePath -> FilePath
    </>) (FilePath -> FilePath) -> m FilePath -> m FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m FilePath
    forall (m :: * -> *). MonadSnap m => m FilePath
    getSafePath
            liftIO (doesDirectoryExist rel) >>= flip unless pass
            rq <- getRequest
            let uri = Request -> ByteString
    uriWithoutQueryString Request
    rq
            let qss = Request -> ByteString
    queryStringSuffix Request
    rq
            let u = [ByteString] -> ByteString
    S.concat [ByteString
    uri, ByteString
    "/", ByteString
    qss]
            redirect u

    ------------------------------------------------------------------------------
    -- | Serves a single file specified by a full or relative path.  If the file
    -- does not exist, throws an exception (not that it does /not/ pass to the
    -- next handler).   The path restrictions on 'serveDirectory' don't apply to
    -- this function since the path is not being supplied by the user.
    serveFile :: MonadSnap m
              => FilePath          -- ^ path to file
              -> m ()
    serveFile :: forall (m :: * -> *). MonadSnap m => FilePath -> m ()
    serveFile FilePath
    fp = ByteString -> FilePath -> m ()
    forall (m :: * -> *). MonadSnap m => ByteString -> FilePath -> m ()
    serveFileAs (MimeMap -> FilePath -> ByteString
    fileType MimeMap
    defaultMimeTypes (FilePath -> FilePath
    takeFileName FilePath
    fp)) FilePath
    fp
    {-# INLINE serveFile #-}

    ------------------------------------------------------------------------------
    -- | Same as 'serveFile', with control over the MIME mapping used.
    serveFileAs :: MonadSnap m
                => ByteString        -- ^ MIME type
                -> FilePath          -- ^ path to file
                -> m ()
    serveFileAs :: forall (m :: * -> *). MonadSnap m => ByteString -> FilePath -> m ()
    serveFileAs ByteString
    mime FilePath
    fp = do
        reqOrig <- m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest

        -- If-Range header must be ignored if there is no Range: header in the
        -- request (RFC 2616 section 14.27)
        let req = if Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> Request -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "range" Request
    reqOrig
                    then CI ByteString -> Request -> Request
    forall a. HasHeaders a => CI ByteString -> a -> a
    deleteHeader CI ByteString
    "if-range" Request
    reqOrig
                    else Request
    reqOrig

        -- check "If-Modified-Since" and "If-Range" headers
        let mbH = CI ByteString -> Request -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "if-modified-since" Request
    req
        mbIfModified <- liftIO $ case mbH of
                                   Maybe ByteString
    Nothing  -> Maybe CTime -> IO (Maybe CTime)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CTime
    forall a. Maybe a
    Nothing
                                   (Just ByteString
    s) -> (CTime -> Maybe CTime) -> IO CTime -> IO (Maybe CTime)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CTime -> Maybe CTime
    forall a. a -> Maybe a
    Just (IO CTime -> IO (Maybe CTime)) -> IO CTime -> IO (Maybe CTime)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> IO CTime
    parseHttpTime ByteString
    s

        -- If-Range header could contain an entity, but then parseHttpTime will
        -- fail and return 0 which means a 200 response will be generated anyways
        mbIfRange <- liftIO $ case getHeader "if-range" req of
                                Maybe ByteString
    Nothing  -> Maybe CTime -> IO (Maybe CTime)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CTime
    forall a. Maybe a
    Nothing
                                (Just ByteString
    s) -> (CTime -> Maybe CTime) -> IO CTime -> IO (Maybe CTime)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CTime -> Maybe CTime
    forall a. a -> Maybe a
    Just (IO CTime -> IO (Maybe CTime)) -> IO CTime -> IO (Maybe CTime)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> IO CTime
    parseHttpTime ByteString
    s

        dbg $ "mbIfModified: " ++ Prelude.show mbIfModified
        dbg $ "mbIfRange: " ++ Prelude.show mbIfRange

        -- check modification time and bug out early if the file is not modified.
        --
        -- TODO: a stat cache would be nice here, but it'd need the date thread
        -- stuff from snap-server to be folded into snap-core
        filestat <- liftIO $ getFileStatus fp
        let mt = FileStatus -> CTime
    modificationTime FileStatus
    filestat
        maybe (return $! ()) (\CTime
    lt -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CTime
    mt CTime -> CTime -> Bool
    forall a. Ord a => a -> a -> Bool
    <= CTime
    lt) m ()
    forall {a}. m a
    notModified) mbIfModified

        let sz = FileOffset -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FileOffset -> Word64) -> FileOffset -> Word64
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> FileOffset
    fileSize FileStatus
    filestat
        lm <- liftIO $ formatHttpTime mt

        -- ok, at this point we know the last-modified time and the
        -- content-type. set those.
        modifyResponse $ setHeader "Last-Modified" lm
                       . setHeader "Accept-Ranges" "bytes"
                       . setContentType mime

        -- now check: is this a range request? If there is an 'If-Range' header
        -- with an old modification time we skip this check and send a 200
        -- response
        let skipRangeCheck = Bool -> (CTime -> Bool) -> Maybe CTime -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool
    False)
                                   (\CTime
    lt -> CTime
    mt CTime -> CTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > CTime
    lt)
                                   Maybe CTime
    mbIfRange

        -- checkRangeReq checks for a Range: header in the request and sends a
        -- partial response if it matches.
        wasRange <- if skipRangeCheck
                      then return False
                      else liftSnap $ checkRangeReq req fp sz

        dbg $ "was this a range request? " ++ Prelude.show wasRange

        -- if we didn't have a range request, we just do normal sendfile
        unless wasRange $ do
          modifyResponse $ setResponseCode 200
                         . setContentLength sz
          liftSnap $ sendFile fp

      where
        --------------------------------------------------------------------------
        notModified :: m a
    notModified = Response -> m a
    forall (m :: * -> *) a. MonadSnap m => Response -> m a
    finishWith (Response -> m a) -> Response -> m a
    forall a b. (a -> b) -> a -> b
    $
                      Int -> Response -> Response
    setResponseCode Int
    304 Response
    emptyResponse

    ------------------------------------------------------------------------------
    lookupExt :: a -> HashMap FilePath a -> FilePath -> a
    lookupExt :: forall a. a -> HashMap FilePath a -> FilePath -> a
    lookupExt a
    def HashMap FilePath a
    m FilePath
    f =
        if FilePath -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    ext
          then a
    def
          else a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe (a -> HashMap FilePath a -> FilePath -> a
    forall a. a -> HashMap FilePath a -> FilePath -> a
    lookupExt a
    def HashMap FilePath a
    m (FilePath -> FilePath
    next FilePath
    ext)) Maybe a
    mbe

      where
        next :: FilePath -> FilePath
    next            = (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop Int
    1
        ext :: FilePath
    ext             = FilePath -> FilePath
    takeExtensions FilePath
    f
        mbe :: Maybe a
    mbe             = FilePath -> HashMap FilePath a -> Maybe a
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup FilePath
    ext HashMap FilePath a
    m

    ------------------------------------------------------------------------------
    -- | Determine a given file's MIME type from its filename and the provided MIME
    -- map.
    fileType :: MimeMap -> FilePath -> ByteString
    fileType :: MimeMap -> FilePath -> ByteString
    fileType = ByteString -> MimeMap -> FilePath -> ByteString
    forall a. a -> HashMap FilePath a -> FilePath -> a
    lookupExt ByteString
    defaultMimeType

    ------------------------------------------------------------------------------
    defaultMimeType :: ByteString
    defaultMimeType :: ByteString
    defaultMimeType = ByteString
    "application/octet-stream"

    ------------------------------------------------------------------------------
    data RangeReq = RangeReq !Word64 !(Maybe Word64)
                  | SuffixRangeReq !Word64

    ------------------------------------------------------------------------------
    rangeParser :: Parser RangeReq
    rangeParser :: Parser RangeReq
    rangeParser = ByteString -> Parser ByteString
    string ByteString
    "bytes=" Parser ByteString -> Parser RangeReq -> Parser RangeReq
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *>
                  (Parser RangeReq
    byteRangeSpec Parser RangeReq -> Parser RangeReq -> Parser RangeReq
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser RangeReq
    suffixByteRangeSpec) Parser RangeReq -> Parser ByteString () -> Parser RangeReq
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*
                  Parser ByteString ()
    forall t. Chunk t => Parser t ()
    endOfInput
      where
        byteRangeSpec :: Parser RangeReq
    byteRangeSpec = do
            start <- Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Word64)
    -> Parser ByteString Int64 -> Parser ByteString Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Int64
    parseNum
            void $! char '-'
            end   <- option Nothing $ liftM Just parseNum

            return $! RangeReq start (fromIntegral <$> end)

        suffixByteRangeSpec :: Parser RangeReq
    suffixByteRangeSpec =
            (Int64 -> RangeReq) -> Parser ByteString Int64 -> Parser RangeReq
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Word64 -> RangeReq
    SuffixRangeReq (Word64 -> RangeReq) -> (Int64 -> Word64) -> Int64 -> RangeReq
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) (Parser ByteString Int64 -> Parser RangeReq)
    -> Parser ByteString Int64 -> Parser RangeReq
    forall a b. (a -> b) -> a -> b
    $ Char -> Parser ByteString Char
    char Char
    '-' Parser ByteString Char
    -> Parser ByteString Int64 -> Parser ByteString Int64
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString Int64
    parseNum

    ------------------------------------------------------------------------------
    checkRangeReq :: (MonadSnap m) => Request -> FilePath -> Word64 -> m Bool
    checkRangeReq :: forall (m :: * -> *).
    MonadSnap m =>
    Request -> FilePath -> Word64 -> m Bool
    checkRangeReq Request
    req FilePath
    fp Word64
    sz = do
        -- TODO/FIXME: multiple ranges
        m Bool -> (ByteString -> m Bool) -> Maybe ByteString -> m Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False)
              (\ByteString
    s -> (FilePath -> m Bool)
    -> (RangeReq -> m Bool) -> Either FilePath RangeReq -> m Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (m Bool -> FilePath -> m Bool
    forall a b. a -> b -> a
    const (m Bool -> FilePath -> m Bool) -> m Bool -> FilePath -> m Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False)
                            RangeReq -> m Bool
    withRange
                            (ByteString -> Parser RangeReq -> Either FilePath RangeReq
    forall a. ByteString -> Parser a -> Either FilePath a
    fullyParse ByteString
    s Parser RangeReq
    rangeParser))
              (CI ByteString -> Request -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "range" Request
    req)

      where
        withRange :: RangeReq -> m Bool
    withRange (RangeReq Word64
    start Maybe Word64
    mend) = do
            let end :: Word64
    end = Word64 -> Maybe Word64 -> Word64
    forall a. a -> Maybe a -> a
    fromMaybe (Word64
    szWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    -Word64
    1) Maybe Word64
    mend
            FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg (FilePath -> m ()) -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "withRange: start=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show Word64
    start
                      FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ", end=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show Word64
    end

            if Word64
    start Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    0 Bool -> Bool -> Bool
    || Word64
    end Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    start Bool -> Bool -> Bool
    || Word64
    start Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word64
    sz Bool -> Bool -> Bool
    || Word64
    end Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word64
    sz
               then m Bool
    send416
               else Word64 -> Word64 -> m Bool
    forall {m :: * -> *}. MonadSnap m => Word64 -> Word64 -> m Bool
    send206 Word64
    start Word64
    end

        withRange (SuffixRangeReq Word64
    nbytes) = do
            let end :: Word64
    end   = Word64
    szWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    -Word64
    1
            let start :: Word64
    start = Word64
    sz Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    nbytes

            FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg (FilePath -> m ()) -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "withRange: start=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show Word64
    start
                      FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ", end=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show Word64
    end

            if Word64
    start Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    0 Bool -> Bool -> Bool
    || Word64
    end Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word64
    start Bool -> Bool -> Bool
    || Word64
    start Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word64
    sz Bool -> Bool -> Bool
    || Word64
    end Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word64
    sz
               then m Bool
    send416
               else Word64 -> Word64 -> m Bool
    forall {m :: * -> *}. MonadSnap m => Word64 -> Word64 -> m Bool
    send206 Word64
    start Word64
    end

        -- note: start and end INCLUSIVE here
        send206 :: Word64 -> Word64 -> m Bool
    send206 Word64
    start Word64
    end = do
            FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg FilePath
    "inside send206"
            let !len :: Word64
    len = Word64
    endWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    -Word64
    startWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    +Word64
    1
            let crng :: ByteString
    crng = [ByteString] -> ByteString
    S.concat ([ByteString] -> ByteString)
    -> (LazyByteString -> [ByteString]) -> LazyByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LazyByteString -> [ByteString]
    L.toChunks (LazyByteString -> ByteString) -> LazyByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                       Builder -> LazyByteString
    toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
    forall a b. (a -> b) -> a -> b
    $
                       [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ ByteString -> Builder
    byteString ByteString
    "bytes "
                               , Word64 -> Builder
    forall a. Show a => a -> Builder
    fromShow Word64
    start
                               , Char -> Builder
    char8 Char
    '-'
                               , Word64 -> Builder
    forall a. Show a => a -> Builder
    fromShow Word64
    end
                               , Char -> Builder
    char8 Char
    '/'
                               , Word64 -> Builder
    forall a. Show a => a -> Builder
    fromShow Word64
    sz ]

            (Response -> Response) -> m ()
    forall (m :: * -> *). MonadSnap m => (Response -> Response) -> m ()
    modifyResponse ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Response -> Response
    setResponseCode Int
    206
                           (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI ByteString -> ByteString -> Response -> Response
    forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
    setHeader CI ByteString
    "Content-Range" ByteString
    crng
                           (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Response -> Response
    setContentLength Word64
    len

            FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg (FilePath -> m ()) -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "send206: sending range (" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show Word64
    start
                    FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "," FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> FilePath
    forall a. Show a => a -> FilePath
    Prelude.show (Word64
    endWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    +Word64
    1) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ") to sendFilePartial"

            -- end here was inclusive, sendFilePartial is exclusive
            FilePath -> (Word64, Word64) -> m ()
    forall (m :: * -> *).
    MonadSnap m =>
    FilePath -> (Word64, Word64) -> m ()
    sendFilePartial FilePath
    fp (Word64
    start,Word64
    endWord64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    +Word64
    1)
            Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

        send416 :: m Bool
    send416 = do
            FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg FilePath
    "inside send416"
            -- if there's an "If-Range" header in the request, then we just send
            -- back 200
            if CI ByteString -> Request -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "If-Range" Request
    req Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe ByteString
    forall a. Maybe a
    Nothing
               then Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
               else do
                   let crng :: ByteString
    crng = [ByteString] -> ByteString
    S.concat ([ByteString] -> ByteString)
    -> (LazyByteString -> [ByteString]) -> LazyByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LazyByteString -> [ByteString]
    L.toChunks (LazyByteString -> ByteString) -> LazyByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                              Builder -> LazyByteString
    toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
    forall a b. (a -> b) -> a -> b
    $
                              [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ ByteString -> Builder
    byteString ByteString
    "bytes */"
                                      , Word64 -> Builder
    forall a. Show a => a -> Builder
    fromShow Word64
    sz ]

                   (Response -> Response) -> m ()
    forall (m :: * -> *). MonadSnap m => (Response -> Response) -> m ()
    modifyResponse ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Response -> Response
    setResponseCode Int
    416
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI ByteString -> ByteString -> Response -> Response
    forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
    setHeader CI ByteString
    "Content-Range" ByteString
    crng
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Response -> Response
    setContentLength Word64
    0
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI ByteString -> Response -> Response
    forall a. HasHeaders a => CI ByteString -> a -> a
    deleteHeader CI ByteString
    "Content-Type"
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI ByteString -> Response -> Response
    forall a. HasHeaders a => CI ByteString -> a -> a
    deleteHeader CI ByteString
    "Content-Encoding"
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI ByteString -> Response -> Response
    forall a. HasHeaders a => CI ByteString -> a -> a
    deleteHeader CI ByteString
    "Transfer-Encoding"
                                  (Response -> Response)
    -> (Response -> Response) -> Response -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OutputStream Builder -> IO (OutputStream Builder))
    -> Response -> Response
    setResponseBody (OutputStream Builder -> IO (OutputStream Builder)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OutputStream Builder -> IO (OutputStream Builder))
    -> (OutputStream Builder -> OutputStream Builder)
    -> OutputStream Builder
    -> IO (OutputStream Builder)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OutputStream Builder -> OutputStream Builder
    forall a. a -> a
    id)

                   Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    ------------------------------------------------------------------------------
    dbg :: (MonadIO m) => String -> m ()
    dbg :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
    dbg FilePath
    s = FilePath -> m ()
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
    debug (FilePath -> m ()) -> FilePath -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "FileServe:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    s

    ------------------------------------------------------------------------------
    uriWithoutQueryString :: Request -> ByteString
    uriWithoutQueryString :: Request -> ByteString
    uriWithoutQueryString Request
    rq = (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '?') ByteString
    uri
      where
        uri :: ByteString
    uri   = Request -> ByteString
    rqURI Request
    rq

    ------------------------------------------------------------------------------
    queryStringSuffix :: Request -> ByteString
    queryStringSuffix :: Request -> ByteString
    queryStringSuffix Request
    rq = [ByteString] -> ByteString
    S.concat [ ByteString
    s, ByteString
    qs ]
      where
        qs :: ByteString
    qs = Request -> ByteString
    rqQueryString Request
    rq
        s :: ByteString
    s  = if ByteString -> Bool
    S.null ByteString
    qs then ByteString
    "" else ByteString
    "?"

    ------------------------------------------------------------------------------
    fromShow :: Show a => a -> Builder
    fromShow :: forall a. Show a => a -> Builder
    fromShow = FilePath -> Builder
    stringUtf8 (FilePath -> Builder) -> (a -> FilePath) -> a -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> FilePath
    forall a. Show a => a -> FilePath
    show