@@ -8,7 +8,10 @@ module Servant.Client.JSaddleSpec where
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
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
42type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
46type TestApi = ReqBody '[OctetStream] ByteString :> Post '[JSON] TestResponse
@@ -104,7 +108,11 @@ 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
111+ let handler :: WS.ConnectionException -> IO ()
112+ handler WS.ConnectionClosed = return ()
113+ handler e = throwIO e
107− Warp.testWithApplication serverApp $ \serverPort -> do
115+ handle handler $ Warp.testWithApplication serverApp $ \serverPort -> do
108 threadDelay $ 500 * 1000
116 threadDelay $ 500 * 1000
110 let clientApp :: IO Application
118 let clientApp :: IO Application