version 2.1.1 (#375)

* server: CLI warning when deleting server configuration

* correction

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

CHANGELOG.md

@@ -1,3 +1,9 @@
+# 2.1.0
+
+SMP server:
+
+- configuration to expire inactive clients in ini file, increased TTL and check interval for client expiration
+
 # 2.0.0
 
 Push notifications server (beta):

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)
@@ -42,7 +42,21 @@ ntfServerCLIConfig =
           defaultServerPort = "443",
           executableName = "ntf-server",
           serverVersion = "SMP notifications server v0.1.0",
-          mkServerConfig = \_storeLogFile transports ->
+          mkIniFile = \enableStoreLog defaultServerPort ->
+            "[STORE_LOG]\n\
+            \# The server uses STM memory for persistence,\n\
+            \# that will be lost on restart (e.g., as with redis).\n\
+            \# This option enables saving memory to append only log,\n\
+            \# and restoring it when the server is started.\n\
+            \# Log is compacted on start (deleted objects are removed).\n\
+            \# The messages are not logged.\n"
+              <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
+              <> "[TRANSPORT]\n\
+                 \port: "
+              <> defaultServerPort
+              <> "\n\
+                 \websockets: off\n",
+          mkServerConfig = \_storeLogFile transports _ ->
             NtfServerConfig
               { transports,
                 subIdBytes = 24,
@@ -52,7 +66,7 @@ ntfServerCLIConfig =
                 pushQSize = 128,
                 smpAgentCfg = defaultSMPClientAgentConfig,
                 apnsConfig = defaultAPNSPushClientConfig,
-                inactiveClientExpiration = Just defaultInactiveClientExpiration,
+                inactiveClientExpiration = Nothing,
                 caCertificateFile = caCrtFile,
                 privateKeyFile = serverKeyFile,
                 certificateFile = serverCrtFile

apps/smp-server/Main.hs

@@ -1,14 +1,17 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Main where
 
 import Control.Logger.Simple
+import Data.Ini (lookupValue)
 import Simplex.Messaging.Server (runSMPServer)
-import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI)
+import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI, readStrictIni)
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
+import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion)
 import System.FilePath (combine)
 
@@ -24,7 +27,11 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 main :: IO ()
 main = do
   setLogLevel LogInfo
-  withGlobalLogging logCfg $ protocolServerCLI smpServerCLIConfig runSMPServer
+  withGlobalLogging logCfg . protocolServerCLI smpServerCLIConfig $ \cfg@ServerConfig {inactiveClientExpiration} -> do
+    putStrLn $ case inactiveClientExpiration of
+      Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
+      _ -> "not expiring inactive clients"
+    runSMPServer cfg
 
 smpServerCLIConfig :: ServerCLIConfig ServerConfig
 smpServerCLIConfig =
@@ -44,7 +51,24 @@ smpServerCLIConfig =
           defaultServerPort = "5223",
           executableName = "smp-server",
           serverVersion = "SMP server v" <> simplexMQVersion,
-          mkServerConfig = \storeLogFile transports ->
+          mkIniFile = \enableStoreLog defaultServerPort ->
+            "[STORE_LOG]\n\
+            \# The server uses STM memory for persistence,\n\
+            \# that will be lost on restart (e.g., as with redis).\n\
+            \# This option enables saving memory to append only log,\n\
+            \# and restoring it when the server is started.\n\
+            \# Log is compacted on start (deleted objects are removed).\n\
+            \# The messages are not logged.\n"
+              <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
+              <> "[TRANSPORT]\n"
+              <> ("port: " <> defaultServerPort <> "\n")
+              <> "websockets: off\n\n"
+              <> "[INACTIVE_CLIENTS]\n\
+                 \# TTL and interval to check inactive clients\n\
+                 \disconnect: off\n"
+              <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
+              <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"),
+          mkServerConfig = \storeLogFile transports ini ->
             ServerConfig
               { transports,
                 tbqSize = 16,
@@ -58,7 +82,15 @@ smpServerCLIConfig =
                 storeLogFile,
                 allowNewQueues = True,
                 messageExpiration = Just defaultMessageExpiration,
-                inactiveClientExpiration = Just defaultInactiveClientExpiration,
+                inactiveClientExpiration =
+                  if lookupValue "INACTIVE_CLIENTS" "disconnect" ini == Right "on"
+                    then
+                      Just
+                        ExpirationConfig
+                          { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
+                            checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
+                          }
+                    else Nothing,
                 logStatsInterval = Just 86400, -- seconds
                 logStatsStartTime = 0 -- seconds from 00:00 UTC
               }

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 2.0.0
+version: 2.1.1
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        2.0.0
+version:        2.1.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -329,6 +329,7 @@ test-suite smp-server-test
       AgentTests.DoubleRatchetTests
       AgentTests.FunctionalAPITests
       AgentTests.NotificationTests
+      AgentTests.SchemaDump
       AgentTests.SQLiteTests
       CoreTests.EncodingTests
       CoreTests.ProtocolErrorTests

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql

@@ -0,0 +1,161 @@
+CREATE TABLE migrations(
+  name TEXT NOT NULL,
+  ts TEXT NOT NULL,
+  PRIMARY KEY(name)
+);
+CREATE TABLE servers(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BLOB NOT NULL,
+  PRIMARY KEY(host, port)
+) WITHOUT ROWID;
+CREATE TABLE connections(
+  conn_id BLOB NOT NULL PRIMARY KEY,
+  conn_mode TEXT NOT NULL,
+  last_internal_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_rcv_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_internal_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_external_snd_msg_id INTEGER NOT NULL DEFAULT 0,
+  last_rcv_msg_hash BLOB NOT NULL DEFAULT x'',
+  last_snd_msg_hash BLOB NOT NULL DEFAULT x'',
+  smp_agent_version INTEGER NOT NULL DEFAULT 1
+) WITHOUT ROWID;
+CREATE TABLE rcv_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  rcv_id BLOB NOT NULL,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  rcv_private_key BLOB NOT NULL,
+  rcv_dh_secret BLOB NOT NULL,
+  e2e_priv_key BLOB NOT NULL,
+  e2e_dh_secret BLOB,
+  snd_id BLOB NOT NULL,
+  snd_key BLOB,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER,
+  PRIMARY KEY(host, port, rcv_id),
+  FOREIGN KEY(host, port) REFERENCES servers
+  ON DELETE RESTRICT ON UPDATE CASCADE,
+  UNIQUE(host, port, snd_id)
+) WITHOUT ROWID;
+CREATE TABLE snd_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  snd_id BLOB NOT NULL,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  snd_private_key BLOB NOT NULL,
+  e2e_dh_secret BLOB NOT NULL,
+  status TEXT NOT NULL,
+  smp_server_version INTEGER NOT NULL DEFAULT 1,
+  smp_client_version INTEGER NOT NULL DEFAULT 1,
+  snd_public_key BLOB,
+  e2e_pub_key BLOB,
+  PRIMARY KEY(host, port, snd_id),
+  FOREIGN KEY(host, port) REFERENCES servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;
+CREATE TABLE messages(
+  conn_id BLOB NOT NULL REFERENCES connections(conn_id)
+  ON DELETE CASCADE,
+  internal_id INTEGER NOT NULL,
+  internal_ts TEXT NOT NULL,
+  internal_rcv_id INTEGER,
+  internal_snd_id INTEGER,
+  msg_type BLOB NOT NULL, --(H)ELLO,(R)EPLY,(D)ELETE. Should SMP confirmation be saved too?
+  msg_body BLOB NOT NULL DEFAULT x'',
+  PRIMARY KEY(conn_id, internal_id),
+  FOREIGN KEY(conn_id, internal_rcv_id) REFERENCES rcv_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED,
+  FOREIGN KEY(conn_id, internal_snd_id) REFERENCES snd_messages
+  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
+) WITHOUT ROWID;
+CREATE TABLE rcv_messages(
+  conn_id BLOB NOT NULL,
+  internal_rcv_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  external_snd_id INTEGER NOT NULL,
+  broker_id BLOB NOT NULL,
+  broker_ts TEXT NOT NULL,
+  internal_hash BLOB NOT NULL,
+  external_prev_snd_hash BLOB NOT NULL,
+  integrity BLOB NOT NULL,
+  PRIMARY KEY(conn_id, internal_rcv_id),
+  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
+  ON DELETE CASCADE
+) WITHOUT ROWID;
+CREATE TABLE snd_messages(
+  conn_id BLOB NOT NULL,
+  internal_snd_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  internal_hash BLOB NOT NULL,
+  previous_msg_hash BLOB NOT NULL DEFAULT x'',
+  PRIMARY KEY(conn_id, internal_snd_id),
+  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
+  ON DELETE CASCADE
+) WITHOUT ROWID;
+CREATE TABLE conn_confirmations(
+  confirmation_id BLOB NOT NULL PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  e2e_snd_pub_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  sender_key BLOB NOT NULL, -- TODO per-queue key. Split?
+  ratchet_state BLOB NOT NULL,
+  sender_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT(datetime('now'))
+) WITHOUT ROWID;
+CREATE TABLE conn_invitations(
+  invitation_id BLOB NOT NULL PRIMARY KEY,
+  contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  cr_invitation BLOB NOT NULL,
+  recipient_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL DEFAULT 0,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT(datetime('now'))
+) WITHOUT ROWID;
+CREATE TABLE ratchets(
+  conn_id BLOB NOT NULL PRIMARY KEY REFERENCES connections
+  ON DELETE CASCADE,
+  -- x3dh keys are not saved on the sending side(the side accepting the connection)
+  x3dh_priv_key_1 BLOB,
+  x3dh_priv_key_2 BLOB,
+  -- ratchet is initially empty on the receiving side(the side offering the connection)
+  ratchet_state BLOB,
+  e2e_version INTEGER NOT NULL DEFAULT 1
+) WITHOUT ROWID;
+CREATE TABLE skipped_messages(
+  skipped_message_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES ratchets
+  ON DELETE CASCADE,
+  header_key BLOB NOT NULL,
+  msg_n INTEGER NOT NULL,
+  msg_key BLOB NOT NULL
+);
+CREATE TABLE ntf_servers(
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  PRIMARY KEY(ntf_host, ntf_port)
+) WITHOUT ROWID;
+CREATE TABLE ntf_tokens(
+  provider TEXT NOT NULL, -- apn
+  device_token TEXT NOT NULL,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  tkn_id BLOB, -- token ID assigned by notifications server
+  tkn_pub_key BLOB NOT NULL, -- client's public key to verify token commands(used by server, for repeat registraions)
+tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands
+tkn_pub_dh_key BLOB NOT NULL, -- client's public DH key(for repeat registraions)
+tkn_priv_dh_key BLOB NOT NULL, -- client's private DH key(for repeat registraions)
+tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
+  tkn_status TEXT NOT NULL,
+  tkn_action BLOB,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')), -- this is to check token status periodically to know when it was last checked
+  PRIMARY KEY(provider, device_token, ntf_host, ntf_port),
+  FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
+  ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;

src/Simplex/Messaging/Server.hs

@@ -131,7 +131,8 @@ smpServer started = do
           atomically $ TM.lookupDelete qId (clientSubs c)
 
     expireMessagesThread_ :: ServerConfig -> [m ()]
-    expireMessagesThread_ = maybe [] ((: []) . expireMessages) . messageExpiration
+    expireMessagesThread_ ServerConfig {messageExpiration = Just msgExp} = [expireMessages msgExp]
+    expireMessagesThread_ _ = []
 
     expireMessages :: ExpirationConfig -> m ()
     expireMessages expCfg = do
@@ -147,8 +148,9 @@ smpServer started = do
             >>= atomically . (`deleteExpiredMsgs` old)
 
     serverStatsThread_ :: ServerConfig -> [m ()]
-    serverStatsThread_ ServerConfig {logStatsInterval, logStatsStartTime} =
-      maybe [] ((: []) . logServerStats logStatsStartTime) logStatsInterval
+    serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime} =
+      [logServerStats logStatsStartTime interval]
+    serverStatsThread_ _ = []
 
     logServerStats :: Int -> Int -> m ()
     logServerStats startAt logInterval = do
@@ -186,7 +188,8 @@ runClientTransport th@THandle {sessionId} = do
   raceAny_ ([send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
     `finally` clientDisconnected c
   where
-    disconnectThread_ c expCfg = maybe [] ((: []) . disconnectTransport th c activeAt) expCfg
+    disconnectThread_ c (Just expCfg) = [disconnectTransport th c activeAt expCfg]
+    disconnectThread_ _ _ = []
 
 clientDisconnected :: (MonadUnliftIO m, MonadReader Env m) => Client -> m ()
 clientDisconnected c@Client {subscriptions, connected} = do

src/Simplex/Messaging/Server/CLI.hs

@@ -26,7 +26,7 @@ import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (BufferMode (..), IOMode (..), hGetLine, hSetBuffering, stderr, stdout, withFile)
+import System.IO (BufferMode (..), IOMode (..), hFlush, hGetLine, hSetBuffering, stderr, stdout, withFile)
 import System.Process (readCreateProcess, shell)
 import Text.Read (readMaybe)
 
@@ -43,7 +43,8 @@ data ServerCLIConfig cfg = ServerCLIConfig
     defaultServerPort :: ServiceName,
     executableName :: String,
     serverVersion :: String,
-    mkServerConfig :: Maybe FilePath -> [(ServiceName, ATransport)] -> cfg
+    mkIniFile :: Bool -> ServiceName -> String,
+    mkServerConfig :: Maybe FilePath -> [(ServiceName, ATransport)] -> Ini -> cfg
   }
 
 protocolServerCLI :: ServerCLIConfig cfg -> (cfg -> IO ()) -> IO ()
@@ -55,13 +56,24 @@ protocolServerCLI cliCfg@ServerCLIConfig {iniFile, executableName} server =
         _ -> initializeServer cliCfg opts
     Start ->
       doesFileExist iniFile >>= \case
-        True -> readIniFile iniFile >>= either exitError (runServer cliCfg server . mkIniOptions)
+        True -> readIniFile iniFile >>= either exitError (runServer cliCfg server)
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    Delete -> cleanup cliCfg >> putStrLn "Deleted configuration and log files"
+    Delete -> do
+      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      cleanup cliCfg
+      putStrLn "Deleted configuration and log files"
 
 exitError :: String -> IO ()
 exitError msg = putStrLn msg >> exitFailure
 
+confirmOrExit :: String -> IO ()
+confirmOrExit s = do
+  putStrLn s
+  putStr "Continue (Y/n): "
+  hFlush stdout
+  ok <- getLine
+  when (ok /= "Y") exitFailure
+
 data CliCommand
   = Init InitOptions
   | Start
@@ -140,12 +152,12 @@ initializeServer cliCfg InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} =
   createDirectoryIfMissing True logDir
   createX509
   fp <- saveFingerprint
