debugging flow control

[kazu-yamamoto]

• Adding debug information of stream error into GOAWAY which follows RST_STREAM
• Sending WINDOW_UPDATE for connection (sid == 0) only when any bodies are consumed

@akshaymankar If you still meet RST_STREAM, please tell me the debug message in GOAWAY which immediately follows RST_STREAM.

[kazu-yamamoto]

This tries to fix #69.

[akshaymankar]

The debug message is "treat a stream error as a connection error"

[kazu-yamamoto]

I guess that you are using v4.1.2. This PR makes debug message richer.

[akshaymankar]

I used the commit from this PR, should I run the test with v4.1.1?

[kazu-yamamoto]

The GOAWAY is from server client, I guess. I want to know the debug message in GOAWAY from the server.

[kazu-yamamoto]

@akshaymankar I cannot reproduce the error with following code neither on macOS nor on Linux. Could you modify it so that the error can be reproduced?

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import Data.Streaming.Network
import Network.HTTP.Types
import qualified Network.HTTP2.Client as C
import qualified Network.HTTP2.Server as S
import Network.Socket

----------------------------------------------------------------

runServer :: Socket -> IO ()
runServer listenSock = do
    listen listenSock 1024
    forever $ do
        (sock, _) <- accept listenSock
        let cleanup cfg = do
                S.freeSimpleConfig cfg
                close sock
        bracket (S.allocSimpleConfig sock 4096) cleanup $ \cfg -> do
            S.run cfg testServer

testServer :: S.Request -> S.Aux -> (S.Response -> [S.PushPromise] -> IO ()) -> IO ()
testServer req _ respWriter = case S.requestPath req of
  Just "/inifite" -> respWriter infiniteResponse []
  _ -> respWriter (S.responseNoBody status404 []) []
  where
    infiniteResponse = S.responseStreaming status200 [] loop
    loop :: (Builder.Builder -> IO ()) -> (IO ()) -> IO ()
    loop bsWriter flush = do
        bsWriter $ Builder.lazyByteString $ LBS.concat $ replicate 1000 "foo\n"
        flush
        loop bsWriter flush

----------------------------------------------------------------

runClient :: Int -> IO ()
runClient serverPort =
  bracket (fst <$> getSocketTCP "localhost" serverPort) close $ \sock ->
    bracket (C.allocSimpleConfig sock 4096) C.freeSimpleConfig $ \http2Cfg -> C.run clientConfig http2Cfg $ testClient
  where
    clientConfig = C.ClientConfig {
        C.scheme = "http"
      , C.authority = "localhost"
      , C.cacheLimit = 20
      }

testClient :: C.Client ()
testClient sendRequest =
    foldr1 concurrently_ [cli "A", cli "B", cli "C", cli "D"]
  where
    cli tag = sendRequest (C.requestNoBody "GET" "/inifite" []) cli'
      where
        cli' res
          | C.responseStatus res == Just status200 = loop res
          | otherwise = error $ "the response isn't 200, due to a typo?"
        loop res = do
            bs <- C.getResponseBodyChunk res
            putStrLn $ tag <> ": " <> show (BS.length bs)
            loop res

main :: IO ()
main = bracket setup teardown $ \(serverPort, listenSock) ->
    race_ (runServer listenSock) (threadDelay 100000 >> runClient serverPort)
  where
    setup = bindRandomPortTCP "*"
    teardown = close . snd

[akshaymankar]

The error only happens when the client gets stuck. In your example if you replace the final loop res call with something like threadDelay maxBound and wait for some time, the server will send RST_STREAM on one of the streams with INTERNAL ERROR (2) as the error.

[kazu-yamamoto]

It's just the timeout of 30 seconds. It's normal.

[kazu-yamamoto]

I merged this PR, anyway.