[Chore] Tests: Wait for server to start

In the `withServer` helper, we now use warp's beforeMainLoop callback and an MVar to synchronize threads. This makes the test suite more resilient to spurious failures on systems with slow IO.
serokell · Nov 2, 2024 · 7128719 · 7128719
1 parent 6986eeb
commit 7128719
Show file tree

Hide file tree

Showing 6 changed files with 72 additions and 58 deletions.
diff --git a/tests/Test/Xrefcheck/RedirectChainSpec.hs b/tests/Test/Xrefcheck/RedirectChainSpec.hs
@@ -11,7 +11,7 @@ import Control.Lens ((.~))
 import Data.CaseInsensitive qualified as CI
 import Network.HTTP.Types (movedPermanently301)
 import Network.HTTP.Types.Header (HeaderName, hLocation)
-import Network.Wai.Handler.Warp qualified as Web
+import Network.Wai qualified as Web
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 import Web.Scotty qualified as Web
@@ -28,7 +28,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
       checkLinkAndProgressWithServer
         (configMod 5)
         setRef
-        mockRedirect
+        (5000, mockRedirect)
         (link "/broken1")
         progress
         (VerifyResult [RedirectMissingLocation $ chain [ "/broken1", "/broken2", "/broken3"]])
@@ -37,7 +37,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
       checkLinkAndProgressWithServer
         (configMod 5)
         setRef
-        mockRedirect
+        (5000, mockRedirect)
         (link "/cycle1")
         progress
         (VerifyResult [RedirectChainCycle $ chain ["/cycle1", "/cycle2", "/cycle3", "/cycle4", "/cycle2"]])
@@ -47,7 +47,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
           checkLinkAndProgressWithServer
             (configMod 1)
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/relative/host")
             progress
             (VerifyResult [RedirectChainLimit $ chain ["/relative/host", "/cycle2", "/cycle3"]])
@@ -56,17 +56,17 @@ test_redirectRequests = testGroup "Redirect chain tests"
           checkLinkAndProgressWithServer
             (configMod 1)
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/relative/path")
             progress
             (VerifyResult [RedirectChainLimit $ chain ["/relative/path", "/relative/host", "/cycle2"]])
       ]
-  , testCase "Other host redirect" $ withServer otherMockRedirect $ do
+  , testCase "Other host redirect" $ withServer (5001, otherMockRedirect) $ do
       setRef <- newIORef mempty
       checkLinkAndProgressWithServer
         (configMod 1)
         setRef
-        mockRedirect
+        (5000, mockRedirect)
         "http://127.0.0.1:5001/other/host"
         progress
         (VerifyResult [RedirectChainLimit $ fromList ["http://127.0.0.1:5001/other/host", link "/relative/host", link "/cycle2"]])
@@ -76,7 +76,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
           checkLinkAndProgressWithServer
             (configMod 2)
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/cycle1")
             progress
             (VerifyResult [RedirectChainLimit $ chain ["/cycle1", "/cycle2", "/cycle3", "/cycle4"]])
@@ -85,7 +85,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
           checkLinkAndProgressWithServer
             (configMod 0)
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/cycle1")
             progress
             (VerifyResult [RedirectChainLimit $ chain ["/cycle1", "/cycle2"]])
@@ -94,7 +94,7 @@ test_redirectRequests = testGroup "Redirect chain tests"
           checkLinkAndProgressWithServer
             (configMod (-1))
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/cycle1")
             progress
             (VerifyResult [RedirectChainCycle $ chain ["/cycle1", "/cycle2", "/cycle3", "/cycle4", "/cycle2"]])
@@ -118,9 +118,9 @@ test_redirectRequests = testGroup "Redirect chain tests"
     setHeader :: HeaderName -> Text -> Web.ActionM ()
     setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value)
 
-    mockRedirect :: IO ()
+    mockRedirect :: IO Web.Application
     mockRedirect = do
-      Web.run 5000 <=< Web.scottyApp $ do
+      Web.scottyApp $ do
         -- A set of redirect routes that correspond to a broken chain.
         Web.matchAny "/broken1" $ do
           setHeader hLocation (link "/broken2")
@@ -155,8 +155,8 @@ test_redirectRequests = testGroup "Redirect chain tests"
           Web.status movedPermanently301
 
     -- To other host
-    otherMockRedirect :: IO ()
+    otherMockRedirect :: IO Web.Application
     otherMockRedirect =
-      Web.run 5001 <=< Web.scottyApp $ Web.matchAny "/other/host" $ do
+      Web.scottyApp $ Web.matchAny "/other/host" $ do
         setHeader hLocation (link "/relative/host")
         Web.status movedPermanently301
