diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index e1fb516c7c..91dd1c7adb 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2630,7 +2630,7 @@ processChatCommand' vr = \case prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> CM (MsgContainer, Maybe (CIQuote 'CTDirect)) prepareMsg fInv_ timed_ = case (quotedItemId_, itemForwarded) of (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward Nothing (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) (Just quotedItemId, Nothing) -> do CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- withStore $ \db -> getDirectChatItem db user contactId quotedItemId @@ -2721,7 +2721,7 @@ data ChangedProfileContact = ChangedProfileContact prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup)) prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward Nothing (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) (Just quotedItemId, Nothing) -> do CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- withStore $ \db -> getGroupChatItem db user groupId quotedItemId diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 3da9c2b2ae..8d8150647e 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -1006,7 +1006,7 @@ data CIForwardedFrom cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom cmForwardedFrom = \case - ACME _ (XMsgNew (MCForward _)) -> Just CIFFUnknown + ACME _ (XMsgNew (MCForward _ _)) -> Just CIFFUnknown _ -> Nothing data CIForwardedFromTag diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index e262de0e74..17605582b5 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -418,6 +418,9 @@ cmToQuotedMsg = \case ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg _ -> Nothing +data ForwardedMsg = ForwardedMsg {} + deriving (Eq, Show) + data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCUnknown_ Text deriving (Eq) @@ -450,14 +453,14 @@ instance ToJSON MsgContentTag where data MsgContainer = MCSimple ExtMsgContent | MCQuote QuotedMsg ExtMsgContent - | MCForward ExtMsgContent + | MCForward (Maybe ForwardedMsg) ExtMsgContent deriving (Eq, Show) mcExtMsgContent :: MsgContainer -> ExtMsgContent mcExtMsgContent = \case MCSimple c -> c MCQuote _ c -> c - MCForward c -> c + MCForward _ c -> c isQuote :: MsgContainer -> Bool isQuote = \case @@ -528,6 +531,8 @@ msgContentTag = \case data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool} deriving (Eq, Show) +$(JQ.deriveJSON defaultJSON ''ForwardedMsg) + $(JQ.deriveJSON defaultJSON ''QuotedMsg) -- this limit reserves space for metadata in forwarded messages @@ -587,7 +592,9 @@ markCompressedBatch = B.cons 'X' parseMsgContainer :: J.Object -> JT.Parser MsgContainer parseMsgContainer v = MCQuote <$> v .: "quote" <*> mc - <|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc) + -- TODO v6.0 (?) deprecate bool encoding for forward + <|> (v .: "forward" >>= \f -> (if f then MCForward Nothing else MCSimple) <$> mc) + <|> (MCForward <$> v .: "forward" <*> mc) <|> MCSimple <$> mc where mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live" @@ -633,7 +640,8 @@ unknownMsgType = "unknown message type" msgContainerJSON :: MsgContainer -> J.Object msgContainerJSON = \case MCQuote qm mc -> o $ ("quote" .= qm) : msgContent mc - MCForward mc -> o $ ("forward" .= True) : msgContent mc + -- TODO v6.0 (?) encode ForwardedMsg object + MCForward _fm mc -> o $ ("forward" .= True) : msgContent mc MCSimple mc -> o $ msgContent mc where o = JM.fromList diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 18fb677be2..de00121f3d 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -154,13 +154,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True)))) it "x.msg.new forward" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}" - ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing)) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward Nothing (extMsgContent (MCText "hello") Nothing)) it "x.msg.new forward - timed message TTL" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}" - ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward Nothing (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) it "x.msg.new forward - live message" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"live\":true}}" - ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward Nothing (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) it "x.msg.new simple text with file" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) @@ -183,7 +183,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ) it "x.msg.new forward with file" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" - ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward Nothing (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) it "x.msg.update" $ "{\"v\":\"1\",\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing