graphql-engine/server/src-lib/Hasura/Server/Compression.hs
Robert 11a454c2d6 server, pro: actually reformat the code-base using ormolu
This commit applies ormolu to the whole Haskell code base by running `make format`.

For in-flight branches, simply merging changes from `main` will result in merge conflicts.
To avoid this, update your branch using the following instructions. Replace `<format-commit>`
by the hash of *this* commit.

$ git checkout my-feature-branch
$ git merge <format-commit>^    # and resolve conflicts normally
$ make format
$ git commit -a -m "reformat with ormolu"
$ git merge -s ours post-ormolu

https://github.com/hasura/graphql-engine-mono/pull/2404

GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
2021-09-23 22:57:37 +00:00

44 lines
1.5 KiB
Haskell

module Hasura.Server.Compression
( compressResponse,
CompressionType (..),
compressionTypeToTxt,
)
where
import Codec.Compression.GZip qualified as GZ
import Data.ByteString.Lazy qualified as BL
import Data.Text qualified as T
import Hasura.Prelude
import Hasura.Server.Utils (gzipHeader)
import Network.HTTP.Types.Header qualified as NH
data CompressionType
= CTGZip
deriving (Show, Eq)
compressionTypeToTxt :: CompressionType -> Text
compressionTypeToTxt CTGZip = "gzip"
compressResponse ::
NH.RequestHeaders ->
BL.ByteString ->
(BL.ByteString, Maybe NH.Header, Maybe CompressionType)
compressResponse reqHeaders unCompressedResp =
let compressionTypeM = getRequestedCompression reqHeaders
appendCompressionType (res, headerM) = (res, headerM, compressionTypeM)
gzipCompressionParams =
GZ.defaultCompressParams {GZ.compressLevel = GZ.compressionLevel 1}
in appendCompressionType $ case compressionTypeM of
Just CTGZip -> (GZ.compressWith gzipCompressionParams unCompressedResp, Just gzipHeader)
Nothing -> (unCompressedResp, Nothing)
getRequestedCompression :: NH.RequestHeaders -> Maybe CompressionType
getRequestedCompression reqHeaders
| "gzip" `elem` acceptEncodingVals = Just CTGZip
| otherwise = Nothing
where
acceptEncodingVals =
concatMap (splitHeaderVal . snd) $
filter (\h -> fst h == NH.hAcceptEncoding) reqHeaders
splitHeaderVal bs = map T.strip $ T.splitOn "," $ bsToTxt bs