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>

src/Simplex/Chat/Store/Connections.hs

@@ -21,11 +21,14 @@ where
 import Control.Applicative ((<|>))
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.IO.Class
+import Data.Bitraversable (bitraverse)
 import Data.Int (Int64)
 import Data.Maybe (catMaybes, fromMaybe)
 import Database.SQLite.Simple (Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
+import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Profiles
@@ -93,8 +96,9 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
           (userId, agentConnId)
     getContactRec_ :: Int64 -> Connection -> ExceptT StoreError IO Contact
     getContactRec_ contactId c = ExceptT $ do
-      toContact' contactId c
-        <$> DB.query
+      chatTags <- getDirectChatTags db contactId
+      firstRow (toContact' contactId c chatTags) (SEInternalError "referenced contact not found") $
+        DB.query
           db
           [sql|
             SELECT
@@ -105,17 +109,16 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
             WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0
           |]
           (userId, contactId)
-    toContact' :: Int64 -> Connection -> [ContactRow'] -> Either StoreError Contact
-    toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)] =
+    toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
+    toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) =
       let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
           chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
           mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
           activeConn = Just conn
-       in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData}
-    toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
+       in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, chatTags, uiThemes, chatDeleted, customData}
     getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
-    getGroupAndMember_ groupMemberId c = ExceptT $ do
-      firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
+    getGroupAndMember_ groupMemberId c = do
+      gm <- ExceptT $ firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
         DB.query
           db
           [sql|
@@ -141,9 +144,10 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
             WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
           |]
           (groupMemberId, userId, userContactId)
+      liftIO $ bitraverse (addGroupChatTags db) pure gm
     toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
     toGroupAndMember c (groupInfoRow :. memberRow) =
-      let groupInfo = toGroupInfo vr userContactId groupInfoRow
+      let groupInfo = toGroupInfo vr userContactId [] groupInfoRow
           member = toGroupMember userContactId memberRow
        in (groupInfo, (member :: GroupMember) {activeConn = Just c})
     getConnSndFileTransfer_ :: Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer