core: auxiliary group chat items (#821)

2026-08-24 09:50:22 +00:00 · 2022-07-20 16:56:55 +04:00
parent 1cb348c102
commit 5e71deaa3d
5 changed files with 326 additions and 200 deletions
@@ -260,7 +260,7 @@ data ChatResponse
  | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
  | CRGroupInvitation {groupInfo :: GroupInfo}
  | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
-  | CRUserJoinedGroup {groupInfo :: GroupInfo}
+  | CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}
  | CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
  | CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
  | CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
@@ -499,6 +499,23 @@ ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text
 ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role =
  "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role)

+rcvGroupEventToText :: RcvGroupEvent -> Text
+rcvGroupEventToText = \case
+  RGEMemberAdded _ p -> "added " <> memberProfileToText p
+  RGEMemberConnected -> "connected"
+  RGEMemberLeft -> "left"
+  RGEMemberDeleted _ p -> "removed " <> memberProfileToText p
+  RGEUserDeleted -> "removed you"
+  RGEGroupDeleted -> "deleted group"
+
+sndGroupEventToText :: SndGroupEvent -> Text
+sndGroupEventToText = \case
+  SGEMemberDeleted _ p -> "removed " <> memberProfileToText p
+  SGEUserLeft -> "left"
+
+memberProfileToText :: Profile -> Text
+memberProfileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName
+
 -- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
 data CIContent (d :: MsgDirection) where
  CISndMsgContent :: MsgContent -> CIContent 'MDSnd
@@ -510,9 +527,39 @@ data CIContent (d :: MsgDirection) where
  CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv
  CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv
  CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd
+  CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv
+  CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd

 deriving instance Show (CIContent d)

+data RcvGroupEvent
+  = RGEMemberAdded GroupMemberId Profile -- CRJoinedGroupMemberConnecting
+  | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
+  | RGEMemberLeft -- CRLeftMember
+  | RGEMemberDeleted GroupMemberId Profile -- CRDeletedMember
+  | RGEUserDeleted -- CRDeletedMemberUser
+  | RGEGroupDeleted -- CRGroupDeleted
+  deriving (Show, Generic)
+
+instance FromJSON RcvGroupEvent where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE"
+
+instance ToJSON RcvGroupEvent where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE"
+
+data SndGroupEvent
+  = SGEMemberDeleted GroupMemberId Profile -- CRUserDeletedMember
+  | SGEUserLeft -- CRLeftMemberUser
+  deriving (Show, Generic)
+
+instance FromJSON SndGroupEvent where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE"
+
+instance ToJSON SndGroupEvent where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE"
+
 data CIGroupInvitation = CIGroupInvitation
  { groupId :: GroupId,
    groupMemberId :: GroupMemberId,
@@ -551,6 +598,8 @@ ciContentToText = \case
  CIRcvIntegrityError err -> msgIntegrityError err
  CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole
  CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole
+  CIRcvGroupEvent event -> rcvGroupEventToText event
+  CISndGroupEvent event -> sndGroupEventToText event

 msgIntegrityError :: MsgErrorType -> Text
 msgIntegrityError = \case
@@ -597,6 +646,8 @@ data JSONCIContent
  | JCIRcvIntegrityError {msgError :: MsgErrorType}
  | JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
  | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
+  | JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent}
+  | JCISndGroupEvent {sndGroupEvent :: SndGroupEvent}
  deriving (Generic)

 instance FromJSON JSONCIContent where
@@ -617,6 +668,8 @@ jsonCIContent = \case
  CIRcvIntegrityError err -> JCIRcvIntegrityError err
  CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole}
  CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole}
+  CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent}
+  CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent}

 aciContentJSON :: JSONCIContent -> ACIContent
 aciContentJSON = \case
@@ -629,6 +682,8 @@ aciContentJSON = \case
  JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err
  JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole
  JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole
+  JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent
+  JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent

 -- platform independent
 data DBJSONCIContent
@@ -641,6 +696,8 @@ data DBJSONCIContent
  | DBJCIRcvIntegrityError {msgError :: MsgErrorType}
  | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
  | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
+  | DBJCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent}
+  | DBJCISndGroupEvent {sndGroupEvent :: SndGroupEvent}
  deriving (Generic)

 instance FromJSON DBJSONCIContent where
@@ -661,6 +718,8 @@ dbJsonCIContent = \case
  CIRcvIntegrityError err -> DBJCIRcvIntegrityError err
  CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole}
  CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole}
