blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into master-ghc8107

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-10-11 21:27:21 +01:00
parent 67d74a0a27 8ff6b392c2
commit effc281271
19 changed files with 450 additions and 230 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+3 -1
View File
@@ -288,6 +288,7 @@ data ChatCommand
| APIGetNetworkConfig
| ReconnectAllServers
| APISetChatSettings ChatRef ChatSettings
| APISetMemberSettings GroupId GroupMemberId GroupMemberSettings
| APIContactInfo ContactId
| APIGroupInfo GroupId
| APIGroupMemberInfo GroupId GroupMemberId
@@ -303,8 +304,9 @@ data ChatCommand
| APIVerifyGroupMember GroupId GroupMemberId (Maybe Text)
| APIEnableContact ContactId
| APIEnableGroupMember GroupId GroupMemberId
| SetShowMessages ChatName Bool
| SetShowMessages ChatName MsgFilter
| SetSendReceipts ChatName (Maybe Bool)
| SetShowMemberMessages GroupName ContactName Bool
| ContactInfo ContactName
| ShowGroupInfo GroupName
| GroupMemberInfo GroupName ContactName
src/Simplex/Chat/Messages.hs
+17 -20
View File
@@ -147,6 +147,19 @@ instance MsgDirectionI d => ToJSON (ChatItem c d) where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
isMention :: ChatItem c d -> Bool
isMention ChatItem {chatDir, quotedItem} = case chatDir of
CIDirectRcv -> userItem quotedItem
CIGroupRcv _ -> userItem quotedItem
_ -> False
where
userItem = \case
Nothing -> False
Just CIQuote {chatDir = cd} -> case cd of
CIQDirectSnd -> True
CIQGroupSnd -> True
_ -> False
data CIDirection (c :: ChatType) (d :: MsgDirection) where
CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
@@ -217,26 +230,6 @@ ciReactionAllowed :: ChatItem c d -> Bool
ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False
ciReactionAllowed ChatItem {content} = isJust $ ciMsgContent content
data CIDeletedState = CIDeletedState
{ markedDeleted :: Bool,
deletedByMember :: Maybe GroupMember
}
deriving (Show, Eq)
chatItemDeletedState :: ChatItem c d -> Maybe CIDeletedState
chatItemDeletedState ChatItem {meta = CIMeta {itemDeleted}, content} =
ciDeletedToDeletedState <$> itemDeleted
where
ciDeletedToDeletedState cid =
case content of
CISndModerated -> CIDeletedState {markedDeleted = False, deletedByMember = byMember cid}
CIRcvModerated -> CIDeletedState {markedDeleted = False, deletedByMember = byMember cid}
_ -> CIDeletedState {markedDeleted = True, deletedByMember = byMember cid}
byMember :: CIDeleted c -> Maybe GroupMember
byMember = \case
CIModerated _ m -> Just m
CIDeleted _ -> Nothing
data ChatDirection (c :: ChatType) (d :: MsgDirection) where
CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv
@@ -926,6 +919,7 @@ checkDirection x = case testEquality (msgDirection @d) (msgDirection @d') of
data CIDeleted (c :: ChatType) where
CIDeleted :: Maybe UTCTime -> CIDeleted c
CIBlocked :: Maybe UTCTime -> CIDeleted c
CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
deriving instance Show (CIDeleted c)
@@ -936,6 +930,7 @@ instance ToJSON (CIDeleted d) where
data JSONCIDeleted
= JCIDDeleted {deletedTs :: Maybe UTCTime}
| JCIBlocked {deletedTs :: Maybe UTCTime}
| JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
deriving (Show, Generic)
@@ -946,11 +941,13 @@ instance ToJSON JSONCIDeleted where
jsonCIDeleted :: CIDeleted d -> JSONCIDeleted
jsonCIDeleted = \case
CIDeleted ts -> JCIDDeleted ts
CIBlocked ts -> JCIBlocked ts
CIModerated ts m -> JCIDModerated ts m
itemDeletedTs :: CIDeleted d -> Maybe UTCTime
itemDeletedTs = \case
CIDeleted ts -> ts
CIBlocked ts -> ts
CIModerated ts _ -> ts
data ChatItemInfo = ChatItemInfo
src/Simplex/Chat/Messages/CIContent.hs
+1 -13
View File
@@ -19,12 +19,8 @@ import Data.Int (Int64)
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word32)
import Database.SQLite.Simple (ResultError (..), SQLData (..))
import Database.SQLite.Simple.FromField (Field, FromField (..), returnError)
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import Simplex.Chat.Protocol
@@ -50,14 +46,6 @@ instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgD
instance ToField MsgDirection where toField = toField . msgDirectionInt
fromIntField_ :: Typeable a => (Int64 -> Maybe a) -> Field -> Ok a
fromIntField_ fromInt = \case
f@(Field (SQLInteger i) _) ->
case fromInt i of
Just x -> Ok x
_ -> returnError ConversionFailed f ("invalid integer: " <> show i)
f -> returnError ConversionFailed f "expecting SQLInteger column type"
data SMsgDirection (d :: MsgDirection) where
SMDRcv :: SMsgDirection 'MDRcv
SMDSnd :: SMsgDirection 'MDSnd
src/Simplex/Chat/Migrations/M20231010_member_settings.hs
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20231010_member_settings where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20231010_member_settings :: Query
m20231010_member_settings =
[sql|
ALTER TABLE group_members ADD COLUMN show_messages INTEGER NOT NULL DEFAULT 1;
|]
down_m20231010_member_settings :: Query
down_m20231010_member_settings =
[sql|
ALTER TABLE group_members DROP COLUMN show_messages;
|]
src/Simplex/Chat/Migrations/chat_schema.sql
+1
View File
@@ -145,6 +145,7 @@ CREATE TABLE group_members(
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL),
member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
show_messages INTEGER NOT NULL DEFAULT 1,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
src/Simplex/Chat/Protocol.hs
+5
View File
@@ -376,6 +376,11 @@ mcExtMsgContent = \case
MCQuote _ c -> c
MCForward c -> c
isQuote :: MsgContainer -> Bool
isQuote = \case
MCQuote {} -> True
_ -> False
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
deriving (Eq, Show, Generic)
src/Simplex/Chat/Store/Connections.hs
+4 -4
View File
@@ -76,10 +76,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
@@ -94,11 +94,11 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
src/Simplex/Chat/Store/Groups.hs
+34 -17
View File
@@ -89,6 +89,7 @@ module Simplex.Chat.Store.Groups
associateContactWithMemberRecord,
deleteOldProbes,
updateGroupSettings,
updateGroupMemberSettings,
getXGrpMemIntroContDirect,
getXGrpMemIntroContGroup,
getHostConnId,
@@ -126,30 +127,31 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
import UnliftIO.STM
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
let membership = toGroupMember userContactId userMemberRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs}
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
memberSettings = GroupMemberSettings {showMessages}
invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing
in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
@@ -245,11 +247,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
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.auth_err_counter,
@@ -295,7 +297,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs
let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False}
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
@@ -340,7 +342,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
insertedRowId db
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs
membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs
let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False}
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
@@ -364,6 +366,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
memberRole,
memberCategory,
memberStatus,
memberSettings = defaultMemberSettings,
invitedBy,
localDisplayName,
memberProfile,
@@ -488,7 +491,7 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
db
[sql|
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status,
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.show_messages,
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
@@ -553,7 +556,7 @@ groupMemberQuery :: Query
groupMemberQuery =
[sql|
SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
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.auth_err_counter,
@@ -660,6 +663,7 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
memberRole,
memberCategory = GCInviteeMember,
memberStatus = GSMemInvited,
memberSettings = defaultMemberSettings,
invitedBy = IBUser,
localDisplayName,
memberProfile = profile,
@@ -810,7 +814,8 @@ createNewMember_
|]
(groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
groupMemberId <- insertedRowId db
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn}
let memberSettings = defaultMemberSettings
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, memberSettings, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
@@ -1008,11 +1013,11 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
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.auth_err_counter,
@@ -1101,7 +1106,7 @@ getGroupInfo db User {userId, userContactId} groupId =
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@@ -1497,6 +1502,18 @@ updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId)
updateGroupMemberSettings :: DB.Connection -> User -> GroupId -> GroupMemberId -> GroupMemberSettings -> IO ()
updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {showMessages} = do
currentTs <- getCurrentTime
DB.execute
db
[sql|
UPDATE group_members
SET show_messages = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|]
(showMessages, currentTs, userId, gId, gMemberId)
getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do
fmap join . maybeFirstRow toCont $
src/Simplex/Chat/Store/Messages.hs
+62 -34
View File
@@ -4,6 +4,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
@@ -48,6 +49,7 @@ module Simplex.Chat.Store.Messages
deleteGroupChatItem,
updateGroupChatItemModerated,
markGroupChatItemDeleted,
markGroupChatItemBlocked,
updateDirectChatItemsRead,
getDirectUnreadTimedItems,
setDirectChatItemDeleteAt,
@@ -434,7 +436,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
SELECT i.chat_item_id,
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@@ -544,7 +546,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- ChatStats
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
@@ -554,17 +556,17 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
-- Maybe GroupMember - sender
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@@ -958,9 +960,9 @@ type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath,
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Bool, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Bool, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Int, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
@@ -1003,7 +1005,9 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
badItem = Left $ SEBadChatItem itemId
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d
ciMeta content status =
let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @'CTDirect deletedTs)
itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
ciTimed :: Maybe CITimed
@@ -1059,10 +1063,10 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
badItem = Left $ SEBadChatItem itemId
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d
ciMeta content status =
let itemDeleted' =
if itemDeleted
then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
else Nothing
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
DBCIBlocked -> Just (CIBlocked @'CTGroup deletedTs)
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
ciTimed :: Maybe CITimed
@@ -1221,8 +1225,8 @@ createChatItemVersion db itemId itemVersionTs msgContent =
|]
(itemId, toMCText msgContent, itemVersionTs)
deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO ()
deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do
deleteDirectChatItem :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> IO ()
deleteDirectChatItem db User {userId} Contact {contactId} ci = do
let itemId = chatItemId' ci
deleteChatItemMessages_ db itemId
deleteChatItemVersions_ db itemId
@@ -1253,8 +1257,8 @@ deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ db itemId =
DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId)
markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> UTCTime -> IO ()
markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId deletedTs = do
markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> MessageId -> UTCTime -> IO (ChatItem 'CTDirect d)
markDirectChatItemDeleted db User {userId} Contact {contactId} ci@ChatItem {meta} msgId deletedTs = do
currentTs <- liftIO getCurrentTime
let itemId = chatItemId' ci
insertChatItemMessage_ db itemId msgId currentTs
@@ -1262,10 +1266,11 @@ markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci)
db
[sql|
UPDATE chat_items
SET item_deleted = 1, item_deleted_ts = ?, updated_at = ?
SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|]
(deletedTs, currentTs, userId, contactId, itemId)
(DBCIDeleted, deletedTs, currentTs, userId, contactId, itemId)
pure ci {meta = meta {itemDeleted = Just $ CIDeleted $ Just deletedTs}}
getDirectChatItemBySharedMsgId :: DB.Connection -> User -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemBySharedMsgId db user@User {userId} contactId sharedMsgId = do
@@ -1376,8 +1381,8 @@ updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ =
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO ()
deleteGroupChatItem db User {userId} g@GroupInfo {groupId} (CChatItem _ ci) = do
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupChatItem db User {userId} g@GroupInfo {groupId} ci = do
let itemId = chatItemId' ci
deleteChatItemMessages_ db itemId
deleteChatItemVersions_ db itemId
@@ -1390,10 +1395,10 @@ deleteGroupChatItem db User {userId} g@GroupInfo {groupId} (CChatItem _ ci) = do
|]
(userId, groupId, itemId)
updateGroupChatItemModerated :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> GroupMember -> UTCTime -> IO AChatItem
updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatItem msgDir ci) m@GroupMember {groupMemberId} deletedTs = do
updateGroupChatItemModerated :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d)
updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMember {groupMemberId} deletedTs = do
currentTs <- getCurrentTime
let toContent = msgDirToModeratedContent_ msgDir
let toContent = msgDirToModeratedContent_ $ msgDirection @d
toText = ciModeratedText
itemId = chatItemId' ci
deleteChatItemMessages_ db itemId
@@ -1407,24 +1412,47 @@ updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatIt
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|]
(deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m), editable = False}, formattedText = Nothing})
pure $ ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m), editable = False}, formattedText = Nothing}
markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> UTCTime -> IO ()
markGroupChatItemDeleted db User {userId} GroupInfo {groupId} (CChatItem _ ci) msgId byGroupMember_ deletedTs = do
pattern DBCINotDeleted :: Int
pattern DBCINotDeleted = 0
pattern DBCIDeleted :: Int
pattern DBCIDeleted = 1
pattern DBCIBlocked :: Int
pattern DBCIBlocked = 2
markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Maybe GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d)
markGroupChatItemDeleted db User {userId} GroupInfo {groupId} ci@ChatItem {meta} msgId byGroupMember_ deletedTs = do
currentTs <- liftIO getCurrentTime
let itemId = chatItemId' ci
deletedByGroupMemberId = case byGroupMember_ of
Just GroupMember {groupMemberId} -> Just groupMemberId
_ -> Nothing
(deletedByGroupMemberId, itemDeleted) = case byGroupMember_ of
Just m@GroupMember {groupMemberId} -> (Just groupMemberId, Just $ CIModerated (Just deletedTs) m)
_ -> (Nothing, Just $ CIDeleted @'CTGroup (Just deletedTs))
insertChatItemMessage_ db itemId msgId currentTs
DB.execute
db
[sql|
UPDATE chat_items
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|]
(deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId)
(DBCIDeleted, deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId)
pure ci {meta = meta {itemDeleted}}
markGroupChatItemBlocked :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
markGroupChatItemBlocked db User {userId} GroupInfo {groupId} ci@ChatItem {meta} = do
deletedTs <- getCurrentTime
DB.execute
db
[sql|
UPDATE chat_items
SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|]
(DBCIBlocked, deletedTs, deletedTs, userId, groupId, chatItemId' ci)
pure ci {meta = meta {itemDeleted = Just $ CIBlocked $ Just deletedTs}}
getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do
@@ -1482,17 +1510,17 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
src/Simplex/Chat/Store/Migrations.hs
+3 -1
View File
@@ -84,6 +84,7 @@ import Simplex.Chat.Migrations.M20230914_member_probes
import Simplex.Chat.Migrations.M20230926_contact_status
import Simplex.Chat.Migrations.M20231002_conn_initiated
import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
import Simplex.Chat.Migrations.M20231010_member_settings
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -167,7 +168,8 @@ schemaMigrations =
("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status),
("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated),
("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash)
("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Shared.hs
+3 -3
View File
@@ -240,20 +240,20 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
[":user_id" := userId, ":profile_id" := profileId]
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
toContact :: User -> ContactRow :. ConnectionRow -> Contact
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
in case toMaybeConnection connRow of
Just activeConn ->
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
src/Simplex/Chat/Terminal/Output.hs
+18 -18
View File
@@ -18,7 +18,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (getCurrentTime)
import Data.Time.LocalTime (getCurrentTimeZone)
import Simplex.Chat (processChatCommand, chatNtf, contactNtf, groupNtf, userNtf)
import Simplex.Chat (processChatCommand)
import Simplex.Chat.Controller
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
@@ -27,7 +27,7 @@ import Simplex.Chat.Options
import Simplex.Chat.Protocol (MsgContent (..), msgContentText)
import Simplex.Chat.Styled
import Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications)
import Simplex.Chat.Types (Contact, GroupInfo (..), User (..), UserContactRequest (..))
import Simplex.Chat.Types
import Simplex.Chat.View
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Encoding.String
@@ -139,8 +139,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d
forever $ do
(_, r) <- atomically $ readTBQueue outputQ
case r of
CRNewChatItem _ ci -> markChatItemRead ci
CRChatItemUpdated _ ci -> markChatItemRead ci
CRNewChatItem u ci -> markChatItemRead u ci
CRChatItemUpdated u ci -> markChatItemRead u ci
_ -> pure ()
let printResp = case logFilePath of
Just path -> if logResponseToFile r then logResponse path else printToTerminal ct
@@ -149,10 +149,10 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d
responseString cc liveItems r >>= printResp
responseNotification ct cc r
where
markChatItemRead (AChatItem _ _ chat item@ChatItem {chatDir, meta = CIMeta {itemStatus}}) =
case (muted chat chatDir, itemStatus) of
(False, CISRcvNew) -> do
let itemId = chatItemId' item
markChatItemRead u (AChatItem _ _ chat ci@ChatItem {chatDir, meta = CIMeta {itemStatus}}) =
case (chatDirNtf u chat chatDir (isMention ci), itemStatus) of
(True, CISRcvNew) -> do
let itemId = chatItemId' ci
chatRef = chatInfoToRef chat
void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc
_ -> pure ()
@@ -160,8 +160,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d
responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO ()
responseNotification t@ChatTerminal {sendNotification} cc = \case
CRNewChatItem u (AChatItem _ SMDRcv cInfo ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) ->
when (chatNtf u cInfo) $ do
CRNewChatItem u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) ->
when (chatDirNtf u cInfo chatDir $ isMention ci) $ do
whenCurrUser cc u $ setActiveChat t cInfo
case (cInfo, chatDir) of
(DirectChat ct, _) -> sendNtf (viewContactName ct <> "> ", text)
@@ -169,26 +169,26 @@ responseNotification t@ChatTerminal {sendNotification} cc = \case
_ -> pure ()
where
text = msgText mc formattedText
CRChatItemUpdated u (AChatItem _ SMDRcv cInfo ChatItem {content = CIRcvMsgContent _}) ->
whenCurrUser cc u $ when (chatNtf u cInfo) $ setActiveChat t cInfo
CRContactConnected u ct _ -> when (contactNtf u ct) $ do
CRChatItemUpdated u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent _}) ->
whenCurrUser cc u $ when (chatDirNtf u cInfo chatDir $ isMention ci) $ setActiveChat t cInfo
CRContactConnected u ct _ -> when (contactNtf u ct False) $ do
whenCurrUser cc u $ setActiveContact t ct
sendNtf (viewContactName ct <> "> ", "connected")
CRContactAnotherClient u ct -> do
whenCurrUser cc u $ unsetActiveContact t ct
when (contactNtf u ct) $ sendNtf (viewContactName ct <> "> ", "connected to another client")
when (contactNtf u ct False) $ sendNtf (viewContactName ct <> "> ", "connected to another client")
CRContactsDisconnected srv _ -> serverNtf srv "disconnected"
CRContactsSubscribed srv _ -> serverNtf srv "connected"
CRReceivedGroupInvitation u g ct _ _ ->
when (contactNtf u ct) $
when (contactNtf u ct False) $
sendNtf ("#" <> viewGroupName g <> " " <> viewContactName ct <> "> ", "invited you to join the group")
CRUserJoinedGroup u g _ -> when (groupNtf u g) $ do
CRUserJoinedGroup u g _ -> when (groupNtf u g False) $ do
whenCurrUser cc u $ setActiveGroup t g
sendNtf ("#" <> viewGroupName g, "you are connected to group")
CRJoinedGroupMember u g m ->
when (groupNtf u g) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
CRConnectedToGroupMember u g m _ ->
when (groupNtf u g) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
CRReceivedContactRequest u UserContactRequest {localDisplayName = n} ->
when (userNtf u) $ sendNtf (viewName n <> ">", "wants to connect to you")
_ -> pure ()
src/Simplex/Chat/Types.hs
+56 -6
View File
@@ -35,7 +35,11 @@ import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Database.SQLite.Simple.FromField (FromField (..))
import Data.Typeable (Typeable)
import Database.SQLite.Simple (ResultError (..), SQLData (..))
import Database.SQLite.Simple.FromField (returnError, FromField(..))
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import Simplex.Chat.Types.Preferences
@@ -44,7 +48,7 @@ import Simplex.FileTransfer.Description (FileDigest)
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON)
import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
import Simplex.Messaging.Util ((<$?>))
import Simplex.Messaging.Version
@@ -383,7 +387,7 @@ contactAndGroupIds = \case
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
data ChatSettings = ChatSettings
{ enableNtfs :: Bool,
{ enableNtfs :: MsgFilter,
sendRcpts :: Maybe Bool,
favorite :: Bool
}
@@ -394,13 +398,48 @@ instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOpt
defaultChatSettings :: ChatSettings
defaultChatSettings =
ChatSettings
{ enableNtfs = True,
{ enableNtfs = MFAll,
sendRcpts = Nothing,
favorite = False
}
pattern DisableNtfs :: ChatSettings
pattern DisableNtfs <- ChatSettings {enableNtfs = False}
chatHasNtfs :: ChatSettings -> Bool
chatHasNtfs ChatSettings {enableNtfs} = enableNtfs /= MFNone
data MsgFilter = MFNone | MFAll | MFMentions
deriving (Eq, Show, Generic)
instance FromJSON MsgFilter where
parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MF"
instance ToJSON MsgFilter where
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MF"
toJSON = J.genericToJSON . enumJSON $ dropPrefix "MF"
instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
instance ToField MsgFilter where toField = toField . msgFilterInt
msgFilterInt :: MsgFilter -> Int
msgFilterInt = \case
MFNone -> 0
MFAll -> 1
MFMentions -> 2
msgFilterIntP :: Int64 -> Maybe MsgFilter
msgFilterIntP = \case
0 -> Just MFNone
1 -> Just MFAll
2 -> Just MFMentions
_ -> Just MFAll
fromIntField_ :: Typeable a => (Int64 -> Maybe a) -> Field -> Ok a
fromIntField_ fromInt = \case
f@(Field (SQLInteger i) _) ->
case fromInt i of
Just x -> Ok x
_ -> returnError ConversionFailed f ("invalid integer: " <> show i)
f -> returnError ConversionFailed f "expecting SQLInteger column type"
featureAllowed :: SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
featureAllowed feature forWhom Contact {mergedPreferences} =
@@ -628,6 +667,7 @@ data GroupMember = GroupMember
memberRole :: GroupMemberRole,
memberCategory :: GroupMemberCategory,
memberStatus :: GroupMemberStatus,
memberSettings :: GroupMemberSettings,
invitedBy :: InvitedBy,
localDisplayName :: ContactName,
-- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test.
@@ -762,6 +802,16 @@ instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
data GroupMemberSettings = GroupMemberSettings
{ showMessages :: Bool
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupMemberSettings where toEncoding = J.genericToEncoding J.defaultOptions
defaultMemberSettings :: GroupMemberSettings
defaultMemberSettings = GroupMemberSettings {showMessages = True}
newtype Probe = Probe {unProbe :: ByteString}
deriving (Eq, Show)
src/Simplex/Chat/View.hs
+78 -43
View File
@@ -101,15 +101,15 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts tz <> viewItemReactions item
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item
CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
CRChatItemStatusUpdated u ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted u chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction u chat reaction $ viewItemReaction showReactions chat reaction added ts tz
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
CRBroadcastSent u mc s f t -> ttyUser u $ viewSentBroadcast mc s f ts tz t
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
@@ -348,24 +348,56 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
contactList :: [ContactRef] -> String
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
unmuted :: ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
unmuted chat ChatItem {chatDir} = unmuted' chat chatDir
unmutedReaction :: ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString]
unmutedReaction chat CIReaction {chatDir} = unmuted' chat chatDir
unmuted' :: ChatInfo c -> CIDirection c d -> [StyledString] -> [StyledString]
unmuted' chat chatDir s
| muted chat chatDir = []
| otherwise = s
unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isMention ci
unmutedReaction :: User -> ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString]
unmutedReaction u chat CIReaction {chatDir} = unmuted' u chat chatDir False
unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString]
unmuted' u chat chatDir mention s
| chatDirNtf u chat chatDir mention = s
| otherwise = []
userNtf :: User -> Bool
userNtf User {showNtfs, activeUser} = showNtfs || activeUser
chatNtf :: User -> ChatInfo c -> Bool -> Bool
chatNtf user cInfo mention = case cInfo of
DirectChat ct -> contactNtf user ct mention
GroupChat g -> groupNtf user g mention
_ -> False
chatDirNtf :: User -> ChatInfo c -> CIDirection c d -> Bool -> Bool
chatDirNtf user cInfo chatDir mention = case (cInfo, chatDir) of
(DirectChat ct, CIDirectRcv) -> contactNtf user ct mention
(GroupChat g, CIGroupRcv m) -> groupNtf user g mention && showMessages (memberSettings m)
_ -> True
contactNtf :: User -> Contact -> Bool -> Bool
contactNtf user Contact {chatSettings} mention =
userNtf user && showMessageNtf chatSettings mention
groupNtf :: User -> GroupInfo -> Bool -> Bool
groupNtf user GroupInfo {chatSettings} mention =
userNtf user && showMessageNtf chatSettings mention
showMessageNtf :: ChatSettings -> Bool -> Bool
showMessageNtf ChatSettings {enableNtfs} mention =
enableNtfs == MFAll || (mention && enableNtfs == MFMentions)
chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text
chatItemDeletedText ci membership_ = deletedStateToText <$> chatItemDeletedState ci
chatItemDeletedText ChatItem {meta = CIMeta {itemDeleted}, content} membership_ =
deletedText <$> itemDeleted
where
deletedStateToText = \CIDeletedState {markedDeleted, deletedByMember} ->
if markedDeleted
then "marked deleted" <> byMember deletedByMember
else "deleted" <> byMember deletedByMember
byMember m_ = case (m_, membership_) of
(Just GroupMember {groupMemberId = mId, localDisplayName = n}, Just GroupMember {groupMemberId = membershipId}) ->
deletedText = \case
CIModerated _ m -> markedDeleted content <> byMember m
CIDeleted _ -> markedDeleted content
CIBlocked _ -> "blocked"
markedDeleted = \case
CISndModerated -> "deleted"
CIRcvModerated -> "deleted"
_ -> "marked deleted"
byMember GroupMember {groupMemberId = mId, localDisplayName = n} = case membership_ of
Just GroupMember {groupMemberId = membershipId} ->
" by " <> if mId == membershipId then "you" else n
_ -> ""
@@ -384,12 +416,6 @@ viewUsersList = mapMaybe userInfo . sortOn ldn
<> ["muted" | not showNtfs]
<> [plain ("unread: " <> show count) | count /= 0]
muted :: ChatInfo c -> CIDirection c d -> Bool
muted chat chatDir = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
(GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True
_ -> False
viewGroupSubscribed :: GroupInfo -> [StyledString]
viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"]
@@ -689,7 +715,7 @@ viewContactsList =
in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn
where
muted' Contact {chatSettings, localDisplayName = ldn}
| enableNtfs chatSettings = ""
| chatHasNtfs chatSettings = ""
| otherwise = " (muted, you can " <> highlight ("/unmute @" <> ldn) <> ")"
alias Contact {profile = LocalProfile {localAlias}}
| localAlias == "" = ""
@@ -822,21 +848,25 @@ viewGroupMembers :: Group -> [StyledString]
viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filter (not . removedOrLeft) $ membership : members
where
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
role m = plain . strEncode $ memberRole (m :: GroupMember)
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m)
role :: GroupMember -> String
role m = B.unpack . strEncode $ memberRole (m :: GroupMember)
category m = case memberCategory m of
GCUserMember -> "you, "
GCInviteeMember -> "invited, "
GCHostMember -> "host, "
_ -> ""
GCUserMember -> ["you"]
GCInviteeMember -> ["invited"]
GCHostMember -> ["host"]
_ -> []
status m = case memberStatus m of
GSMemRemoved -> "removed"
GSMemLeft -> "left"
GSMemInvited -> "not yet joined"
GSMemConnected -> "connected"
GSMemComplete -> "connected"
GSMemCreator -> "created group"
_ -> ""
GSMemRemoved -> ["removed"]
GSMemLeft -> ["left"]
GSMemInvited -> ["not yet joined"]
GSMemConnected -> ["connected"]
GSMemComplete -> ["connected"]
GSMemCreator -> ["created group"]
_ -> []
muted m
| showMessages (memberSettings m) = []
| otherwise = ["blocked"]
viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString]
viewContactConnected ct userIncognitoProfile testView =
@@ -857,8 +887,9 @@ viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString]
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
viewGroupsList gs = map groupSS $ sortOn ldn_ gs
where
ldn_ :: GroupInfo -> Text
ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) . fst
groupSS (g@GroupInfo {membership, chatSettings}, GroupSummary {currentMembers}) =
groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) =
case memberStatus membership of
GSMemInvited -> groupInvitation' g
s -> membershipIncognito g <> ttyFullGroup g <> viewMemberStatus s
@@ -867,9 +898,13 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs
GSMemRemoved -> delete "you are removed"
GSMemLeft -> delete "you left"
GSMemGroupDeleted -> delete "group deleted"
_
| enableNtfs chatSettings -> " (" <> memberCount <> ")"
| otherwise -> " (" <> memberCount <> ", muted, you can " <> highlight ("/unmute #" <> viewGroupName g) <> ")"
_ -> " (" <> memberCount <>
case enableNtfs of
MFAll -> ")"
MFNone -> ", muted, " <> unmute
MFMentions -> ", mentions only, " <> unmute
where
unmute = "you can " <> highlight ("/unmute #" <> viewGroupName g) <> ")"
delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> viewGroupName g) <> ")"
memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s"