core: forward member name; ui: don't show "Member" label if unknown member was created with name (#6211)

src/Simplex/Chat/Library/Internal.hs

@@ -1196,9 +1196,15 @@ sendHistory user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn
                 _ -> pure []
               let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
                   GroupMember {memberId} = sender
-                  msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+                  memberName = Just $ memberShortenedName sender
+                  msgForwardEvents = map (\cm -> XGrpMsgForward memberId memberName cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
               pure msgForwardEvents
 
+memberShortenedName :: GroupMember -> ContactName
+memberShortenedName GroupMember {memberProfile = LocalProfile {displayName}}
+  | T.length displayName <= 16 = displayName
+  | otherwise = T.take 16 displayName `T.snoc` '…'
+
 splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
 splitFileDescr partSize rfdText = splitParts 1 rfdText
   where

src/Simplex/Chat/Library/Subscriber.hs

@@ -974,7 +974,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               XGrpPrefs ps' -> (,False) <$> xGrpPrefs gInfo' m'' ps'
               -- TODO [knocking] why don't we forward these messages?
               XGrpDirectInv connReq mContent_ msgScope -> memberCanSend m'' msgScope $ (Nothing, False) <$ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs
-              XGrpMsgForward memberId msg' msgTs -> (Nothing, False) <$ xGrpMsgForward gInfo' m'' memberId msg' msgTs
+              XGrpMsgForward memberId memberName msg' msgTs -> (Nothing, False) <$ xGrpMsgForward gInfo' m'' memberId memberName msg' msgTs
               XInfoProbe probe -> (Nothing, False) <$ xInfoProbe (COMGroupMember m'') probe
               XInfoProbeCheck probeHash -> (Nothing, False) <$ xInfoProbeCheck (COMGroupMember m'') probeHash
               XInfoProbeOk probe -> (Nothing, False) <$ xInfoProbeOk (COMGroupMember m'') probe
@@ -1001,7 +1001,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           forwardMsgs groupForwardScope fwdMsgs = do
             ms <- buildMemberList
             let GroupMember {memberId} = m
-                events = L.map (\cm -> XGrpMsgForward memberId cm brokerTs) fwdMsgs
+                memberName = Just $ memberShortenedName m
+                events = L.map (\cm -> XGrpMsgForward memberId memberName cm brokerTs) fwdMsgs
             unless (null ms) $ void $ sendGroupMessages_ user gInfo ms events
             where
               buildMemberList = case groupForwardScope of
@@ -2924,7 +2925,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                     toView CEvtMemberBlockedForAll {user, groupInfo = gInfo', byMember = m', member = bm', blocked}
                     pure $ memberEventForwardScope bm
               Left (SEGroupMemberNotFoundByMemberId _) -> do
-                bm <- createUnknownMember gInfo memId
+                bm <- createUnknownMember gInfo memId Nothing
                 bm' <- setMemberBlocked bm
                 toView $ CEvtUnknownMemberBlocked user gInfo m bm'
                 pure $ Just GFSMain
@@ -3023,7 +3024,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         forwardToMember :: GroupMember -> CM ()
         forwardToMember member = do
           let GroupMember {memberId} = m
-              event = XGrpMsgForward memberId chatMsg brokerTs
+              memberName = Just $ memberShortenedName m
+              event = XGrpMsgForward memberId memberName chatMsg brokerTs
           sendGroupMemberMessage gInfo member event Nothing (pure ())
 
     isUserGrpFwdRelay :: GroupInfo -> Bool
@@ -3181,13 +3183,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       toViewTE $ TEContactVerificationReset user ct
       createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
 
-    xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> CM ()
-    xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId chatMsg msgTs = do
+    xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> Maybe ContactName -> ChatMessage 'Json -> UTCTime -> CM ()
+    xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId memberName chatMsg msgTs = do
       when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName)
       withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
         Right author -> processForwardedMsg author
         Left (SEGroupMemberNotFoundByMemberId _) -> do
-          unknownAuthor <- createUnknownMember gInfo memberId
+          unknownAuthor <- createUnknownMember gInfo memberId memberName
           toView $ CEvtUnknownMemberCreated user gInfo m unknownAuthor
           processForwardedMsg unknownAuthor
         Left e -> throwError $ ChatErrorStore e
@@ -3216,9 +3218,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             XGrpPrefs ps' -> void $ xGrpPrefs gInfo author ps'
             _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event)
 
-    createUnknownMember :: GroupInfo -> MemberId -> CM GroupMember
-    createUnknownMember gInfo memberId = do
-      let name = nameFromMemberId memberId
+    createUnknownMember :: GroupInfo -> MemberId -> Maybe ContactName -> CM GroupMember
+    createUnknownMember gInfo memberId memberName = do
+      let name = fromMaybe (nameFromMemberId memberId) memberName
       withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name
 
     directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM ()

src/Simplex/Chat/Protocol.hs

@@ -348,7 +348,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
   XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json
   XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
-  XGrpMsgForward :: MemberId -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json
+  XGrpMsgForward :: MemberId -> Maybe ContactName -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json
   XInfoProbe :: Probe -> ChatMsgEvent 'Json
   XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
   XInfoProbeOk :: Probe -> ChatMsgEvent 'Json
@@ -1136,7 +1136,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
       XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
       XGrpPrefs_ -> XGrpPrefs <$> p "groupPreferences"
       XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope"
-      XGrpMsgForward_ -> XGrpMsgForward <$> p "memberId" <*> p "msg" <*> p "msgTs"
+      XGrpMsgForward_ -> XGrpMsgForward <$> p "memberId" <*> opt "memberName" <*> p "msg" <*> p "msgTs"
       XInfoProbe_ -> XInfoProbe <$> p "probe"
       XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
       XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
@@ -1195,7 +1195,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
       XGrpInfo p -> o ["groupProfile" .= p]
       XGrpPrefs p -> o ["groupPreferences" .= p]
       XGrpDirectInv connReq content scope -> o $ ("content" .=? content) $ ("scope" .=? scope) ["connReq" .= connReq]
-      XGrpMsgForward memberId msg msgTs -> o ["memberId" .= memberId, "msg" .= msg, "msgTs" .= msgTs]
+      XGrpMsgForward memberId memberName msg msgTs -> o $ ("memberName" .=? memberName) ["memberId" .= memberId, "msg" .= msg, "msgTs" .= msgTs]
       XInfoProbe probe -> o ["probe" .= probe]
       XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
       XInfoProbeOk probe -> o ["probe" .= probe]