diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 152e3a70a4..c7d6e6043c 100644 --- a/src/Simplex/Chat.hs +++ b/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 diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index be06ea8878..3a850e73fe 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/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