Skip to content

Commit 6cf7c73

Browse files
authored
Merge pull request #1233 from haskell-servant/servant-jsaddle-test-delays
Add few delays in servant-jsaddle tests
2 parents 1047510 + 99aa09e commit 6cf7c73

File tree

2 files changed

+15
-4
lines changed

2 files changed

+15
-4
lines changed

changelog.d/todo

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,4 @@ prs: #1194 #1201 #1198 #1197 #1190 #1188
44
prs: #1183 #1181 #1182 #1175 #1175 #1174
55
prs: #1173 #1171 #1154 #1162 #1157 #1159
66
prs: #1156
7+
prs: #1233

servant-jsaddle/test/Servant/Client/JSaddleSpec.hs

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,10 @@ module Servant.Client.JSaddleSpec where
88

99
import Control.Concurrent
1010
(threadDelay)
11-
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
11+
import Control.Concurrent.MVar
12+
(newEmptyMVar, putMVar, takeMVar)
13+
import Control.Exception
14+
(handle, throwIO)
1215
import Control.Monad.Trans
1316
import Data.Aeson
1417
import Data.ByteString
@@ -28,15 +31,16 @@ import qualified Language.Javascript.JSaddle.WebSockets as WS
2831
import qualified Network.HTTP.Types as Http
2932
import qualified Network.Wai as Wai
3033
import Network.Wai.Handler.Warp as Warp
31-
import qualified System.Process as P
3234
import Network.Wai.Middleware.AddHeaders
3335
import Network.Wai.Middleware.Cors
3436
(simpleCors)
3537
import Network.WebSockets
3638
(defaultConnectionOptions)
39+
import qualified Network.WebSockets as WS
3740
import Servant.API
3841
import Servant.Client.JSaddle
3942
import Servant.Server
43+
import qualified System.Process as P
4044
import Test.Hspec
4145

4246
type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
@@ -104,17 +108,23 @@ spec = do
104108
let serverApp :: IO Application
105109
serverApp = pure $ logRequest $ addCors $ serve testApi testServer
106110

107-
Warp.testWithApplication serverApp $ \serverPort -> do
111+
let handler :: WS.ConnectionException -> IO ()
112+
handler WS.ConnectionClosed = return ()
113+
handler e = throwIO e
114+
115+
handle handler $ Warp.testWithApplication serverApp $ \serverPort -> do
116+
threadDelay $ 500 * 1000
108117

109118
let clientApp :: IO Application
110119
clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp
111120

112121
Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do
122+
threadDelay $ 500 * 1000
123+
113124
putStrLn $ "server http://localhost:" ++ show serverPort
114125
putStrLn $ "client http://localhost:" ++ show clientPort
115126
putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort
116127

117-
-- threadDelay $ 1000 * 1000 * 1000
118128

119129
-- Run headless chrome
120130
-- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode

0 commit comments

Comments
 (0)