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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
{-# LANGUAGE OverloadedStrings #-}
module Network.HPACK.HeaderBlock.Integer (
encodeI,
encodeInteger,
decodeI,
decodeInteger,
) where
import Data.Array (Array, listArray)
import Data.Array.Base (unsafeAt)
import Network.ByteOrder
import Imports
-- $setup
-- >>> import qualified Data.ByteString as BS
powerArray :: Array Int Int
powerArray = listArray (1, 8) [1, 3, 7, 15, 31, 63, 127, 255]
----------------------------------------------------------------
{-
if I < 2^N - 1, encode I on N bits
else
encode (2^N - 1) on N bits
I = I - (2^N - 1)
while I >= 128
encode (I % 128 + 128) on 8 bits
I = I / 128
encode I on 8 bits
-}
-- | Encoding integer with a temporary buffer whose size is 4096.
-- No prefix is set.
--
-- >>> BS.unpack <$> encodeInteger 5 10
-- [10]
-- >>> BS.unpack <$> encodeInteger 5 1337
-- [31,154,10]
-- >>> BS.unpack <$> encodeInteger 8 42
-- [42]
encodeInteger
:: Int
-- ^ N+
-> Int
-- ^ Target
-> IO ByteString
encodeInteger n i = withWriteBuffer 4096 $ \wbuf -> encodeI wbuf id n i
-- Using write8 is faster than using internals directly.
--
-- | Integer encoding with a write buffer.
{-# INLINEABLE encodeI #-}
encodeI
:: WriteBuffer
-> (Word8 -> Word8)
-- ^ Setting prefix
-> Int
-- ^ N+
-> Int
-- ^ Target
-> IO ()
encodeI wbuf set n i
| i < p = write8 wbuf $ set $ fromIntegral i
| otherwise = do
write8 wbuf $ set $ fromIntegral p
encode' (i - p)
where
p = powerArray `unsafeAt` (n - 1)
encode' :: Int -> IO ()
encode' j
| j < 128 = write8 wbuf $ fromIntegral j
| otherwise = do
let q = j `shiftR` 7
r = j .&. 0x7f
write8 wbuf $ fromIntegral (r + 128)
encode' q
----------------------------------------------------------------
{-
decode I from the next N bits
if I < 2^N - 1, return I
else
M = 0
repeat
B = next octet
I = I + (B & 127) * 2^M
M = M + 7
while B & 128 == 128
return I
-}
-- | Integer decoding. The first argument is N of prefix.
--
-- >>> decodeInteger 5 10 $ BS.empty
-- 10
-- >>> decodeInteger 5 31 $ BS.pack [154,10]
-- 1337
-- >>> decodeInteger 8 42 $ BS.empty
-- 42
decodeInteger
:: Int
-- ^ N+
-> Word8
-- ^ The head of encoded integer whose prefix is already dropped
-> ByteString
-- ^ The tail of encoded integer
-> IO Int
decodeInteger n w bs = withReadBuffer bs $ \rbuf -> decodeI n w rbuf
{-# INLINEABLE decodeI #-}
-- | Integer decoding with a read buffer. The first argument is N of prefix.
decodeI
:: Int
-- ^ N+
-> Word8
-- ^ The head of encoded integer whose prefix is already dropped
-> ReadBuffer
-> IO Int
decodeI n w rbuf
| i < p = return i
| otherwise = decode 0 i
where
p = powerArray `unsafeAt` (n - 1)
i = fromIntegral w
decode :: Int -> Int -> IO Int
decode m j = do
b <- fromIntegral <$> read8 rbuf
let j' = j + (b .&. 0x7f) * 2 ^ m
m' = m + 7
cont = b `testBit` 7
if cont then decode m' j' else return j'
|
