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
|
{-# LANGUAGE OverloadedStrings #-}
module HPACKEncode (
run,
EncodeStrategy (..),
defaultEncodeStrategy,
CompressionAlgo (..),
) where
import Control.Monad (when)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as C8
import Data.Char
import Data.Maybe (fromMaybe)
import Network.HPACK
import Network.HPACK.Table
import JSON
data Conf = Conf
{ debug :: Bool
, enc :: DynamicTable -> HeaderList -> IO ByteString
}
run :: Bool -> EncodeStrategy -> Test -> IO [ByteString]
run _ _ (Test _ []) = return []
run d stgy (Test _ ccs@(c : _)) = do
let siz = fromMaybe 4096 $ size c
withDynamicTableForEncoding siz $ \dyntbl -> do
let conf = Conf{debug = d, enc = encodeHeader stgy 4096}
testLoop conf ccs dyntbl []
testLoop
:: Conf
-> [Case]
-> DynamicTable
-> [ByteString]
-> IO [ByteString]
testLoop _ [] _ hexs = return $ reverse hexs
testLoop conf (c : cs) dyntbl hxs = do
hx <- test conf c dyntbl
testLoop conf cs dyntbl (C8.map toLower hx : hxs)
test
:: Conf
-> Case
-> DynamicTable
-> IO ByteString
test conf c dyntbl = do
out <- enc conf dyntbl hs
let hex' = B16.encode out
when (debug conf) $ do
putStrLn "---- Output context"
printDynamicTable dyntbl
putStrLn "--------------------------------"
return hex'
where
hs = headers c
|
