1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-26 08:52:12 +03:00
graphql-engine/server/src-lib/Hasura/Server/Compression.hs
Rakesh Emmadi f80b69e931
few actions' fixes and improvements (fix , & close ) ()
* add 'ID' to default scalars for custom types, fix 

* preserve cookie headers from sync action webhook, close 

* validate action webhook response to conform to output type, fix 

* fix tests, don't run actions' tests on PG version < 10

* update CHANGELOG.md

* no-op refactor, use types from http-network more

Co-authored-by: Vamshi Surabhi <0x777@users.noreply.github.com>
2020-03-20 12:16:45 +05:30

45 lines
1.5 KiB
Haskell

module Hasura.Server.Compression
( compressResponse
, CompressionType(..)
, compressionTypeToTxt
)
where
import Hasura.Prelude
import Hasura.Server.Utils (gzipHeader)
import qualified Codec.Compression.GZip as GZ
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Network.HTTP.Types.Header as NH
data CompressionType
= CTGZip
deriving (Show, Eq)
compressionTypeToTxt :: CompressionType -> T.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