http2-client 0.8.0.1 → 0.8.0.2

raw patch · 4 files changed

+60/−27 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• http2-client.cabal +2/−2
• src/Network/HTTP2/Client.hs +34/−25
• src/Network/HTTP2/Client/RawConnection.hs +15/−0

@@ -0,0 +1,9 @@+# Changelog for http2-client++## Unreleased changes++## v0.8.0.2++- first Changelog!+- performance improvement: use `TCP_NODELAY`+- performance improvement: change stream-initialization functions to make less work under the HEADER-protection lock

@@ -1,5 +1,5 @@ name:                http2-client-version:             0.8.0.1+version:             0.8.0.2 synopsis:            A native HTTP2 client library. description:         Please read the README.md at the homepage. homepage:            https://github.com/lucasdicioccio/http2-client@@ -10,7 +10,7 @@ copyright:           2017 Lucas DiCioccio category:            Web build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md, ChangeLog.md cabal-version:       >=1.10  library

@@ -415,8 +415,10 @@                                             goAwayHandler                                             fallbackHandler -    _initIncomingFlowControl <- newIncomingFlowControl dispatchControl controlStream-    (_initOutgoingFlowControl,windowUpdatesChan) <- newOutgoingFlowControl dispatchControl 0+    let baseWindowSize = return HTTP2.defaultInitialWindowSize+    _initIncomingFlowControl <- newIncomingFlowControl dispatchControl baseWindowSize (sendWindowUpdateFrame controlStream)+    windowUpdatesChan <- newChan+    _initOutgoingFlowControl <- newOutgoingFlowControl dispatchControl windowUpdatesChan baseWindowSize      dispatchHPACK <- newDispatchHPACKIO decoderBufSize     (incomingLoop,endIncomingLoop) <- dispatchLoop conn dispatch dispatchControl windowUpdatesChan _initIncomingFlowControl dispatchHPACK@@ -437,12 +439,14 @@             then                 return $ Left $ TooMuchConcurrency roomNeeded             else Right <$> do+                windowUpdatesChan <- newChan                 cont <- withClientStreamId $ \sid -> do                     dispatchStream <- newDispatchStreamIO sid                     initializeStream conn                                      dispatch                                      dispatchControl                                      dispatchStream+                                     windowUpdatesChan                                      getWork                                      Idle                 v <- cont@@ -480,20 +484,16 @@   -> Dispatch   -> DispatchControl   -> DispatchStream+  -> Chan (FrameHeader, FramePayload)   -> (Http2Stream -> StreamDefinition a)   -> StreamFSMState   -> IO (IO a)-initializeStream conn dispatch control stream getWork initialState = do+initializeStream conn dispatch control stream windowUpdatesChan getWork initialState = do     let sid = _dispatchStreamId stream     let frameStream = makeFrameClientStream conn sid      let events        = _dispatchStreamReadEvents stream -    -- Builds a flow-control context.-    incomingStreamFlowControl <- newIncomingFlowControl control frameStream-    (outgoingStreamFlowControl, windowUpdatesChan) <- newOutgoingFlowControl control sid-    registerStream dispatch sid (StreamState windowUpdatesChan events initialState)-     -- Prepare handlers.     let _headers headersList flags = do             splitter <- settingsPayloadSplitter <$> readSettings control@@ -513,21 +513,32 @@     let _handlePushPromise ppSid ppHeaders ppHandler = do             let mkStreamActions s = StreamDefinition (return CST) (ppHandler sid s ppHeaders)             newStream <- newDispatchStreamIO ppSid+            ppWindowsUpdatesChan <- newChan             ppCont <- initializeStream conn                                        dispatch                                        control                                        newStream+                                       ppWindowsUpdatesChan                                        mkStreamActions                                        ReservedRemote             ppCont      let streamActions = getWork $ Http2Stream{..} -    -- Perform the 1st action, the stream won't be idle anymore.+    -- Register handlers for receiving frames and perform the 1st action, the+    -- stream won't be idle anymore.+    registerStream dispatch sid (StreamState windowUpdatesChan events initialState)     _ <- _initStream streamActions      -- Returns 2nd action.-    return $ _handleStream streamActions incomingStreamFlowControl outgoingStreamFlowControl+    -- We build the flow control contexts in this action outside the exclusive+    -- lock on clientStreamIdMutex will be released.+    return $ do+        let baseIncomingWindowSize = initialWindowSize . _clientSettings <$> readSettings control+        isfc <- newIncomingFlowControl control baseIncomingWindowSize (sendWindowUpdateFrame frameStream)+        let baseOutgoingWindowSize = initialWindowSize . _serverSettings <$> readSettings control+        osfc <- newOutgoingFlowControl control windowUpdatesChan baseOutgoingWindowSize+        _handleStream streamActions isfc osfc  dispatchLoop   :: Http2FrameConnection@@ -732,12 +743,12 @@  newIncomingFlowControl   :: DispatchControl-  -> Http2FrameClientStream+  -> IO Int+  -- ^ Action to get the base window size.+  -> (WindowSize -> IO())+  -- ^ Action to send the window update to the server.   -> IO IncomingFlowControl-newIncomingFlowControl control stream = do-    let getBase = if _getStreamId stream == 0-                  then return HTTP2.defaultInitialWindowSize-                  else initialWindowSize . _clientSettings <$> readSettings control+newIncomingFlowControl control getBase doSendUpdate = do     creditAdded <- newIORef 0     creditConsumed <- newIORef 0     let _addCredit n = atomicModifyIORef' creditAdded (\c -> (c + n, ()))@@ -756,22 +767,20 @@              _addCredit (negate transferred)             _ <- _consumeCredit (negate transferred)--            when shouldUpdate (sendWindowUpdateFrame stream transferred)+            when shouldUpdate (doSendUpdate transferred)              return shouldUpdate     return $ IncomingFlowControl _addCredit _consumeCredit _updateWindow  newOutgoingFlowControl ::      DispatchControl-  -> StreamId-  -> IO (OutgoingFlowControl, Chan (FrameHeader, FramePayload))-newOutgoingFlowControl control sid = do+  -- ^ Control dispatching reference.+  -> Chan (FrameHeader, FramePayload)+  -> IO Int+  -- ^ Action to get the instantaneous base window-size.+  -> IO OutgoingFlowControl+newOutgoingFlowControl control frames getBase = do     credit <- newIORef 0-    frames <- newChan-    let getBase = if sid == 0-                  then return HTTP2.defaultInitialWindowSize-                  else initialWindowSize . _serverSettings <$> readSettings control     let receive n = atomicModifyIORef' credit (\c -> (c + n, ()))     let withdraw 0 = return 0         withdraw n = do@@ -786,7 +795,7 @@                 amount <- race (waitSettingsChange base) (waitSomeCredit frames)                 receive (either (const 0) id amount)                 withdraw n-    return $ (OutgoingFlowControl receive withdraw, frames)+    return $ OutgoingFlowControl receive withdraw   where     -- TODO: broadcast settings changes from ConnectionSettings using a better data type     -- than IORef+busy loop. Currently the busy loop is fine because

@@ -5,6 +5,7 @@ module Network.HTTP2.Client.RawConnection (       RawHttp2Connection (..)     , newRawHttp2Connection+    , newRawHttp2ConnectionSocket     ) where  import           Control.Monad (forever, when)@@ -45,8 +46,22 @@     let hints = defaultHints { addrFlags = [AI_NUMERICSERV], addrSocketType = Stream }     addr:_ <- getAddrInfo (Just hints) (Just host) (Just $ show port)     skt <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+    setSocketOption skt NoDelay 1     connect skt (addrAddress addr)+    newRawHttp2ConnectionSocket skt mparams +-- | Initiates a RawHttp2Connection with a server over a connected socket.+--+-- The current code does not handle closing the connexion, yikes.+-- Since 0.8.0.2+newRawHttp2ConnectionSocket+  :: Socket+  -- ^ A connected socket.+  -> Maybe TLS.ClientParams+  -- ^ TLS parameters. The 'TLS.onSuggestALPN' hook is+  -- overwritten to always return ["h2", "h2-17"].+  -> IO RawHttp2Connection+newRawHttp2ConnectionSocket skt mparams = do     -- Prepare structure with abstract API.     conn <- maybe (plainTextRaw skt) (tlsRaw skt) mparams