Merge pull request #1233 from haskell-servant/servant-jsaddle-test-delays

Add few delays in servant-jsaddle tests
This commit is contained in:
Oleg Grenrus 2019-10-01 17:28:17 +03:00 committed by GitHub
commit 6cf7c73824
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 15 additions and 4 deletions

View file

@ -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

View file

@ -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,17 +108,23 @@ 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
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