{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Compression
--
-- Intended for unqualified import.
module Network.GRPC.Spec.Compression (
    -- * Definition
    Compression(..)
  , noCompression
  , gzip
  , allSupportedCompression
  , compressionIsIdentity
    -- ** ID
  , CompressionId(..)
  , serializeCompressionId
  , deserializeCompressionId
  ) where

import Codec.Compression.GZip qualified as GZip
import Codec.Compression.Zlib qualified as Deflate
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Lazy qualified as Lazy (ByteString)
import Data.ByteString.UTF8 qualified as BS.Strict.UTF8
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty(..))
import Data.String
import GHC.Generics (Generic)

#ifdef SNAPPY
import Codec.Compression.SnappyC.Framed qualified as Snappy
#endif

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Compression scheme
data Compression = Compression {
      -- | Compression identifier
      Compression -> CompressionId
compressionId :: CompressionId

      -- | Compress
    , Compression -> ByteString -> ByteString
compress :: Lazy.ByteString -> Lazy.ByteString

      -- | Decompress
      --
      -- TODO: <https://github.com/well-typed/grapesy/issues/57>.
      -- We need to deal with decompression failures.
    , Compression -> ByteString -> ByteString
decompress :: Lazy.ByteString -> Lazy.ByteString

      -- | Uncompressed size threshold
      --
      -- Compression is only useful for uncompressed data sizes satisfying this
      -- predicate.
    , Compression -> Int64 -> Bool
uncompressedSizeThreshold :: Int64 -> Bool
    }

instance Show Compression where
  show :: Compression -> String
show Compression{CompressionId
compressionId :: Compression -> CompressionId
compressionId :: CompressionId
compressionId} = String
"<Compression " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CompressionId -> String
forall a. Show a => a -> String
show CompressionId
compressionId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | All supported compression algorithms supported
--
-- The order of this list is important: algorithms listed earlier are preferred
-- over algorithms listed later.
allSupportedCompression :: NonEmpty Compression
allSupportedCompression :: NonEmpty Compression
allSupportedCompression =
    Compression
gzip Compression -> [Compression] -> NonEmpty Compression
forall a. a -> [a] -> NonEmpty a
:|
      [ Compression
deflate
#ifdef SNAPPY
      , Compression
snappy
#endif
      , Compression
noCompression
      ]

{-------------------------------------------------------------------------------
  Compression ID
-------------------------------------------------------------------------------}

-- | Compression ID
--
-- The gRPC specification defines
--
-- > Content-Coding → "identity" / "gzip" / "deflate" / "snappy" / {custom}
data CompressionId =
    Identity
  | GZip
  | Deflate
  | Snappy
  | Custom String
  deriving stock (CompressionId -> CompressionId -> Bool
(CompressionId -> CompressionId -> Bool)
-> (CompressionId -> CompressionId -> Bool) -> Eq CompressionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionId -> CompressionId -> Bool
== :: CompressionId -> CompressionId -> Bool
$c/= :: CompressionId -> CompressionId -> Bool
/= :: CompressionId -> CompressionId -> Bool
Eq, Eq CompressionId
Eq CompressionId =>
(CompressionId -> CompressionId -> Ordering)
-> (CompressionId -> CompressionId -> Bool)
-> (CompressionId -> CompressionId -> Bool)
-> (CompressionId -> CompressionId -> Bool)
-> (CompressionId -> CompressionId -> Bool)
-> (CompressionId -> CompressionId -> CompressionId)
-> (CompressionId -> CompressionId -> CompressionId)
-> Ord CompressionId
CompressionId -> CompressionId -> Bool
CompressionId -> CompressionId -> Ordering
CompressionId -> CompressionId -> CompressionId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompressionId -> CompressionId -> Ordering
compare :: CompressionId -> CompressionId -> Ordering
$c< :: CompressionId -> CompressionId -> Bool
< :: CompressionId -> CompressionId -> Bool
$c<= :: CompressionId -> CompressionId -> Bool
<= :: CompressionId -> CompressionId -> Bool
$c> :: CompressionId -> CompressionId -> Bool
> :: CompressionId -> CompressionId -> Bool
$c>= :: CompressionId -> CompressionId -> Bool
>= :: CompressionId -> CompressionId -> Bool
$cmax :: CompressionId -> CompressionId -> CompressionId
max :: CompressionId -> CompressionId -> CompressionId
$cmin :: CompressionId -> CompressionId -> CompressionId
min :: CompressionId -> CompressionId -> CompressionId
Ord, (forall x. CompressionId -> Rep CompressionId x)
-> (forall x. Rep CompressionId x -> CompressionId)
-> Generic CompressionId
forall x. Rep CompressionId x -> CompressionId
forall x. CompressionId -> Rep CompressionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompressionId -> Rep CompressionId x
from :: forall x. CompressionId -> Rep CompressionId x
$cto :: forall x. Rep CompressionId x -> CompressionId
to :: forall x. Rep CompressionId x -> CompressionId
Generic)

