diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs index 17c42e37d..5111955cd 100644 --- a/apps/ntf-server/Main.hs +++ b/apps/ntf-server/Main.hs @@ -5,7 +5,7 @@ module Main where import Control.Logger.Simple import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig) import Simplex.Messaging.Notifications.Server (runNtfServer) -import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..), defaultInactiveClientExpiration) +import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..)) import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig) import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI) import System.FilePath (combine) @@ -66,7 +66,7 @@ ntfServerCLIConfig = pushQSize = 128, smpAgentCfg = defaultSMPClientAgentConfig, apnsConfig = defaultAPNSPushClientConfig, - inactiveClientExpiration = Just defaultInactiveClientExpiration, + inactiveClientExpiration = Nothing, caCertificateFile = caCrtFile, privateKeyFile = serverKeyFile, certificateFile = serverCrtFile diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 86d599ad8..5f9253665 100644 --- a/apps/smp-server/Main.hs +++ b/apps/smp-server/Main.hs @@ -65,9 +65,9 @@ smpServerCLIConfig = <> "websockets: off\n\n" <> "[INACTIVE_CLIENTS]\n\ \# TTL and interval to check inactive clients\n\ - \disconnect: on\n" - <> ("ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n") - <> ("check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"), + \disconnect: off\n" + <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n") + <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"), mkServerConfig = \storeLogFile transports ini -> ServerConfig { transports, diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs index 55393d278..c2e12aff0 100644 --- a/src/Simplex/Messaging/Transport/Server.hs +++ b/src/Simplex/Messaging/Transport/Server.hs @@ -41,27 +41,27 @@ runTransportServer started port serverParams server = do E.bracket (startTCPServer started port) (closeServer started clients) - $ \sock -> forever $ do - (connSock, _) <- accept sock - tid <- forkIO $ connectClient u connSock `catchAll_` close connSock `catchAll_` pure () + $ \sock -> forever . E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> do + -- catchAll_ is needed here in case the connection was closed earlier + tid <- forkFinally (connectClient u conn) (const . liftIO $ gracefulClose conn 5000 `catchAll_` pure ()) atomically . modifyTVar' clients $ S.insert tid where connectClient :: UnliftIO m -> Socket -> IO () - connectClient u connSock = + connectClient u conn = E.bracket - (connectTLS serverParams connSock >>= getServerConnection) + (connectTLS serverParams conn >>= getServerConnection) closeConnection (unliftIO u . server) +-- | Run TCP server without TLS - only used in SimpleX Chat runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO () runTCPServer started port server = do clients <- newTVarIO S.empty E.bracket (startTCPServer started port) (closeServer started clients) - $ \sock -> forever $ do - (connSock, _) <- accept sock - tid <- forkIO $ server connSock `catchAll_` pure () + $ \sock -> forever . E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> do + tid <- forkFinally (server conn) (const $ gracefulClose conn 5000) atomically . modifyTVar' clients $ S.insert tid closeServer :: TMVar Bool -> TVar (Set ThreadId) -> Socket -> IO ()