Add reproducer

Repro.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Network.Socket
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Network.HTTP.Types (status200)
+import Network.Wai.Handler.Warp.Internal
+import Data.ByteString.Builder (byteString)
+import Debug.Trace
+import Control.Concurrent
+import qualified Control.Exception as E
+
+main :: IO ()
+main = do
+ let settings =
+ defaultSettings { 
+ settingsOnClose = \_ -> msg "closed!",
+ settingsOnException = \_ e -> msg ("Exception: " ++ show e) >> E.throw e
+ }
+ runSettings settings app
+
+msg :: String -> IO ()
+msg s = traceEventIO s
+
+
+app :: Application
+app req respond = E.handle onErr $ do
+ connectionIsInactive req
+ msg "starting handler"
+ threadDelay $ 10*1000*1000
+ msg "handler responding..." 
+ x <- respond $ responseBuilder status200 [("Content-Type", "text/plain")] (byteString "Hello, world!")
+ msg "handler done" 
+ return x
+ where
+ onErr e =
+ msg ("Handler exception: " ++ show @E.SomeException e) >> E.throw e
+

Test.hs

@@ -0,0 +1,20 @@
+import Control.Concurrent
+import System.IO
+import Network.Socket as N
+
+main :: IO ()
+main = do
+ addr:_ <- N.getAddrInfo (Just N.defaultHints) (Just "127.0.0.1") (Just "3000")
+ s <- N.openSocket addr
+ N.connect s (addrAddress addr)
+ putStrLn "Client connected"
+ hdl <- N.socketToHandle s ReadWriteMode
+ hPutStr hdl $ unlines
+ [ "GET / HTTP/1.1"
+ , ""
+ , ""
+ , ""
+ ]
+ threadDelay (100*1000)
+ putStrLn "Client closing"
+ N.close s

run.sh

@@ -0,0 +1,29 @@
+#!/usr/bin/env bash
+
+set -e
+
+GHC="$HOME/ghc/ghc-compare-3/_build/stage1/bin/ghc"
+#GHC="$HOME/ghcs-nix/ghcs/9.4.5/bin/ghc"
+
+cabal build -w $GHC warp --write-ghc-environment-file=always
+$GHC Repro.hs -threaded -debug
+$GHC Test.hs -threaded -debug
+
+run() {
+ echo "Starting server..."
+ ./Repro +RTS -N2 -v-au 2>&1 &
+ sleep 1
+
+ echo "Starting client..."
+ ./Test
+ echo "Client done"
+
+ sleep 15
+ echo "Killing server..."
+ kill -INT %1
+
+ echo "Done"
+ #nix run nixpkgs#haskellPackages.ghc-events -- show Repro.eventlog
+}
+
+run | nix shell nixpkgs#moreutils -c ts -i "%.S"