Hello community, here is the log from the commit of package ghc-http2 for openSUSE:Factory checked in at 2016-08-26 23:17:07 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http2 (Old) and /work/SRC/openSUSE:Factory/.ghc-http2.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http2" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http2/ghc-http2.changes 2016-07-21 08:06:55.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http2.new/ghc-http2.changes 2016-08-26 23:17:10.000000000 +0200 @@ -1,0 +2,5 @@ +Sun Aug 21 17:19:56 UTC 2016 - [email protected] + +- Update to version 1.6.2 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- http2-1.6.1.tar.gz New: ---- http2-1.6.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http2.spec ++++++ --- /var/tmp/diff_new_pack.LqH2Ru/_old 2016-08-26 23:17:11.000000000 +0200 +++ /var/tmp/diff_new_pack.LqH2Ru/_new 2016-08-26 23:17:11.000000000 +0200 @@ -19,44 +19,37 @@ %global pkg_name http2 %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.6.1 +Version: 1.6.2 Release: 0 Summary: HTTP/2.0 library including frames and HPACK License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: +BuildRequires: ghc-aeson-devel +BuildRequires: ghc-aeson-pretty-devel BuildRequires: ghc-array-devel BuildRequires: ghc-bytestring-builder-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-case-insensitive-devel BuildRequires: ghc-containers-devel +BuildRequires: ghc-directory-devel +BuildRequires: ghc-filepath-devel +BuildRequires: ghc-hex-devel BuildRequires: ghc-psqueues-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-stm-devel +BuildRequires: ghc-text-devel +BuildRequires: ghc-unordered-containers-devel +BuildRequires: ghc-vector-devel +BuildRequires: ghc-word8-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-Glob-devel -BuildRequires: ghc-aeson-devel -BuildRequires: ghc-aeson-pretty-devel -BuildRequires: ghc-directory-devel BuildRequires: ghc-doctest-devel -BuildRequires: ghc-filepath-devel -BuildRequires: ghc-hex-devel BuildRequires: ghc-hspec-devel -BuildRequires: ghc-text-devel -BuildRequires: ghc-unordered-containers-devel -BuildRequires: ghc-vector-devel -BuildRequires: ghc-word8-devel %endif -# End cabal-rpm deps -BuildRequires: ghc-aeson-devel -BuildRequires: ghc-aeson-pretty-devel -BuildRequires: ghc-hex-devel -BuildRequires: ghc-vector-devel -BuildRequires: ghc-word8-devel %description HTTP/2.0 library including frames and HPACK. @@ -75,20 +68,15 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build +%define cabal_configure_options -f-devel %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ http2-1.6.1.tar.gz -> http2-1.6.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Buffer.hs new/http2-1.6.2/Network/HPACK/Buffer.hs --- old/http2-1.6.1/Network/HPACK/Buffer.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Buffer.hs 2016-08-15 05:42:18.000000000 +0200 @@ -20,6 +20,7 @@ , hasMoreBytes , rewindOneByte , getByte + , getByte' , extractByteString ) where @@ -174,6 +175,18 @@ 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 src <- readIORef cur diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/HeaderBlock/Decode.hs new/http2-1.6.2/Network/HPACK/HeaderBlock/Decode.hs --- old/http2-1.6.1/Network/HPACK/HeaderBlock/Decode.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/HeaderBlock/Decode.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/HeaderBlock/Encode.hs new/http2-1.6.2/Network/HPACK/HeaderBlock/Encode.hs --- old/http2-1.6.1/Network/HPACK/HeaderBlock/Encode.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/HeaderBlock/Encode.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/HeaderBlock/Integer.hs new/http2-1.6.2/Network/HPACK/HeaderBlock/Integer.hs --- old/http2-1.6.1/Network/HPACK/HeaderBlock/Integer.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/HeaderBlock/Integer.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Huffman/Decode.hs new/http2-1.6.2/Network/HPACK/Huffman/Decode.hs --- old/http2-1.6.1/Network/HPACK/Huffman/Decode.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Huffman/Decode.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 -> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Huffman/Encode.hs new/http2-1.6.2/Network/HPACK/Huffman/Encode.hs --- old/http2-1.6.1/Network/HPACK/Huffman/Encode.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Huffman/Encode.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 +huffmanLength :: UArray Int Int +huffmanLength = listArray (0,idxEos) $ map length huffmanTable -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 - -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 -> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Huffman/Table.hs new/http2-1.6.2/Network/HPACK/Huffman/Table.hs --- old/http2-1.6.1/Network/HPACK/Huffman/Table.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Huffman/Table.hs 2016-08-15 05:42:18.000000000 +0200 @@ -1,5 +1,6 @@ module Network.HPACK.Huffman.Table where +import Data.Word (Word64) import Network.HPACK.Huffman.Bit huffmanTable :: [Bits] @@ -262,3 +263,264 @@ , [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 + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Table/Dynamic.hs new/http2-1.6.2/Network/HPACK/Table/Dynamic.hs --- old/http2-1.6.1/Network/HPACK/Table/Dynamic.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Table/Dynamic.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Table/RevIndex.hs new/http2-1.6.2/Network/HPACK/Table/RevIndex.hs --- old/http2-1.6.1/Network/HPACK/Table/RevIndex.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Table/RevIndex.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/Network/HPACK/Table/Static.hs new/http2-1.6.2/Network/HPACK/Table/Static.hs --- old/http2-1.6.1/Network/HPACK/Table/Static.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/Network/HPACK/Table/Static.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/http2.cabal new/http2-1.6.2/http2.cabal --- old/http2-1.6.1/http2.cabal 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/http2.cabal 2016-08-15 05:42:18.000000000 +0200 @@ -1,5 +1,5 @@ Name: http2 -Version: 1.6.1 +Version: 1.6.2 Author: Kazu Yamamoto <[email protected]> Maintainer: Kazu Yamamoto <[email protected]> License: BSD3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/test-frame/JSON.hs new/http2-1.6.2/test-frame/JSON.hs --- old/http2-1.6.1/test-frame/JSON.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/test-frame/JSON.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-1.6.1/test-hpack/JSON.hs new/http2-1.6.2/test-hpack/JSON.hs --- old/http2-1.6.1/test-hpack/JSON.hs 2016-07-08 06:03:48.000000000 +0200 +++ new/http2-1.6.2/test-hpack/JSON.hs 2016-08-15 05:42:18.000000000 +0200 @@ -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
