stripped contactLinkSubs

src/Simplex/Chat.hs

@@ -3356,7 +3356,7 @@ subscribeUserConnections vr onlyNeeded user = do
     if onlyNeeded
       then do
         (conns, entities) <- withStore' $ \a -> getConnectionsToSubscribe a vr user
-        let (ctConns, ucs, mConns, sfts, rfts, pcConns) = foldl' addEntity ([], M.empty, [], M.empty, M.empty, []) entities
+        let (ctConns, ucs, mConns, sfts, rfts, pcConns) = foldl' addEntity ([], [], [], M.empty, M.empty, []) entities
         pure (conns, ctConns, ucs, [], mConns, sfts, rfts, pcConns)
       else do
         withStore' (`unsetConnectionToSubscribe` user)
@@ -3386,16 +3386,12 @@ subscribeUserConnections vr onlyNeeded user = do
     runSubscriber :: CM () -> CM' ()
     runSubscriber action = tryAllErrors' mkChatError action >>= either (logError . tshow) pure
     addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case
-      RcvDirectMsgConnection c (Just _ct) -> let cts' = addSub c cts in (cts', ucs, ms, sfts, rfts, pcs)
-      RcvDirectMsgConnection c Nothing -> let pcs' = addSub c pcs in (cts, ucs, ms, sfts, rfts, pcs')
-      RcvGroupMsgConnection c _g _m -> let ms' = addSub c ms in (cts, ucs, ms', sfts, rfts, pcs)
-      SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs)
-      RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs)
-      UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs)
-    addConn :: Connection -> a -> Map ConnId a -> Map ConnId a
-    addConn = M.insert . aConnId
-    addSub :: Connection -> [ConnId] -> [ConnId]
-    addSub c = (aConnId c :)
+      RcvDirectMsgConnection c (Just _ct) -> let cts' = aConnId c : cts in (cts', ucs, ms, sfts, rfts, pcs)
+      RcvDirectMsgConnection c Nothing -> let pcs' = aConnId c : pcs in (cts, ucs, ms, sfts, rfts, pcs')
+      RcvGroupMsgConnection c _g _m -> let ms' = aConnId c : ms in (cts, ucs, ms', sfts, rfts, pcs)
+      SndFileConnection c sft -> let sfts' = M.insert (aConnId c) sft sfts in (cts, ucs, ms, sfts', rfts, pcs)
+      RcvFileConnection c rft -> let rfts' = M.insert (aConnId c) rft rfts in (cts, ucs, ms, sfts, rfts', pcs)
+      UserContactConnection c uc -> let ucs' = (aConnId c, isNothing $ userContactGroupId uc) : ucs in (cts, ucs', ms, sfts, rfts, pcs)
     getContactConns :: CM [ConnId]
     getContactConns = do
       ctConns <- withStore_ getUserContactConnIds
@@ -3404,11 +3400,10 @@ subscribeUserConnections vr onlyNeeded user = do
         logError $ "getContactConns differ: " <> tshow (ctConns, ctConns')
         fail "abandon ship!"
       pure ctConns -- (map fst cts', M.fromList cts')
-    getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact)
+    getUserContactLinkConns :: CM ([ConnId], [(ConnId, Bool)])
     getUserContactLinkConns = do
-      (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr)
-      let connIds = map aConnId cs
-      pure (connIds, M.fromList $ zip connIds ucs)
+      ucs <- withStore_ getUserContactLinks
+      pure (map fst ucs, ucs)
     getGroupMemberConns :: CM ([(GroupInfo, [ConnId])], [ConnId])
     getGroupMemberConns = do
       gs <- withStore_ (`getUserGroupMemberConnIds` vr)
@@ -3450,9 +3445,9 @@ subscribeUserConnections vr onlyNeeded user = do
               BROKER _ NETWORK -> "network"
               SMP _ SMP.AUTH -> "contact deleted"
               e -> show e
-    contactLinkSubsToView :: Map ConnId AgentErrorType -> Map ConnId UserContact -> CM ()
+    contactLinkSubsToView :: Map ConnId AgentErrorType -> [(ConnId, Bool)] -> CM ()
     contactLinkSubsToView errs ucs = do
-      let (addresses, groupLinks) = partition (\(_, uc) -> isNothing $ userContactGroupId uc) (M.assocs ucs) -- TODO: move into query
+      let (addresses, groupLinks) = partition snd ucs
       forM_ addresses $ \(acId, _uc) -> toView $ CRUserAddrSubStatus {user, userContactError = (`ChatErrorAgent` Nothing) <$> M.lookup acId errs}
       let groups = S.fromList $ map fst groupLinks
           errGroups = M.restrictKeys errs groups

src/Simplex/Chat/Store/Profiles.hs

@@ -350,25 +350,17 @@ getUserAddressConnections db vr User {userId} = do
           |]
           (userId, userId)
 
-getUserContactLinks :: DB.Connection -> VersionRangeChat -> User -> IO [(Connection, UserContact)]
-getUserContactLinks db vr User {userId} =
-  map toUserContactConnection
-    <$> DB.query
-      db
-      [sql|
-        SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
-          c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
-          c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
-          c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
-          uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
-        FROM connections c
-        JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
-        WHERE c.user_id = ? AND uc.user_id = ?
-      |]
-      (userId, userId)
-  where
-    toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact)
-    toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection vr connRow, UserContact {userContactLinkId, connReqContact, groupId})
+getUserContactLinks :: DB.Connection -> User -> IO [(ConnId, Bool)]
+getUserContactLinks db User {userId} =
+  DB.query
+    db
+    [sql|
+      SELECT c.agent_conn_id, uc.group_id IS NULL
+      FROM connections c
+      JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
+      WHERE c.user_id = ? AND uc.user_id = ?
+    |]
+    (userId, userId)
 
 deleteUserAddress :: DB.Connection -> User -> IO ()
 deleteUserAddress db user@User {userId} = do