    {-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
    ---------------------------------------------------------
    -- |
    -- 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
        ( gzip
        , GzipSettings
        , gzipFiles
        , GzipFiles (..)
        , gzipCheckMime
        , def
        , defaultCheckMime
        ) where

    import Network.Wai
    import Data.Maybe (fromMaybe, isJust)
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString as S
    import Data.Default.Class
    import Network.HTTP.Types ( Status, Header, hContentEncoding, hUserAgent
                              , hContentType, hContentLength)
    import System.Directory (doesFileExist, createDirectoryIfMissing)
    import Data.ByteString.Builder (byteString)
    import qualified Data.ByteString.Builder.Extra as Blaze (flush)
    import Control.Exception (try, SomeException)
    import qualified Data.Set as Set
    import Network.Wai.Header
    import Network.Wai.Internal
    import qualified Data.Streaming.ByteString.Builder as B
    import qualified Data.Streaming.Zlib as Z
    import Control.Monad (unless)
    import Data.Function (fix)
    import Control.Exception (throwIO)
    import qualified System.IO as IO
    import Data.ByteString.Lazy.Internal (defaultChunkSize)
    import Data.Word8 (_semicolon)

    data GzipSettings = GzipSettings
        { GzipSettings -> GzipFiles
    gzipFiles :: GzipFiles
        , GzipSettings -> ByteString -> Bool
    gzipCheckMime :: S.ByteString -> Bool
        }

    -- | Gzip behavior for files.
    data GzipFiles
        = GzipIgnore -- ^ Do not compress file responses.
        | GzipCompress -- ^ Compress files. Note that this may counteract
                       -- zero-copy response optimizations on some
                       -- platforms.
        | GzipCacheFolder FilePath -- ^ Compress files, caching them in
                                   -- some directory.
        | GzipPreCompressed GzipFiles -- ^ 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
        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
    showList :: [GzipFiles] -> ShowS
    $cshowList :: [GzipFiles] -> ShowS
    show :: GzipFiles -> String
    $cshow :: GzipFiles -> String
    showsPrec :: Int -> GzipFiles -> ShowS
    $cshowsPrec :: Int -> GzipFiles -> ShowS
    Show, GzipFiles -> GzipFiles -> Bool
    (GzipFiles -> GzipFiles -> Bool)
    -> (GzipFiles -> GzipFiles -> Bool) -> Eq GzipFiles
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: GzipFiles -> GzipFiles -> Bool
    $c/= :: GzipFiles -> GzipFiles -> Bool
    == :: GzipFiles -> GzipFiles -> Bool
    $c== :: 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
    readListPrec :: ReadPrec [GzipFiles]
    $creadListPrec :: ReadPrec [GzipFiles]
    readPrec :: ReadPrec GzipFiles
    $creadPrec :: ReadPrec GzipFiles
    readList :: ReadS [GzipFiles]
    $creadList :: ReadS [GzipFiles]
    readsPrec :: Int -> ReadS GzipFiles
    $creadsPrec :: Int -> ReadS GzipFiles
    Read)

    -- | Use default MIME settings; /do not/ compress files.
    instance Default GzipSettings where
        def :: GzipSettings
    def = GzipFiles -> (ByteString -> Bool) -> GzipSettings
    GzipSettings GzipFiles
    GzipIgnore ByteString -> Bool
    defaultCheckMime

    -- | 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 bs :: ByteString
    bs =
        ByteString -> ByteString -> Bool
    S8.isPrefixOf "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
            [ "application/json"
            , "application/javascript"
            , "application/ecmascript"
            , "image/x-icon"
            ]

    -- | Use gzip to compress the body of the response.
    --
    -- Analyzes the \"Accept-Encoding\" header from the client to determine
    -- if gzip is supported.
    --
    -- File responses will be compressed according to the 'GzipFiles' setting.
    --
    -- Will only be applied based on the 'gzipCheckMime' setting. For default
    -- behavior, see 'defaultCheckMime'.
    gzip :: GzipSettings -> Middleware
    gzip :: GzipSettings -> Middleware
    gzip set :: GzipSettings
    set app :: Application
    app env :: Request
    env sendResponse :: Response -> IO ResponseReceived
    sendResponse = Application
    app Request
    env ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \res :: Response
    res ->
        case Response
    res of
            ResponseRaw{} -> Response -> IO ResponseReceived
    sendResponse Response
    res
            ResponseFile{} | GzipSettings -> GzipFiles
    gzipFiles GzipSettings
    set GzipFiles -> GzipFiles -> Bool
    forall a. Eq a => a -> a -> Bool
    == GzipFiles
    GzipIgnore -> Response -> IO ResponseReceived
    sendResponse Response
    res
            _ -> if "gzip" String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    enc Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    isMSIE6 Bool -> Bool -> Bool
    && Bool -> Bool
    not (Response -> Bool
    isEncoded Response
    res) Bool -> Bool -> Bool
    && (Response -> Bool
    bigEnough Response
    res)
                    then
                        let runAction :: (Response, GzipFiles) -> IO ResponseReceived
    runAction x :: (Response, GzipFiles)
    x = case (Response, GzipFiles)
    x of
                                (ResponseFile s :: Status
    s hs :: ResponseHeaders
    hs file :: String
    file Nothing, GzipPreCompressed nextAction :: GzipFiles
    nextAction) ->
                                     let
                                        compressedVersion :: String
    compressedVersion = String
    file String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ".gz"
                                     in
                                        String -> IO Bool
    doesFileExist String
    compressedVersion IO Bool -> (Bool -> IO ResponseReceived) -> IO ResponseReceived
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \y :: 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))
                                (ResponseFile s :: Status
    s hs :: ResponseHeaders
    hs file :: String
    file Nothing, GzipCacheFolder cache :: String
    cache) ->
                                    case HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hContentType ResponseHeaders
    hs of
                                        Just m :: ByteString
    m
                                            | GzipSettings -> ByteString -> Bool
    gzipCheckMime GzipSettings
    set ByteString
    m -> Status
    -> ResponseHeaders
    -> String
    -> String
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    forall a.
    Status
    -> ResponseHeaders
    -> String
    -> String
    -> (Response -> IO a)
    -> IO a
    compressFile Status
    s ResponseHeaders
    hs String
    file String
    cache Response -> IO ResponseReceived
    sendResponse
                                        _ -> Response -> IO ResponseReceived
    sendResponse Response
    res
                                (ResponseFile {}, GzipIgnore) -> Response -> IO ResponseReceived
    sendResponse Response
    res
                                _ -> GzipSettings
    -> Response
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    forall a. GzipSettings -> Response -> (Response -> IO a) -> IO a
    compressE GzipSettings
    set Response
    res Response -> IO ResponseReceived
    sendResponse
                        in (Response, GzipFiles) -> IO ResponseReceived
    runAction (Response
    res, GzipSettings -> GzipFiles
    gzipFiles GzipSettings
    set)
                    else Response -> IO ResponseReceived
    sendResponse Response
    res
      where
        enc :: [String]
    enc = [String] -> Maybe [String] -> [String]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> [String]
    splitCommas (String -> [String])
    -> (ByteString -> String) -> ByteString -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    S8.unpack)
                        (ByteString -> [String]) -> Maybe ByteString -> Maybe [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "Accept-Encoding" (Request -> ResponseHeaders
    requestHeaders Request
    env)
        ua :: ByteString
    ua = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hUserAgent (ResponseHeaders -> Maybe ByteString)
    -> ResponseHeaders -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> ResponseHeaders
    requestHeaders Request
    env
        isMSIE6 :: Bool
    isMSIE6 = "MSIE 6" ByteString -> ByteString -> Bool
    `S.isInfixOf` ByteString
    ua
        isEncoded :: Response -> Bool
    isEncoded res :: Response
    res = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hContentEncoding (ResponseHeaders -> Maybe ByteString)
    -> ResponseHeaders -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Response -> ResponseHeaders
    responseHeaders Response
    res

        bigEnough :: Response -> Bool
    bigEnough rsp :: Response
    rsp = case ResponseHeaders -> Maybe Integer
    contentLength (Response -> ResponseHeaders
    responseHeaders Response
    rsp) of
          Nothing -> Bool
    True -- This could be a streaming case
          Just len :: Integer
    len -> Integer
    len Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    minimumLength

        -- 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 = 860

    compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a
    compressFile :: Status
    -> ResponseHeaders
    -> String
    -> String
    -> (Response -> IO a)
    -> IO a
    compressFile s :: Status
    s hs :: ResponseHeaders
    hs file :: String
    file cache :: String
    cache sendResponse :: 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
    $ \inH :: 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
    $ \outH :: Handle
    outH -> do
                        Deflate
    deflate <- Int -> WindowBits -> IO Deflate
    Z.initDeflate 7 (WindowBits -> IO Deflate) -> WindowBits -> IO Deflate
    forall a b. (a -> b) -> a -> b
    $ Int -> WindowBits
    Z.WindowBits 31
                        -- FIXME this code should write to a temporary file, then
                        -- rename to the final file
                        let goPopper :: IO PopperRes -> IO ()
    goPopper popper :: 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
    $ \loop :: IO ()
    loop -> do
                                PopperRes
    res <- IO PopperRes
    popper
                                case PopperRes
    res of
                                    Z.PRDone -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                    Z.PRNext bs :: ByteString
    bs -> do
                                        Handle -> ByteString -> IO ()
    S.hPut Handle
    outH ByteString
    bs
                                        IO ()
    loop
                                    Z.PRError ex :: 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
    $ \loop :: 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 (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
    forall p. p -> IO a
    onErr (IO a -> () -> IO a
    forall a b. a -> b -> a
    const IO a
    onSucc) (Either SomeException ()
    x :: Either SomeException ()) -- FIXME bad! don't catch all exceptions like that!
      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

        onErr :: p -> IO a
    onErr _ = 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 -- FIXME log the error message

        tmpfile :: String
    tmpfile = String
    cache String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ '/' Char -> ShowS
    forall a. a -> [a] -> [a]
    : (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    safe String
    file
        safe :: Char -> Char
    safe c :: Char
    c
            | 'A' Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 'Z' = Char
    c
            | 'a' Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 'z' = Char
    c
            | '0' Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= '9' = Char
    c
        safe '-' = '-'
        safe '_' = '_'
        safe _ = '_'

    compressE :: GzipSettings
              -> Response
              -> (Response -> IO a)
              -> IO a
    compressE :: GzipSettings -> Response -> (Response -> IO a) -> IO a
    compressE set :: GzipSettings
    set res :: Response
    res sendResponse :: Response -> IO a
    sendResponse =
        case HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hContentType ResponseHeaders
    hs of
            Just m :: ByteString
    m | GzipSettings -> ByteString -> Bool
    gzipCheckMime GzipSettings
    set ByteString
    m ->
                let hs' :: ResponseHeaders
    hs' = ResponseHeaders -> ResponseHeaders
    fixHeaders ResponseHeaders
    hs
                 in (StreamingBody -> IO a) -> IO a
    forall a. (StreamingBody -> IO a) -> IO a
    wb ((StreamingBody -> IO a) -> IO a)
    -> (StreamingBody -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \body :: StreamingBody
    body -> Response -> IO a
    sendResponse (Response -> IO a) -> Response -> IO a
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> StreamingBody -> Response
    responseStream Status
    s ResponseHeaders
    hs' (StreamingBody -> Response) -> StreamingBody -> Response
    forall a b. (a -> b) -> a -> b
    $ \sendChunk :: Builder -> IO ()
    sendChunk flush :: IO ()
    flush -> do
                        (blazeRecv :: BuilderRecv
    blazeRecv, _) <- BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
    B.newBuilderRecv BufferAllocStrategy
    B.defaultStrategy
                        Deflate
    deflate <- Int -> WindowBits -> IO Deflate
    Z.initDeflate 1 (Int -> WindowBits
    Z.WindowBits 31)
                        let sendBuilder :: Builder -> IO ()
    sendBuilder builder :: 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
    $ \loop :: 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 bs :: ByteString
    bs = Deflate -> ByteString -> IO (IO PopperRes)
    Z.feedDeflate Deflate
    deflate ByteString
    bs IO (IO PopperRes) -> (IO PopperRes -> IO ()) -> IO ()
    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 popper :: 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
    $ \loop :: IO ()
    loop -> do
                                PopperRes
    result <- IO PopperRes
    popper
                                case PopperRes
    result of
                                    Z.PRDone -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                    Z.PRNext bs' :: 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 e :: 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
            _ -> Response -> IO a
    sendResponse Response
    res
      where
        (s :: Status
    s, hs :: ResponseHeaders
    hs, wb :: (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
    hContentEncoding, "gzip") (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    :) (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 (x :: HeaderName
    x, _) = HeaderName
    x HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HeaderName
    hContentLength

    splitCommas :: String -> [String]
    splitCommas :: String -> [String]
    splitCommas [] = []
    splitCommas x :: String
    x =
        let (y :: String
    y, z :: String
    z) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ',') String
    x
         in String
    y String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    splitCommas ((Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ' ') ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 1 String
    z)