on master help sign in
Merge pull request #1233 from haskell-servant/servant-jsaddle-test-delays
6cf7c73Oleg Grenrus
changelog.d/todo+1
@@ -4,3 +4,4 @@ prs: #1194 #1201 #1198 #1197 #1190 #1188
4prs: #1183 #1181 #1182 #1175 #1175 #1174
4prs: #1183 #1181 #1182 #1175 #1175 #1174
5prs: #1173 #1171 #1154 #1162 #1157 #1159
5prs: #1173 #1171 #1154 #1162 #1157 #1159
6prs: #1156
6prs: #1156
7+prs: #1233
servant-jsaddle/test/Servant/Client/JSaddleSpec.hs+14−4
@@ -8,7 +8,10 @@ module Servant.Client.JSaddleSpec where
8
8
9import Control.Concurrent
9import Control.Concurrent
10 (threadDelay)
10 (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)
12import Control.Monad.Trans
15import Control.Monad.Trans
13import Data.Aeson
16import Data.Aeson
14import Data.ByteString
17import Data.ByteString
@@ -28,15 +31,16 @@ import qualified Language.Javascript.JSaddle.WebSockets as WS
28import qualified Network.HTTP.Types as Http
31import qualified Network.HTTP.Types as Http
29import qualified Network.Wai as Wai
32import qualified Network.Wai as Wai
30import Network.Wai.Handler.Warp as Warp
33import Network.Wai.Handler.Warp as Warp
31−import qualified System.Process as P
32import Network.Wai.Middleware.AddHeaders
34import Network.Wai.Middleware.AddHeaders
33import Network.Wai.Middleware.Cors
35import Network.Wai.Middleware.Cors
34 (simpleCors)
36 (simpleCors)
35import Network.WebSockets
37import Network.WebSockets
36 (defaultConnectionOptions)
38 (defaultConnectionOptions)
39+import qualified Network.WebSockets as WS
37import Servant.API
40import Servant.API
38import Servant.Client.JSaddle
41import Servant.Client.JSaddle
39import Servant.Server
42import Servant.Server
43+import qualified System.Process as P
40import Test.Hspec
44import Test.Hspec
41
45
42type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
46type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
@@ -104,17 +108,23 @@ spec = do
104 let serverApp :: IO Application
108 let serverApp :: IO Application
105 serverApp = pure $ logRequest $ addCors $ serve testApi testServer
109 serverApp = pure $ logRequest $ addCors $ serve testApi testServer
106
110
111+ let handler :: WS.ConnectionException -> IO ()
112+ handler WS.ConnectionClosed = return ()
113+ handler e = throwIO e
114+
107− Warp.testWithApplication serverApp $ \serverPort -> do
115+ handle handler $ Warp.testWithApplication serverApp $ \serverPort -> do
116+ threadDelay $ 500 * 1000
108
117
109 let clientApp :: IO Application
118 let clientApp :: IO Application
110 clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp
119 clientApp = WS.jsaddleOr defaultConnectionOptions (action serverPort >> Run.syncPoint) WS.jsaddleApp
111
120
112 Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do
121 Warp.testWithApplication (simpleCors <$> clientApp) $ \clientPort -> do
122+ threadDelay $ 500 * 1000
123+
113 putStrLn $ "server http://localhost:" ++ show serverPort
124 putStrLn $ "server http://localhost:" ++ show serverPort
114 putStrLn $ "client http://localhost:" ++ show clientPort
125 putStrLn $ "client http://localhost:" ++ show clientPort
115 putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort
126 putStrLn $ "google-chrome-stable --headless --disable-gpu --screenshot http://localhost:" ++ show clientPort
116
127
117− -- threadDelay $ 1000 * 1000 * 1000
118
128
119 -- Run headless chrome
129 -- Run headless chrome
120 -- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode
130 -- https://docs.travis-ci.com/user/gui-and-headless-browsers/#using-the-chrome-addon-in-the-headless-mode