core: batch contact disconnections and re-subscriptions to one event per server (#564)

* core: batch contact disconnections and re-subscriptions to one event per server

* update simplexmq

* update query to use temp table

* remove old code

src/Simplex/Chat/Controller.hs

@@ -221,8 +221,8 @@ data ChatResponse
   | CRContactConnecting {contact :: Contact}
   | CRContactConnected {contact :: Contact}
   | CRContactAnotherClient {contact :: Contact}
-  | CRContactDisconnected {contact :: Contact}
-  | CRContactSubscribed {contact :: Contact}
+  | CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
+  | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
   | CRContactSubError {contact :: Contact, chatError :: ChatError}
   | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
   | CRGroupInvitation {groupInfo :: GroupInfo}

src/Simplex/Chat/Store.hs

@@ -53,6 +53,7 @@ module Simplex.Chat.Store
     getPendingConnections,
     getContactConnections,
     getConnectionEntity,
+    getConnectionsContacts,
     getGroupAndMember,
     updateConnectionStatus,
     createNewGroup,
@@ -1193,6 +1194,28 @@ getConnectionEntity st User {userId, userContactId} agentConnId =
         userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
         userContact_ _ = Left SEUserContactLinkNotFound
 
+getConnectionsContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> [ConnId] -> m [ContactRef]
+getConnectionsContacts st userId agentConnIds =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute_ db "DROP TABLE IF EXISTS temp.conn_ids"
+    DB.execute_ db "CREATE TABLE temp.conn_ids (conn_id BLOB)"
+    DB.executeMany db "INSERT INTO temp.conn_ids (conn_id) VALUES (?)" $ map Only agentConnIds
+    conns <-
+      map (uncurry ContactRef)
+        <$> DB.query
+          db
+          [sql|
+            SELECT ct.contact_id, ct.local_display_name
+            FROM contacts ct
+            JOIN connections c ON c.contact_id = ct.contact_id
+            WHERE ct.user_id = ? AND c.agent_conn_id IN (SELECT conn_id FROM temp.conn_ids)
+              AND c.conn_type = ?
+              AND (c.conn_status = ? OR c.conn_status = ?)
+          |]
+          (userId, ConnContact, ConnReady, ConnSndReady)
+    DB.execute_ db "DROP TABLE temp.conn_ids"
+    pure conns
+
 getGroupAndMember :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (GroupInfo, GroupMember)
 getGroupAndMember st User {userId, userContactId} groupMemberId =
   liftIOEither . withTransaction st $ \db ->

src/Simplex/Chat/Types.hs

@@ -84,6 +84,14 @@ contactConn = activeConn
 contactConnId :: Contact -> ConnId
 contactConnId Contact {activeConn} = aConnId activeConn
 
+data ContactRef = ContactRef
+  { contactId :: Int64,
+    localDisplayName :: ContactName
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions
+
 data UserContact = UserContact
   { userContactLinkId :: Int64,
     connReqContact :: ConnReqContact

src/Simplex/Chat/View.hs

@@ -111,8 +111,8 @@ responseToView testView = \case
   CRContactConnecting _ -> []
   CRContactConnected ct -> [ttyFullContact ct <> ": contact is connected"]
   CRContactAnotherClient c -> [ttyContact' c <> ": contact is connected to another client"]
-  CRContactDisconnected c -> [ttyContact' c <> ": disconnected from server (messages will be queued)"]
-  CRContactSubscribed c -> [ttyContact' c <> ": connected to server"]
+  CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> smpServer srv <> " (" <> contactList cs <> ")"]
+  CRContactsSubscribed srv cs -> [plain $ "server connected " <> smpServer srv <> " (" <> contactList cs <> ")"]
   CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
   CRContactSubSummary summary ->
     [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
@@ -174,6 +174,10 @@ responseToView testView = \case
               _ -> Nothing
     viewErrorsSummary :: [a] -> StyledString -> [StyledString]
     viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
+    smpServer :: SMPServer -> String
+    smpServer SMP.ProtocolServer {host, port} = B.unpack . strEncode $ SrvLoc host port
+    contactList :: [ContactRef] -> String
+    contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
 
 viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
 viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of