-  createIni
+  writeFile iniFile $ mkIniFile enableStoreLog defaultServerPort
   putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
   printServiceInfo cliCfg fp
   warnCAPrivateKeyFile
   where
-    ServerCLIConfig {cfgDir, logDir, iniFile, executableName, caKeyFile, caCrtFile, serverKeyFile, serverCrtFile, fingerprintFile, defaultServerPort} = cliCfg
+    ServerCLIConfig {cfgDir, logDir, iniFile, executableName, caKeyFile, caCrtFile, serverKeyFile, serverCrtFile, fingerprintFile, defaultServerPort, mkIniFile} = cliCfg
     createX509 = do
       createOpensslCaConf
       createOpensslServerConf
@@ -199,22 +211,6 @@ initializeServer cliCfg InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} =
       withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
       pure fp
 
-    createIni = do
-      writeFile iniFile $
-        "[STORE_LOG]\n\
-        \# The server uses STM memory for persistence,\n\
-        \# that will be lost on restart (e.g., as with redis).\n\
-        \# This option enables saving memory to append only log,\n\
-        \# and restoring it when the server is started.\n\
-        \# Log is compacted on start (deleted objects are removed).\n\
-        \# The messages are not logged.\n"
-          <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
-          <> "[TRANSPORT]\n\
-             \port: "
-          <> defaultServerPort
-          <> "\n\
-             \websockets: off\n"
-
     warnCAPrivateKeyFile =
       putStrLn $
         "----------\n\
@@ -231,29 +227,32 @@ data IniOptions = IniOptions
     enableWebsockets :: Bool
   }
 
--- TODO ? properly parse ini as a whole
 mkIniOptions :: Ini -> IniOptions
 mkIniOptions ini =
   IniOptions
