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

Catch WS.ConnectionClosed

Browse source
This commit is contained in:
Oleg Grenrus 2019-10-01 16:28:28 +03:00
parent 6d0c415377
commit 99aa09e65b
1 changed files with 11 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
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,7 +108,11 @@ 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 threadDelay $ 500 * 1000
let clientApp :: IO Application let clientApp :: IO Application