http2 1.6.3 → 1.6.4
raw patch · 5 files changed
+64/−112 lines, 5 filesdep +network-byte-orderdep −bytestring-builderdep −hashtablesdep ~Globdep ~base
Dependencies added: network-byte-order
Dependencies removed: bytestring-builder, hashtables
Dependency ranges changed: Glob, base
Files
- Network/HTTP2/Decode.hs +23/−43
- Network/HTTP2/Encode.hs +18/−54
- bench-priority/Main.hs +10/−3
- bench-priority/RandomSkewHeap.hs +1/−1
- http2.cabal +12/−11
Network/HTTP2/Decode.hs view
@@ -25,14 +25,14 @@ import Control.Applicative ((<$>)) #endif import Data.Array (Array, listArray, (!))-import Data.Bits (clearBit, shiftL, (.|.))+import Data.Bits (clearBit) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..)) import Data.Word import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (peek)+import qualified Network.ByteOrder as N import System.IO.Unsafe (unsafeDupablePerformIO) import Network.HTTP2.Types@@ -59,14 +59,11 @@ decodeFrameHeader :: ByteString -> (FrameTypeId, FrameHeader) decodeFrameHeader (PS fptr off _) = unsafeDupablePerformIO $ withForeignPtr fptr $ \ptr -> do let p = ptr +. off- l0 <- fromIntegral <$> peek p- l1 <- fromIntegral <$> peek (p +. 1)- l2 <- fromIntegral <$> peek (p +. 2)- typ <- toFrameTypeId <$> peek (p +. 3)- flg <- peek (p +. 4)- w32 <- word32' (p +. 5)- let !len = (l0 `shiftL` 16) .|. (l1 `shiftL` 8) .|. l2- !sid = streamIdentifier w32+ len <- fromIntegral <$> N.peek24 p 0+ typ <- toFrameTypeId <$> N.peek8 p 3+ flg <- N.peek8 p 4+ w32 <- N.peek32 p 5+ let !sid = streamIdentifier w32 return (typ, FrameHeader len flg sid) (+.) :: Ptr Word8 -> Int -> Ptr Word8@@ -90,6 +87,13 @@ Left $ ConnectionError ProtocolError "cannot used in non-zero stream" | otherwise = checkType typ where+ checkType FrameHeaders+ | testPadded flags && payloadLength < 1 =+ Left $ ConnectionError FrameSizeError "insufficient payload for Pad Length"+ | testPriority flags && payloadLength < 5 =+ Left $ ConnectionError FrameSizeError "insufficient payload for priority fields"+ | testPadded flags && testPriority flags && payloadLength < 6 =+ Left $ ConnectionError FrameSizeError "insufficient payload for Pad Length and priority fields" checkType FramePriority | payloadLength /= 5 = Left $ StreamError FrameSizeError streamId checkType FrameRSTStream | payloadLength /= 4 =@@ -182,7 +186,7 @@ -- | Frame payload decoder for RST_STREAM frame. decoderstStreamFrame :: FramePayloadDecoder-decoderstStreamFrame _ bs = Right $ RSTStreamFrame $ toErrorCodeId (word32 bs)+decoderstStreamFrame _ bs = Right $ RSTStreamFrame $ toErrorCodeId (N.word32 bs) -- | Frame payload decoder for SETTINGS frame. decodeSettingsFrame :: FramePayloadDecoder@@ -194,13 +198,13 @@ settings num p id settings 0 _ builder = return $ builder [] settings n p builder = do- rawSetting <- word16' p+ rawSetting <- N.peek16 p 0 let msettings = toSettingsKeyId rawSetting n' = n - 1 case msettings of Nothing -> settings n' (p +. 6) builder -- ignoring unknown one (Section 6.5.2) Just k -> do- w32 <- word32' (p +. 2)+ w32 <- N.peek32 p 2 let v = fromIntegral w32 settings n' (p +. 6) (builder. ((k,v):)) @@ -208,7 +212,7 @@ decodePushPromiseFrame :: FramePayloadDecoder decodePushPromiseFrame header bs = decodeWithPadding header bs $ \bs' -> let (bs0,bs1) = BS.splitAt 4 bs'- sid = streamIdentifier (word32 bs0)+ sid = streamIdentifier (N.word32 bs0) in PushPromiseFrame sid bs1 -- | Frame payload decoder for PING frame.@@ -221,8 +225,8 @@ where (bs0,bs1') = BS.splitAt 4 bs (bs1,bs2) = BS.splitAt 4 bs1'- sid = streamIdentifier (word32 bs0)- ecid = toErrorCodeId (word32 bs1)+ sid = streamIdentifier (N.word32 bs0)+ ecid = toErrorCodeId (N.word32 bs1) -- | Frame payload decoder for WINDOW_UPDATE frame. decodeWindowUpdateFrame :: FramePayloadDecoder@@ -230,7 +234,7 @@ | wsi == 0 = Left $ ConnectionError ProtocolError "window update must not be 0" | otherwise = Right $ WindowUpdateFrame wsi where- !wsi = fromIntegral (word32 bs `clearBit` 31)+ !wsi = fromIntegral (N.word32 bs `clearBit` 31) -- | Frame payload decoder for CONTINUATION frame. decodeContinuationFrame :: FramePayloadDecoder@@ -270,36 +274,12 @@ priority :: ByteString -> Priority priority (PS fptr off _) = unsafeDupablePerformIO $ withForeignPtr fptr $ \ptr -> do let p = ptr +. off- w32 <- word32' p+ w32 <- N.peek32 p 0 let !streamdId = streamIdentifier w32 !exclusive = testExclusive (fromIntegral w32) -- fixme- w8 <- peek (p +. 4)+ w8 <- N.peek8 p 4 let weight = intFromWord8 w8 + 1 return $ Priority exclusive streamdId weight intFromWord8 :: Word8 -> Int intFromWord8 = fromIntegral--word32 :: ByteString -> Word32-word32 (PS fptr off _) = unsafeDupablePerformIO $ withForeignPtr fptr $ \ptr -> do- let p = ptr +. off- word32' p-{-# INLINE word32 #-}--word32' :: Ptr Word8 -> IO Word32-word32' p = do- w0 <- fromIntegral <$> peek p- w1 <- fromIntegral <$> peek (p +. 1)- w2 <- fromIntegral <$> peek (p +. 2)- w3 <- fromIntegral <$> peek (p +. 3)- let !w32 = (w0 `shiftL` 24) .|. (w1 `shiftL` 16) .|. (w2 `shiftL` 8) .|. w3- return w32-{-# INLINE word32' #-}--word16' :: Ptr Word8 -> IO Word16-word16' p = do- w0 <- fromIntegral <$> peek p- w1 <- fromIntegral <$> peek (p +. 1)- let !w16 = (w0 `shiftL` 8) .|. w1- return w16-{-# INLINE word16' #-}
Network/HTTP2/Encode.hs view
@@ -10,12 +10,11 @@ , encodeInfo ) where -import Data.Bits (shiftR, (.&.)) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString, unsafeCreate)-import Data.Word (Word8, Word16, Word32)+import Data.Word (Word8) import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (poke)+import qualified Network.ByteOrder as N import Network.HTTP2.Types @@ -73,11 +72,12 @@ -- The length of the buffer must be larger than or equal to 9 bytes. encodeFrameHeaderBuf :: FrameTypeId -> FrameHeader -> Ptr Word8 -> IO () encodeFrameHeaderBuf ftid FrameHeader{..} ptr = do- poke24 ptr payloadLength- poke8 ptr 3 typ- poke8 ptr 4 flags- poke32 (ptr `plusPtr` 5) sid+ N.poke24 plen ptr 0+ N.poke8 typ ptr 3+ N.poke8 flags ptr 4+ N.poke32 sid ptr 5 where+ plen = fromIntegral payloadLength typ = fromFrameTypeId ftid sid = fromIntegral streamId @@ -142,8 +142,10 @@ | exclusive = setExclusive streamDependency | otherwise = streamDependency priority = unsafeCreate 5 $ \ptr -> do- poke32 ptr $ fromIntegral estream- poke8 ptr 4 $ fromIntegral $ weight - 1+ let esid = fromIntegral estream+ w = fromIntegral $ weight - 1+ N.poke32 esid ptr 0+ N.poke8 w ptr 4 ---------------------------------------------------------------- @@ -177,7 +179,7 @@ buildFramePayloadRSTStream EncodeInfo{..} e = (header, builder) where builder = (b4 :)- b4 = bytestring4 $ fromErrorCodeId e+ b4 = N.bytestring32 $ fromErrorCodeId e header = FrameHeader 4 encodeFlags encodeStreamId buildFramePayloadSettings :: EncodeInfo -> SettingsList -> (FrameHeader, Builder)@@ -187,8 +189,8 @@ settings = unsafeCreate len $ \ptr -> go ptr alist go _ [] = return () go p ((k,v):kvs) = do- poke16 p $ fromSettingsKeyId k- poke32 (p `plusPtr` 2) $ fromIntegral v+ N.poke16 (fromSettingsKeyId k) p 0+ N.poke32 (fromIntegral v) p 2 go (p `plusPtr` 6) kvs len = length alist * 6 header = FrameHeader len encodeFlags encodeStreamId@@ -197,7 +199,7 @@ buildFramePayloadPushPromise einfo sid hdr = buildPadding einfo builder len where builder = (b4 :) . (hdr :)- b4 = bytestring4 $ fromIntegral sid+ b4 = N.bytestring32 $ fromIntegral sid len = 4 + BS.length hdr buildFramePayloadPing :: EncodeInfo -> ByteString -> (FrameHeader, Builder)@@ -212,8 +214,8 @@ builder = (b8 :) . (debug :) len0 = 8 b8 = unsafeCreate len0 $ \ptr -> do- poke32 ptr $ fromIntegral sid- poke32 (ptr `plusPtr` 4) $ fromErrorCodeId e+ N.poke32 (fromIntegral sid) ptr 0+ N.poke32 (fromErrorCodeId e) ptr 4 len = len0 + BS.length debug header = FrameHeader len encodeFlags encodeStreamId @@ -222,7 +224,7 @@ where -- fixme: reserve bit builder = (b4 :)- b4 = bytestring4 $ fromIntegral size+ b4 = N.bytestring32 $ fromIntegral size header = FrameHeader 4 encodeFlags encodeStreamId buildFramePayloadContinuation :: EncodeInfo -> HeaderBlockFragment -> (FrameHeader, Builder)@@ -234,41 +236,3 @@ buildFramePayloadUnknown :: EncodeInfo -> ByteString -> (FrameHeader, Builder) buildFramePayloadUnknown = buildFramePayloadData--------------------------------------------------------------------poke8 :: Ptr Word8 -> Int -> Word8 -> IO ()-poke8 ptr n w = poke (ptr `plusPtr` n) w--poke16 :: Ptr Word8 -> Word16 -> IO ()-poke16 ptr i = do- poke ptr w0- poke8 ptr 1 w1- where- w0 = fromIntegral ((i `shiftR` 8) .&. 0xff)- w1 = fromIntegral (i .&. 0xff)--poke24 :: Ptr Word8 -> Int -> IO ()-poke24 ptr i = do- poke ptr w0- poke8 ptr 1 w1- poke8 ptr 2 w2- where- w0 = fromIntegral ((i `shiftR` 16) .&. 0xff)- w1 = fromIntegral ((i `shiftR` 8) .&. 0xff)- w2 = fromIntegral (i .&. 0xff)--poke32 :: Ptr Word8 -> Word32 -> IO ()-poke32 ptr i = do- poke ptr w0- poke8 ptr 1 w1- poke8 ptr 2 w2- poke8 ptr 3 w3- where- w0 = fromIntegral ((i `shiftR` 24) .&. 0xff)- w1 = fromIntegral ((i `shiftR` 16) .&. 0xff)- w2 = fromIntegral ((i `shiftR` 8) .&. 0xff)- w3 = fromIntegral (i .&. 0xff)--bytestring4 :: Word32 -> ByteString-bytestring4 i = unsafeCreate 4 $ \ptr -> poke32 ptr i
bench-priority/Main.hs view
@@ -5,7 +5,7 @@ import Control.Concurrent.STM import Criterion.Main import Data.List (foldl')-import System.Random+import System.Random.MWC import qualified RingOfQueuesSTM as A import qualified RingOfQueues as AIO@@ -26,9 +26,9 @@ main :: IO () main = do- gen <- getStdGen+ gen <- create+ ws <- uniformRs (1,256) gen numOfStreams let ks = [1,3..]- ws = take numOfStreams $ randomRs (1,256) gen xs = zip ks ws defaultMain [ bgroup "enqueue & dequeue" [@@ -49,6 +49,13 @@ , bench "Ring of Queues IO" $ nfIO (deleteAIO xs) ] ]+ where+ uniformRs range gen n = loop n []+ where+ loop 0 rs = return rs+ loop i rs = do+ r <- uniformR range gen+ loop (i-1) (r:rs) ----------------------------------------------------------------
bench-priority/RandomSkewHeap.hs view
@@ -5,7 +5,7 @@ -- If we take weight as priority, a typical heap (priority queue) -- is not fair enough. Consider two weight 201 for A and 101 for B. -- A typical heap would generate A(201), A(200), A(199), A(198), ....,--- and finaly A(101), B(101), A(100), B(100).+-- and finally A(101), B(101), A(100), B(100). -- What we want is A, A, B, A, A, B... -- -- So, we introduce randomness to Skew Heap.
http2.cabal view
@@ -1,5 +1,5 @@ Name: http2-Version: 1.6.3+Version: 1.6.4 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -79,12 +79,12 @@ Network.HTTP2.Priority.PSQ Network.HTTP2.Priority.Queue Network.HTTP2.Types- Build-Depends: base >= 4.6 && < 5+ Build-Depends: base >= 4.8 && < 5 , array , bytestring >= 0.10- , bytestring-builder , case-insensitive , containers >= 0.5+ , network-byte-order , psqueues , stm @@ -115,11 +115,11 @@ Build-Depends: base >= 4 && < 5 , array , bytestring- , bytestring-builder , case-insensitive , containers , hex , hspec >= 1.3+ , network-byte-order , psqueues , stm , word8@@ -138,13 +138,13 @@ , aeson-pretty , array , bytestring- , bytestring-builder , case-insensitive , containers , directory , filepath , hex , hspec >= 1.3+ , network-byte-order , text , unordered-containers , vector@@ -159,7 +159,7 @@ Other-Modules: Case JSON Build-Depends: base >= 4 && < 5- , Glob+ , Glob >= 0.9 , aeson , aeson-pretty , bytestring@@ -168,6 +168,7 @@ , hex , hspec >= 1.3 , http2+ , network-byte-order , text , unordered-containers @@ -188,10 +189,10 @@ , aeson-pretty , array , bytestring- , bytestring-builder , case-insensitive , containers , hex+ , network-byte-order , text , unordered-containers , vector@@ -210,10 +211,10 @@ , aeson , array , bytestring- , bytestring-builder , case-insensitive , containers , hex+ , network-byte-order , text , unordered-containers , vector@@ -233,11 +234,11 @@ , aeson-pretty , array , bytestring- , bytestring-builder , case-insensitive , containers , directory , filepath+ , network-byte-order , text , unordered-containers , vector@@ -281,9 +282,9 @@ , case-insensitive , containers , criterion- , hashtables , heaps , mwc-random+ , network-byte-order , psqueues , stm @@ -299,5 +300,5 @@ , case-insensitive , containers , criterion- , hashtables+ , network-byte-order , stm