+  CIRcvGroupEvent rcvGroupEvent -> DBJCIRcvGroupEvent {rcvGroupEvent}
+  CISndGroupEvent sndGroupEvent -> DBJCISndGroupEvent {sndGroupEvent}

 aciContentDBJSON :: DBJSONCIContent -> ACIContent
 aciContentDBJSON = \case
@@ -673,6 +732,8 @@ aciContentDBJSON = \case
  DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err
  DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole
  DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole
+  DBJCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent
+  DBJCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent

 data CICallStatus
  = CISCallPending
@@ -6,7 +6,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}

 module Simplex.Chat.View where
@@ -60,8 +59,8 @@ responseToView testView = \case
  CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
  CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
  CRUserSMPServers smpServers -> viewSMPServers smpServers testView
-  CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item
-  CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item) chatItems
+  CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False
+  CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems
  CRChatItemStatusUpdated _ -> []
  CRChatItemUpdated (AChatItem _ _ chat item) -> viewItemUpdate chat item
  CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> viewItemDelete chat deletedItem toItem
@@ -134,7 +133,7 @@ responseToView testView = \case
  CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} ->
    [groupInvitation' ldn fullName]
  CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
-  CRUserJoinedGroup g -> [ttyGroup' g <> ": you joined the group"]
+  CRUserJoinedGroup g _ -> [ttyGroup' g <> ": you joined the group"]
  CRJoinedGroupMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
  CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
  CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
@@ -200,22 +199,24 @@ responseToView testView = \case
    contactList :: [ContactRef] -> String
    contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs

-viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
-viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of
+viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString]
+viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of
  DirectChat c -> case chatDir of
    CIDirectSnd -> case content of
      CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
-      CISndDeleted _ -> []
-      CISndCall {} -> []
-      CISndGroupInvitation {} -> []
+      CISndDeleted _ -> showSndItem to
+      CISndCall {} -> showSndItem to
+      CISndGroupInvitation {} -> showSndItem to
+      CISndGroupEvent {} -> showSndItemProhibited to
      where
        to = ttyToContact' c
    CIDirectRcv -> case content of
      CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
-      CIRcvDeleted _ -> []
-      CIRcvCall {} -> []
+      CIRcvDeleted _ -> showRcvItem from
+      CIRcvCall {} -> showRcvItem from
      CIRcvIntegrityError err -> viewRcvIntegrityError from err meta
-      CIRcvGroupInvitation {} -> []
+      CIRcvGroupInvitation {} -> showRcvItem from
+      CIRcvGroupEvent {} -> showRcvItemProhibited from
      where
        from = ttyFromContact' c
    where
@@ -223,17 +224,19 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
  GroupChat g -> case chatDir of
    CIGroupSnd -> case content of
      CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
-      CISndDeleted _ -> []
-      CISndCall {} -> []
-      CISndGroupInvitation {} -> [] -- prohibited
+      CISndDeleted _ -> showSndItem to
+      CISndCall {} -> showSndItem to
+      CISndGroupInvitation {} -> showSndItemProhibited to
+      CISndGroupEvent {} -> showSndItem to
      where
        to = ttyToGroup g
    CIGroupRcv m -> case content of
      CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
-      CIRcvDeleted _ -> []
-      CIRcvCall {} -> []
+      CIRcvDeleted _ -> showRcvItem from
+      CIRcvCall {} -> showRcvItem from
      CIRcvIntegrityError err -> viewRcvIntegrityError from err meta
-      CIRcvGroupInvitation {} -> [] -- prohibited
+      CIRcvGroupInvitation {} -> showRcvItemProhibited from
+      CIRcvGroupEvent {} -> showRcvItem from
      where
        from = ttyFromGroup' g m
    where
@@ -249,6 +252,13 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
      ("", Just _, []) -> []
      ("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) meta
      _ -> view dir quote mc meta
+    showSndItem to = showItem $ sentWithTime_ [to <> plainContent content] meta
+    showRcvItem from = showItem $ receivedWithTime_ from [] meta [plainContent content]
+    showSndItemProhibited to = showItem $ sentWithTime_ [to <> plainContent content <> " " <> prohibited] meta
+    showRcvItemProhibited from = showItem $ receivedWithTime_ from [] meta [plainContent content <> " " <> prohibited]
+    showItem ss = if doShow then ss else []
+    plainContent = plain . ciContentToText
+    prohibited = styled (colored Red) ("[prohibited - it's a bug if this chat item was created in this context, please report it to dev team]" :: String)

 viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
 viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of