Recover rxflow on closing

[kazu-yamamoto]

This should fix kazu-yamamoto/http-semantics#5.

@FinleyMcIlwaine Could you test this branch?
getResponseBodyChunk should not be necessary anymore.

[FinleyMcIlwaine]

Thanks for the ping! This appears to suffer from the same behavior. I updated it so that adjustRxFlow uses informWindowUpdate and it fixed my test case. Opened another PR at #126.

Here's the client for my test case. It just sends 400 GET requests to the server at localhost:12080, printing every 50 requests:

{-# LANGUAGE OverloadedStrings #-}
module Client where

import Control.Concurrent
import Control.Monad
import Data.ByteString qualified as BS
import UnliftIO.Exception

-- network-run
import Network.HTTP.Types
import Network.Run.TCP (runTCPClient)

-- http2
import Network.HTTP2.Client as Client

runClient :: IO ()
runClient =
    runTCPClient "localhost" "12080" runHTTP2Client
  where
    runHTTP2Client s =
        allocSimpleConfig s 4096 `bracket` freeSimpleConfig $
          \conf ->
            Client.run
              (defaultClientConfig { authority = "localhost" })
              conf
              client

    client :: Client ()
    client sendRequest _aux =
        forM_ [0 .. 400 :: Int] $ \i -> do
          when (i `mod` 50 == 0) $ print i
          let req = requestNoBody methodGet "/" []
          sendRequest req $ \_rsp -> do
            let _readAll r = do
                  c <- getResponseBodyChunk r
                  if BS.null c then
                    return ()
                  else
                    _readAll r
            -- Without this line, window size exhaustion occurs and the server
            -- refuses to send more data
            -- !r <- _readAll _rsp
            threadDelay 10000
            return ()

The server responds with a large (16000 bytes, arbitrarily) response body:

{-# LANGUAGE OverloadedStrings #-}
module Server where

import qualified Data.ByteString.Builder as BSB
import qualified UnliftIO.Exception as E

-- http-types
import Network.HTTP.Types

-- network-run
import Network.Run.TCP (runTCPServer)

-- http2
import Network.HTTP2.Client as Client
import Network.HTTP2.Server as Server

runServer :: IO ()
runServer =
    runTCPServer (Just "localhost") "12080" runHTTP2Server
  where
    runHTTP2Server s =
        allocSimpleConfig s 4096 `E.bracket` freeSimpleConfig $
          \conf ->
            Server.run
              defaultServerConfig
              conf
              server

    server _req _aux sendResponse = sendResponse response []
      where
        response = responseBuilder ok200 header body
        header   = [("Content-Type", "text/plain")]
        body     = BSB.string8 $ take 16000 $ cycle ['0' .. '9']

Running the client and server, the client will stop printing and just hang after sending a request, while the server sits and waits for the client to update the window size.