-    { enableStoreLog = (== "on") $ strict "STORE_LOG" "enable",
-      port = T.unpack $ strict "TRANSPORT" "port",
-      enableWebsockets = (== "on") $ strict "TRANSPORT" "websockets"
+    { enableStoreLog = (== "on") $ strictIni "STORE_LOG" "enable" ini,
+      port = T.unpack $ strictIni "TRANSPORT" "port" ini,
+      enableWebsockets = (== "on") $ strictIni "TRANSPORT" "websockets" ini
     }
-  where
-    strict :: String -> String -> T.Text
-    strict section key =
-      fromRight (error ("no key " <> key <> " in section " <> section)) $
-        lookupValue (T.pack section) (T.pack key) ini
 
-runServer :: ServerCLIConfig cfg -> (cfg -> IO ()) -> IniOptions -> IO ()
-runServer cliCfg server IniOptions {enableStoreLog, port, enableWebsockets} = do
+strictIni :: String -> String -> Ini -> T.Text
+strictIni section key ini =
+  fromRight (error ("no key " <> key <> " in section " <> section)) $
+    lookupValue (T.pack section) (T.pack key) ini
+
+readStrictIni :: Read a => String -> String -> Ini -> a
+readStrictIni section key = read . T.unpack . strictIni section key
+
+runServer :: ServerCLIConfig cfg -> (cfg -> IO ()) -> Ini -> IO ()
+runServer cliCfg server ini = do
   hSetBuffering stdout LineBuffering
   hSetBuffering stderr LineBuffering
   fp <- checkSavedFingerprint
   printServiceInfo cliCfg fp
-  let transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
+  let IniOptions {enableStoreLog, port, enableWebsockets} = mkIniOptions ini
+      transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
       logFile = if enableStoreLog then Just storeLogFile else Nothing
-      cfg = mkServerConfig logFile transports
+      cfg = mkServerConfig logFile transports ini
   printServerConfig logFile transports
   server cfg
   where

src/Simplex/Messaging/Server/Env/STM.hs

@@ -70,8 +70,8 @@ defaultMessageExpiration =
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
-    { ttl = 7200, -- 2 hours
-      checkInterval = 3600 -- seconds, 1 hour
+    { ttl = 86400, -- seconds, 24 hours
+      checkInterval = 43200 -- seconds, 12 hours
     }
 
 data Env = Env

src/Simplex/Messaging/Transport.hs

@@ -96,7 +96,7 @@ supportedSMPVersions :: VersionRange
 supportedSMPVersions = mkVersionRange 1 1
 
 simplexMQVersion :: String
-simplexMQVersion = "2.0.0"
+simplexMQVersion = "2.1.1"
 
 -- * Transport connection class
 

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 ()

tests/AgentTests.hs

@@ -13,6 +13,7 @@ import AgentTests.ConnectionRequestTests
 import AgentTests.DoubleRatchetTests (doubleRatchetTests)
 import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.SQLiteTests (storeTests)
+import AgentTests.SchemaDump (schemaDumpTest)
 import Control.Concurrent
 import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
@@ -36,6 +37,7 @@ agentTests (ATransport t) = do
   describe "Double ratchet tests" doubleRatchetTests
   describe "Functional API" $ functionalAPITests (ATransport t)
   describe "SQLite store" storeTests
+  describe "SQLite schema dump" schemaDumpTest
   describe "SMP agent protocol syntax" $ syntaxTests t
   describe "Establishing duplex connection" $ do
     it "should connect via one server and one agent" $

tests/AgentTests/SchemaDump.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module AgentTests.SchemaDump where
+
+import Control.Monad (void)
+import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
+import System.Process (readCreateProcess, shell)
+import Test.Hspec
+
+testDB :: FilePath
+testDB = "tests/tmp/test_agent_schema.db"
+
+schema :: FilePath
+schema = "src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql"
+
+schemaDumpTest :: Spec
+schemaDumpTest =
+  it "verify and overwrite schema dump" testVerifySchemaDump
+
+testVerifySchemaDump :: IO ()
+testVerifySchemaDump = do
+  void $ createSQLiteStore testDB 1 Migrations.app False
+  void $ readCreateProcess (shell $ "touch " <> schema) ""
+  savedSchema <- readFile schema
+  savedSchema `seq` pure ()
+  void $ readCreateProcess (shell $ "sqlite3 " <> testDB <> " '.schema --indent' > " <> schema) ""
+  currentSchema <- readFile schema
+  savedSchema `shouldBe` currentSchema