    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell, CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE PatternGuards #-}
    -- | Static file serving for WAI.
    module Network.Wai.Application.Static
        ( -- * WAI application
          staticApp
          -- ** Default Settings
        , defaultWebAppSettings
        , webAppSettingsWithLookup
        , defaultFileServerSettings
        , embeddedSettings
          -- ** Settings
        , StaticSettings
        , ssLookupFile
        , ssMkRedirect
        , ssGetMimeType
        , ssListing
        , ssIndices
        , ssMaxAge
        , ssRedirectToIndex
        , ssAddTrailingSlash
        , ss404Handler
        ) where

    import Prelude hiding (FilePath)
    import qualified Network.Wai as W
    import qualified Network.HTTP.Types as H
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString.Lazy as L
    import Data.ByteString.Lazy.Char8 ()
    import Control.Monad.IO.Class (liftIO)

    import Data.ByteString.Builder (toLazyByteString)

    import Data.FileEmbed (embedFile)

    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as TE

    import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)

    import WaiAppStatic.Types
    import Util
    import WaiAppStatic.Storage.Filesystem
    import WaiAppStatic.Storage.Embedded
    import Network.Mime (MimeType)

    data StaticResponse =
          -- | Just the etag hash or Nothing for no etag hash
          Redirect Pieces (Maybe ByteString)
        | RawRedirect ByteString
        | NotFound
        | FileResponse File H.ResponseHeaders
        | NotModified
        -- TODO: add file size
        | SendContent MimeType L.ByteString
        | WaiResponse W.Response

    safeInit  :: [a] -> [a]
    safeInit :: [a] -> [a]
    safeInit [] = []
    safeInit xs :: [a]
    xs = [a] -> [a]
    forall a. [a] -> [a]
    init [a]
    xs

    filterButLast :: (a -> Bool) -> [a] -> [a]
    filterButLast :: (a -> Bool) -> [a] -> [a]
    filterButLast _ [] = []
    filterButLast _ [x :: a
    x] = [a
    x]
    filterButLast f :: a -> Bool
    f (x :: a
    x:xs :: [a]
    xs)
        | a -> Bool
    f a
    x = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filterButLast a -> Bool
    f [a]
    xs
        | Bool
    otherwise = (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filterButLast a -> Bool
    f [a]
    xs

    -- | Serve an appropriate response for a folder request.
    serveFolder :: StaticSettings -> Pieces -> W.Request -> Folder -> IO StaticResponse
    serveFolder :: StaticSettings -> Pieces -> Request -> Folder -> IO StaticResponse
    serveFolder StaticSettings {..} pieces :: Pieces
    pieces req :: Request
    req folder :: Folder
    folder@Folder {..} =
        case Maybe Listing
    ssListing of
            Just _ | Just path :: ByteString
    path <- Request -> Maybe ByteString
    addTrailingSlash Request
    req, Bool
    ssAddTrailingSlash ->
                StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> IO StaticResponse)
    -> StaticResponse -> IO StaticResponse
    forall a b. (a -> b) -> a -> b
    $ ByteString -> StaticResponse
    RawRedirect ByteString
    path
            Just listing :: Listing
    listing -> do
                -- directory listings turned on, display it
                Builder
    builder <- Listing
    listing Pieces
    pieces Folder
    folder
                StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> IO StaticResponse)
    -> StaticResponse -> IO StaticResponse
    forall a b. (a -> b) -> a -> b
    $ Response -> StaticResponse
    WaiResponse (Response -> StaticResponse) -> Response -> StaticResponse
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> Builder -> Response
    W.responseBuilder Status
    H.status200
                    [ ("Content-Type", "text/html; charset=utf-8")
                    ] Builder
    builder
            Nothing -> StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> IO StaticResponse)
    -> StaticResponse -> IO StaticResponse
    forall a b. (a -> b) -> a -> b
    $ Response -> StaticResponse
    WaiResponse (Response -> StaticResponse) -> Response -> StaticResponse
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status403
                [ ("Content-Type", "text/plain")
                ] "Directory listings disabled"

    addTrailingSlash :: W.Request -> Maybe ByteString
    addTrailingSlash :: Request -> Maybe ByteString
    addTrailingSlash req :: Request
    req
        | ByteString -> Bool
    S8.null ByteString
    rp = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just "/"
        | ByteString -> Char
    S8.last ByteString
    rp Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/' = Maybe ByteString
    forall a. Maybe a
    Nothing
        | Bool
    otherwise = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Char -> ByteString
    S8.snoc ByteString
    rp '/'
      where
        rp :: ByteString
    rp = Request -> ByteString
    W.rawPathInfo Request
    req

    checkPieces :: StaticSettings
                -> Pieces                    -- ^ parsed request
                -> W.Request
                -> IO StaticResponse
    -- If we have any empty pieces in the middle of the requested path, generate a
    -- redirect to get rid of them.
    checkPieces :: StaticSettings -> Pieces -> Request -> IO StaticResponse
    checkPieces _ pieces :: Pieces
    pieces _ | (FolderName -> Bool) -> Pieces -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> Bool
    T.null (Text -> Bool) -> (FolderName -> Text) -> FolderName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FolderName -> Text
    fromPiece) (Pieces -> Bool) -> Pieces -> Bool
    forall a b. (a -> b) -> a -> b
    $ Pieces -> Pieces
    forall a. [a] -> [a]
    safeInit Pieces
    pieces =
        StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> IO StaticResponse)
    -> StaticResponse -> IO StaticResponse
    forall a b. (a -> b) -> a -> b
    $ Pieces -> Maybe ByteString -> StaticResponse
    Redirect ((FolderName -> Bool) -> Pieces -> Pieces
    forall a. (a -> Bool) -> [a] -> [a]
    filterButLast (Bool -> Bool
    not (Bool -> Bool) -> (FolderName -> Bool) -> FolderName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    T.null (Text -> Bool) -> (FolderName -> Text) -> FolderName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FolderName -> Text
    fromPiece) Pieces
    pieces) Maybe ByteString
    forall a. Maybe a
    Nothing

    checkPieces ss :: StaticSettings
    ss@StaticSettings {..} pieces :: Pieces
    pieces req :: Request
    req = do
        Either ByteString LookupResult
    res <- IO (Either ByteString LookupResult)
    lookupResult
        case Either ByteString LookupResult
    res of
            Left location :: ByteString
    location -> StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> IO StaticResponse)
    -> StaticResponse -> IO StaticResponse
    forall a b. (a -> b) -> a -> b
    $ ByteString -> StaticResponse
    RawRedirect ByteString
    location
            Right LRNotFound -> StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return StaticResponse
    NotFound
            Right (LRFile file :: File
    file) -> StaticSettings -> Request -> File -> IO StaticResponse
    serveFile StaticSettings
    ss Request
    req File
    file
            Right (LRFolder folder :: Folder
    folder) -> StaticSettings -> Pieces -> Request -> Folder -> IO StaticResponse
    serveFolder StaticSettings
    ss Pieces
    pieces Request
    req Folder
    folder
      where
        lookupResult :: IO (Either ByteString LookupResult)
        lookupResult :: IO (Either ByteString LookupResult)
    lookupResult = do
          LookupResult
    nonIndexResult <- Pieces -> IO LookupResult
    ssLookupFile Pieces
    pieces
          case LookupResult
    nonIndexResult of
              LRFile{} -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ByteString LookupResult
     -> IO (Either ByteString LookupResult))
    -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall a b. (a -> b) -> a -> b
    $ LookupResult -> Either ByteString LookupResult
    forall a b. b -> Either a b
    Right LookupResult
    nonIndexResult
              _ -> do
                  Either ByteString LookupResult
    eIndexResult <- [Pieces] -> IO (Either ByteString LookupResult)
    lookupIndices ((FolderName -> Pieces) -> Pieces -> [Pieces]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ index :: FolderName
    index -> Pieces -> Pieces
    dropLastIfNull Pieces
    pieces Pieces -> Pieces -> Pieces
    forall a. [a] -> [a] -> [a]
    ++ [FolderName
    index]) Pieces
    ssIndices)
                  Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ByteString LookupResult
     -> IO (Either ByteString LookupResult))
    -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall a b. (a -> b) -> a -> b
    $ case Either ByteString LookupResult
    eIndexResult of
                      Left redirect :: ByteString
    redirect -> ByteString -> Either ByteString LookupResult
    forall a b. a -> Either a b
    Left ByteString
    redirect
                      Right indexResult :: LookupResult
    indexResult -> case LookupResult
    indexResult of
                          LRNotFound -> LookupResult -> Either ByteString LookupResult
    forall a b. b -> Either a b
    Right LookupResult
    nonIndexResult
                          LRFile file :: File
    file | Bool
    ssRedirectToIndex ->
                              let relPath :: Text
    relPath =
                                      case Pieces -> Pieces
    forall a. [a] -> [a]
    reverse Pieces
    pieces of
                                          -- Served at root
                                          [] -> FolderName -> Text
    fromPiece (FolderName -> Text) -> FolderName -> Text
    forall a b. (a -> b) -> a -> b
    $ File -> FolderName
    fileName File
    file
                                          lastSegment :: FolderName
    lastSegment:_ ->
                                              case FolderName -> Text
    fromPiece FolderName
    lastSegment of
                                                  -- Ends with a trailing slash
                                                  "" -> FolderName -> Text
    fromPiece (FolderName -> Text) -> FolderName -> Text
    forall a b. (a -> b) -> a -> b
    $ File -> FolderName
    fileName File
    file
                                                  -- Lacks a trailing slash
                                                  lastSegment' :: Text
    lastSegment' -> [Text] -> Text
    T.concat
                                                      [ Text
    lastSegment'
                                                      , "/"
                                                      , FolderName -> Text
    fromPiece (FolderName -> Text) -> FolderName -> Text
    forall a b. (a -> b) -> a -> b
    $ File -> FolderName
    fileName File
    file
                                                      ]
                               in ByteString -> Either ByteString LookupResult
    forall a b. a -> Either a b
    Left (ByteString -> Either ByteString LookupResult)
    -> ByteString -> Either ByteString LookupResult
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    TE.encodeUtf8 Text
    relPath
                          _ -> LookupResult -> Either ByteString LookupResult
    forall a b. b -> Either a b
    Right LookupResult
    indexResult

        lookupIndices :: [Pieces] -> IO (Either ByteString LookupResult)
        lookupIndices :: [Pieces] -> IO (Either ByteString LookupResult)
    lookupIndices (x :: Pieces
    x : xs :: [Pieces]
    xs) = do
            LookupResult
    res <- Pieces -> IO LookupResult
    ssLookupFile Pieces
    x
            case LookupResult
    res of
                LRNotFound -> [Pieces] -> IO (Either ByteString LookupResult)
    lookupIndices [Pieces]
    xs
                _ -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ByteString LookupResult
     -> IO (Either ByteString LookupResult))
    -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall a b. (a -> b) -> a -> b
    $ case (Bool
    ssAddTrailingSlash, Request -> Maybe ByteString
    addTrailingSlash Request
    req) of
                    (True, Just redirect :: ByteString
    redirect) -> ByteString -> Either ByteString LookupResult
    forall a b. a -> Either a b
    Left ByteString
    redirect
                    _ -> LookupResult -> Either ByteString LookupResult
    forall a b. b -> Either a b
    Right LookupResult
    res
        lookupIndices [] = Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ByteString LookupResult
     -> IO (Either ByteString LookupResult))
    -> Either ByteString LookupResult
    -> IO (Either ByteString LookupResult)
    forall a b. (a -> b) -> a -> b
    $ LookupResult -> Either ByteString LookupResult
    forall a b. b -> Either a b
    Right LookupResult
    LRNotFound

    serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse
    serveFile :: StaticSettings -> Request -> File -> IO StaticResponse
    serveFile StaticSettings {..} req :: Request
    req file :: File
    file
        -- First check etag values, if turned on
        | Bool
    ssUseHash = do
            Maybe ByteString
    mHash <- File -> IO (Maybe ByteString)
    fileGetHash File
    file
            case (Maybe ByteString
    mHash, HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "if-none-match" (ResponseHeaders -> Maybe ByteString)
    -> ResponseHeaders -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> ResponseHeaders
    W.requestHeaders Request
    req) of
                -- if-none-match matches the actual hash, return a 304
                (Just hash :: ByteString
    hash, Just lastHash :: ByteString
    lastHash) | ByteString
    hash ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    lastHash -> StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return StaticResponse
    NotModified

                -- Didn't match, but we have a hash value. Send the file contents
                -- with an ETag header.
                --
                -- Note: It would be arguably better to next check
                -- if-modified-since and return a 304 if that indicates a match as
                -- well. However, the circumstances under which such a situation
                -- could arise would be very anomalous, and should likely warrant a
                -- new file being sent anyway.
                (Just hash :: ByteString
    hash, _) -> ResponseHeaders -> IO StaticResponse
    forall (m :: * -> *).
    Monad m =>
    ResponseHeaders -> m StaticResponse
    respond [("ETag", ByteString
    hash)]

                -- No hash value available, fall back to last modified support.
                (Nothing, _) -> IO StaticResponse
    lastMod
        -- etag turned off, so jump straight to last modified
        | Bool
    otherwise = IO StaticResponse
    lastMod
      where
        mLastSent :: Maybe HTTPDate
    mLastSent = HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "if-modified-since" (Request -> ResponseHeaders
    W.requestHeaders Request
    req) Maybe ByteString
    -> (ByteString -> Maybe HTTPDate) -> Maybe HTTPDate
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Maybe HTTPDate
    parseHTTPDate
        lastMod :: IO StaticResponse
    lastMod =
            case ((EpochTime -> HTTPDate) -> Maybe EpochTime -> Maybe HTTPDate
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap EpochTime -> HTTPDate
    epochTimeToHTTPDate (Maybe EpochTime -> Maybe HTTPDate)
    -> Maybe EpochTime -> Maybe HTTPDate
    forall a b. (a -> b) -> a -> b
    $ File -> Maybe EpochTime
    fileGetModified File
    file, Maybe HTTPDate
    mLastSent) of
                -- File modified time is equal to the if-modified-since header,
                -- return a 304.
                --
                -- Question: should the comparison be, date <= lastSent?
                (Just mdate :: HTTPDate
    mdate, Just lastSent :: HTTPDate
    lastSent)
                    | HTTPDate
    mdate HTTPDate -> HTTPDate -> Bool
    forall a. Eq a => a -> a -> Bool
    == HTTPDate
    lastSent -> StaticResponse -> IO StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return StaticResponse
    NotModified

                -- Did not match, but we have a new last-modified header
                (Just mdate :: HTTPDate
    mdate, _) -> ResponseHeaders -> IO StaticResponse
    forall (m :: * -> *).
    Monad m =>
    ResponseHeaders -> m StaticResponse
    respond [("last-modified", HTTPDate -> ByteString
    formatHTTPDate HTTPDate
    mdate)]

                -- No modification time available
                (Nothing, _) -> ResponseHeaders -> IO StaticResponse
    forall (m :: * -> *).
    Monad m =>
    ResponseHeaders -> m StaticResponse
    respond []

        -- Send a file response with the additional weak headers provided.
        respond :: ResponseHeaders -> m StaticResponse
    respond headers :: ResponseHeaders
    headers = StaticResponse -> m StaticResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StaticResponse -> m StaticResponse)
    -> StaticResponse -> m StaticResponse
    forall a b. (a -> b) -> a -> b
    $ File -> ResponseHeaders -> StaticResponse
    FileResponse File
    file (ResponseHeaders -> StaticResponse)
    -> ResponseHeaders -> StaticResponse
    forall a b. (a -> b) -> a -> b
    $ MaxAge -> ResponseHeaders -> ResponseHeaders
    cacheControl MaxAge
    ssMaxAge ResponseHeaders
    headers

    -- | Return a difference list of headers based on the specified MaxAge.
    --
    -- This function will return both Cache-Control and Expires headers, as
    -- relevant.
    cacheControl :: MaxAge -> (H.ResponseHeaders -> H.ResponseHeaders)
    cacheControl :: MaxAge -> ResponseHeaders -> ResponseHeaders
    cacheControl maxage :: MaxAge
    maxage =
        ResponseHeaders -> ResponseHeaders
    headerCacheControl (ResponseHeaders -> ResponseHeaders)
    -> (ResponseHeaders -> ResponseHeaders)
    -> ResponseHeaders
    -> ResponseHeaders
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResponseHeaders -> ResponseHeaders
    headerExpires
      where
        ccInt :: Maybe Int
    ccInt =
            case MaxAge
    maxage of
                NoMaxAge -> Maybe Int
    forall a. Maybe a
    Nothing
                MaxAgeSeconds i :: Int
    i -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    i
                MaxAgeForever -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    oneYear
        oneYear :: Int
        oneYear :: Int
    oneYear = 60 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 60 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 24 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 365

        headerCacheControl :: ResponseHeaders -> ResponseHeaders
    headerCacheControl =
          case Maybe Int
    ccInt of
            Nothing -> ResponseHeaders -> ResponseHeaders
    forall a. a -> a
    id
            Just i :: Int
    i  -> (:) ("Cache-Control", ByteString -> ByteString -> ByteString
    S8.append "public, max-age=" (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    S8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
        headerExpires :: ResponseHeaders -> ResponseHeaders
    headerExpires =
          case MaxAge
    maxage of
            NoMaxAge        -> ResponseHeaders -> ResponseHeaders
    forall a. a -> a
    id
            MaxAgeSeconds _ -> ResponseHeaders -> ResponseHeaders
    forall a. a -> a
    id -- FIXME
            MaxAgeForever   -> (:) ("Expires", "Thu, 31 Dec 2037 23:55:55 GMT")

    -- | Turn a @StaticSettings@ into a WAI application.
    staticApp :: StaticSettings -> W.Application
    staticApp :: StaticSettings -> Application
    staticApp set :: StaticSettings
    set req :: Request
    req = StaticSettings -> [Text] -> Application
    staticAppPieces StaticSettings
    set (Request -> [Text]
    W.pathInfo Request
    req) Request
    req

    staticAppPieces :: StaticSettings -> [Text] -> W.Application
    staticAppPieces :: StaticSettings -> [Text] -> Application
    staticAppPieces _ _ req :: Request
    req sendResponse :: Response -> IO ResponseReceived
    sendResponse
        | ByteString -> [ByteString] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem (Request -> ByteString
    W.requestMethod Request
    req) ["GET", "HEAD"] = Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS
            Status
    H.status405
            [("Content-Type", "text/plain")]
            "Only GET or HEAD is supported"
    staticAppPieces _ [".hidden", "folder.png"] _ sendResponse :: Response -> IO ResponseReceived
    sendResponse = Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status200 [("Content-Type", "image/png")] (ByteString -> Response) -> ByteString -> Response
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    L.fromChunks [$(embedFile "images/folder.png")]
    staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse :: Response -> IO ResponseReceived
    sendResponse = Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status200 [("Content-Type", "image/png")] (ByteString -> Response) -> ByteString -> Response
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    L.fromChunks [$(embedFile "images/haskell.png")]
    staticAppPieces ss :: StaticSettings
    ss rawPieces :: [Text]
    rawPieces req :: Request
    req sendResponse :: Response -> IO ResponseReceived
    sendResponse = IO ResponseReceived -> IO ResponseReceived
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ResponseReceived -> IO ResponseReceived)
    -> IO ResponseReceived -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ do
        case [Text] -> Maybe Pieces
    toPieces [Text]
    rawPieces of
            Just pieces :: Pieces
    pieces -> StaticSettings -> Pieces -> Request -> IO StaticResponse
    checkPieces StaticSettings
    ss Pieces
    pieces Request
    req IO StaticResponse
    -> (StaticResponse -> IO ResponseReceived) -> IO ResponseReceived
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= StaticResponse -> IO ResponseReceived
    response
            Nothing -> Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status403
                [ ("Content-Type", "text/plain")
                ] "Forbidden"
      where
        response :: StaticResponse -> IO W.ResponseReceived
        response :: StaticResponse -> IO ResponseReceived
    response (FileResponse file :: File
    file ch :: ResponseHeaders
    ch) = do
            ByteString
    mimetype <- StaticSettings -> File -> IO ByteString
    ssGetMimeType StaticSettings
    ss File
    file
            let filesize :: Integer
    filesize = File -> Integer
    fileGetSize File
    file
            let headers :: ResponseHeaders
    headers = ("Content-Type", ByteString
    mimetype)
                        -- Let Warp provide the content-length, since it takes
                        -- range requests into account
                        -- : ("Content-Length", S8.pack $ show filesize)
                        (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    ch
            Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ File -> Status -> ResponseHeaders -> Response
    fileToResponse File
    file Status
    H.status200 ResponseHeaders
    headers

        response NotModified =
                Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status304 [] ""

        response (SendContent mt :: ByteString
    mt lbs :: ByteString
    lbs) = do
                -- TODO: set caching headers
                Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status200
                    [ ("Content-Type", ByteString
    mt)
                      -- TODO: set Content-Length
                    ] ByteString
    lbs

        response (Redirect pieces' :: Pieces
    pieces' mHash :: Maybe ByteString
    mHash) = do
                let loc :: ByteString
    loc = StaticSettings -> Pieces -> ByteString -> ByteString
    ssMkRedirect StaticSettings
    ss Pieces
    pieces' (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    toLazyByteString ([Text] -> Builder
    H.encodePathSegments ([Text] -> Builder) -> [Text] -> Builder
    forall a b. (a -> b) -> a -> b
    $ (FolderName -> Text) -> Pieces -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map FolderName -> Text
    fromPiece Pieces
    pieces')
                let qString :: [(ByteString, Maybe ByteString)]
    qString = case Maybe ByteString
    mHash of
                      Just hash :: ByteString
    hash -> ByteString
    -> Maybe ByteString
    -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
    forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    replace "etag" (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    hash) (Request -> [(ByteString, Maybe ByteString)]
    W.queryString Request
    req)
                      Nothing   -> ByteString
    -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
    forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
    remove "etag" (Request -> [(ByteString, Maybe ByteString)]
    W.queryString Request
    req)

                Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status302
                    [ ("Content-Type", "text/plain")
                    , ("Location", ByteString -> ByteString -> ByteString
    S8.append ByteString
    loc (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Bool -> [(ByteString, Maybe ByteString)] -> ByteString
    H.renderQuery Bool
    True [(ByteString, Maybe ByteString)]
    qString)
                    ] "Redirect"

        response (RawRedirect path :: ByteString
    path) =
                Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status302
                    [ ("Content-Type", "text/plain")
                    , ("Location", ByteString
    path)
                    ] "Redirect"

        response NotFound = case (StaticSettings -> Maybe Application
    ss404Handler StaticSettings
    ss) of
            Just app :: Application
    app -> Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse
            Nothing  -> Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    W.responseLBS Status
    H.status404
                            [ ("Content-Type", "text/plain")
                            ] "File not found"

        response (WaiResponse r :: Response
    r) = Response -> IO ResponseReceived
    sendResponse Response
    r