mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: block member for all (#3689)
* core: silence member wip * change approach * more types * remove comment * bool in protocol msg * flag in items, event * send event, process * apply moderation * remove comment * filter for forward, view * tests * rename * separate response, check already blocked * add test * fix terminal api * add comment * don't send profile update * corrections * refactor * rework - flag blocked by admin * blocked in intro * fix test * cant block unblock self * muted view, create unknown member * blocked by admin in members list * create with maybe null * protocol changes * align code with protocol * revert terminal api * restrict block api for admins * stabilize test * rename * update protocol/types * refactor * refactor2 * stabilize test * member field --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy
GitHub
@@ -294,6 +294,7 @@ data ChatCommand
|
||||
| APIAddMember GroupId ContactId GroupMemberRole
|
||||
| APIJoinGroup GroupId
|
||||
| APIMemberRole GroupId GroupMemberId GroupMemberRole
|
||||
| APIBlockMemberForAll GroupId GroupMemberId Bool
|
||||
| APIRemoveMember GroupId GroupMemberId
|
||||
| APILeaveGroup GroupId
|
||||
| APIListMembers GroupId
|
||||
@@ -393,6 +394,7 @@ data ChatCommand
|
||||
| AddMember GroupName ContactName GroupMemberRole
|
||||
| JoinGroup GroupName
|
||||
| MemberRole GroupName ContactName GroupMemberRole
|
||||
| BlockForAll GroupName ContactName Bool
|
||||
| RemoveMember GroupName ContactName
|
||||
| LeaveGroup GroupName
|
||||
| DeleteGroup GroupName
|
||||
@@ -630,11 +632,14 @@ data ChatResponse
|
||||
| CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
|
||||
| CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
|
||||
| CRMemberBlockedForAllUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, blocked :: Bool}
|
||||
| CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
|
||||
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
|
||||
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
|
||||
| CRUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
|
||||
| CRUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember}
|
||||
| CRGroupEmpty {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupRemoved {user :: User, groupInfo :: GroupInfo}
|
||||
@@ -1053,6 +1058,7 @@ data ChatErrorType
|
||||
| CEGroupDuplicateMemberId
|
||||
| CEGroupNotJoined {groupInfo :: GroupInfo}
|
||||
| CEGroupMemberNotActive
|
||||
| CECantBlockMemberForSelf {groupInfo :: GroupInfo, member :: GroupMember, setShowMessages :: Bool}
|
||||
| CEGroupMemberUserRemoved
|
||||
| CEGroupMemberNotFound
|
||||
| CEGroupMemberIntroNotFound {contactName :: ContactName}
|
||||
|
||||
@@ -929,6 +929,7 @@ msgDeliveryStatusT' s =
|
||||
data CIDeleted (c :: ChatType) where
|
||||
CIDeleted :: Maybe UTCTime -> CIDeleted c
|
||||
CIBlocked :: Maybe UTCTime -> CIDeleted 'CTGroup
|
||||
CIBlockedByAdmin :: Maybe UTCTime -> CIDeleted 'CTGroup
|
||||
CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
|
||||
|
||||
deriving instance Show (CIDeleted c)
|
||||
@@ -938,6 +939,7 @@ data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c
|
||||
data JSONCIDeleted
|
||||
= JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
|
||||
| JCIDBlocked {deletedTs :: Maybe UTCTime}
|
||||
| JCIBlockedByAdmin {deletedTs :: Maybe UTCTime}
|
||||
| JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
|
||||
deriving (Show)
|
||||
|
||||
@@ -945,18 +947,21 @@ jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
|
||||
jsonCIDeleted = \case
|
||||
CIDeleted ts -> JCIDDeleted ts (toChatType $ chatTypeI @d)
|
||||
CIBlocked ts -> JCIDBlocked ts
|
||||
CIBlockedByAdmin ts -> JCIBlockedByAdmin ts
|
||||
CIModerated ts m -> JCIDModerated ts m
|
||||
|
||||
jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
|
||||
jsonACIDeleted = \case
|
||||
JCIDDeleted ts cType -> case aChatType cType of ACT c -> ACIDeleted c $ CIDeleted ts
|
||||
JCIDBlocked ts -> ACIDeleted SCTGroup $ CIBlocked ts
|
||||
JCIBlockedByAdmin ts -> ACIDeleted SCTGroup $ CIBlockedByAdmin ts
|
||||
JCIDModerated ts m -> ACIDeleted SCTGroup (CIModerated ts m)
|
||||
|
||||
itemDeletedTs :: CIDeleted d -> Maybe UTCTime
|
||||
itemDeletedTs = \case
|
||||
CIDeleted ts -> ts
|
||||
CIBlocked ts -> ts
|
||||
CIBlockedByAdmin ts -> ts
|
||||
CIModerated ts _ -> ts
|
||||
|
||||
data ChatItemInfo = ChatItemInfo
|
||||
|
||||
@@ -138,6 +138,7 @@ data CIContent (d :: MsgDirection) where
|
||||
CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv
|
||||
CISndModerated :: CIContent 'MDSnd
|
||||
CIRcvModerated :: CIContent 'MDRcv
|
||||
CIRcvBlocked :: CIContent 'MDRcv
|
||||
CIInvalidJSON :: Text -> CIContent d
|
||||
-- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
|
||||
-- ! ^ Nested sum types also have to use different encodings for database and API
|
||||
@@ -177,6 +178,7 @@ ciRequiresAttention content = case msgDirection @d of
|
||||
RGEMemberConnected -> False
|
||||
RGEMemberLeft -> False
|
||||
RGEMemberRole {} -> False
|
||||
RGEMemberBlocked {} -> False
|
||||
RGEUserRole _ -> True
|
||||
RGEMemberDeleted {} -> False
|
||||
RGEUserDeleted -> True
|
||||
@@ -192,6 +194,7 @@ ciRequiresAttention content = case msgDirection @d of
|
||||
CIRcvChatFeatureRejected _ -> True
|
||||
CIRcvGroupFeatureRejected _ -> True
|
||||
CIRcvModerated -> True
|
||||
CIRcvBlocked -> False
|
||||
CIInvalidJSON _ -> False
|
||||
|
||||
newtype DBMsgErrorType = DBME MsgErrorType
|
||||
@@ -246,6 +249,7 @@ ciContentToText = \case
|
||||
CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited"
|
||||
CISndModerated -> ciModeratedText
|
||||
CIRcvModerated -> ciModeratedText
|
||||
CIRcvBlocked -> "blocked"
|
||||
CIInvalidJSON _ -> "invalid content JSON"
|
||||
|
||||
ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text
|
||||
@@ -263,6 +267,7 @@ rcvGroupEventToText = \case
|
||||
RGEMemberConnected -> "connected"
|
||||
RGEMemberLeft -> "left"
|
||||
RGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r)
|
||||
RGEMemberBlocked _ p blocked -> (if blocked then "blocked" else "unblocked") <> " " <> profileToText p
|
||||
RGEUserRole r -> "changed your role to " <> safeDecodeUtf8 (strEncode r)
|
||||
RGEMemberDeleted _ p -> "removed " <> profileToText p
|
||||
RGEUserDeleted -> "removed you"
|
||||
@@ -275,6 +280,7 @@ rcvGroupEventToText = \case
|
||||
sndGroupEventToText :: SndGroupEvent -> Text
|
||||
sndGroupEventToText = \case
|
||||
SGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r)
|
||||
SGEMemberBlocked _ p blocked -> (if blocked then "blocked" else "unblocked") <> " " <> profileToText p
|
||||
SGEUserRole r -> "changed role for yourself to " <> safeDecodeUtf8 (strEncode r)
|
||||
SGEMemberDeleted _ p -> "removed " <> profileToText p
|
||||
SGEUserLeft -> "left"
|
||||
@@ -375,6 +381,7 @@ data JSONCIContent
|
||||
| JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
|
||||
| JCISndModerated
|
||||
| JCIRcvModerated
|
||||
| JCIRcvBlocked
|
||||
| JCIInvalidJSON {direction :: MsgDirection, json :: Text}
|
||||
|
||||
jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent
|
||||
@@ -404,6 +411,7 @@ jsonCIContent = \case
|
||||
CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature}
|
||||
CISndModerated -> JCISndModerated
|
||||
CIRcvModerated -> JCIRcvModerated
|
||||
CIRcvBlocked -> JCIRcvBlocked
|
||||
CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json
|
||||
|
||||
aciContentJSON :: JSONCIContent -> ACIContent
|
||||
@@ -433,6 +441,7 @@ aciContentJSON = \case
|
||||
JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
|
||||
JCISndModerated -> ACIContent SMDSnd CISndModerated
|
||||
JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
|
||||
JCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked
|
||||
JCIInvalidJSON dir json -> case fromMsgDirection dir of
|
||||
AMsgDirection d -> ACIContent d $ CIInvalidJSON json
|
||||
|
||||
@@ -463,6 +472,7 @@ data DBJSONCIContent
|
||||
| DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
|
||||
| DBJCISndModerated
|
||||
| DBJCIRcvModerated
|
||||
| DBJCIRcvBlocked
|
||||
| DBJCIInvalidJSON {direction :: MsgDirection, json :: Text}
|
||||
|
||||
dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent
|
||||
@@ -492,6 +502,7 @@ dbJsonCIContent = \case
|
||||
CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature}
|
||||
CISndModerated -> DBJCISndModerated
|
||||
CIRcvModerated -> DBJCIRcvModerated
|
||||
CIRcvBlocked -> DBJCIRcvBlocked
|
||||
CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json
|
||||
|
||||
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
||||
@@ -521,6 +532,7 @@ aciContentDBJSON = \case
|
||||
DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
|
||||
DBJCISndModerated -> ACIContent SMDSnd CISndModerated
|
||||
DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
|
||||
DBJCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked
|
||||
DBJCIInvalidJSON dir json -> case fromMsgDirection dir of
|
||||
AMsgDirection d -> ACIContent d $ CIInvalidJSON json
|
||||
|
||||
@@ -613,4 +625,5 @@ toCIContentTag ciContent = case ciContent of
|
||||
CIRcvGroupFeatureRejected _ -> "rcvGroupFeatureRejected"
|
||||
CISndModerated -> "sndModerated"
|
||||
CIRcvModerated -> "rcvModerated"
|
||||
CIRcvBlocked -> "rcvBlocked"
|
||||
CIInvalidJSON _ -> "invalidJSON"
|
||||
|
||||
@@ -15,6 +15,7 @@ data RcvGroupEvent
|
||||
| RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
|
||||
| RGEMemberLeft -- CRLeftMember
|
||||
| RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
|
||||
| RGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAll
|
||||
| RGEUserRole {role :: GroupMemberRole}
|
||||
| RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
|
||||
| RGEUserDeleted -- CRDeletedMemberUser
|
||||
@@ -30,6 +31,7 @@ data RcvGroupEvent
|
||||
|
||||
data SndGroupEvent
|
||||
= SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
|
||||
| SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAllUser
|
||||
| SGEUserRole {role :: GroupMemberRole}
|
||||
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
|
||||
| SGEUserLeft -- CRLeftMemberUser
|
||||
|
||||
@@ -0,0 +1,18 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240115_block_member_for_all where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240115_block_member_for_all :: Query
|
||||
m20240115_block_member_for_all =
|
||||
[sql|
|
||||
ALTER TABLE group_members ADD COLUMN member_restriction TEXT;
|
||||
|]
|
||||
|
||||
down_m20240115_block_member_for_all :: Query
|
||||
down_m20240115_block_member_for_all =
|
||||
[sql|
|
||||
ALTER TABLE group_members DROP COLUMN member_restriction;
|
||||
|]
|
||||
@@ -152,6 +152,7 @@ CREATE TABLE group_members(
|
||||
invited_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
|
||||
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
|
||||
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
||||
member_restriction TEXT,
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -244,11 +244,12 @@ data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
|
||||
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
|
||||
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
|
||||
XGrpMemIntro :: MemberInfo -> ChatMsgEvent 'Json
|
||||
XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
|
||||
XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
|
||||
XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
|
||||
XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
|
||||
XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
|
||||
XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
|
||||
XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
|
||||
XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
|
||||
XGrpMemDel :: MemberId -> ChatMsgEvent 'Json
|
||||
@@ -290,6 +291,7 @@ isForwardedGroupMsg ev = case ev of
|
||||
XInfo _ -> True
|
||||
XGrpMemNew _ -> True
|
||||
XGrpMemRole {} -> True
|
||||
XGrpMemRestrict {} -> True
|
||||
XGrpMemDel _ -> True -- TODO there should be a special logic when deleting host member (e.g., host forwards it before deleting connections)
|
||||
XGrpLeave -> True
|
||||
XGrpDel -> True -- TODO there should be a special logic - host should forward before deleting connections
|
||||
@@ -301,6 +303,14 @@ forwardedGroupMsg msg@ChatMessage {chatMsgEvent} = case encoding @e of
|
||||
SJson | isForwardedGroupMsg chatMsgEvent -> Just msg
|
||||
_ -> Nothing
|
||||
|
||||
-- applied after checking forwardedGroupMsg and building list of group members to forward to, see Chat
|
||||
forwardedToGroupMembers :: forall e. MsgEncodingI e => [GroupMember] -> ChatMessage e -> [GroupMember]
|
||||
forwardedToGroupMembers ms ChatMessage {chatMsgEvent} = case encoding @e of
|
||||
SJson -> case chatMsgEvent of
|
||||
XGrpMemRestrict mId _ -> filter (\GroupMember {memberId} -> memberId /= mId) ms
|
||||
_ -> ms
|
||||
_ -> []
|
||||
|
||||
data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -629,6 +639,7 @@ data CMEventTag (e :: MsgEncoding) where
|
||||
XGrpMemFwd_ :: CMEventTag 'Json
|
||||
XGrpMemInfo_ :: CMEventTag 'Json
|
||||
XGrpMemRole_ :: CMEventTag 'Json
|
||||
XGrpMemRestrict_ :: CMEventTag 'Json
|
||||
XGrpMemCon_ :: CMEventTag 'Json
|
||||
XGrpMemConAll_ :: CMEventTag 'Json
|
||||
XGrpMemDel_ :: CMEventTag 'Json
|
||||
@@ -678,6 +689,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
|
||||
XGrpMemFwd_ -> "x.grp.mem.fwd"
|
||||
XGrpMemInfo_ -> "x.grp.mem.info"
|
||||
XGrpMemRole_ -> "x.grp.mem.role"
|
||||
XGrpMemRestrict_ -> "x.grp.mem.restrict"
|
||||
XGrpMemCon_ -> "x.grp.mem.con"
|
||||
XGrpMemConAll_ -> "x.grp.mem.con.all"
|
||||
XGrpMemDel_ -> "x.grp.mem.del"
|
||||
@@ -728,6 +740,7 @@ instance StrEncoding ACMEventTag where
|
||||
"x.grp.mem.fwd" -> XGrpMemFwd_
|
||||
"x.grp.mem.info" -> XGrpMemInfo_
|
||||
"x.grp.mem.role" -> XGrpMemRole_
|
||||
"x.grp.mem.restrict" -> XGrpMemRestrict_
|
||||
"x.grp.mem.con" -> XGrpMemCon_
|
||||
"x.grp.mem.con.all" -> XGrpMemConAll_
|
||||
"x.grp.mem.del" -> XGrpMemDel_
|
||||
@@ -769,11 +782,12 @@ toCMEventTag msg = case msg of
|
||||
XGrpLinkInv _ -> XGrpLinkInv_
|
||||
XGrpLinkMem _ -> XGrpLinkMem_
|
||||
XGrpMemNew _ -> XGrpMemNew_
|
||||
XGrpMemIntro _ -> XGrpMemIntro_
|
||||
XGrpMemIntro _ _ -> XGrpMemIntro_
|
||||
XGrpMemInv _ _ -> XGrpMemInv_
|
||||
XGrpMemFwd _ _ -> XGrpMemFwd_
|
||||
XGrpMemInfo _ _ -> XGrpMemInfo_
|
||||
XGrpMemRole _ _ -> XGrpMemRole_
|
||||
XGrpMemRestrict _ _ -> XGrpMemRestrict_
|
||||
XGrpMemCon _ -> XGrpMemCon_
|
||||
XGrpMemConAll _ -> XGrpMemConAll_
|
||||
XGrpMemDel _ -> XGrpMemDel_
|
||||
@@ -868,11 +882,12 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
||||
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
|
||||
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
|
||||
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
|
||||
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
|
||||
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
|
||||
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
|
||||
XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
|
||||
XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
|
||||
XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role"
|
||||
XGrpMemRestrict_ -> XGrpMemRestrict <$> p "memberId" <*> p "memberRestrictions"
|
||||
XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
|
||||
XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
|
||||
XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
|
||||
@@ -928,11 +943,12 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
|
||||
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
|
||||
XGrpLinkMem profile -> o ["profile" .= profile]
|
||||
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
|
||||
XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
|
||||
XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
|
||||
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
|
||||
XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
|
||||
XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
|
||||
XGrpMemRole memId role -> o ["memberId" .= memId, "role" .= role]
|
||||
XGrpMemRestrict memId memRestrictions -> o ["memberId" .= memId, "memberRestrictions" .= memRestrictions]
|
||||
XGrpMemCon memId -> o ["memberId" .= memId]
|
||||
XGrpMemConAll memId -> o ["memberId" .= memId]
|
||||
XGrpMemDel memId -> o ["memberId" .= memId]
|
||||
|
||||
@@ -101,11 +101,11 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, 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.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, 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)
|
||||
|
||||
@@ -98,6 +98,7 @@ module Simplex.Chat.Store.Groups
|
||||
deleteOldProbes,
|
||||
updateGroupSettings,
|
||||
updateGroupMemberSettings,
|
||||
updateGroupMemberBlocked,
|
||||
getXGrpMemIntroContDirect,
|
||||
getXGrpMemIntroContGroup,
|
||||
getHostConnId,
|
||||
@@ -147,9 +148,9 @@ import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, 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 Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
|
||||
toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) =
|
||||
@@ -160,17 +161,18 @@ toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName,
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt}
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
memberSettings = GroupMemberSettings {showMessages}
|
||||
blockedByAdmin = maybe False mrsBlocked memberRestriction_
|
||||
invitedBy = toInvitedBy userContactId invitedById
|
||||
activeConn = Nothing
|
||||
memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
in GroupMember {..}
|
||||
|
||||
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, 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 ()
|
||||
@@ -268,11 +270,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, 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.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, 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,
|
||||
@@ -429,6 +431,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
|
||||
memberCategory,
|
||||
memberStatus,
|
||||
memberSettings = defaultMemberSettings,
|
||||
blockedByAdmin = False,
|
||||
invitedBy,
|
||||
invitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
@@ -615,7 +618,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
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, g.user_member_profile_sent_at,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
|
||||
mu.invited_by, mu.invited_by_group_member_id, 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)
|
||||
@@ -678,7 +681,7 @@ groupMemberQuery :: Query
|
||||
groupMemberQuery =
|
||||
[sql|
|
||||
SELECT
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, 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,
|
||||
@@ -797,6 +800,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
|
||||
memberCategory = GCInviteeMember,
|
||||
memberStatus = GSMemInvited,
|
||||
memberSettings = defaultMemberSettings,
|
||||
blockedByAdmin = False,
|
||||
invitedBy = IBUser,
|
||||
invitedByGroupMemberId = Just invitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
@@ -954,6 +958,7 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m
|
||||
{ memInfo,
|
||||
memCategory,
|
||||
memStatus,
|
||||
memRestriction = Nothing,
|
||||
memInvitedBy = IBUnknown,
|
||||
memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
|
||||
localDisplayName,
|
||||
@@ -981,6 +986,7 @@ createNewMember_
|
||||
{ memInfo = MemberInfo memberId memberRole memChatVRange memberProfile,
|
||||
memCategory = memberCategory,
|
||||
memStatus = memberStatus,
|
||||
memRestriction,
|
||||
memInvitedBy = invitedBy,
|
||||
memInvitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
@@ -995,12 +1001,12 @@ createNewMember_
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
(group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
(group_id, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, memInvitedByGroupMemberId)
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, invitedById, memInvitedByGroupMemberId)
|
||||
:. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
@@ -1014,6 +1020,7 @@ createNewMember_
|
||||
memberCategory,
|
||||
memberStatus,
|
||||
memberSettings = defaultMemberSettings,
|
||||
blockedByAdmin = maybe False mrsBlocked memRestriction,
|
||||
invitedBy,
|
||||
invitedByGroupMemberId = memInvitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
@@ -1189,26 +1196,37 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do
|
||||
WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
|
||||
|]
|
||||
|
||||
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
|
||||
let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
|
||||
currentTs <- liftIO getCurrentTime
|
||||
newMember <- case directConnIds of
|
||||
Just (directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
Nothing -> do
|
||||
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
liftIO $ do
|
||||
member <- createNewMember_ db user gInfo newMember currentTs
|
||||
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user groupCmdId groupConnId
|
||||
pure (member :: GroupMember) {activeConn = Just conn}
|
||||
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createIntroReMember
|
||||
db
|
||||
user@User {userId}
|
||||
gInfo@GroupInfo {groupId}
|
||||
_host@GroupMember {memberContactId, activeConn}
|
||||
memInfo@(MemberInfo _ _ memChatVRange memberProfile)
|
||||
memRestrictions_
|
||||
(groupCmdId, groupAgentConnId)
|
||||
directConnIds
|
||||
customUserProfileId
|
||||
subMode = do
|
||||
let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
|
||||
memRestriction = restriction <$> memRestrictions_
|
||||
currentTs <- liftIO getCurrentTime
|
||||
newMember <- case directConnIds of
|
||||
Just (directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
Nothing -> do
|
||||
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
liftIO $ do
|
||||
member <- createNewMember_ db user gInfo newMember currentTs
|
||||
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user groupCmdId groupConnId
|
||||
pure (member :: GroupMember) {activeConn = Just conn}
|
||||
|
||||
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
|
||||
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
|
||||
@@ -1263,11 +1281,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, 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.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
|
||||
m.invited_by, m.invited_by_group_member_id, 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,
|
||||
@@ -1358,7 +1376,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, 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
|
||||
@@ -1768,6 +1786,18 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
|
||||
|]
|
||||
(showMessages, currentTs, userId, gId, gMemberId)
|
||||
|
||||
updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
|
||||
updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE group_members
|
||||
SET member_restriction = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|
||||
|]
|
||||
(memberBlocked, currentTs, userId, gId, gMemberId)
|
||||
|
||||
getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
|
||||
getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do
|
||||
fmap join . maybeFirstRow toCont $
|
||||
|
||||
@@ -52,8 +52,10 @@ module Simplex.Chat.Store.Messages
|
||||
updateGroupChatItem,
|
||||
deleteGroupChatItem,
|
||||
updateGroupChatItemModerated,
|
||||
updateGroupCIBlockedByAdmin,
|
||||
markGroupChatItemDeleted,
|
||||
markGroupChatItemBlocked,
|
||||
markGroupCIBlockedByAdmin,
|
||||
deleteLocalChatItem,
|
||||
updateDirectChatItemsRead,
|
||||
getDirectUnreadTimedItems,
|
||||
@@ -462,7 +464,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.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, 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)
|
||||
@@ -828,7 +830,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
||||
ciMeta content status =
|
||||
let itemDeleted' = case itemDeleted of
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @'CTLocal deletedTs)
|
||||
_ -> Just (CIDeleted @CTLocal deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
@@ -1361,7 +1363,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
ciMeta content status =
|
||||
let itemDeleted' = case itemDeleted of
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @'CTDirect deletedTs)
|
||||
_ -> Just (CIDeleted @CTDirect deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
@@ -1413,7 +1415,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
let itemDeleted' = case itemDeleted of
|
||||
DBCINotDeleted -> Nothing
|
||||
DBCIBlocked -> Just (CIBlocked deletedTs)
|
||||
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
DBCIBlockedByAdmin -> Just (CIBlockedByAdmin 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 forwardedByMember createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
@@ -1764,7 +1767,24 @@ updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMemb
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
|
||||
pure $ 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 deletedTs) m), editable = False}, formattedText = Nothing}
|
||||
|
||||
updateGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> UTCTime -> IO (ChatItem 'CTGroup d)
|
||||
updateGroupCIBlockedByAdmin db User {userId} GroupInfo {groupId} ci deletedTs = do
|
||||
currentTs <- getCurrentTime
|
||||
let itemId = chatItemId' ci
|
||||
deleteChatItemMessages_ db itemId
|
||||
deleteChatItemVersions_ db itemId
|
||||
liftIO $
|
||||
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 = ?
|
||||
|]
|
||||
(DBCIBlockedByAdmin, deletedTs, currentTs, userId, groupId, itemId)
|
||||
pure $ ci {meta = (meta ci) {itemDeleted = Just (CIBlockedByAdmin $ Just deletedTs), editable = False}, formattedText = Nothing}
|
||||
|
||||
pattern DBCINotDeleted :: Int
|
||||
pattern DBCINotDeleted = 0
|
||||
@@ -1775,13 +1795,16 @@ pattern DBCIDeleted = 1
|
||||
pattern DBCIBlocked :: Int
|
||||
pattern DBCIBlocked = 2
|
||||
|
||||
pattern DBCIBlockedByAdmin :: Int
|
||||
pattern DBCIBlockedByAdmin = 3
|
||||
|
||||
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, itemDeleted) = case byGroupMember_ of
|
||||
Just m@GroupMember {groupMemberId} -> (Just groupMemberId, Just $ CIModerated (Just deletedTs) m)
|
||||
_ -> (Nothing, Just $ CIDeleted @'CTGroup (Just deletedTs))
|
||||
_ -> (Nothing, Just $ CIDeleted @CTGroup (Just deletedTs))
|
||||
insertChatItemMessage_ db itemId msgId currentTs
|
||||
DB.execute
|
||||
db
|
||||
@@ -1806,6 +1829,19 @@ markGroupChatItemBlocked db User {userId} GroupInfo {groupId} ci@ChatItem {meta}
|
||||
(DBCIBlocked, deletedTs, deletedTs, userId, groupId, chatItemId' ci)
|
||||
pure ci {meta = meta {itemDeleted = Just $ CIBlocked $ Just deletedTs}}
|
||||
|
||||
markGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
|
||||
markGroupCIBlockedByAdmin 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 = ?
|
||||
|]
|
||||
(DBCIBlockedByAdmin, deletedTs, deletedTs, userId, groupId, chatItemId' ci)
|
||||
pure ci {meta = meta {itemDeleted = Just $ CIBlockedByAdmin $ Just deletedTs}}
|
||||
|
||||
getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do
|
||||
itemId <-
|
||||
@@ -1864,17 +1900,17 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
i.forwarded_by_group_member_id,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, 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.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, 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.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, 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
|
||||
|
||||
@@ -96,6 +96,7 @@ import Simplex.Chat.Migrations.M20231214_item_content_tag
|
||||
import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
|
||||
import Simplex.Chat.Migrations.M20240102_note_folders
|
||||
import Simplex.Chat.Migrations.M20240104_members_profile_update
|
||||
import Simplex.Chat.Migrations.M20240115_block_member_for_all
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -191,7 +192,8 @@ schemaMigrations =
|
||||
("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
|
||||
("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries),
|
||||
("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders),
|
||||
("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update)
|
||||
("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update),
|
||||
("20240115_block_member_for_all", m20240115_block_member_for_all, Just down_m20240115_block_member_for_all)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -35,6 +35,7 @@ import Data.Int (Int64)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Typeable (Typeable)
|
||||
import Database.SQLite.Simple (ResultError (..), SQLData (..))
|
||||
@@ -50,7 +51,7 @@ import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
|
||||
import Simplex.Messaging.Util ((<$?>))
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
|
||||
import Simplex.Messaging.Version
|
||||
|
||||
class IsContact a where
|
||||
@@ -596,9 +597,55 @@ data MemberInfo = MemberInfo
|
||||
|
||||
memberInfo :: GroupMember -> MemberInfo
|
||||
memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
|
||||
MemberInfo memberId memberRole cvr (redactedMemberProfile $ fromLocalProfile memberProfile)
|
||||
where
|
||||
cvr = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn
|
||||
MemberInfo
|
||||
{ memberId,
|
||||
memberRole,
|
||||
v = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn,
|
||||
profile = redactedMemberProfile $ fromLocalProfile memberProfile
|
||||
}
|
||||
|
||||
data MemberRestrictionStatus
|
||||
= MRSBlocked
|
||||
| MRSUnrestricted
|
||||
| MRSUnknown Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromField MemberRestrictionStatus where fromField = fromBlobField_ strDecode
|
||||
|
||||
instance ToField MemberRestrictionStatus where toField = toField . strEncode
|
||||
|
||||
instance StrEncoding MemberRestrictionStatus where
|
||||
strEncode = \case
|
||||
MRSBlocked -> "blocked"
|
||||
MRSUnrestricted -> "unrestricted"
|
||||
MRSUnknown tag -> encodeUtf8 tag
|
||||
strDecode s = Right $ case s of
|
||||
"blocked" -> MRSBlocked
|
||||
"unrestricted" -> MRSUnrestricted
|
||||
tag -> MRSUnknown $ safeDecodeUtf8 tag
|
||||
strP = strDecode <$?> A.takeByteString
|
||||
|
||||
instance FromJSON MemberRestrictionStatus where
|
||||
parseJSON = strParseJSON "MemberRestrictionStatus"
|
||||
|
||||
instance ToJSON MemberRestrictionStatus where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
mrsBlocked :: MemberRestrictionStatus -> Bool
|
||||
mrsBlocked = \case
|
||||
MRSBlocked -> True
|
||||
_ -> False
|
||||
|
||||
data MemberRestrictions = MemberRestrictions
|
||||
{ restriction :: MemberRestrictionStatus
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
memberRestrictions :: GroupMember -> Maybe MemberRestrictions
|
||||
memberRestrictions m
|
||||
| blockedByAdmin m = Just MemberRestrictions {restriction = MRSBlocked}
|
||||
| otherwise = Nothing
|
||||
|
||||
data ReceivedGroupInvitation = ReceivedGroupInvitation
|
||||
{ fromMember :: GroupMember,
|
||||
@@ -619,6 +666,7 @@ data GroupMember = GroupMember
|
||||
memberCategory :: GroupMemberCategory,
|
||||
memberStatus :: GroupMemberStatus,
|
||||
memberSettings :: GroupMemberSettings,
|
||||
blockedByAdmin :: Bool,
|
||||
invitedBy :: InvitedBy,
|
||||
invitedByGroupMemberId :: Maybe GroupMemberId,
|
||||
localDisplayName :: ContactName,
|
||||
@@ -679,6 +727,7 @@ data NewGroupMember = NewGroupMember
|
||||
{ memInfo :: MemberInfo,
|
||||
memCategory :: GroupMemberCategory,
|
||||
memStatus :: GroupMemberStatus,
|
||||
memRestriction :: Maybe MemberRestrictionStatus,
|
||||
memInvitedBy :: InvitedBy,
|
||||
memInvitedByGroupMemberId :: Maybe GroupMemberId,
|
||||
localDisplayName :: ContactName,
|
||||
@@ -1641,6 +1690,8 @@ $(JQ.deriveJSON defaultJSON ''IntroInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberRestrictions)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupMemberRef)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''FileDescr)
|
||||
|
||||
@@ -179,6 +179,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
|
||||
CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
|
||||
CRUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m]
|
||||
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileDescrReady _ _ -> []
|
||||
@@ -243,6 +244,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
|
||||
CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
|
||||
CRMemberBlockedForAllUser u g m blocked -> ttyUser u $ viewMemberBlockedForAllUser g m blocked
|
||||
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
@@ -436,21 +439,16 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString]
|
||||
unmuted' u chat chatDir mention s
|
||||
| chatDirNtf u chat chatDir mention = s
|
||||
| testView = map (<> " <muted>") 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)
|
||||
(GroupChat g, CIGroupRcv m) -> groupNtf user g mention && not (blockedByAdmin m) && showMessages (memberSettings m)
|
||||
_ -> True
|
||||
|
||||
contactNtf :: User -> Contact -> Bool -> Bool
|
||||
@@ -473,6 +471,7 @@ chatItemDeletedText ChatItem {meta = CIMeta {itemDeleted}, content} membership_
|
||||
CIModerated _ m -> markedDeleted content <> byMember m
|
||||
CIDeleted _ -> markedDeleted content
|
||||
CIBlocked _ -> "blocked"
|
||||
CIBlockedByAdmin _ -> "blocked by admin"
|
||||
markedDeleted = \case
|
||||
CISndModerated -> "deleted"
|
||||
CIRcvModerated -> "deleted"
|
||||
@@ -555,6 +554,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvGroupInvitation {} -> showRcvItemProhibited from
|
||||
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
|
||||
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
from = ttyFromGroup g m
|
||||
@@ -978,6 +978,14 @@ viewMemberRoleUserChanged g@GroupInfo {membership} m r r'
|
||||
where
|
||||
view s = [ttyGroup' g <> ": you changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
|
||||
|
||||
viewMemberBlockedForAll :: GroupInfo -> GroupMember -> GroupMember -> Bool -> [StyledString]
|
||||
viewMemberBlockedForAll g by m blocked =
|
||||
[ttyGroup' g <> ": " <> ttyMember by <> " " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
|
||||
|
||||
viewMemberBlockedForAllUser :: GroupInfo -> GroupMember -> Bool -> [StyledString]
|
||||
viewMemberBlockedForAllUser g m blocked =
|
||||
[ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
|
||||
|
||||
showRole :: GroupMemberRole -> StyledString
|
||||
showRole = plain . strEncode
|
||||
|
||||
@@ -1003,8 +1011,9 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
|
||||
GSMemCreator -> ["created group"]
|
||||
_ -> []
|
||||
muted m
|
||||
| showMessages (memberSettings m) = []
|
||||
| otherwise = ["blocked"]
|
||||
| blockedByAdmin m = ["blocked by admin"]
|
||||
| not (showMessages $ memberSettings m) = ["blocked"]
|
||||
| otherwise = []
|
||||
|
||||
viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString]
|
||||
viewContactConnected ct userIncognitoProfile testView =
|
||||
@@ -1847,6 +1856,13 @@ viewChatError logLevel testView = \case
|
||||
CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
|
||||
CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> viewGroupName g)]
|
||||
CEGroupMemberNotActive -> ["your group connection is not active yet, try later"]
|
||||
CECantBlockMemberForSelf g m showMsgs ->
|
||||
[ "admins or above can't block member for self, use "
|
||||
<> highlight
|
||||
( (if showMsgs then "/unblock for all" else "/block for all")
|
||||
<> (" #" <> viewGroupName g <> " " <> viewMemberName m)
|
||||
)
|
||||
]
|
||||
CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
|
||||
CEGroupMemberNotFound -> ["group doesn't have this member"]
|
||||
CEGroupMemberIntroNotFound c -> ["group member intro not found for " <> ttyContact c]
|
||||
|
||||
Reference in New Issue
Block a user