directory service: fix queries (#6539)

* fix directory service queries

* fix

* reduce postgres pool size to 1

* stabilize postgres client tests, remove slow handshake tests

* update simplexmq

* fix test

* test delay

src/Simplex/Chat/Controller.hs

@@ -96,7 +96,12 @@ import Simplex.RemoteControl.Types
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-#if !defined(dbPostgres)
+
+#if defined(dbPostgres)
+import qualified Database.PostgreSQL.Simple as PSQL
+
+type SQLError = PSQL.SqlError
+#else
 import Database.SQLite.Simple (SQLError)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
@@ -1542,25 +1547,24 @@ withFastStore = withStorePriority True
 withStorePriority :: Bool -> (DB.Connection -> ExceptT StoreError IO a) -> CM a
 withStorePriority priority action = do
   ChatController {chatStore} <- ask
-  liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
+  liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catch` handleDBErrors
 
 withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a))
 withStoreBatch actions = do
   ChatController {chatStore} <- ask
-  liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
+  liftIO $ withTransaction chatStore $ mapM (`E.catch` handleDBErrors) . actions
 
--- TODO [postgres] postgres specific error handling
-handleDBErrors :: [E.Handler (Either ChatError a)]
-handleDBErrors =
-#if !defined(dbPostgres)
-  ( E.Handler $ \(e :: SQLError) ->
-      let se = SQL.sqlError e
-          busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
-       in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e
-  ) :
+handleDBErrors :: E.SomeException -> IO (Either ChatError a)
+handleDBErrors e = pure $ Left $ ChatErrorStore $ case E.fromException e of
+  Just (e' :: SQLError) ->
+#if defined(dbPostgres)
+    SEDBException $ show e'
+#else
+    let se = SQL.sqlError e'
+        busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
+     in (if busy then SEDBBusyError else SEDBException) $ show e'
 #endif
-  [ E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
-  ]
+  Nothing -> SEDBException $ show e
 
 withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a))
 withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions

src/Simplex/Chat/Library/Commands.hs

@@ -262,7 +262,7 @@ stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles,
   readTVarIO remoteHostSessions >>= mapM_ (cancelRemoteHost False . snd)
   atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd)
   disconnectAgentClient smpAgent
-  readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
+  readTVarIO s >>= mapM_ (\(a1, a2) -> forkIO $ uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
   closeFiles rcvFiles
   atomically $ do
@@ -1805,7 +1805,7 @@ processChatCommand vr nm = \case
     conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
     let PendingContactConnection {pccConnStatus, connLinkInv} = conn
     case (pccConnStatus, connLinkInv) of
-      (ConnNew, Just _ссLink) -> do
+      (ConnNew, Just _ccLink) -> do
         newUser <- privateGetUser newUserId
         conn' <- recreateConn user conn newUser
         pure $ CRConnectionUserChanged user conn conn' newUser

src/Simplex/Chat/Options/Postgres.hs

@@ -42,7 +42,7 @@ chatDbOptsP _appDir defaultDbName = do
       ( long "pool-size"
           <> metavar "DB_POOL_SIZE"
           <> help "Database connection pool size"
-          <> value 10
+          <> value 1
           <> showDefault
       )
   dbCreateSchema <-
@@ -84,7 +84,7 @@ mobileDbOpts schemaPrefix connstr = do
     ChatDbOpts
       { dbConnstr,
         dbSchemaPrefix,
-        dbPoolSize = 10,
+        dbPoolSize = 1,
         dbCreateSchema = True
       }