{-# 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 Network.HTTP.Types.Header (hVary)
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, _space, _comma)

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 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.
--
-- 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 GzipSettings
set Application
app Request
env 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
$ \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
        Response
_ -> if ByteString
"gzip" ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
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 (Response, GzipFiles)
x = case (Response, GzipFiles)
x of
                            (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 (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))
                            (ResponseFile Status
s ResponseHeaders
hs String
file Maybe FilePart
Nothing, GzipCacheFolder String
cache) ->
                                case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType ResponseHeaders
hs of
                                    Just 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
                                    Maybe ByteString
_ -> Response -> IO ResponseReceived
sendResponse Response
res
                            (ResponseFile {}, GzipFiles
GzipIgnore) -> Response -> IO ResponseReceived
sendResponse Response
res
                            (Response, GzipFiles)
_ -> 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
    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 ((HeaderName, ByteString)
vary(HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
:)
    vary :: (HeaderName, ByteString)
vary = (HeaderName
hVary, ByteString
"Accept-Encoding")
    enc :: [ByteString]
enc = [ByteString] -> Maybe [ByteString] -> [ByteString]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [ByteString] -> [ByteString])
-> Maybe [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
splitCommas
                    (ByteString -> [ByteString])
-> Maybe ByteString -> Maybe [ByteString]
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 HeaderName
"Accept-Encoding" (Request -> ResponseHeaders
requestHeaders Request
env)
    ua :: ByteString
ua = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (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 = ByteString
"MSIE 6" ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString
ua
    isEncoded :: Response -> Bool
isEncoded 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 Response
rsp = case ResponseHeaders -> Maybe Integer
contentLength (Response -> ResponseHeaders
responseHeaders Response
rsp) of
      Maybe Integer
Nothing -> Bool
True -- This could be a streaming case
      Just 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 = Integer
860

compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a
compressFile :: Status
-> ResponseHeaders
-> String
-> String
-> (Response -> IO a)
-> IO a
compressFile Status
s ResponseHeaders
hs String
file 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 (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 (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 p
_ = 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
'/' 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 Char
c
        | Char
'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
<= Char
'Z' = Char
c
        | Char
'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
<= Char
'z' = Char
c
        | Char
'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
<= Char
'9' = Char
c
    safe Char
'-' = Char
'-'
    safe Char
'_' = Char
'_'
    safe Char
_ = Char
'_'

compressE :: GzipSettings
          -> Response
          -> (Response -> IO a)
          -> IO a
compressE :: GzipSettings -> Response -> (Response -> IO a) -> IO a
compressE GzipSettings
set Response
res 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 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
$ \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
$ \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 (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 (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
        Maybe ByteString
_ -> Response -> IO a
sendResponse Response
res
  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
hContentEncoding, ByteString
"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 (HeaderName
x, b
_) = HeaderName
x HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
hContentLength

splitCommas :: S.ByteString -> [S.ByteString]
splitCommas :: ByteString -> [ByteString]
splitCommas = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space)) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
S.split Word8
_comma