mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-26 16:14:39 +00:00
core, ios: chat tags (#5367)
* types and db * migration module * chat tag * store method proposal * profiles build * update type * update return type * building * working api * update * refactor * attach tags to contact * simplify * attach chat tags to group info * get chat tags with supplied user id * get tags fix * ios: chat tags poc (#5370) * ios: chat tags poc * updates to sheet * temporary display for other option on swipe * sheet height * only show preset when it has matches * changes * worst emoji picker ever * simplify tag casts and collapse * open on create tag if no tags * simple emoji text field * nice emoji picker * dismiss sheets on tag/untag * semibold selection * all preset tag and change collapsed icon on selection * default selected tag (all) * only apply tag filters on empty search * + button when no custom lists * reset selection of tag filter on profile changes * edit tag (broken menu inside swiftui list) * create list to end of list * swipe changes * remove context menu * delete and edit on swipe actions * tap unread filter deselects other filters * remove delete tag if empty * show tag creation sheet when + button pressed * in memory tag edit * color, size * frame * layout * refactor * remove code * add unread to same unit * fraction on long press * nav fixes * in memory list * emoji picker improvements * remove diff * secondary plus * stop flickering on chat tags load * reuse string * fix reset glitches * delete destructive * simplify? * changes * api updates * fix styles on list via swipe * fixed untag * update schema * move user tags loading to get users chat data * move presets to model * update preset tags when chats are updated * style fixes and locate getPresetTags near tags model --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com> * deleted contacts and card should not match contact preset * fix update presets on chat remove * update migration indices * fix migration * not used chat model * disable button on repeated list name or emoji * no chats message for search fix * fix edits and trim * error in footer, not in alert * styling fixes due to wrong place to attach sheet * update library * remove log * idea for dynamic sheet height * max fraction 62% * minor fixes * disable save button when no changes and while saving * disable preset filter if it is no longer shown * remove comments from schema * fix emoji * remove apiChatTagsResponse * always read chat tags * fix --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com> Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
@@ -122,6 +122,8 @@ module Simplex.Chat.Store.Groups
|
||||
updateUserMemberProfileSentAt,
|
||||
setGroupCustomData,
|
||||
setGroupUIThemes,
|
||||
updateGroupChatTags,
|
||||
getGroupChatTags,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -130,6 +132,7 @@ import Control.Monad.Except
|
||||
import Control.Monad.IO.Class
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Bifunctor (second)
|
||||
import Data.Bitraversable (bitraverse)
|
||||
import Data.Either (rights)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (partition, sortOn)
|
||||
@@ -249,8 +252,8 @@ setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
|
||||
DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
|
||||
|
||||
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
|
||||
getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
|
||||
gm <- ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
@@ -285,10 +288,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|
||||
|]
|
||||
(userId, groupMemberId, userId, userContactId)
|
||||
liftIO $ bitraverse (addGroupChatTags db) pure gm
|
||||
where
|
||||
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
|
||||
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
|
||||
let groupInfo = toGroupInfo vr userContactId groupInfoRow
|
||||
let groupInfo = toGroupInfo vr userContactId [] groupInfoRow
|
||||
member = toGroupMember userContactId memberRow
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
|
||||
|
||||
@@ -333,6 +337,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs,
|
||||
chatTags = [],
|
||||
uiThemes = Nothing,
|
||||
customData = Nothing
|
||||
}
|
||||
@@ -401,6 +406,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs,
|
||||
chatTags = [],
|
||||
uiThemes = Nothing,
|
||||
customData = Nothing
|
||||
},
|
||||
@@ -624,8 +630,8 @@ getUserGroups db vr user@User {userId} = do
|
||||
rights <$> mapM (runExceptT . getGroup db vr user) groupIds
|
||||
|
||||
getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
|
||||
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
map (toGroupInfo vr userContactId)
|
||||
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
|
||||
g_ <- map (toGroupInfo vr userContactId [])
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
@@ -643,6 +649,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
AND (gp.display_name LIKE '%' || ? || '%' OR gp.full_name LIKE '%' || ? || '%' OR gp.description LIKE '%' || ? || '%')
|
||||
|]
|
||||
(userId, userContactId, search, search, search)
|
||||
mapM (addGroupChatTags db) g_
|
||||
where
|
||||
search = fromMaybe "" search_
|
||||
|
||||
@@ -1362,8 +1369,8 @@ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange
|
||||
createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff
|
||||
|
||||
getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
|
||||
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
maybeFirstRow toGroupAndMember $
|
||||
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
|
||||
gm_ <- maybeFirstRow toGroupAndMember $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
@@ -1399,10 +1406,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0
|
||||
|]
|
||||
(userId, userId, contactId, userContactId)
|
||||
mapM (bitraverse (addGroupChatTags db) pure) gm_
|
||||
where
|
||||
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
|
||||
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
|
||||
let groupInfo = toGroupInfo vr userContactId groupInfoRow
|
||||
let groupInfo = toGroupInfo vr userContactId [] groupInfoRow
|
||||
member = toGroupMember userContactId memberRow
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
|
||||
|
||||
@@ -1482,22 +1490,24 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName
|
||||
updateGroupProfile db user g' p'
|
||||
where
|
||||
getGroupProfile =
|
||||
ExceptT $ firstRow toGroupProfile (SEGroupNotFound groupId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
ExceptT $
|
||||
firstRow toGroupProfile (SEGroupNotFound groupId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences
|
||||
FROM group_profiles gp
|
||||
JOIN groups g ON gp.group_profile_id = g.group_profile_id
|
||||
WHERE g.group_id = ?
|
||||
|]
|
||||
(Only groupId)
|
||||
(Only groupId)
|
||||
toGroupProfile (displayName, fullName, description, image, groupPreferences) =
|
||||
GroupProfile {displayName, fullName, description, image, groupPreferences}
|
||||
|
||||
getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfo db vr User {userId, userContactId} groupId =
|
||||
ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
|
||||
getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do
|
||||
chatTags <- getGroupChatTags db groupId
|
||||
firstRow (toGroupInfo vr userContactId chatTags) (SEGroupNotFound groupId) $
|
||||
DB.query
|
||||
db
|
||||
(groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
|
||||
@@ -2053,7 +2063,7 @@ createMemberContact
|
||||
quotaErrCounter = 0
|
||||
}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing}
|
||||
|
||||
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db vr user contactId = do
|
||||
@@ -2090,7 +2100,7 @@ createMemberContactInvited
|
||||
contactId <- createContactUpdateMember currentTs userPreferences
|
||||
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
|
||||
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing}
|
||||
m' = m {memberContactId = Just contactId}
|
||||
pure (mCt', m')
|
||||
where
|
||||
@@ -2301,3 +2311,31 @@ setGroupUIThemes :: DB.Connection -> User -> GroupInfo -> Maybe UIThemeEntityOve
|
||||
setGroupUIThemes db User {userId} GroupInfo {groupId} uiThemes = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE groups SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (uiThemes, updatedAt, userId, groupId)
|
||||
|
||||
updateGroupChatTags :: DB.Connection -> GroupId -> [ChatTagId] -> IO ()
|
||||
updateGroupChatTags db gId tIds = do
|
||||
currentTags <- getGroupChatTags db gId
|
||||
let tagsToAdd = filter (`notElem` currentTags) tIds
|
||||
tagsToDelete = filter (`notElem` tIds) currentTags
|
||||
forM_ tagsToDelete $ untagGroupChat db gId
|
||||
forM_ tagsToAdd $ tagGroupChat db gId
|
||||
|
||||
tagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO ()
|
||||
tagGroupChat db groupId tId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO chat_tags_chats (group_id, chat_tag_id)
|
||||
VALUES (?,?)
|
||||
|]
|
||||
(groupId, tId)
|
||||
|
||||
untagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO ()
|
||||
untagGroupChat db groupId tId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
DELETE FROM chat_tags_chats
|
||||
WHERE group_id = ? AND chat_tag_id = ?
|
||||
|]
|
||||
(groupId, tId)
|
||||
|
||||
Reference in New Issue
Block a user