    {-# OPTIONS_HADDOCK hide #-}
    {-# LANGUAGE ExistentialQuantification #-}
    -- |
    -- Module      : Network.TLS.Compression
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.Compression
        ( CompressionC(..)
        , Compression(..)
        , CompressionID
        , nullCompression
        , NullCompression

        -- * member redefined for the class abstraction
        , compressionID
        , compressionDeflate
        , compressionInflate

        -- * helper
        , compressionIntersectID
        ) where

    import Network.TLS.Types (CompressionID)
    import Network.TLS.Imports
    import Control.Arrow (first)

    -- | supported compression algorithms need to be part of this class
    class CompressionC a where
        compressionCID      :: a -> CompressionID
        compressionCDeflate :: a -> ByteString -> (a, ByteString)
        compressionCInflate :: a -> ByteString -> (a, ByteString)

    -- | every compression need to be wrapped in this, to fit in structure
    data Compression = forall a . CompressionC a => Compression a

    -- | return the associated ID for this algorithm
    compressionID :: Compression -> CompressionID
    compressionID :: Compression -> CompressionID
    compressionID (Compression c :: a
    c) = a -> CompressionID
    forall a. CompressionC a => a -> CompressionID
    compressionCID a
    c

    -- | deflate (compress) a bytestring using a compression context and return the result
    -- along with the new compression context.
    compressionDeflate :: ByteString -> Compression -> (Compression, ByteString)
    compressionDeflate :: ByteString -> Compression -> (Compression, ByteString)
    compressionDeflate bytes :: ByteString
    bytes (Compression c :: a
    c) = (a -> Compression) -> (a, ByteString) -> (Compression, ByteString)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first a -> Compression
    forall a. CompressionC a => a -> Compression
    Compression ((a, ByteString) -> (Compression, ByteString))
    -> (a, ByteString) -> (Compression, ByteString)
    forall a b. (a -> b) -> a -> b
    $ a -> ByteString -> (a, ByteString)
    forall a. CompressionC a => a -> ByteString -> (a, ByteString)
    compressionCDeflate a
    c ByteString
    bytes

    -- | inflate (decompress) a bytestring using a compression context and return the result
    -- along the new compression context.
    compressionInflate :: ByteString -> Compression -> (Compression, ByteString)
    compressionInflate :: ByteString -> Compression -> (Compression, ByteString)
    compressionInflate bytes :: ByteString
    bytes (Compression c :: a
    c) = (a -> Compression) -> (a, ByteString) -> (Compression, ByteString)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first a -> Compression
    forall a. CompressionC a => a -> Compression
    Compression ((a, ByteString) -> (Compression, ByteString))
    -> (a, ByteString) -> (Compression, ByteString)
    forall a b. (a -> b) -> a -> b
    $ a -> ByteString -> (a, ByteString)
    forall a. CompressionC a => a -> ByteString -> (a, ByteString)
    compressionCInflate a
    c ByteString
    bytes

    instance Show Compression where
        show :: Compression -> String
    show = CompressionID -> String
    forall a. Show a => a -> String
    show (CompressionID -> String)
    -> (Compression -> CompressionID) -> Compression -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Compression -> CompressionID
    compressionID
    instance Eq Compression where
        == :: Compression -> Compression -> Bool
    (==) c1 :: Compression
    c1 c2 :: Compression
    c2 = Compression -> CompressionID
    compressionID Compression
    c1 CompressionID -> CompressionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == Compression -> CompressionID
    compressionID Compression
    c2

    -- | intersect a list of ids commonly given by the other side with a list of compression
    -- the function keeps the list of compression in order, to be able to find quickly the prefered
    -- compression.
    compressionIntersectID :: [Compression] -> [Word8] -> [Compression]
    compressionIntersectID :: [Compression] -> [CompressionID] -> [Compression]
    compressionIntersectID l :: [Compression]
    l ids :: [CompressionID]
    ids = (Compression -> Bool) -> [Compression] -> [Compression]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\c :: Compression
    c -> Compression -> CompressionID
    compressionID Compression
    c CompressionID -> [CompressionID] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CompressionID]
    ids) [Compression]
    l

    -- | This is the default compression which is a NOOP.
    data NullCompression = NullCompression

    instance CompressionC NullCompression where
        compressionCID :: NullCompression -> CompressionID
    compressionCID _        = 0
        compressionCDeflate :: NullCompression -> ByteString -> (NullCompression, ByteString)
    compressionCDeflate s :: NullCompression
    s b :: ByteString
    b = (NullCompression
    s, ByteString
    b)
        compressionCInflate :: NullCompression -> ByteString -> (NullCompression, ByteString)
    compressionCInflate s :: NullCompression
    s b :: ByteString
    b = (NullCompression
    s, ByteString
    b)

    -- | default null compression
    nullCompression :: Compression
    nullCompression :: Compression
    nullCompression = NullCompression -> Compression
    forall a. CompressionC a => a -> Compression
    Compression NullCompression
    NullCompression