1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_HADDOCK hide #-}
module Network.TLS.Compression (
CompressionC (..),
Compression (..),
CompressionID,
nullCompression,
NullCompression,
-- * member redefined for the class abstraction
compressionID,
compressionDeflate,
compressionInflate,
-- * helper
compressionIntersectID,
) where
import Control.Arrow (first)
import Network.TLS.Imports
import Network.TLS.Types (CompressionID)
-- | 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 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
instance Eq Compression where
(==) c1 c2 = compressionID c1 == compressionID 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 l ids = filter (\c -> compressionID c `elem` ids) l
-- | This is the default compression which is a NOOP.
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
|
