-- | Public 'Compression' API
--
-- Intended for qualified import.
--
-- > import Network.GRPC.Common.Compression (Compression(..))
-- > import Network.GRPC.Common.Compression qualified as Compr
module Network.GRPC.Common.Compression (
    -- * Definition
    Compression(..)
  , CompressionId(..)
    -- * Standard compression schemes
  , gzip
  , allSupportedCompression
    -- * Negotation
  , Negotation(..)
  , getSupported
    -- ** Specific negotation strategies
  , none
  , chooseFirst
  , only
  , insist
  ) where

import Data.Default
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty(..))
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as Map

import Network.GRPC.Spec

{-------------------------------------------------------------------------------
  Negotation
-------------------------------------------------------------------------------}

-- | Compression negotation
data Negotation = Negotation {
      -- | Which algorithms should be offered (in this order) to the peer?
      --
      -- This should normally always include 'Identity' (see 'choose');
      -- but see 'insist'.
      Negotation -> NonEmpty CompressionId
offer :: NonEmpty CompressionId

      -- | Choose compression algorithm
      --
      -- We will run this only once per open connection, when the server first
      -- tells us their list of supported compression algorithms. Unless
      -- compression negotation has taken place, no compression should be used.
      --
      -- This cannot fail: the least common denominator is to use no
      -- compression. This must be allowed, because the gRPC specification
      -- /anyway/ allows a per-message flag to indicate whether the message
      -- is compressed or not; thus, even if a specific compression algorithm
      -- is negotiated, there is no guarantee anything is compressed.
    , Negotation -> NonEmpty CompressionId -> Compression
choose :: NonEmpty CompressionId -> Compression

      -- | All supported compression algorithms
    , Negotation -> Map CompressionId Compression
supported :: Map CompressionId Compression
    }

-- | Map 'CompressionId' to 'Compression' for supported algorithms
getSupported :: Negotation -> CompressionId -> Maybe Compression
getSupported :: Negotation -> CompressionId -> Maybe Compression
getSupported Negotation
compr CompressionId
cid = CompressionId -> Map CompressionId Compression -> Maybe Compression
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CompressionId
cid (Negotation -> Map CompressionId Compression
supported Negotation
compr)

instance Default Negotation where
  def :: Negotation
def = NonEmpty Compression -> Negotation
chooseFirst NonEmpty Compression
allSupportedCompression

-- | Disable all compression
none :: Negotation
none :: Negotation
none = Compression -> Negotation
insist Compression
noCompression

-- | Choose the first algorithm that appears in the list of peer supported
--
-- Precondition: the list should include the identity.
chooseFirst :: NonEmpty Compression -> Negotation
chooseFirst :: NonEmpty Compression -> Negotation
chooseFirst NonEmpty Compression
ourSupported = Negotation {
      offer :: NonEmpty CompressionId
offer =
        (Compression -> CompressionId)
-> NonEmpty Compression -> NonEmpty CompressionId
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compression -> CompressionId
compressionId NonEmpty Compression
ourSupported
    , choose :: NonEmpty CompressionId -> Compression
choose = \NonEmpty CompressionId
peerSupported ->
        let peerSupports :: Compression -> Bool
            peerSupports :: Compression -> Bool
peerSupports = (CompressionId -> NonEmpty CompressionId -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` NonEmpty CompressionId
peerSupported) (CompressionId -> Bool)
-> (Compression -> CompressionId) -> Compression -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression -> CompressionId
compressionId
        in case (Compression -> Bool) -> NonEmpty Compression -> [Compression]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter Compression -> Bool
peerSupports NonEmpty Compression
ourSupported of
             Compression
c:[Compression]
_ -> Compression
c
             []  -> Compression
noCompression
    , supported :: Map CompressionId Compression
supported =
        [(CompressionId, Compression)] -> Map CompressionId Compression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CompressionId, Compression)] -> Map CompressionId Compression)
-> [(CompressionId, Compression)] -> Map CompressionId Compression
forall a b. (a -> b) -> a -> b
$
          (Compression -> (CompressionId, Compression))
-> [Compression] -> [(CompressionId, Compression)]
forall a b. (a -> b) -> [a] -> [b]
map (\Compression
c -> (Compression -> CompressionId
compressionId Compression
c, Compression
c)) (NonEmpty Compression -> [Compression]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Compression
ourSupported)
    }

-- | Only use the given algorithm, if the peer supports it
only :: Compression -> Negotation
only :: Compression -> Negotation
only Compression
compr = NonEmpty Compression -> Negotation
chooseFirst (Compression
compr Compression -> [Compression] -> NonEmpty Compression
forall a. a -> [a] -> NonEmpty a
:| [Compression
noCompression])

-- | Insist on the specified algorithm, /no matter what the peer offers/
--
-- This is dangerous: if the peer does not support the specified algorithm, it
-- will be unable to decompress any messages. Primarily used for testing.
--
-- See also 'only'.
insist :: Compression -> Negotation
insist :: Compression -> Negotation
insist Compression
compr = Negotation {
      offer :: NonEmpty CompressionId
offer     = Compression -> CompressionId
compressionId Compression
compr CompressionId -> [CompressionId] -> NonEmpty CompressionId
forall a. a -> [a] -> NonEmpty a
:| []
    , choose :: NonEmpty CompressionId -> Compression
choose    = \NonEmpty CompressionId
_ -> Compression
compr
    , supported :: Map CompressionId Compression
supported = CompressionId -> Compression -> Map CompressionId Compression
forall k a. k -> a -> Map k a
Map.singleton (Compression -> CompressionId
compressionId Compression
compr) Compression
compr
    }