git.iko.soy/project-m36
on master help sign in
improve connection failure handling
commit86de73fa7954d26427cfc26fd9ef8867471d60dc authorAgentM <agentm@themactionfaction.com> dateSun 7 Mar 2021, 20:33 (6 years ago) parent1d0771b
2 files changed+22−13
compare with master
unifiedsplit
src/lib/ProjectM36/Client.hs+11−9 test/Server/Main.hs+11−4
src/lib/ProjectM36/Client.hs+11−9
@@ -297,16 +297,18 @@ connectProjectM36 (RemoteConnectionInfo dbName hostName servicePort notification
297297 \(NotificationMessage notifications') ->
298298 forM_ (M.toList notifications') (uncurry notificationCallback)
299299 ]
300−-- TODO missing async callback
301− conn <- RPC.connect notificationHandlers (hostAddressToTuple addr) port
302− eRet <- RPC.call conn (Login dbName)
303−-- TODO handle connection errors
304− case eRet of
305− Left err -> error (show err)
306− Right False -> error "wtf"
307− Right True ->
300+ let connectExcHandler (e :: IOException) = pure $ Left (IOExceptionError e)
301+ eConn <- (Right <$> RPC.connect notificationHandlers (hostAddressToTuple addr) port) `catch` connectExcHandler
302+ case eConn of
303+ Left err -> pure (Left err)
304+ Right conn -> do
305+ eRet <- RPC.call conn (Login dbName)
306+ case eRet of
307+ Left err -> error (show err)
308+ Right False -> error "wtf"
309+ Right True ->
308310 --TODO handle connection errors!
309− pure (Right (RemoteConnection (RemoteConnectionConf conn)))
311+ pure (Right (RemoteConnection (RemoteConnectionConf conn)))
310312
311313--convert RPC errors into exceptions
312314convertRPCErrors :: RPC.ConnectionError -> IO a
test/Server/Main.hs+11−4
@@ -23,8 +23,6 @@ import System.FilePath
2323import System.Directory
2424#endif
2525
26−import Debug.Trace
27−
2826type Timeout = Int
2927
3028testList :: SessionId -> Connection -> MVar () -> Test
@@ -44,7 +42,7 @@ testList sessionId conn notificationTestMVar = TestList $ serverTests ++ session
4442 testRelationVariableSummary,
4543 testNotification notificationTestMVar
4644 ]
47− serverTests = [testRequestTimeout, testFileDescriptorCount]
45+ serverTests = [testRequestTimeout, testFileDescriptorCount, testClientConnectFail]
4846
4947main :: IO ()
5048main = do
@@ -209,7 +207,7 @@ testRequestTimeout = TestCase $ do
209207 case eTestConn of
210208 Left err -> putStrLn ("failed to connect: " ++ show err) >> exitFailure
211209 Right (session, testConn) -> do
212− res <- catchJust (\exc -> if traceShowId exc == RequestTimeoutException then Just exc else Nothing) (callTestTimeout_ session testConn) (const (pure False))
210+ res <- catchJust (\exc -> if exc == RequestTimeoutException then Just exc else Nothing) (callTestTimeout_ session testConn) (const (pure False))
213211 assertBool "timeout exception was not thrown" (not res)
214212 killThread serverTid
215213
@@ -240,3 +238,12 @@ fdCount = do
240238--pass on non-linux platforms
241239testFileDescriptorCount = TestCase (pure ())
242240#endif
241+
242+testClientConnectFail :: Test
243+testClientConnectFail = TestCase $ do
244+ let connInfo = RemoteConnectionInfo "non-existent-db" "127.0.0.1" "8888" emptyNotificationCallback
245+ eConn <- connectProjectM36 connInfo
246+ case eConn of
247+ Left err -> pure ()
248+ Right _ -> assertFailure "unexpected connection success"
249+