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 (Int -> CompressionType -> ShowS
[CompressionType] -> ShowS
CompressionType -> String
(Int -> CompressionType -> ShowS)
-> (CompressionType -> String)
-> ([CompressionType] -> ShowS)
-> Show CompressionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionType] -> ShowS
$cshowList :: [CompressionType] -> ShowS
show :: CompressionType -> String
$cshow :: CompressionType -> String
showsPrec :: Int -> CompressionType -> ShowS
$cshowsPrec :: Int -> CompressionType -> ShowS
Show, CompressionType -> CompressionType -> Bool
(CompressionType -> CompressionType -> Bool)
-> (CompressionType -> CompressionType -> Bool)
-> Eq CompressionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionType -> CompressionType -> Bool
$c/= :: CompressionType -> CompressionType -> Bool
== :: CompressionType -> CompressionType -> Bool
$c== :: CompressionType -> CompressionType -> Bool
Eq)

compressionTypeToTxt :: CompressionType -> Text
compressionTypeToTxt :: CompressionType -> Text
compressionTypeToTxt CompressionType
CTGZip = Text
"gzip"

-- | Maybe compress the response body
compressResponse ::
  NH.RequestHeaders ->
  BL.ByteString ->
  (BL.ByteString, Maybe NH.Header, Maybe CompressionType)
compressResponse :: RequestHeaders
-> ByteString -> (ByteString, Maybe Header, Maybe CompressionType)
compressResponse RequestHeaders
reqHeaders ByteString
unCompressedResp =
  let compressionTypeM :: Maybe CompressionType
compressionTypeM = RequestHeaders -> Maybe CompressionType
getAcceptedCompression RequestHeaders
reqHeaders
      appendCompressionType :: (ByteString, Maybe Header)
-> (ByteString, Maybe Header, Maybe CompressionType)
appendCompressionType (ByteString
res, Maybe Header
headerM) = (ByteString
res, Maybe Header
headerM, Maybe CompressionType
compressionTypeM)
      gzipCompressionParams :: CompressParams
gzipCompressionParams =
        -- See Note [Compression ratios]
        CompressParams
GZ.defaultCompressParams {compressLevel :: CompressionLevel
GZ.compressLevel = Int -> CompressionLevel
GZ.compressionLevel Int
1}
   in (ByteString, Maybe Header)
-> (ByteString, Maybe Header, Maybe CompressionType)
appendCompressionType ((ByteString, Maybe Header)
 -> (ByteString, Maybe Header, Maybe CompressionType))
-> (ByteString, Maybe Header)
-> (ByteString, Maybe Header, Maybe CompressionType)
forall a b. (a -> b) -> a -> b
$ case Maybe CompressionType
compressionTypeM of
        Just CompressionType
CTGZip -> (CompressParams -> ByteString -> ByteString
GZ.compressWith CompressParams
gzipCompressionParams ByteString
unCompressedResp, Header -> Maybe Header
forall a. a -> Maybe a
Just Header
gzipHeader)
        Maybe CompressionType
Nothing -> (ByteString
unCompressedResp, Maybe Header
forall a. Maybe a
Nothing)

-- | Which, if any, compressed encodings can the client accept?
--
-- https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Accept-Encoding
getAcceptedCompression :: NH.RequestHeaders -> Maybe CompressionType
getAcceptedCompression :: RequestHeaders -> Maybe CompressionType
getAcceptedCompression RequestHeaders
reqHeaders
  | Text
"gzip" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
acceptEncodingVals = CompressionType -> Maybe CompressionType
forall a. a -> Maybe a
Just CompressionType
CTGZip
  | Bool
otherwise = Maybe CompressionType
forall a. Maybe a
Nothing
  where
    acceptEncodingVals :: [Text]
acceptEncodingVals =
      (Header -> [Text]) -> RequestHeaders -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString -> [Text]
splitHeaderVal (ByteString -> [Text])
-> (Header -> ByteString) -> Header -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> ByteString
forall a b. (a, b) -> b
snd) (RequestHeaders -> [Text]) -> RequestHeaders -> [Text]
forall a b. (a -> b) -> a -> b
$
        (Header -> Bool) -> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\Header
h -> Header -> HeaderName
forall a b. (a, b) -> a
fst Header
h HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
NH.hAcceptEncoding) RequestHeaders
reqHeaders
    splitHeaderVal :: ByteString -> [Text]
splitHeaderVal ByteString
bs = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt ByteString
bs

{-
Note [Compression ratios]
~~~~~~~~~~~~~~~~~~~~~~~~~

I did some measurements of compression ratios at `gzip -1` (libc) of some
randomly generated json, real json datasets, and output from our benchmarked
chinook queries:

    2552/6131    = 0.41
    4666/8718    = 0.53
    13921/27131  = 0.51
    5895/8879    = 0.66  <----- completely random strings
    8634/28261   = 0.30
    70422/372466 = 0.18

    200/600      = 0.33  <----| from chinook graphql benchmarks
    3000/33000   = 0.09  <----|
    13000/190000 = 0.07  <----'

Given these numbers I would suggest using a rule-of-thumb expected compression
ratio between 2:1 and 10:1, depending on what being conservative means in the
context.

I didn't test higher compression levels much, but `gzip -4` for the most part
resulted in less than 10% smaller output on random json, and ~30% on our highly
compressible benchmark output.
-}