eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
changelog.d/todo
View file

@ -4,3 +4,4 @@ prs: #1194 #1201 #1198 #1197 #1190 #1188
prs: #1183 #1181 #1182 #1175 #1175 #1174 prs: #1183 #1181 #1182 #1175 #1175 #1174
prs: #1173 #1171 #1154 #1162 #1157 #1159 prs: #1173 #1171 #1154 #1162 #1157 #1159
prs: #1156 prs: #1156
prs: #1233

18
servant-jsaddle/test/Servant/Client/JSaddleSpec.hs
View file

@ -8,7 +8,10 @@ module Servant.Client.JSaddleSpec where
import Control.Concurrent import Control.Concurrent
(threadDelay) (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 Control.Monad.Trans
import Data.Aeson import Data.Aeson
import Data.ByteString 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.HTTP.Types as Http
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp import Network.Wai.Handler.Warp as Warp
import qualified System.Process as P
import Network.Wai.Middleware.AddHeaders import Network.Wai.Middleware.AddHeaders
import Network.Wai.Middleware.Cors import Network.Wai.Middleware.Cors
(simpleCors) (simpleCors)
import Network.WebSockets import Network.WebSockets
(defaultConnectionOptions) (defaultConnectionOptions)
import qualified Network.WebSockets as WS
import Servant.API import Servant.API
import Servant.Client.JSaddle import Servant.Client.JSaddle
import Servant.Server import Servant.Server
import qualified System.Process as P
import Test.Hspec import Test.Hspec
type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
@ -104,17 +108,23 @@ spec = do
let serverApp :: IO Application let serverApp :: IO Application
serverApp = pure $ logRequest $ addCors $ serve testApi testServer 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 let clientApp :: IO Application
clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp
Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do
threadDelay $ 500 * 1000
putStrLn $ "server http://localhost:" ++ show serverPort putStrLn $ "server http://localhost:" ++ show serverPort
putStrLn $ "client http://localhost:" ++ show clientPort putStrLn $ "client http://localhost:" ++ show clientPort
putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort
-- threadDelay $ 1000 * 1000 * 1000
-- Run headless chrome -- Run headless chrome
-- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode -- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode