    ---------------------------------------------------------

    ---------------------------------------------------------

    -- |
    -- Module        : Network.Wai.Middleware.Gzip
    -- Copyright     : Michael Snoyman
    -- License       : BSD3
    --
    -- Maintainer    : Michael Snoyman <michael@snoyman.com>
    -- Stability     : Unstable
    -- Portability   : portable
    --
    -- Automatic gzip compression of responses.
    module Network.Wai.Middleware.Gzip (
        -- * How to use this module
        -- $howto

        -- ** The Middleware
        -- $gzip
        gzip,

        -- ** The Settings
        -- $settings
        GzipSettings,
        defaultGzipSettings,
        gzipFiles,
        gzipCheckMime,
        gzipSizeThreshold,

        -- ** How to handle file responses
        GzipFiles (..),

        -- ** Miscellaneous
        -- $miscellaneous
        defaultCheckMime,
        def,
    ) where

    import Control.Exception (
        IOException,
        SomeException,
        fromException,
        throwIO,
        try,
     )
    import Control.Monad (unless)
    import qualified Data.ByteString as S
    import Data.ByteString.Builder (byteString)
    import qualified Data.ByteString.Builder.Extra as Blaze (flush)
    import qualified Data.ByteString.Char8 as S8
    import Data.ByteString.Lazy.Internal (defaultChunkSize)
    import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
    import Data.Default.Class (Default (..))
    import Data.Function (fix)
    import Data.Maybe (isJust)
    import qualified Data.Set as Set
    import qualified Data.Streaming.ByteString.Builder as B
    import qualified Data.Streaming.Zlib as Z
    import Data.Word8 as W8 (toLower, _semicolon)
    import Network.HTTP.Types (
        Header,
        Status (statusCode),
        hContentEncoding,
        hContentLength,
        hContentType,
        hUserAgent,
     )
    import Network.HTTP.Types.Header (hAcceptEncoding, hETag, hVary)
    import Network.Wai
    import Network.Wai.Internal (Response (..))
    import System.Directory (createDirectoryIfMissing, doesFileExist)
    import qualified System.IO as IO

    import Network.Wai.Header (contentLength, parseQValueList, replaceHeader)
    import Network.Wai.Util (splitCommas, trimWS)

    -- $howto
    --
    -- This 'Middleware' adds @gzip encoding@ to an application.
    -- Its use is pretty straightforward, but it's good to know
    -- how and when it decides to encode the response body.
    --
    -- A few things to keep in mind when using this middleware:
    --
    -- * It is advised to put any 'Middleware's that change the
    --   response behind this one, because it bases a lot of its
    --   decisions on the returned response.
    -- * Enabling compression may counteract zero-copy response
    --   optimizations on some platforms.
    -- * This middleware is applied to every response by default.
    --   If it should only encode certain paths,
    --   "Network.Wai.Middleware.Routed" might be helpful.

    -- $gzip
    --
    -- There are a good amount of requirements that should be
    -- fulfilled before a response will actually be @gzip encoded@
    -- by this 'Middleware', so here's a short summary.
    --
    -- Request requirements:
    --
    -- * The request needs to accept \"gzip\" in the \"Accept-Encoding\" header.
    -- * Requests from Internet Explorer 6 will not be encoded.
    --   (i.e. if the request's \"User-Agent\" header contains \"MSIE 6\")
    --
    -- Response requirements:
    --
    -- * The response isn't already encoded. (i.e. shouldn't already
    --   have a \"Content-Encoding\" header)
    -- * The response isn't a @206 Partial Content@ (partial content
    --   should never be compressed)
    -- * If the response contains a \"Content-Length\" header, it
    --   should be larger than the 'gzipSizeThreshold'.
    -- * The \"Content-Type\" response header's value should
    --   evaluate to 'True' when applied to 'gzipCheckMime'
    --   (though 'GzipPreCompressed' will use the \".gz\" file regardless
    --   of MIME type on any 'ResponseFile' response)

    -- $settings
    --
    -- If you would like to use the default settings, using just 'def' is enough.
    -- The default settings don't compress file responses, only builder and stream
    -- responses, and only if the response passes the MIME and length checks. (cf.
    -- 'defaultCheckMime' and 'gzipSizeThreshold')
    --
    -- To customize your own settings, use the 'def' method and set the
    -- fields you would like to change as follows:
    --
    -- @
    -- myGzipSettings :: 'GzipSettings'
    -- myGzipSettings =
    --   'defaultGzipSettings'
    --     { 'gzipFiles' = 'GzipCompress'
    --     , 'gzipCheckMime' = myMimeCheckFunction
    --     , 'gzipSizeThreshold' = 860
    --     }
    -- @

    data GzipSettings = GzipSettings
        { GzipSettings -> GzipFiles
    gzipFiles :: GzipFiles
        -- ^ Gzip behavior for files
        --
        -- Only applies to 'ResponseFile' ('responseFile') responses.
        -- So any streamed data will be compressed based solely on the
        -- response headers having the right \"Content-Type\" and
        -- \"Content-Length\". (which are checked with 'gzipCheckMime'
        -- and 'gzipSizeThreshold', respectively)
        , GzipSettings -> ByteString -> Bool
    gzipCheckMime :: S.ByteString -> Bool
        -- ^ Decide which files to compress based on MIME type
        --
        -- The 'S.ByteString' is the value of the \"Content-Type\" response
        -- header and will default to 'False' if the header is missing.
        --
        -- E.g. if you'd only want to compress @json@ data, you might
        -- define your own function as follows:
        --
        -- > myCheckMime mime = mime == "application/json"
        , GzipSettings -> Integer
    gzipSizeThreshold :: Integer
        -- ^ Skip compression when the size of the response body is
        -- below this amount of bytes (default: 860.)
        --
        -- /Setting this option to less than 150 will actually increase/
        -- /the size of outgoing data if its original size is less than 150 bytes/.
        --
        -- This will only skip compression if the response includes a
        -- \"Content-Length\" header /AND/ the length is less than this
        -- threshold.
        }

    -- | Gzip behavior for files.
    data GzipFiles
        = -- | Do not compress file ('ResponseFile') responses.
          -- Any 'ResponseBuilder' or 'ResponseStream' might still be compressed.
          GzipIgnore
        | -- | Compress files. Note that this may counteract
          -- zero-copy response optimizations on some platforms.
          GzipCompress
        | -- | Compress files, caching the compressed version in the given directory.
          GzipCacheFolder FilePath
        | -- | Takes the ETag response header into consideration when caching
          -- files in the given folder. If there's no ETag header,
          -- this setting is equivalent to 'GzipCacheFolder'.
          --
          -- N.B. Make sure the 'gzip' middleware is applied before
          -- any 'Middleware' that will set the ETag header.
          --
          -- @since 3.1.12
          GzipCacheETag FilePath
        | -- | If we use compression then try to use the filename with \".gz\"
          -- appended to it. If the file is missing then try next action.
          --
          -- @since 3.0.17
          GzipPreCompressed GzipFiles
        deriving (Int -> GzipFiles -> ShowS
    [GzipFiles] -> ShowS
    GzipFiles -> String
    (Int -> GzipFiles -> ShowS)
    -> (GzipFiles -> String)
    -> ([GzipFiles] -> ShowS)
    -> Show GzipFiles
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> GzipFiles -> ShowS
    showsPrec :: Int -> GzipFiles -> ShowS
    $cshow :: GzipFiles -> String
    show :: GzipFiles -> String
    $cshowList :: [GzipFiles] -> ShowS
    showList :: [GzipFiles] -> ShowS
    Show, GzipFiles -> GzipFiles -> Bool
    (GzipFiles -> GzipFiles -> Bool)
    -> (GzipFiles -> GzipFiles -> Bool) -> Eq GzipFiles
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: GzipFiles -> GzipFiles -> Bool
    == :: GzipFiles -> GzipFiles -> Bool
    $c/= :: GzipFiles -> GzipFiles -> Bool
    /= :: GzipFiles -> GzipFiles -> Bool
    Eq, ReadPrec [GzipFiles]
    ReadPrec GzipFiles
    Int -> ReadS GzipFiles
    ReadS [GzipFiles]
    (Int -> ReadS GzipFiles)
    -> ReadS [GzipFiles]
    -> ReadPrec GzipFiles
    -> ReadPrec [GzipFiles]
    -> Read GzipFiles
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS GzipFiles
    readsPrec :: Int -> ReadS GzipFiles
    $creadList :: ReadS [GzipFiles]
    readList :: ReadS [GzipFiles]
    $creadPrec :: ReadPrec GzipFiles
    readPrec :: ReadPrec GzipFiles
    $creadListPrec :: ReadPrec [GzipFiles]
    readListPrec :: ReadPrec [GzipFiles]
    Read)

    -- $miscellaneous
    --
    -- 'def' is re-exported for convenience sake, and 'defaultCheckMime'
    -- is exported in case anyone wants to use it in defining their own
    -- 'gzipCheckMime' function.

    -- | Use default MIME settings; /do not/ compress files; skip
    -- compression on data smaller than 860 bytes.
    instance Default GzipSettings where
        def :: GzipSettings
    def = GzipSettings
    defaultGzipSettings

    -- | Default settings for the 'gzip' middleware.
    --
    -- * Does not compress files.
    -- * Uses 'defaultCheckMime'.
    -- * Compession threshold set to 860 bytes.
    --
    -- @since 3.1.14.0
    defaultGzipSettings :: GzipSettings
    defaultGzipSettings :: GzipSettings
    defaultGzipSettings = GzipFiles -> (ByteString -> Bool) -> Integer -> GzipSettings
    GzipSettings GzipFiles
    GzipIgnore ByteString -> Bool
    defaultCheckMime Integer
    minimumLength

    -- | MIME types that will be compressed by default:
    -- @text/@ @*@, @application/json@, @application/javascript@,
    -- @application/ecmascript@, @image/x-icon@.
    defaultCheckMime :: S.ByteString -> Bool
    defaultCheckMime :: ByteString -> Bool
    defaultCheckMime ByteString
    bs =
        ByteString -> ByteString -> Bool
    S8.isPrefixOf ByteString
    "text/" ByteString
    bs Bool -> Bool -> Bool
    || ByteString
    bs' ByteString -> Set ByteString -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ByteString
    toCompress
      where
        bs' :: ByteString
    bs' = (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> a
    fst ((ByteString, ByteString) -> ByteString)
    -> (ByteString, ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    S.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _semicolon) ByteString
    bs
        toCompress :: Set ByteString
    toCompress =
            [ByteString] -> Set ByteString
    forall a. Ord a => [a] -> Set a
    Set.fromList
                [ ByteString
    "application/json"
                , ByteString
    "application/javascript"
                , ByteString
    "application/ecmascript"
                , ByteString
    "image/x-icon"
                ]

    -- | Use gzip to compress the body of the response.
    gzip :: GzipSettings -> Middleware
    gzip :: GzipSettings -> Middleware
    gzip GzipSettings
    set Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse'
        | Bool
    skipCompress = Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse
        | Bool
    otherwise = Application
    app Request
    req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> ((Response -> IO ResponseReceived)
        -> Response -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    checkCompress ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    res ->
            let runAction :: (Response, GzipFiles) -> IO ResponseReceived
    runAction (Response, GzipFiles)
    x = case (Response, GzipFiles)
    x of
                    (ResponseRaw{}, GzipFiles
    _) -> Response -> IO ResponseReceived
    sendResponse Response
    res
                    -- Always skip if 'GzipIgnore'
                    (ResponseFile{}, GzipFiles
    GzipIgnore) -> Response -> IO ResponseReceived
    sendResponse Response
    res
                    -- If there's a compressed version of the file, we send that.
                    (ResponseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    Nothing, GzipPreCompressed GzipFiles
    nextAction) ->
                        let compressedVersion :: String
    compressedVersion = String
    file String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ".gz"
                         in String -> IO Bool
    doesFileExist String
    compressedVersion IO Bool -> (Bool -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    y ->
                                if Bool
    y
                                    then Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
    ResponseFile Status
    s (ResponseHeaders -> ResponseHeaders
    fixHeaders ResponseHeaders
    hs) String
    compressedVersion Maybe FilePart
    forall a. Maybe a
    Nothing
                                    else (Response, GzipFiles) -> IO ResponseReceived
    runAction (Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
    ResponseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    forall a. Maybe a
    Nothing, GzipFiles
    nextAction)
                    -- Skip if it's not a MIME type we want to compress
                    (Response, GzipFiles)
    _ | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ResponseHeaders -> Bool
    isCorrectMime (Response -> ResponseHeaders
    responseHeaders Response
    res) -> Response -> IO ResponseReceived
    sendResponse Response
    res
                    -- Use static caching logic
                    (ResponseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    Nothing, GzipCacheFolder String
    cache) ->
                        Status
    -> ResponseHeaders
    -> String
    -> Maybe ByteString
    -> String
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    forall a.
    Status
    -> ResponseHeaders
    -> String
    -> Maybe ByteString
    -> String
    -> (Response -> IO a)
    -> IO a
    compressFile Status
    s ResponseHeaders
    hs String
    file Maybe ByteString
    forall a. Maybe a
    Nothing String
    cache Response -> IO ResponseReceived
    sendResponse
                    -- Use static caching logic with "ETag" signatures
                    (ResponseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    Nothing, GzipCacheETag String
    cache) ->
                        let mETag :: Maybe ByteString
    mETag = HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hETag ResponseHeaders
    hs
                         in Status
    -> ResponseHeaders
    -> String
    -> Maybe ByteString
    -> String
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    forall a.
    Status
    -> ResponseHeaders
    -> String
    -> Maybe ByteString
    -> String
    -> (Response -> IO a)
    -> IO a
    compressFile Status
    s ResponseHeaders
    hs String
    file Maybe ByteString
    mETag String
    cache Response -> IO ResponseReceived
    sendResponse
                    -- Use streaming logic
                    (Response, GzipFiles)
    _ -> Response
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    compressE Response
    res Response -> IO ResponseReceived
    sendResponse
             in (Response, GzipFiles) -> IO ResponseReceived
    runAction (Response
    res, GzipSettings -> GzipFiles
    gzipFiles GzipSettings
    set)
      where
        isCorrectMime :: ResponseHeaders -> Bool
    isCorrectMime =
            Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (GzipSettings -> ByteString -> Bool
    gzipCheckMime GzipSettings
    set) (Maybe ByteString -> Bool)
    -> (ResponseHeaders -> Maybe ByteString) -> ResponseHeaders -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hContentType
        sendResponse :: Response -> IO ResponseReceived
    sendResponse = Response -> IO ResponseReceived
    sendResponse' (Response -> IO ResponseReceived)
    -> (Response -> Response) -> Response -> IO ResponseReceived
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ResponseHeaders -> ResponseHeaders) -> Response -> Response
    mapResponseHeaders ResponseHeaders -> ResponseHeaders
    mAddVary
        acceptEncoding :: ByteString
    acceptEncoding = ByteString
    "Accept-Encoding"
        acceptEncodingLC :: ByteString
    acceptEncodingLC = ByteString
    "accept-encoding"
        -- Instead of just adding a header willy-nilly, we check if
        -- "Vary" is already present, and add to it if not already included.
        mAddVary :: ResponseHeaders -> ResponseHeaders
    mAddVary [] = [(HeaderName
    hVary, ByteString
    acceptEncoding)]
        mAddVary (h :: (HeaderName, ByteString)
    h@(HeaderName
    nm, ByteString
    val) : ResponseHeaders
    hs)
            | HeaderName
    nm HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName
    hVary =
                let vals :: [ByteString]
    vals = ByteString -> [ByteString]
    splitCommas ByteString
    val
                    lowercase :: ByteString -> ByteString
    lowercase = (Word8 -> Word8) -> ByteString -> ByteString
    S.map Word8 -> Word8
    W8.toLower
                    -- Field names are case-insensitive, so we lowercase to match
                    hasAccEnc :: Bool
    hasAccEnc = ByteString
    acceptEncodingLC ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> ByteString
    lowercase [ByteString]
    vals
                    newH :: (HeaderName, ByteString)
    newH
                        | Bool
    hasAccEnc = (HeaderName, ByteString)
    h
                        | Bool
    otherwise = (HeaderName
    hVary, ByteString
    acceptEncoding ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    ", " ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    val)
                 in (HeaderName, ByteString)
    newH (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    hs
            | Bool
    otherwise = (HeaderName, ByteString)
    h (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders -> ResponseHeaders
    mAddVary ResponseHeaders
    hs

        -- Can we skip from just looking at the 'Request'?
        skipCompress :: Bool
    skipCompress =
            Bool -> Bool
    not Bool
    acceptsGZipEncoding Bool -> Bool -> Bool
    || Bool
    isMSIE6
          where
            reqHdrs :: ResponseHeaders
    reqHdrs = Request -> ResponseHeaders
    requestHeaders Request
    req
            acceptsGZipEncoding :: Bool
    acceptsGZipEncoding =
                Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (((ByteString, Maybe Int) -> Bool)
    -> [(ByteString, Maybe Int)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (ByteString, Maybe Int) -> Bool
    forall {a} {a}.
    (IsString a, Eq a, Eq a, Num a) =>
    (a, Maybe a) -> Bool
    isGzip ([(ByteString, Maybe Int)] -> Bool)
    -> (ByteString -> [(ByteString, Maybe Int)]) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [(ByteString, Maybe Int)]
    parseQValueList) (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderName
    hAcceptEncoding HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` ResponseHeaders
    reqHdrs
            isGzip :: (a, Maybe a) -> Bool
    isGzip (a
    bs, Maybe a
    q) =
                -- We skip if 'q' = Nothing, because it is malformed,
                -- or if it is 0, because that is an explicit "DO NOT USE GZIP"
                a
    bs a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    "gzip" Bool -> Bool -> Bool
    && Bool -> (a -> Bool) -> Maybe a -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0) Maybe a
    q
            isMSIE6 :: Bool
    isMSIE6 =
                Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (ByteString
    "MSIE 6" ByteString -> ByteString -> Bool
    `S.isInfixOf`) (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderName
    hUserAgent HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` ResponseHeaders
    reqHdrs

        -- Can we skip just by looking at the current 'Response'?
        checkCompress
            :: (Response -> IO ResponseReceived) -> Response -> IO ResponseReceived
        checkCompress :: (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    checkCompress Response -> IO ResponseReceived
    continue Response
    res =
            if Bool
    isEncodedAlready Bool -> Bool -> Bool
    || Bool
    isPartial Bool -> Bool -> Bool
    || Bool
    tooSmall
                then Response -> IO ResponseReceived
    sendResponse Response
    res
                else Response -> IO ResponseReceived
    continue Response
    res
          where
            resHdrs :: ResponseHeaders
    resHdrs = Response -> ResponseHeaders
    responseHeaders Response
    res
            -- Partial content should NEVER be compressed.
            isPartial :: Bool
    isPartial = Status -> Int
    statusCode (Response -> Status
    responseStatus Response
    res) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    206
            isEncodedAlready :: Bool
    isEncodedAlready = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderName
    hContentEncoding HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` ResponseHeaders
    resHdrs
            tooSmall :: Bool
    tooSmall =
                Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                    Bool
    False -- This could be a streaming case
                    (Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < GzipSettings -> Integer
    gzipSizeThreshold GzipSettings
    set)
                    (Maybe Integer -> Bool) -> Maybe Integer -> Bool
    forall a b. (a -> b) -> a -> b
    $ ResponseHeaders -> Maybe Integer
    contentLength ResponseHeaders
    resHdrs

    -- For a small enough response, gzipping will actually increase the size
    -- Potentially for anything less than 860 bytes gzipping could be a net loss
    -- The actual number is application specific though and may need to be adjusted
    -- http://webmasters.stackexchange.com/questions/31750/what-is-recommended-minimum-object-size-for-gzip-performance-benefits
    minimumLength :: Integer
    minimumLength :: Integer
    minimumLength = Integer
    860

    compressFile
        :: Status
        -> [Header]
        -> FilePath
        -> Maybe S.ByteString
        -> FilePath
        -> (Response -> IO a)
        -> IO a
    compressFile :: forall a.
    Status
    -> ResponseHeaders
    -> String
    -> Maybe ByteString
    -> String
    -> (Response -> IO a)
    -> IO a
    compressFile Status
    s ResponseHeaders
    hs String
    file Maybe ByteString
    mETag String
    cache Response -> IO a
    sendResponse = do
        Bool
    e <- String -> IO Bool
    doesFileExist String
    tmpfile
        if Bool
    e
            then IO a
    onSucc
            else do
                Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    cache
                Either SomeException ()
    x <- IO () -> IO (Either SomeException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $
                    String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    IO.withBinaryFile String
    file IOMode
    IO.ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    inH ->
                        String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    IO.withBinaryFile String
    tmpfile IOMode
    IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    outH -> do
                            Deflate
    deflate <- Int -> WindowBits -> IO Deflate
    Z.initDeflate Int
    7 (WindowBits -> IO Deflate) -> WindowBits -> IO Deflate
    forall a b. (a -> b) -> a -> b
    $ Int -> WindowBits
    Z.WindowBits Int
    31
                            -- FIXME this code should write to a temporary file, then
                            -- rename to the final file
                            let goPopper :: IO PopperRes -> IO ()
    goPopper IO PopperRes
    popper = (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IO ()
    loop -> do
                                    PopperRes
    res <- IO PopperRes
    popper
                                    case PopperRes
    res of
                                        PopperRes
    Z.PRDone -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                        Z.PRNext ByteString
    bs -> do
                                            Handle -> ByteString -> IO ()
    S.hPut Handle
    outH ByteString
    bs
                                            IO ()
    loop
                                        Z.PRError ZlibException
    ex -> ZlibException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ZlibException
    ex
                            (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IO ()
    loop -> do
                                ByteString
    bs <- Handle -> Int -> IO ByteString
    S.hGetSome Handle
    inH Int
    defaultChunkSize
                                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Bool
    S.null ByteString
    bs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                    Deflate -> ByteString -> IO (IO PopperRes)
    Z.feedDeflate Deflate
    deflate ByteString
    bs IO (IO PopperRes) -> (IO PopperRes -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO PopperRes -> IO ()
    goPopper
                                    IO ()
    loop
                            IO PopperRes -> IO ()
    goPopper (IO PopperRes -> IO ()) -> IO PopperRes -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Deflate -> IO PopperRes
    Z.finishDeflate Deflate
    deflate
                (SomeException -> IO a)
    -> (() -> IO a) -> Either SomeException () -> IO a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> IO a
    onErr (IO a -> () -> IO a
    forall a b. a -> b -> a
    const IO a
    onSucc) (Either SomeException ()
    x :: Either SomeException ())
      where
        onSucc :: IO a
    onSucc = Response -> IO a
    sendResponse (Response -> IO a) -> Response -> IO a
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
    responseFile Status
    s (ResponseHeaders -> ResponseHeaders
    fixHeaders ResponseHeaders
    hs) String
    tmpfile Maybe FilePart
    forall a. Maybe a
    Nothing
        reportError :: String -> IO ()
    reportError String
    err =
            Handle -> String -> IO ()
    IO.hPutStrLn Handle
    IO.stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                String
    "Network.Wai.Middleware.Gzip: compression failed: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    err
        onErr :: SomeException -> IO a
    onErr SomeException
    e
            -- Catching IOExceptions for file system / hardware oopsies
            | Just IOException
    ioe <- SomeException -> Maybe IOException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e = do
                String -> IO ()
    reportError (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IOException -> String
    forall a. Show a => a -> String
    show (IOException
    ioe :: IOException)
                Response -> IO a
    sendResponse (Response -> IO a) -> Response -> IO a
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
    responseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    forall a. Maybe a
    Nothing
            -- Catching ZlibExceptions for compression oopsies
            | Just ZlibException
    zlibe <- SomeException -> Maybe ZlibException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e = do
                String -> IO ()
    reportError (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ZlibException -> String
    forall a. Show a => a -> String
    show (ZlibException
    zlibe :: Z.ZlibException)
                Response -> IO a
    sendResponse (Response -> IO a) -> Response -> IO a
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
    responseFile Status
    s ResponseHeaders
    hs String
    file Maybe FilePart
    forall a. Maybe a
    Nothing
            | Bool
    otherwise = SomeException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO SomeException
    e

        -- If there's an ETag, use it as the suffix of the cached file.
        eTag :: String
    eTag = String -> (ByteString -> String) -> Maybe ByteString -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    safe ShowS -> (ByteString -> String) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    S8.unpack (ByteString -> String)
    -> (ByteString -> ByteString) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    trimWS) Maybe ByteString
    mETag
        tmpfile :: String
    tmpfile = String
    cache String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/' Char -> ShowS
    forall a. a -> [a] -> [a]
    : (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    safe String
    file String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    eTag

        safe :: Char -> Char
    safe Char
    c
            | Char -> Bool
    isAsciiUpper Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isAsciiLower Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isDigit Char
    c = Char
    c
        safe Char
    '-' = Char
    '-'
        safe Char
    '_' = Char
    '_'
        safe Char
    _ = Char
    '_'

    compressE
        :: Response
        -> (Response -> IO ResponseReceived)
        -> IO ResponseReceived
    compressE :: Response
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    compressE Response
    res Response -> IO ResponseReceived
    sendResponse =
        (StreamingBody -> IO ResponseReceived) -> IO ResponseReceived
    forall {a}. (StreamingBody -> IO a) -> IO a
    wb ((StreamingBody -> IO ResponseReceived) -> IO ResponseReceived)
    -> (StreamingBody -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \StreamingBody
    body -> Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $
            Status -> ResponseHeaders -> StreamingBody -> Response
    responseStream Status
    s (ResponseHeaders -> ResponseHeaders
    fixHeaders ResponseHeaders
    hs) (StreamingBody -> Response) -> StreamingBody -> Response
    forall a b. (a -> b) -> a -> b
    $ \Builder -> IO ()
    sendChunk IO ()
    flush -> do
                (BuilderRecv
    blazeRecv, BuilderFinish
    _) <- BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
    B.newBuilderRecv BufferAllocStrategy
    B.defaultStrategy
                Deflate
    deflate <- Int -> WindowBits -> IO Deflate
    Z.initDeflate Int
    1 (Int -> WindowBits
    Z.WindowBits Int
    31)
                let sendBuilder :: Builder -> IO ()
    sendBuilder Builder
    builder = do
                        IO ByteString
    popper <- BuilderRecv
    blazeRecv Builder
    builder
                        (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IO ()
    loop -> do
                            ByteString
    bs <- IO ByteString
    popper
                            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Bool
    S.null ByteString
    bs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                ByteString -> IO ()
    sendBS ByteString
    bs
                                IO ()
    loop
                    sendBS :: ByteString -> IO ()
    sendBS ByteString
    bs = Deflate -> ByteString -> IO (IO PopperRes)
    Z.feedDeflate Deflate
    deflate ByteString
    bs IO (IO PopperRes) -> (IO PopperRes -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO PopperRes -> IO ()
    deflatePopper
                    flushBuilder :: IO ()
    flushBuilder = do
                        Builder -> IO ()
    sendBuilder Builder
    Blaze.flush
                        IO PopperRes -> IO ()
    deflatePopper (IO PopperRes -> IO ()) -> IO PopperRes -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Deflate -> IO PopperRes
    Z.flushDeflate Deflate
    deflate
                        IO ()
    flush
                    deflatePopper :: IO PopperRes -> IO ()
    deflatePopper IO PopperRes
    popper = (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IO ()
    loop -> do
                        PopperRes
    result <- IO PopperRes
    popper
                        case PopperRes
    result of
                            PopperRes
    Z.PRDone -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                            Z.PRNext ByteString
    bs' -> do
                                Builder -> IO ()
    sendChunk (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    byteString ByteString
    bs'
                                IO ()
    loop
                            Z.PRError ZlibException
    e -> ZlibException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ZlibException
    e

                StreamingBody
    body Builder -> IO ()
    sendBuilder IO ()
    flushBuilder
                Builder -> IO ()
    sendBuilder Builder
    Blaze.flush
                IO PopperRes -> IO ()
    deflatePopper (IO PopperRes -> IO ()) -> IO PopperRes -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Deflate -> IO PopperRes
    Z.finishDeflate Deflate
    deflate
      where
        (Status
    s, ResponseHeaders
    hs, (StreamingBody -> IO a) -> IO a
    wb) = Response
    -> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
    forall a.
    Response
    -> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
    responseToStream Response
    res

    -- Remove Content-Length header, since we will certainly have a
    -- different length after gzip compression.
    fixHeaders :: [Header] -> [Header]
    fixHeaders :: ResponseHeaders -> ResponseHeaders
    fixHeaders =
        HeaderName -> ByteString -> ResponseHeaders -> ResponseHeaders
    replaceHeader HeaderName
    hContentEncoding ByteString
    "gzip" (ResponseHeaders -> ResponseHeaders)
    -> (ResponseHeaders -> ResponseHeaders)
    -> ResponseHeaders
    -> ResponseHeaders
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((HeaderName, ByteString) -> Bool)
    -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter (HeaderName, ByteString) -> Bool
    forall {b}. (HeaderName, b) -> Bool
    notLength
      where
        notLength :: (HeaderName, b) -> Bool
    notLength (HeaderName
    x, b
    _) = HeaderName
    x HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HeaderName
    hContentLength