From 6d0c415377d8b02aa8c55ee9a60b42f7927b3290 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 1 Oct 2019 13:49:25 +0300 Subject: [PATCH 1/2] Add few delays in servant-jsaddle tests Hopefully they will fail less on Travis with these --- changelog.d/todo | 1 + servant-jsaddle/test/Servant/Client/JSaddleSpec.hs | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/changelog.d/todo b/changelog.d/todo index 7ee059f6..a4b587c3 100644 --- a/changelog.d/todo +++ b/changelog.d/todo @@ -4,3 +4,4 @@ prs: #1194 #1201 #1198 #1197 #1190 #1188 prs: #1183 #1181 #1182 #1175 #1175 #1174 prs: #1173 #1171 #1154 #1162 #1157 #1159 prs: #1156 +prs: #1233 diff --git a/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs b/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs index 759fbebe..c5820d8e 100644 --- a/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs +++ b/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs @@ -105,16 +105,18 @@ spec = do serverApp = pure $ logRequest $ addCors $ serve testApi testServer Warp.testWithApplication serverApp $ \serverPort -> do + threadDelay $ 500 * 1000 let clientApp :: IO Application clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do + threadDelay $ 500 * 1000 + putStrLn $ "server http://localhost:" ++ show serverPort putStrLn $ "client http://localhost:" ++ show clientPort putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort - -- threadDelay $ 1000 * 1000 * 1000 -- Run headless chrome -- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode From 99aa09e65bc2e2a6d1653cf52558e0d008f64035 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 1 Oct 2019 16:28:28 +0300 Subject: [PATCH 2/2] Catch WS.ConnectionClosed --- servant-jsaddle/test/Servant/Client/JSaddleSpec.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs b/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs index c5820d8e..55c29fbf 100644 --- a/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs +++ b/servant-jsaddle/test/Servant/Client/JSaddleSpec.hs @@ -8,7 +8,10 @@ module Servant.Client.JSaddleSpec where import Control.Concurrent (threadDelay) -import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Control.Concurrent.MVar + (newEmptyMVar, putMVar, takeMVar) +import Control.Exception + (handle, throwIO) import Control.Monad.Trans import Data.Aeson import Data.ByteString @@ -28,15 +31,16 @@ import qualified Language.Javascript.JSaddle.WebSockets as WS import qualified Network.HTTP.Types as Http import qualified Network.Wai as Wai import Network.Wai.Handler.Warp as Warp -import qualified System.Process as P import Network.Wai.Middleware.AddHeaders import Network.Wai.Middleware.Cors (simpleCors) import Network.WebSockets (defaultConnectionOptions) +import qualified Network.WebSockets as WS import Servant.API import Servant.Client.JSaddle import Servant.Server +import qualified System.Process as P import Test.Hspec type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse @@ -104,7 +108,11 @@ spec = do let serverApp :: IO Application serverApp = pure $ logRequest $ addCors $ serve testApi testServer - Warp.testWithApplication serverApp $ \serverPort -> do + let handler :: WS.ConnectionException -> IO () + handler WS.ConnectionClosed = return () + handler e = throwIO e + + handle handler $ Warp.testWithApplication serverApp $ \serverPort -> do threadDelay $ 500 * 1000 let clientApp :: IO Application