diff --git a/tests/Test/Xrefcheck/RedirectConfigSpec.hs b/tests/Test/Xrefcheck/RedirectConfigSpec.hs
@@ -11,7 +11,7 @@ import Control.Lens ((%~), (.~))
 import Data.CaseInsensitive qualified as CI
 import Network.HTTP.Types (found302, movedPermanently301, temporaryRedirect307)
 import Network.HTTP.Types.Header (HeaderName, hLocation)
-import Network.Wai.Handler.Warp qualified as Web
+import Network.Wai qualified as Web
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 import Text.Regex.TDFA.Text qualified as R
@@ -32,7 +32,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule Nothing Nothing (Just RROTemporary) RROInvalid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/temporary-redirect")
                 (progress False)
                 (VerifyResult [RedirectRuleError (chain ["/temporary-redirect", "/ok"]) (Just RROTemporary)])
@@ -41,7 +41,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule Nothing Nothing (Just RROPermanent) RROInvalid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/temporary-redirect")
                 (progress True)
                 (VerifyResult [])
@@ -52,7 +52,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule Nothing (regex ".*/ok") Nothing RROValid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/permanent-redirect")
                 (progress True)
                 (VerifyResult [])
@@ -61,7 +61,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule Nothing (regex ".*/no-ok") (Just RROPermanent) RROValid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/permanent-redirect")
                 (progress False)
                 (VerifyResult [RedirectRuleError (chain ["/permanent-redirect", "/ok"]) (Just RROPermanent)])
@@ -72,7 +72,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule (regex ".*/permanent-.*") Nothing Nothing RROValid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/permanent-redirect")
                 (progress True)
                 (VerifyResult [])
@@ -81,7 +81,7 @@ test_redirectRequests = testGroup "Redirect config tests"
               checkLinkAndProgressWithServer
                 (configMod [RedirectRule (regex ".*/temporary-.*") Nothing (Just RROPermanent) RROValid] [])
                 setRef
-                mockRedirect
+                (5000, mockRedirect)
                 (link "/permanent-redirect")
                 (progress False)
                 (VerifyResult [RedirectRuleError (chain ["/permanent-redirect", "/ok"]) (Just RROPermanent)])
@@ -92,7 +92,7 @@ test_redirectRequests = testGroup "Redirect config tests"
             checkLinkAndProgressWithServer
               (configMod [RedirectRule (regex ".*/follow[0-9]") (regex "^.*/ok$") (Just (RROCode 307)) RROInvalid] [])
               setRef
-              mockRedirect
+              (5000, mockRedirect)
               (link "/follow3")
               (progress False)
               (VerifyResult [RedirectRuleError (chain ["/follow3", "/ok"]) (Just (RROCode 307))])
@@ -101,7 +101,7 @@ test_redirectRequests = testGroup "Redirect config tests"
             checkLinkAndProgressWithServer
               (configMod [RedirectRule (regex ".*/follow[0-9]") (regex "^.*/ok$") (Just (RROCode 307)) RROInvalid] [])
               setRef
-              mockRedirect
+              (5000, mockRedirect)
               (link "/follow2")
               (progress True)
               (VerifyResult [])
@@ -111,7 +111,7 @@ test_redirectRequests = testGroup "Redirect config tests"
           checkLinkAndProgressWithServer
             (configMod [RedirectRule Nothing Nothing Nothing RROValid] [])
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/follow1")
             (progress True)
             (VerifyResult [])
@@ -122,7 +122,7 @@ test_redirectRequests = testGroup "Redirect config tests"
           checkLinkAndProgressWithServer
             (configMod [RedirectRule Nothing Nothing Nothing RROFollow] [])
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/follow1")
             (progress True)
             (VerifyResult [])
@@ -131,7 +131,7 @@ test_redirectRequests = testGroup "Redirect config tests"
           checkLinkAndProgressWithServer
             (configMod [RedirectRule Nothing Nothing (Just (RROCode 307)) RROInvalid, RedirectRule Nothing Nothing Nothing RROFollow] [])
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/follow1")
             (progress False)
             (VerifyResult [RedirectRuleError (chain ["/follow1", "/follow2", "/follow3", "/ok"]) (Just (RROCode 307))])
@@ -140,7 +140,7 @@ test_redirectRequests = testGroup "Redirect config tests"
           checkLinkAndProgressWithServer
             (configMod [RedirectRule Nothing Nothing (Just (RROCode 307)) RROInvalid, RedirectRule Nothing Nothing Nothing RROFollow] (maybeToList (regex ".*/follow3")))
             setRef
