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.hs

@@ -836,7 +836,7 @@ subscribeUserConnections user@User {userId} = do
       contacts <- withStore (`getUserContacts` user)
       toView . CRContactSubSummary =<< pooledForConcurrentlyN n contacts (\ct -> ContactSubStatus ct <$> subscribeContact ce ct)
     subscribeContact ce ct =
-      (subscribe (contactConnId ct) >> when ce (toView $ CRContactSubscribed ct) $> Nothing)
+      (subscribe (contactConnId ct) $> Nothing)
         `catchError` (\e -> when ce (toView $ CRContactSubError ct e) $> Just e)
     subscribeGroups n ce = do
       groups <- withStore (`getUserGroups` user)
@@ -898,6 +898,15 @@ subscribeUserConnections user@User {userId} = do
 
 processAgentMessage :: forall m. ChatMonad m => Maybe User -> ConnId -> ACommand 'Agent -> m ()
 processAgentMessage Nothing _ _ = throwChatError CENoActiveUser
+processAgentMessage (Just User {userId}) "" agentMessage = case agentMessage of
+  DOWN srv conns -> serverEvent srv conns CRContactsDisconnected "disconnected"
+  UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected"
+  _ -> pure ()
+  where
+    serverEvent srv@SMP.ProtocolServer {host, port} conns event str = do
+      cs <- withStore $ \st -> getConnectionsContacts st userId conns
+      toView $ event srv cs
+      showToast ("server " <> str) (safeDecodeUtf8 . strEncode $ SrvLoc host port)
 processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage =
   (withStore (\st -> getConnectionEntity st user agentConnId) >>= updateConnStatus) >>= \case
     RcvDirectMsgConnection conn contact_ ->
@@ -1011,13 +1020,6 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
           toView $ CRContactAnotherClient ct
           showToast (c <> "> ") "connected to another client"
           unsetActive $ ActiveC c
-        DOWN -> do
-          toView $ CRContactDisconnected ct
-          showToast (c <> "> ") "disconnected"
-        UP -> do
-          toView $ CRContactSubscribed ct
-          showToast (c <> "> ") "is active"
-          setActive $ ActiveC c
         -- TODO print errors
         MERR msgId err -> do
           chatItemId_ <- withStore $ \st -> getChatItemIdByAgentMsgId st connId msgId

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