http2 1.6.1 → 1.6.2
raw patch · 13 files changed
+380/−144 lines, 13 files
Files
- Network/HPACK/Buffer.hs +13/−0
- Network/HPACK/HeaderBlock/Decode.hs +9/−8
- Network/HPACK/HeaderBlock/Encode.hs +5/−1
- Network/HPACK/HeaderBlock/Integer.hs +6/−4
- Network/HPACK/Huffman/Decode.hs +7/−6
- Network/HPACK/Huffman/Encode.hs +54/−104
- Network/HPACK/Huffman/Table.hs +262/−0
- Network/HPACK/Table/Dynamic.hs +9/−8
- Network/HPACK/Table/RevIndex.hs +7/−6
- Network/HPACK/Table/Static.hs +3/−2
- http2.cabal +1/−1
- test-frame/JSON.hs +2/−2
- test-hpack/JSON.hs +2/−2
Network/HPACK/Buffer.hs view
@@ -20,6 +20,7 @@ , hasMoreBytes , rewindOneByte , getByte+ , getByte' , extractByteString ) where @@ -173,6 +174,18 @@ w <- peek ptr writeIORef cur $! ptr `plusPtr` 1 return w++{-# INLINE getByte' #-}+getByte' :: ReadBuffer -> IO Int+getByte' ReadBuffer{..} = do+ ptr <- readIORef cur+ if ptr < end then do+ w <- peek ptr+ writeIORef cur $! ptr `plusPtr` 1+ let !i = fromIntegral w+ return i+ else+ return (-1) extractByteString :: ReadBuffer -> Int -> IO ByteString extractByteString ReadBuffer{..} len = do
Network/HPACK/HeaderBlock/Decode.hs view
@@ -14,7 +14,8 @@ import Control.Exception (throwIO) import Control.Monad (unless, when) import Data.Maybe (isJust)-import Data.Array (Array, (!))+import Data.Array (Array)+import Data.Array.Base (unsafeAt, unsafeRead, unsafeWrite) import qualified Data.Array.IO as IOA import qualified Data.Array.Unsafe as Unsafe import Data.Bits (testBit, clearBit, (.&.))@@ -38,7 +39,7 @@ -- | Accessing 'HeaderValue' with 'Token'. {-# INLINE getHeaderValue #-} getHeaderValue :: Token -> ValueTable -> Maybe HeaderValue-getHeaderValue t tbl = tbl ! tokenIx t+getHeaderValue t tbl = tbl `unsafeAt` tokenIx t ---------------------------------------------------------------- @@ -123,15 +124,15 @@ w <- getByte rbuf tv@(!Token{..},!v) <- toTokenHeader dyntbl w rbuf if isPseudo then do- mx <- IOA.readArray arr ix+ mx <- unsafeRead arr ix when (isJust mx) $ throwIO IllegalHeaderName when (isMaxTokenIx ix) $ throwIO IllegalHeaderName- IOA.writeArray arr ix (Just v)+ unsafeWrite arr ix (Just v) pseudo else do when (isMaxTokenIx ix && B8.any isUpper (original tokenKey)) $ throwIO IllegalHeaderName- IOA.writeArray arr ix (Just v)+ unsafeWrite arr ix (Just v) if isCookieTokenIx ix then normal empty (empty << v) else@@ -146,7 +147,7 @@ when isPseudo $ throwIO IllegalHeaderName when (isMaxTokenIx ix && B8.any isUpper (original tokenKey)) $ throwIO IllegalHeaderName- IOA.writeArray arr ix (Just v)+ unsafeWrite arr ix (Just v) if isCookieTokenIx ix then normal builder (cookie << v) else@@ -159,7 +160,7 @@ else do let !v = BS.intercalate "; " cook !tvs = (tokenCookie, v) : tvs0- IOA.writeArray arr cookieTokenIx (Just v)+ unsafeWrite arr cookieTokenIx (Just v) return tvs toTokenHeader :: DynamicTable -> Word8 -> ReadBuffer -> IO TokenHeader@@ -300,7 +301,7 @@ go [] builder = return $ run builder go ((k,v):xs) builder = do let !t = toToken (foldedCase k)- IOA.writeArray arr (tokenIx t) (Just v)+ unsafeWrite arr (tokenIx t) (Just v) let !tv = (t,v) !builder' = builder << tv go xs builder'
Network/HPACK/HeaderBlock/Encode.hs view
@@ -242,7 +242,11 @@ wind wbuf expectedIntLen len <- Huffman.encode wbuf bs let !intLen = integerLength len- if intLen == expectedIntLen then do+ if origLen < len then do+ wind wbuf (negate (expectedIntLen + len))+ I.encode wbuf id 7 origLen+ copyByteString wbuf bs+ else if intLen == expectedIntLen then do wind wbuf (negate (expectedIntLen + len)) I.encode wbuf setH 7 len wind wbuf len
Network/HPACK/HeaderBlock/Integer.hs view
@@ -10,7 +10,8 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif-import Data.Array (Array, listArray, (!))+import Data.Array (Array, listArray)+import Data.Array.Base (unsafeAt) import Data.Bits ((.&.), shiftR, testBit) import Data.ByteString (ByteString) import Data.Word (Word8)@@ -38,6 +39,7 @@ encodeInteger :: Int -> Int -> IO ByteString encodeInteger n i = withTemporaryBuffer 4096 $ \wbuf -> encode wbuf id n i +-- Using writeWord8 is faster than using internals directly. {-# INLINABLE encode #-} encode :: WorkingBuffer -> (Word8 -> Word8) -> Int -> Int -> IO () encode wbuf set n i@@ -46,7 +48,7 @@ writeWord8 wbuf $ set $ fromIntegral p encode' (i - p) where- !p = powerArray ! n+ !p = powerArray `unsafeAt` (n - 1) encode' :: Int -> IO () encode' j | j < 128 = writeWord8 wbuf $ fromIntegral j@@ -89,8 +91,8 @@ | i < p = return i | otherwise = decode' 0 i where- p = powerArray ! n- i = fromIntegral w+ !p = powerArray `unsafeAt` (n - 1)+ !i = fromIntegral w decode' :: Int -> Int -> IO Int decode' m j = do !b <- fromIntegral <$> getByte rbuf
Network/HPACK/Huffman/Decode.hs view
@@ -8,7 +8,8 @@ ) where import Control.Exception (throwIO)-import Data.Array (Array, (!), listArray)+import Data.Array (Array, listArray)+import Data.Array.Base (unsafeAt) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..)) import Data.Word (Word8)@@ -39,7 +40,7 @@ type Way256 = Array Word8 WayStep next :: WayStep -> Word8 -> Pin-next (WayStep _ a16) w = a16 ! w+next (WayStep _ a16) w = a16 `unsafeAt` fromIntegral w ---------------------------------------------------------------- @@ -51,7 +52,7 @@ toByteString wbuf dec :: WorkingBuffer -> ReadBuffer -> Int -> IO ()-dec wbuf rbuf len = go len (way256 ! 0)+dec wbuf rbuf len = go len (way256 `unsafeAt` 0) where go 0 way0 = case way0 of WayStep Nothing _ -> throwIO IllegalEos@@ -64,14 +65,14 @@ go (n - 1) way doit !way !w = case next way w of EndOfString -> throwIO EosInTheMiddle- Forward n -> return $ way256 ! n+ Forward n -> return $ way256 `unsafeAt` fromIntegral n GoBack n v -> do writeWord8 wbuf v- return $ way256 ! n+ return $ way256 `unsafeAt` fromIntegral n GoBack2 n v1 v2 -> do writeWord8 wbuf v1 writeWord8 wbuf v2- return $ way256 ! n+ return $ way256 `unsafeAt` fromIntegral n decodeHuffman :: ByteString -> IO ByteString decodeHuffman bs = withTemporaryBuffer 4096 $ \wbuf ->
Network/HPACK/Huffman/Encode.hs view
@@ -12,77 +12,27 @@ #endif import Control.Exception (throwIO) import Control.Monad (when, void)-import Data.Array-import Data.Bits ((.|.))+import Data.Array.Base (unsafeAt)+import Data.Array.IArray (listArray)+import Data.Array.Unboxed (UArray)+import Data.Bits ((.|.), shiftR, shiftL) import Data.ByteString (ByteString) import Data.IORef-import Data.Word (Word8)-import Foreign.Ptr (plusPtr, minusPtr, Ptr)-import Foreign.Storable (peek, poke)+import Data.Word (Word8, Word64)+import Foreign.Ptr (plusPtr, minusPtr)+import Foreign.Storable (poke) import Network.HPACK.Buffer-import Network.HPACK.Huffman.Bit-import Network.HPACK.Huffman.Params+import Network.HPACK.Huffman.Params (idxEos) import Network.HPACK.Huffman.Table import Network.HPACK.Types (BufferOverrun(..)) ---------------------------------------------------------------- -type AOSA = Array Int ShiftedArray--type ShiftedArray = Array Int Shifted--data WS = W0- | W1 !Word8- | W2 !Word8 !Word8- | W3 !Word8 !Word8 !Word8- | W4 !Word8 !Word8 !Word8 !Word8- deriving Show--data Shifted = Shifted !Int -- How many bits in the last byte- !Int -- Total bytes (3rd + 4th)- !Word8 -- First word. If Int is 0, this is dummy- !WS -- Following words, up to 4 bytes- deriving Show--------------------------------------------------------------------aosa :: AOSA-aosa = listArray (0,idxEos) $ map toShiftedArray huffmanTable---- |------ >>> toShifted [T,T,T,T] 0--- Shifted 4 1 240 W0--- >>> toShifted [T,T,T,T] 4--- Shifted 0 1 15 W0--- >>> toShifted [T,T,T,T] 5--- Shifted 1 2 7 (W1 128)--toShifted :: Bits -> Int -> Shifted-toShifted bits n = Shifted r siz w ws- where- shifted = replicate n F ++ bits- len = length shifted- !r = len `mod` 8- ws0 = map fromBits $ group8 shifted- !siz = length ws0- !w = head ws0- !ws = case tail ws0 of- [] -> W0- [w1] -> W1 w1- [w1,w2] -> W2 w1 w2- [w1,w2,w3] -> W3 w1 w2 w3- [w1,w2,w3,w4] -> W4 w1 w2 w3 w4- _ -> error "toShifted"- group8 xs- | null zs = pad ys : []- | otherwise = ys : group8 zs- where- (ys,zs) = splitAt 8 xs- pad xs = take 8 $ xs ++ repeat F+huffmanLength :: UArray Int Int+huffmanLength = listArray (0,idxEos) $ map length huffmanTable -toShiftedArray :: Bits -> ShiftedArray-toShiftedArray bits = listArray (0,7) $ map (toShifted bits) [0..7]+huffmanCode :: UArray Int Word64+huffmanCode = listArray (0,idxEos) huffmanTable' ---------------------------------------------------------------- @@ -93,55 +43,55 @@ encode :: HuffmanEncoding encode dst bs = withReadBuffer bs $ enc dst +-- The maximum length of Huffman code is 30.+-- 40 is enough as a work space.+initialOffset :: Int+initialOffset = 40++shiftForWrite :: Int+shiftForWrite = 32+ enc :: WorkingBuffer -> ReadBuffer -> IO Int enc WorkingBuffer{..} rbuf = do beg <- readIORef offset- end <- go 0 beg+ end <- go (beg,0,initialOffset) writeIORef offset end let !len = end `minusPtr` beg return len where- go n ptr = do- more <- hasOneByte rbuf- if more then do- !i <- fromIntegral <$> getByte rbuf- let Shifted n' len b bs = (aosa ! i) ! n- !ptr' | n' == 0 = ptr `plusPtr` len- | otherwise = ptr `plusPtr` (len - 1)- when (ptr' >= limit) $ throwIO BufferOverrun- if n == 0 then- poke ptr b- else do- b0 <- peek ptr- poke ptr (b0 .|. b)- copy (ptr `plusPtr` 1) bs- go n' ptr'- else- if (n == 0) then- return ptr- else do- let Shifted _ _ b _ = (aosa ! idxEos) ! n- b0 <- peek ptr- poke ptr (b0 .|. b)- let !ptr' = ptr `plusPtr` 1- return ptr'--{-# INLINE copy #-}-copy :: Ptr Word8 -> WS -> IO ()-copy _ W0 = return ()-copy ptr (W1 w1) = poke ptr w1-copy ptr (W2 w1 w2) = do- poke ptr w1- poke (ptr `plusPtr` 1) w2-copy ptr (W3 w1 w2 w3) = do- poke ptr w1- poke (ptr `plusPtr` 1) w2- poke (ptr `plusPtr` 2) w3-copy ptr (W4 w1 w2 w3 w4) = do- poke ptr w1- poke (ptr `plusPtr` 1) w2- poke (ptr `plusPtr` 2) w3- poke (ptr `plusPtr` 3) w4+ go (dst,encoded,off) = do+ !i <- getByte' rbuf+ if i >= 0 then+ copy dst (bond i) >>= go+ else if off == initialOffset then+ return dst+ else do+ let (encoded1,_) = bond idxEos+ write dst encoded1+ where+ {-# INLINE bond #-}+ bond i = (encoded', off')+ where+ !len = huffmanLength `unsafeAt` i+ !code = huffmanCode `unsafeAt` i+ !scode = code `shiftL` (off - len)+ !encoded' = encoded .|. scode+ !off' = off - len+ {-# INLINE write #-}+ write p w = do+ when (p >= limit) $ throwIO BufferOverrun+ let !w8 = fromIntegral (w `shiftR` shiftForWrite) :: Word8+ poke p w8+ let !p' = p `plusPtr` 1+ return p'+ {-# INLINE copy #-}+ copy p (w,o)+ | o > shiftForWrite = return (p,w,o)+ | otherwise = do+ p' <- write p w+ let !w' = w `shiftL` 8+ !o' = o + 8+ copy p' (w',o') encodeHuffman :: ByteString -> IO ByteString encodeHuffman bs = withTemporaryBuffer 4096 $ \wbuf ->
Network/HPACK/Huffman/Table.hs view
@@ -1,5 +1,6 @@ module Network.HPACK.Huffman.Table where +import Data.Word (Word64) import Network.HPACK.Huffman.Bit huffmanTable :: [Bits]@@ -261,4 +262,265 @@ , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,F,F,F] , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,F,T,T,T,F] , [T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T,T]+ ]++huffmanTable' :: [Word64]+huffmanTable' = [+ 0x1ff8+ , 0x7fffd8+ , 0xfffffe2+ , 0xfffffe3+ , 0xfffffe4+ , 0xfffffe5+ , 0xfffffe6+ , 0xfffffe7+ , 0xfffffe8+ , 0xffffea+ , 0x3ffffffc+ , 0xfffffe9+ , 0xfffffea+ , 0x3ffffffd+ , 0xfffffeb+ , 0xfffffec+ , 0xfffffed+ , 0xfffffee+ , 0xfffffef+ , 0xffffff0+ , 0xffffff1+ , 0xffffff2+ , 0x3ffffffe+ , 0xffffff3+ , 0xffffff4+ , 0xffffff5+ , 0xffffff6+ , 0xffffff7+ , 0xffffff8+ , 0xffffff9+ , 0xffffffa+ , 0xffffffb+ , 0x14+ , 0x3f8+ , 0x3f9+ , 0xffa+ , 0x1ff9+ , 0x15+ , 0xf8+ , 0x7fa+ , 0x3fa+ , 0x3fb+ , 0xf9+ , 0x7fb+ , 0xfa+ , 0x16+ , 0x17+ , 0x18+ , 0x0+ , 0x1+ , 0x2+ , 0x19+ , 0x1a+ , 0x1b+ , 0x1c+ , 0x1d+ , 0x1e+ , 0x1f+ , 0x5c+ , 0xfb+ , 0x7ffc+ , 0x20+ , 0xffb+ , 0x3fc+ , 0x1ffa+ , 0x21+ , 0x5d+ , 0x5e+ , 0x5f+ , 0x60+ , 0x61+ , 0x62+ , 0x63+ , 0x64+ , 0x65+ , 0x66+ , 0x67+ , 0x68+ , 0x69+ , 0x6a+ , 0x6b+ , 0x6c+ , 0x6d+ , 0x6e+ , 0x6f+ , 0x70+ , 0x71+ , 0x72+ , 0xfc+ , 0x73+ , 0xfd+ , 0x1ffb+ , 0x7fff0+ , 0x1ffc+ , 0x3ffc+ , 0x22+ , 0x7ffd+ , 0x3+ , 0x23+ , 0x4+ , 0x24+ , 0x5+ , 0x25+ , 0x26+ , 0x27+ , 0x6+ , 0x74+ , 0x75+ , 0x28+ , 0x29+ , 0x2a+ , 0x7+ , 0x2b+ , 0x76+ , 0x2c+ , 0x8+ , 0x9+ , 0x2d+ , 0x77+ , 0x78+ , 0x79+ , 0x7a+ , 0x7b+ , 0x7ffe+ , 0x7fc+ , 0x3ffd+ , 0x1ffd+ , 0xffffffc+ , 0xfffe6+ , 0x3fffd2+ , 0xfffe7+ , 0xfffe8+ , 0x3fffd3+ , 0x3fffd4+ , 0x3fffd5+ , 0x7fffd9+ , 0x3fffd6+ , 0x7fffda+ , 0x7fffdb+ , 0x7fffdc+ , 0x7fffdd+ , 0x7fffde+ , 0xffffeb+ , 0x7fffdf+ , 0xffffec+ , 0xffffed+ , 0x3fffd7+ , 0x7fffe0+ , 0xffffee+ , 0x7fffe1+ , 0x7fffe2+ , 0x7fffe3+ , 0x7fffe4+ , 0x1fffdc+ , 0x3fffd8+ , 0x7fffe5+ , 0x3fffd9+ , 0x7fffe6+ , 0x7fffe7+ , 0xffffef+ , 0x3fffda+ , 0x1fffdd+ , 0xfffe9+ , 0x3fffdb+ , 0x3fffdc+ , 0x7fffe8+ , 0x7fffe9+ , 0x1fffde+ , 0x7fffea+ , 0x3fffdd+ , 0x3fffde+ , 0xfffff0+ , 0x1fffdf+ , 0x3fffdf+ , 0x7fffeb+ , 0x7fffec+ , 0x1fffe0+ , 0x1fffe1+ , 0x3fffe0+ , 0x1fffe2+ , 0x7fffed+ , 0x3fffe1+ , 0x7fffee+ , 0x7fffef+ , 0xfffea+ , 0x3fffe2+ , 0x3fffe3+ , 0x3fffe4+ , 0x7ffff0+ , 0x3fffe5+ , 0x3fffe6+ , 0x7ffff1+ , 0x3ffffe0+ , 0x3ffffe1+ , 0xfffeb+ , 0x7fff1+ , 0x3fffe7+ , 0x7ffff2+ , 0x3fffe8+ , 0x1ffffec+ , 0x3ffffe2+ , 0x3ffffe3+ , 0x3ffffe4+ , 0x7ffffde+ , 0x7ffffdf+ , 0x3ffffe5+ , 0xfffff1+ , 0x1ffffed+ , 0x7fff2+ , 0x1fffe3+ , 0x3ffffe6+ , 0x7ffffe0+ , 0x7ffffe1+ , 0x3ffffe7+ , 0x7ffffe2+ , 0xfffff2+ , 0x1fffe4+ , 0x1fffe5+ , 0x3ffffe8+ , 0x3ffffe9+ , 0xffffffd+ , 0x7ffffe3+ , 0x7ffffe4+ , 0x7ffffe5+ , 0xfffec+ , 0xfffff3+ , 0xfffed+ , 0x1fffe6+ , 0x3fffe9+ , 0x1fffe7+ , 0x1fffe8+ , 0x7ffff3+ , 0x3fffea+ , 0x3fffeb+ , 0x1ffffee+ , 0x1ffffef+ , 0xfffff4+ , 0xfffff5+ , 0x3ffffea+ , 0x7ffff4+ , 0x3ffffeb+ , 0x7ffffe6+ , 0x3ffffec+ , 0x3ffffed+ , 0x7ffffe7+ , 0x7ffffe8+ , 0x7ffffe9+ , 0x7ffffea+ , 0x7ffffeb+ , 0xffffffe+ , 0x7ffffec+ , 0x7ffffed+ , 0x7ffffee+ , 0x7ffffef+ , 0x7fffff0+ , 0x3ffffee+ , 0x3fffffff ]
Network/HPACK/Table/Dynamic.hs view
@@ -30,7 +30,8 @@ #endif import Control.Exception (bracket, throwIO) import Control.Monad (forM, when, (>=>))-import Data.Array.IO (IOArray, newArray, readArray, writeArray)+import Data.Array.Base (unsafeRead, unsafeWrite)+import Data.Array.IO (IOArray, newArray) import qualified Data.ByteString.Char8 as BS import Data.IORef import Foreign.Marshal.Alloc@@ -133,7 +134,7 @@ let !beg = off + 1 !end = off + n tbl <- readIORef circularTable- es <- mapM (adj maxN >=> readArray tbl) [beg .. end]+ es <- mapM (adj maxN >=> unsafeRead tbl) [beg .. end] let !ts = zip [1..] es mapM_ printEntry ts dsize <- readIORef dynamicTableSize@@ -251,7 +252,7 @@ off <- readIORef offset n <- readIORef numOfEntries table <- readIORef circularTable- let readTable i = adj maxN (off + i) >>= readArray table+ let readTable i = adj maxN (off + i) >>= unsafeRead table forM [1 .. n] readTable copyEntries :: DynamicTable -> [Entry] -> IO ()@@ -321,7 +322,7 @@ let i = off !dsize' = dsize + entrySize e !off' <- adj maxN (off - 1)- writeArray table i e+ unsafeWrite table i e writeIORef offset off' writeIORef numOfEntries $ n + 1 writeIORef dynamicTableSize dsize'@@ -353,7 +354,7 @@ table <- readIORef circularTable !i <- adj maxN (off + n + 1) let !dsize' = dsize + entrySize e- writeArray table i e+ unsafeWrite table i e writeIORef numOfEntries $ n + 1 writeIORef dynamicTableSize dsize' case codeInfo of@@ -369,8 +370,8 @@ n <- readIORef numOfEntries !i <- adj maxN (off + n) table <- readIORef circularTable- e <- readArray table i- writeArray table i dummyEntry -- let the entry GCed+ e <- unsafeRead table i+ unsafeWrite table i dummyEntry -- let the entry GCed dsize <- readIORef dynamicTableSize let !dsize' = dsize - entrySize e writeIORef numOfEntries (n - 1)@@ -386,7 +387,7 @@ !off <- readIORef offset !didx <- adj maxN (idx + off - staticTableSize) !table <- readIORef circularTable- readArray table didx+ unsafeRead table didx ----------------------------------------------------------------
Network/HPACK/Table/RevIndex.hs view
@@ -13,8 +13,9 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>), (<*>)) #endif-import Data.Array (Array, (!))+import Data.Array (Array) import qualified Data.Array as A+import Data.Array.Base (unsafeAt) import Data.Function (on) import Data.CaseInsensitive (foldedCase) import Data.IORef@@ -69,7 +70,7 @@ {-# INLINE lookupStaticRevIndex #-} lookupStaticRevIndex :: Int -> HeaderValue -> (HIndex -> IO ()) -> (HIndex -> IO ()) -> IO ()-lookupStaticRevIndex ix v fa' fbd' = case staticRevIndex ! ix of+lookupStaticRevIndex ix v fa' fbd' = case staticRevIndex `unsafeAt` ix of StaticEntry i Nothing -> fbd' i StaticEntry i (Just m) -> case M.lookup v m of Nothing -> fbd' i@@ -87,7 +88,7 @@ renewDynamicRevIndex :: DynamicRevIndex -> IO () renewDynamicRevIndex drev = mapM_ clear [minTokenIx..maxStaticTokenIx] where- clear t = writeIORef (drev ! t) M.empty+ clear t = writeIORef (drev `unsafeAt` t) M.empty {-# INLINE lookupDynamicStaticRevIndex #-} lookupDynamicStaticRevIndex :: Int -> HeaderValue -> DynamicRevIndex@@ -95,7 +96,7 @@ -> (HIndex -> IO ()) -> IO () lookupDynamicStaticRevIndex ix v drev fa' fbd' = do- let ref = drev ! ix+ let ref = drev `unsafeAt` ix m <- readIORef ref case M.lookup v m of Just i -> fa' i@@ -105,13 +106,13 @@ insertDynamicRevIndex :: Token -> HeaderValue -> HIndex -> DynamicRevIndex -> IO () insertDynamicRevIndex t v i drev = modifyIORef ref $ M.insert v i where- ref = drev ! tokenIx t+ ref = drev `unsafeAt` tokenIx t {-# INLINE deleteDynamicRevIndex #-} deleteDynamicRevIndex :: Token -> HeaderValue -> DynamicRevIndex -> IO () deleteDynamicRevIndex t v drev = modifyIORef ref $ M.delete v where- ref = drev ! tokenIx t+ ref = drev `unsafeAt` tokenIx t ----------------------------------------------------------------
Network/HPACK/Table/Static.hs view
@@ -6,7 +6,8 @@ , staticTableList ) where -import Data.Array (Array, listArray, (!))+import Data.Array (Array, listArray)+import Data.Array.Base (unsafeAt) import Network.HPACK.Table.Entry ----------------------------------------------------------------@@ -25,7 +26,7 @@ -- >>> toStaticEntry 50 -- Entry 37 (Token {ix = 40, shouldBeIndexed = True, isPseudo = False, tokenKey = "Range"}) "" toStaticEntry :: Index -> Entry-toStaticEntry sidx = staticTable ! sidx+toStaticEntry sidx = staticTable `unsafeAt` (sidx - 1) -- | Pre-defined static table. staticTable :: Array Index Entry
http2.cabal view
@@ -1,5 +1,5 @@ Name: http2-Version: 1.6.1+Version: 1.6.2 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3
test-frame/JSON.hs view
@@ -72,10 +72,10 @@ instance FromJSON ErrorCodeId where parseJSON e = toErrorCodeId <$> parseJSON e -instance ToJSON SettingsList where+instance {-# OVERLAPPING #-} ToJSON SettingsList where toJSON settings = toJSON $ map (first fromSettingsKeyId) settings -instance FromJSON SettingsList where+instance {-# OVERLAPPING #-} FromJSON SettingsList where parseJSON x = map (first (fromJust . toSettingsKeyId)) <$> parseJSON x instance ToJSON ByteString where
test-hpack/JSON.hs view
@@ -72,11 +72,11 @@ ,"seqno" .= no ] -instance FromJSON HeaderList where+instance {-# OVERLAPPING #-} FromJSON HeaderList where parseJSON (Array a) = mapM parseJSON $ V.toList a parseJSON _ = mzero -instance ToJSON HeaderList where+instance {-# OVERLAPPING #-} ToJSON HeaderList where toJSON hs = toJSON $ map toJSON hs instance {-# OVERLAPPING #-} FromJSON Header where