-            mockRedirect
+            (5000, mockRedirect)
             (link "/follow1")
             (progress True)
             (VerifyResult [])
@@ -172,9 +172,9 @@ test_redirectRequests = testGroup "Redirect config tests"
           then reportSuccess
           else reportError
 
-    mockRedirect :: IO ()
+    mockRedirect :: IO Web.Application
     mockRedirect =
-      Web.run 5000 <=< Web.scottyApp $ do
+      Web.scottyApp $ do
         Web.matchAny "/ok" $ Web.raw "Ok"
         Web.matchAny "/permanent-redirect" $ do
           setHeader hLocation "/ok"

diff --git a/tests/Test/Xrefcheck/RedirectDefaultSpec.hs b/tests/Test/Xrefcheck/RedirectDefaultSpec.hs
@@ -11,7 +11,7 @@ import Data.CaseInsensitive qualified as CI
 import Data.Set qualified as S
 import Network.HTTP.Types (Status, mkStatus)
 import Network.HTTP.Types.Header (HeaderName, hLocation)
-import Network.Wai.Handler.Warp qualified as Web
+import Network.Wai qualified as Web
 import Test.Tasty (TestName, TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, testCase)
 import Web.Scotty qualified as Web
@@ -69,17 +69,16 @@ test_redirectRequests = testGroup "Redirect response defaults"
       setRef <- newIORef S.empty
       checkLinkAndProgressWithServerDefault
         setRef
-        (mockRedirect expectedLocation expectedStatus)
+        (5000, mockRedirect expectedLocation expectedStatus)
         url
         ( (if isNothing expectedError then reportSuccess else reportError) "" $
             initProgress 1
         )
         (VerifyResult $ maybeToList expectedError)
 
-    mockRedirect :: Maybe Text -> Status -> IO ()
+    mockRedirect :: Maybe Text -> Status -> IO Web.Application
     mockRedirect expectedLocation expectedStatus =
-      Web.run 5000 <=< Web.scottyApp $
-      Web.matchAny "/redirect" $ do
+      Web.scottyApp $ Web.matchAny "/redirect" $ do
         whenJust expectedLocation (setHeader hLocation)
         Web.status expectedStatus
 

diff --git a/tests/Test/Xrefcheck/TimeoutSpec.hs b/tests/Test/Xrefcheck/TimeoutSpec.hs
@@ -12,7 +12,7 @@ import Data.CaseInsensitive qualified as CI
 import Data.Set qualified as S
 import Network.HTTP.Types (ok200, tooManyRequests429)
 import Network.HTTP.Types.Header (HeaderName, hRetryAfter)
-import Network.Wai.Handler.Warp qualified as Web
+import Network.Wai qualified as Web
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 import Time (Second, Time, sec, threadDelay)
@@ -49,7 +49,7 @@ test_timeout = testGroup "Timeout tests"
   , testCase "Fails on timeout if another domain returned 429" $ do
       setRef <- newIORef S.empty
       checkMultipleLinksWithServer
-        (mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
+        (5000, mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
         setRef
         [ VerifyLinkTestEntry
             { vlteConfigModifier = \c -> c
@@ -73,7 +73,7 @@ test_timeout = testGroup "Timeout tests"
   , testCase "Succeeds on timeout if another path of this domain returned 429" $ do
       setRef <- newIORef S.empty
       checkMultipleLinksWithServer
-        (mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
+        (5000, mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
         setRef
         [ VerifyLinkTestEntry
             { vlteConfigModifier = \c -> c
@@ -111,18 +111,18 @@ test_timeout = testGroup "Timeout tests"
           & setAllowedTimeout
           & configModifier)
         setRef
-        (mockTimeout (sec 0.4) mockResponses)
+        (5000, mockTimeout (sec 0.4) mockResponses)
         "http://127.0.0.1:5000/timeout" prog $
           VerifyResult $
             [ExternalHttpTimeout $ Just (DomainName "127.0.0.1") | not shouldSucceed]
 
     -- When called for the first (N-1) times, waits for specified
     -- amount of seconds and returns an arbitrary result.
     -- When called N time returns the result immediately.
-    mockTimeout :: Time Second -> [MockTimeoutBehaviour] -> IO ()
+    mockTimeout :: Time Second -> [MockTimeoutBehaviour] -> IO Web.Application
     mockTimeout timeout behList = do
       ref <- newIORef @_ behList
-      Web.run 5000 <=< Web.scottyApp $ do
+      Web.scottyApp $ do
         Web.matchAny "/timeout" $ handler ref
         Web.matchAny "/timeoutother" $ handler ref
       where