Add timeouts so stalling is more obvious

yesod-core/test/YesodCoreTest/RawResponse.hs

@@ -13,15 +13,13 @@ import qualified Data.ByteString.Char8 as S8
 import Data.Conduit
 import qualified Data.Conduit.Binary as CB
 import Data.Char (toUpper)
-import Control.Exception (try, IOException)
 import Data.Conduit.Network
-import Network.Socket (close)
 import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async (withAsync)
+import Control.Concurrent.Async (race)
 import Control.Monad.Trans.Resource (register)
 import Data.IORef
-import Data.Streaming.Network (bindPortTCP)
 import Network.HTTP.Types (status200)
+import Network.Wai.Handler.Warp (testWithApplication)
 
 mkYesod "App" [parseRoutes|
 / HomeR GET
@@ -56,35 +54,20 @@ getWaiAppStreamR = sendWaiApplication $ \_ f -> f $ responseStream status200 []
     flush
     send " world"
 
-getFreePort :: IO Int
+allowFiveSeconds :: IO a -> IO a
-getFreePort = do
+allowFiveSeconds = fmap (either id id) . race (threadDelay 5000000 >> error "timed out")
-    loop 43124
-  where
-    loop port = do
-        esocket <- try $ bindPortTCP port "*"
-        case esocket of
-            Left (_ :: IOException) -> loop (succ port)
-            Right socket -> do
-                close socket
-                return port
 
 specs :: Spec
 specs = do
     describe "RawResponse" $ do
-        it "works" $ do
+        it "works" $ allowFiveSeconds $ testWithApplication (toWaiApp App) $ \port -> do
-            port <- getFreePort
-            withAsync (warp port App) $ \_ -> do
-                threadDelay 100000
             runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do
                 runConduit $ yield "GET / HTTP/1.1\r\n\r\nhello" .| appSink ad
                 runConduit (appSource ad .| CB.take 6) >>= (`shouldBe` "0HELLO")
                 runConduit $ yield "WORLd" .| appSink ad
                 runConduit (appSource ad .| await) >>= (`shouldBe` Just "WORLD")
 
-    let body req = do
+    let body req = allowFiveSeconds $ testWithApplication (toWaiApp App) $ \port -> do
-            port <- getFreePort
-            withAsync (warp port App) $ \_ -> do
-                threadDelay 100000
             runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do
                 runConduit $ yield req .| appSink ad
                 runConduit $ appSource ad .| CB.lines .| do

yesod-core/yesod-core.cabal

@@ -191,8 +191,9 @@ test-suite tests
                   , unliftio
                   , wai >= 3.0
                   , wai-extra
+                  , warp
                   , yesod-core
-    ghc-options:     -Wall
+    ghc-options:     -Wall -threaded
     extensions: TemplateHaskell
 
 benchmark widgets