-- | Serialize compression ID
serializeCompressionId :: CompressionId -> Strict.ByteString
serializeCompressionId :: CompressionId -> ByteString
serializeCompressionId CompressionId
Identity   = ByteString
"identity"
serializeCompressionId CompressionId
GZip       = ByteString
"gzip"
serializeCompressionId CompressionId
Deflate    = ByteString
"deflate"
serializeCompressionId CompressionId
Snappy     = ByteString
"snappy"
serializeCompressionId (Custom String
i) = String -> ByteString
BS.Strict.UTF8.fromString String
i

-- | Parse compression ID
deserializeCompressionId :: Strict.ByteString -> CompressionId
deserializeCompressionId :: ByteString -> CompressionId
deserializeCompressionId ByteString
"identity" = CompressionId
Identity
deserializeCompressionId ByteString
"gzip"     = CompressionId
GZip
deserializeCompressionId ByteString
"deflate"  = CompressionId
Deflate
deserializeCompressionId ByteString
"snappy"   = CompressionId
Snappy
deserializeCompressionId ByteString
i          = String -> CompressionId
Custom (ByteString -> String
BS.Strict.UTF8.toString ByteString
i)

instance Show CompressionId where
  show :: CompressionId -> String
show = ByteString -> String
BS.Strict.UTF8.toString (ByteString -> String)
-> (CompressionId -> ByteString) -> CompressionId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressionId -> ByteString
serializeCompressionId

instance IsString CompressionId where
  fromString :: String -> CompressionId
fromString = ByteString -> CompressionId
deserializeCompressionId (ByteString -> CompressionId)
-> (String -> ByteString) -> String -> CompressionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.Strict.UTF8.fromString

compressionIsIdentity :: Compression -> Bool
compressionIsIdentity :: Compression -> Bool
compressionIsIdentity = (CompressionId -> CompressionId -> Bool
forall a. Eq a => a -> a -> Bool
== CompressionId
Identity) (CompressionId -> Bool)
-> (Compression -> CompressionId) -> Compression -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression -> CompressionId
compressionId

{-------------------------------------------------------------------------------
  Compression algorithms
-------------------------------------------------------------------------------}

-- | Disable compression (referred to as @identity@ in the gRPC spec)
noCompression :: Compression
noCompression :: Compression
noCompression = Compression {
      compressionId :: CompressionId
compressionId             = CompressionId
Identity
    , compress :: ByteString -> ByteString
compress                  = ByteString -> ByteString
forall a. a -> a
id
    , decompress :: ByteString -> ByteString
decompress                = ByteString -> ByteString
forall a. a -> a
id
    , uncompressedSizeThreshold :: Int64 -> Bool
uncompressedSizeThreshold = Bool -> Int64 -> Bool
forall a b. a -> b -> a
const Bool
False
    }

-- | @gzip@
gzip :: Compression
gzip :: Compression
gzip = Compression {
      compressionId :: CompressionId
compressionId = CompressionId
GZip
    , compress :: ByteString -> ByteString
compress      = ByteString -> ByteString
GZip.compress
    , decompress :: ByteString -> ByteString
decompress    = ByteString -> ByteString
GZip.decompress

      -- gzip only achieves a compression ratio of 8:7 for messages of at least
      -- 27 bytes.
    , uncompressedSizeThreshold :: Int64 -> Bool
uncompressedSizeThreshold = (Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
27)
    }

-- | @zlib@ (aka @deflate@) compression
--
-- Note: The gRPC spec calls this "deflate", but it is /not/ raw deflate
-- format. The expected format (at least by the python server) is just zlib
-- (which is an envelope holding the deflate data).
deflate :: Compression
deflate :: Compression
deflate = Compression {
      compressionId :: CompressionId
compressionId = CompressionId
Deflate
    , compress :: ByteString -> ByteString
compress      = ByteString -> ByteString
Deflate.compress
    , decompress :: ByteString -> ByteString
decompress    = ByteString -> ByteString
Deflate.decompress

      -- zlib deflate only achieves a compression ratio of 8:7 for messages of
      -- at least 13 bytes.
    , uncompressedSizeThreshold :: Int64 -> Bool
uncompressedSizeThreshold = (Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
13)
    }

#ifdef SNAPPY
-- | Snappy compression
snappy :: Compression
snappy :: Compression
snappy = Compression {
      compressionId :: CompressionId
compressionId = CompressionId
Snappy
    , compress :: ByteString -> ByteString
compress      = ByteString -> ByteString
Snappy.compress
    , decompress :: ByteString -> ByteString
decompress    = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
Snappy.decompress

      -- snappy only achieves a compression ratio of 8:7 for messages of at
      -- least 28 bytes.
    , uncompressedSizeThreshold :: Int64 -> Bool
uncompressedSizeThreshold = (Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
28)
    }
#endif