core: message reactions (#2429)

* core: message reactions

* remove comments

* core: commands to set reactions

* fix tests

* process reaction messages

* store functions

* include reactions on item updates

* remove print

* view, tests

* load reactions for new items

* test removing reaction

* remove spaces

* limit the number of different reactions on one item

* remove unique constraints

* fix permissions

* indexes

* check chat item content before adding reaction

* fix group reactions

* simpler index

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

src/Simplex/Chat/View.hs

@@ -61,7 +61,7 @@ serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -
 serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz
 
 responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString]
-responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
+responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts tz = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
@@ -83,14 +83,17 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
   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
-  CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
+  CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts <> viewItemReactions item
+  CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts <> 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 _ -> ttyUser u []
   CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
   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 testView
+  CRChatItemReaction u (ACIReaction _ _ chat reaction) added
+    | showReactions -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction chat reaction added ts tz
+    | otherwise -> []
   CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
   CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t
   CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
@@ -141,7 +144,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
   CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
   CRRcvFileDescrReady _ _ -> []
   CRRcvFileDescrNotReady _ _ -> []
-  CRRcvFileProgressXFTP _ _ _ _ -> []
+  CRRcvFileProgressXFTP {} -> []
   CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
   CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
   CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
@@ -299,8 +302,12 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
     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 s
-      | muted chat chatItem = []
+    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
 
 chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text
@@ -330,8 +337,8 @@ viewUsersList = mapMaybe userInfo . sortOn ldn
             <> ["muted" | not showNtfs]
             <> [plain ("unread: " <> show count) | count /= 0]
 
-muted :: ChatInfo c -> ChatItem c d -> Bool
-muted chat ChatItem {chatDir} = case (chat, chatDir) of
+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
@@ -504,6 +511,38 @@ viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} toItem by
       Just (AChatItem _ _ _ ci) -> chatItemDeletedText ci $ chatInfoMembership chat
     prohibited = [styled (colored Red) ("[unexpected message deletion, please report to developers]" :: String)]
 
+viewItemReaction :: forall c d. ChatInfo c -> CIReaction c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
+viewItemReaction chat CIReaction {chatDir, chatItem = CChatItem md ChatItem {chatDir = itemDir, content}, sentAt, reaction} added ts tz =
+  case (chat, chatDir) of
+    (DirectChat c, CIDirectRcv) -> case content of
+      CIRcvMsgContent mc -> view from $ reactionMsg mc
+      CISndMsgContent mc -> view from $ reactionMsg mc
+      _ -> []
+      where
+        from = ttyFromContact c
+        reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">"
+    (GroupChat g, CIGroupRcv m) -> case content of
+      CIRcvMsgContent mc -> view from $ reactionMsg mc
+      CISndMsgContent mc -> view from $ reactionMsg mc
+      _ -> []
+      where
+        from = ttyFromGroup g m
+        reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir
+    (_, CIDirectSnd) -> [sentText]
+    (_, CIGroupSnd) -> [sentText]
+  where
+    view from msg = viewReceivedReaction from msg reactionText ts $ utcToZonedTime tz sentAt
+    reactionText = plain $ (if added then "+ " else "- ") <> [emoji]
+    MREmoji (MREmojiChar emoji) = reaction
+    sentText = plain $ (if added then "added " else "removed ") <> [emoji]
+
+viewItemReactions :: ChatItem c d -> [StyledString]
+viewItemReactions ChatItem {reactions} = ["      " <> viewReactions reactions | not (null reactions)]
+  where
+    viewReactions = mconcat . intersperse " " . map viewReaction
+    viewReaction CIReactionCount {reaction = MREmoji (MREmojiChar emoji), userReacted, totalReacted} =
+      plain [emoji, ' '] <> (if userReacted then styled Italic else plain) (show totalReacted)
+
 directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString]
 directQuote _ CIQuote {content = qmc, chatDir = quoteDir} =
   quoteText qmc $ if toMsgDirection (msgDirection @d') == quoteMsgDirection quoteDir then ">>" else ">"
@@ -516,6 +555,11 @@ sentByMember GroupInfo {membership} = \case
   CIQGroupSnd -> Just membership
   CIQGroupRcv m -> m
 
+sentByMember' :: GroupInfo -> CIDirection 'CTGroup d -> GroupMember
+sentByMember' GroupInfo {membership} = \case
+  CIGroupSnd -> membership
+  CIGroupRcv m -> m
+
 quoteText :: MsgContent -> StyledString -> [StyledString]
 quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc
 
@@ -1037,6 +1081,10 @@ viewReceivedUpdatedMessage = viewReceivedMessage_ True
 viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString]
 viewReceivedMessage_ updated from quote mc ts meta = receivedWithTime_ ts from quote meta (ttyMsgContent mc) updated
 
+viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> ZonedTime -> [StyledString]
+viewReceivedReaction from styledMsg reactionText ts reactionTs =
+  prependFirst (ttyMsgTime ts reactionTs <> " " <> from) (styledMsg <> ["    " <> reactionText])
+
 receivedWithTime_ :: CurrentTime -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
 receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDeleted, itemLive} styledMsg updated = do
   prependFirst (ttyMsgTime ts localItemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)