diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index eea606e5be..b1542a1257 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -900,27 +900,29 @@ processChatCommand' vr = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APICreateChatTag (ChatRef cType chatId) (ChatTagData emoji text) -> withUser $ \user -> withFastStore $ \db -> case cType of CTDirect -> do - ctId <- liftIO $ createChatTag db user emoji text - tagDirectChat' db user chatId ctId + tId <- liftIO $ createChatTag db user emoji text + liftIO $ tagDirectChat db chatId tId + CRTagsUpdated user <$> liftIO (getUserChatTags db user) <*> liftIO (getDirectChatTags db chatId) CTGroup -> do - ctId <- liftIO $ createChatTag db user emoji text - tagGroupChat' db user chatId ctId + tId <- liftIO $ createChatTag db user emoji text + liftIO $ tagGroupChat db chatId tId + CRTagsUpdated user <$> liftIO (getUserChatTags db user) <*> liftIO (getGroupChatTags db chatId) _ -> pure $ chatCmdError (Just user) "not supported" - APITagChat (ChatRef cType chatId) ctId -> withUser $ \user -> withFastStore $ \db -> case cType of - CTDirect -> tagDirectChat' db user chatId ctId - CTGroup -> tagGroupChat' db user chatId ctId - _ -> pure $ chatCmdError (Just user) "not supported" - APIUntagChat (ChatRef cType chatId) ctId -> withUser $ \user -> withFastStore $ \db -> case cType of + APITagChat (ChatRef cType chatId) tId -> withUser $ \user -> withFastStore $ \db -> case cType of CTDirect -> do - _ <- liftIO $ untagDirectChat db chatId ctId - _ <- deleteChatTagIfEmpty db user ctId - (allTags, chatTags) <- updatedDirectChatTags db user chatId - pure $ CRChatUntagged user allTags chatTags + liftIO $ tagDirectChat db chatId tId + CRTagsUpdated user <$> liftIO (getUserChatTags db user) <*> liftIO (getDirectChatTags db chatId) CTGroup -> do - _ <- liftIO $ untagGroupChat db chatId ctId - _ <- deleteChatTagIfEmpty db user ctId - (allTags, chatTags) <- updatedGroupChatTags db user chatId - pure $ CRChatUntagged user allTags chatTags + liftIO $ tagGroupChat db chatId tId + CRTagsUpdated user <$> liftIO (getUserChatTags db user) <*> liftIO (getGroupChatTags db chatId) + _ -> pure $ chatCmdError (Just user) "not supported" + APIUntagChat (ChatRef cType chatId) tId -> withUser $ \user -> withFastStore $ \db -> case cType of + CTDirect -> do + liftIO $ untagDirectChat db user chatId tId + CRChatUntagged user <$> liftIO (getUserChatTags db user) <*> liftIO (getDirectChatTags db chatId) + CTGroup -> do + liftIO $ untagGroupChat db user chatId tId + CRChatUntagged user <$> liftIO (getUserChatTags db user) <*> liftIO (getGroupChatTags db chatId) _ -> pure $ chatCmdError (Just user) "not supported" APICreateChatItems folderId cms -> withUser $ \user -> createNoteFolderContentItems user folderId (L.map (,Nothing) cms) @@ -7487,35 +7489,6 @@ closeFileHandle fileId files = do h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m) liftIO $ mapM_ hClose h_ `catchAll_` pure () -tagGroupChat' :: DB.Connection -> User -> GroupId -> ChatTagId -> ExceptT StoreError IO ChatResponse -tagGroupChat' db user gId ctId = do - liftIO $ tagGroupChat db gId ctId - (allTags, chatTags) <- updatedGroupChatTags db user gId - pure $ CRChatTagged user allTags chatTags - -updatedGroupChatTags :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ([ChatTag], [ChatTag]) -updatedGroupChatTags db user gId = do - allTags <- liftIO $ getUserChatTags db user - let (groupTags, otherTags) = partition (\ChatTag {groupId} -> groupId == Just gId) allTags - pure (groupTags, otherTags) - -deleteChatTagIfEmpty :: DB.Connection -> User -> ChatTagId -> ExceptT StoreError IO () -deleteChatTagIfEmpty db user ctId = do - tagChatsCount <- liftIO $ getTagChatsCount db ctId - when (tagChatsCount == 0) $ liftIO $ deleteChatTag db user ctId - -tagDirectChat' :: DB.Connection -> User -> ContactId -> ChatTagId -> ExceptT StoreError IO ChatResponse -tagDirectChat' db user cId ctId = do - liftIO $ tagDirectChat db cId ctId - (allTags, chatTags) <- updatedDirectChatTags db user cId - pure $ CRChatTagged user allTags chatTags - -updatedDirectChatTags :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO ([ChatTag], [ChatTag]) -updatedDirectChatTags db user cId = do - allTags <- liftIO $ getUserChatTags db user - let (directTags, otherTags) = partition (\ChatTag {contactId} -> contactId == Just cId) allTags - pure (directTags, otherTags) - deleteMembersConnections :: User -> [GroupMember] -> CM () deleteMembersConnections user members = deleteMembersConnections' user members False diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index e21b8f5b29..6b772efd51 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -622,8 +622,8 @@ data ChatResponse | CRContactCode {user :: User, contact :: Contact, connectionCode :: Text} | CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text} | CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text} - | CRTagsUpdated {user :: User, userTags :: [ChatTag], chatTags :: [ChatTag]} - | CRChatUntagged {user :: User, userTags :: [ChatTag], chatTags :: [ChatTag]} + | CRTagsUpdated {user :: User, userTags :: [ChatTag], chatTags :: [ChatTagId]} + | CRChatUntagged {user :: User, userTags :: [ChatTag], chatTags :: [ChatTagId]} | CRNewChatItems {user :: User, chatItems :: [AChatItem]} | CRChatItemsStatusesUpdated {user :: User, chatItems :: [AChatItem]} | CRChatItemUpdated {user :: User, chatItem :: AChatItem} diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index cabe06a5e1..5e84c83985 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -79,6 +79,9 @@ module Simplex.Chat.Store.Direct setContactCustomData, setContactUIThemes, setContactChatDeleted, + tagDirectChat, + untagDirectChat, + getDirectChatTags, ) where @@ -1020,3 +1023,31 @@ setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO () setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (chatDeleted, updatedAt, userId, contactId) + +tagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO () +tagDirectChat db contactId tId = + DB.execute + db + [sql| + INSERT INTO chat_tags_chats (contact_id, chat_tag_id) + VALUES (?,?) + |] + (contactId, tId) + +untagDirectChat :: DB.Connection -> User -> ContactId -> ChatTagId -> IO () +untagDirectChat db user contactId tId = do + untagDirectChat' db contactId tId + deleteChatTagIfEmpty db user tId + +untagDirectChat' :: DB.Connection -> ContactId -> ChatTagId -> IO () +untagDirectChat' db contactId tId = + DB.execute + db + [sql| + DELETE FROM chat_tags_chats + WHERE contact_id = ? AND chat_tag_id = ? + |] + (contactId, tId) + +getDirectChatTags :: DB.Connection -> ContactId -> IO [ChatTagId] +getDirectChatTags db contactId = map fromOnly <$> DB.query db "SELECT chat_tag_id FROM chat_tags_chats WHERE contact_id = ?" (Only contactId) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index ad3d779573..d72e91020c 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -122,6 +122,9 @@ module Simplex.Chat.Store.Groups updateUserMemberProfileSentAt, setGroupCustomData, setGroupUIThemes, + tagGroupChat, + untagGroupChat, + getGroupChatTags, ) where @@ -1484,16 +1487,17 @@ 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} @@ -2303,3 +2307,32 @@ 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) + +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 -> User -> GroupId -> ChatTagId -> IO () +untagGroupChat db user gId tId = do + untagGroupChat' db gId tId + deleteChatTagIfEmpty db user 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) + +getGroupChatTags :: DB.Connection -> GroupId -> IO [ChatTagId] +getGroupChatTags db groupId = + map fromOnly <$> DB.query db "SELECT chat_tag_id FROM chat_tags_chats WHERE group_id = ?" (Only groupId) diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 536ab0f210..e88cf39feb 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -70,14 +70,6 @@ module Simplex.Chat.Store.Profiles updateCommandStatus, getCommandDataByCorrId, setUserUIThemes, - createChatTag, - tagDirectChat, - tagGroupChat, - deleteChatTag, - untagGroupChat, - untagDirectChat, - getUserChatTags, - getTagChatsCount, ) where @@ -900,84 +892,3 @@ setUserUIThemes :: DB.Connection -> User -> Maybe UIThemeEntityOverrides -> IO ( setUserUIThemes db User {userId} uiThemes = do updatedAt <- getCurrentTime DB.execute db "UPDATE users SET ui_themes = ?, updated_at = ? WHERE user_id = ?" (uiThemes, updatedAt, userId) - -createChatTag :: DB.Connection -> User -> Text -> Text -> IO ChatTagId -createChatTag db User {userId} emoji text = do - DB.execute - db - [sql| - INSERT INTO chat_tags (user_id, chat_tag_emoji, chat_tag_text) - VALUES (?,?,?) - |] - (userId, emoji, text) - insertedRowId db - -tagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO () -tagDirectChat db contactId tId = - DB.execute - db - [sql| - INSERT INTO chat_tags_chats (contact_id, chat_tag_id) - VALUES (?,?) - |] - (contactId, tId) - -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) - -deleteChatTag :: DB.Connection -> User -> ChatTagId -> IO () -deleteChatTag db User {userId} tId = - DB.execute - db - [sql| - DELETE FROM chat_tags - WHERE user_id = ? AND chat_tag_id = ? - |] - (userId, 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) - -untagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO () -untagDirectChat db contactId tId = - DB.execute - db - [sql| - DELETE FROM chat_tags_chats - WHERE contact_id = ? AND chat_tag_id = ? - |] - (contactId, tId) - -getUserChatTags :: DB.Connection -> User -> IO [ChatTag] -getUserChatTags db User {userId} = - map toChatTag - <$> DB.query - db - [sql| - SELECT t.chat_tag_id, t.chat_tag_emoji, t.chat_tag_text, ct.contact_id, ct.group_id - FROM chat_tags_chats ct - JOIN chat_tags t ON ct.chat_tag_id = t.chat_tag_id - WHERE t.user_id = ? - |] - (Only userId) - where - toChatTag :: (ChatTagId, Text, Text, Maybe ContactId, Maybe GroupId) -> ChatTag - toChatTag (chatTagId, chatTagEmoji, chatTagText, contactId, groupId) = ChatTag {chatTagId, chatTagEmoji, chatTagText, contactId, groupId} - -getTagChatsCount :: DB.Connection -> ChatTagId -> IO Int -getTagChatsCount db tId = - fromOnly . head <$> DB.query db "SELECT COUNT(*) FROM chat_tags_chats WHERE chat_tag_id = ?" (Only tId) \ No newline at end of file diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index ff77321ec5..94f23f9229 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -592,3 +592,48 @@ groupInfoQuery = JOIN group_members mu ON mu.group_id = g.group_id JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id) |] + +createChatTag :: DB.Connection -> User -> Text -> Text -> IO ChatTagId +createChatTag db User {userId} emoji text = do + DB.execute + db + [sql| + INSERT INTO chat_tags (user_id, chat_tag_emoji, chat_tag_text) + VALUES (?,?,?) + |] + (userId, emoji, text) + insertedRowId db + +deleteChatTag :: DB.Connection -> User -> ChatTagId -> IO () +deleteChatTag db User {userId} tId = + DB.execute + db + [sql| + DELETE FROM chat_tags + WHERE user_id = ? AND chat_tag_id = ? + |] + (userId, tId) + +getTagChatsCount :: DB.Connection -> ChatTagId -> IO Int +getTagChatsCount db tId = + fromOnly . head <$> DB.query db "SELECT COUNT(*) FROM chat_tags_chats WHERE chat_tag_id = ?" (Only tId) + +deleteChatTagIfEmpty :: DB.Connection -> User -> ChatTagId -> IO () +deleteChatTagIfEmpty db user ctId = do + tagChatsCount <- getTagChatsCount db ctId + when (tagChatsCount == 0) $ deleteChatTag db user ctId + +getUserChatTags :: DB.Connection -> User -> IO [ChatTag] +getUserChatTags db User {userId} = + map toChatTag + <$> DB.query + db + [sql| + SELECT chat_tag_id, chat_tag_emoji, chat_tag_text + FROM chat_tags + WHERE user_id = ? + |] + (Only userId) + where + toChatTag :: (ChatTagId, Text, Text) -> ChatTag + toChatTag (chatTagId, chatTagEmoji, chatTagText) = ChatTag {chatTagId, chatTagEmoji, chatTagText} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index c8a0499856..8c37d3e51b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -150,7 +150,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe | otherwise -> [] CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci - CRChatTagged u _ _ -> ttyUser u ["chat tagged"] + CRTagsUpdated u _ _ -> ttyUser u ["chat tagged"] CRChatUntagged u _ _ -> ttyUser u ["chat untagged"] CRChatItemsDeleted u deletions byUser timed -> case deletions of [ChatItemDeletion (AChatItem _ _ chat deletedItem) toItem] ->