{-# 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(..)
	, nullCompression

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

	-- * helper
	, compressionIntersectID
	) where

import Data.Word
import Data.ByteString (ByteString)
import Control.Arrow (first)

-- | supported compression algorithms need to be part of this class
class CompressionC a where
	compressionCID      :: a -> Word8
	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 -> Word8
compressionID (Compression c) = compressionCID 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 bytes (Compression c) = first Compression $ compressionCDeflate c bytes

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

instance Show Compression where
	show = show . compressionID

-- | 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 l ids = filter (\c -> elem (compressionID c) ids) l

data NullCompression = NullCompression

instance CompressionC NullCompression where
	compressionCID _         = 0
	compressionCDeflate s b = (s, b)
	compressionCInflate s b = (s, b)

-- | default null compression
nullCompression :: Compression
nullCompression = Compression NullCompression