diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index f37110b8f8..d2660c6203 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1281,7 +1281,7 @@ processChatCommand vr nm = \case Just smId -> void $ sendDirectContactMessage user ct $ XMsgUpdate smId mc M.empty Nothing Nothing Nothing Nothing Nothing -> do - (msg, _) <- sendDirectContactMessage user ct $ XMsgNew $ MCSimple $ extMsgContent mc Nothing + (msg, _) <- sendDirectContactMessage user ct $ XMsgNew $ mcSimple mc ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] APIRejectContact connReqId -> withUser $ \user -> do @@ -2026,7 +2026,7 @@ processChatCommand vr nm = \case -- create changed feature items (connecting incognito sends default preferences, instead of user preferences) lift . when incognito $ createContactChangedFeatureItems user ct ct' forM_ msgContent_ $ \mc -> do - let evt = XMsgNew $ MCSimple (extMsgContent mc Nothing) + let evt = XMsgNew $ mcSimple mc (msg, _) <- sendDirectContactMessage user ct' evt ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc) toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci] @@ -2374,7 +2374,7 @@ processChatCommand vr nm = \case Right conn | directOrUsed ct -> (ct, conn) : ctConns _ -> ctConns ctSndEvent :: (Contact, Connection) -> (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json) - ctSndEvent (_, Connection {connId}) = (ConnectionId connId, Nothing, XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ctSndEvent (_, Connection {connId}) = (ConnectionId connId, Nothing, XMsgNew $ mcSimple mc) ctMsgReq :: (Contact, Connection) -> SndMessage -> ChatMsgReq ctMsgReq (_, conn) SndMessage {msgId, msgBody} = (conn, MsgFlags {notification = hasNotification XMsgNew_}, (vrValue msgBody, [msgId])) combineResults :: (Contact, Connection) -> Either ChatError SndMessage -> Either ChatError ([Int64], PQEncryption) -> Either ChatError (Contact, SndMessage) @@ -2570,7 +2570,7 @@ processChatCommand vr nm = \case void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') msg when (maxVersion (memberChatVRange m) < groupKnockingVersion) $ forM_ (memberConn m) $ \mConn -> do - let msg2 = XMsgNew $ MCSimple $ extMsgContent (MCText acceptedToGroupMessage) Nothing + let msg2 = XMsgNew $ mcSimple (MCText acceptedToGroupMessage) void $ sendDirectMemberMessage mConn msg2 groupId when (memberCategory m == GCInviteeMember) $ do introduceToRemaining vr user gInfo m {memberRole = role} @@ -4134,9 +4134,9 @@ processChatCommand vr nm = \case prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))) prepareMsgs cmsFileInvs timed_ = withFastStore $ \db -> forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded, _, _), fInv_) -> do - case (quotedItemId, itemForwarded) of - (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live) Nothing Nothing), Nothing) - (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live) Nothing Nothing), Nothing) + (mc', quotedItem_) <- case (quotedItemId, itemForwarded) of + (Nothing, Nothing) -> pure (mcSimple mc, Nothing) + (Nothing, Just _) -> pure (mcForward mc, Nothing) (Just qiId, Nothing) -> do CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- getDirectChatItem db user contactId qiId @@ -4144,8 +4144,9 @@ processChatCommand vr nm = \case let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} qmc = quoteContent mc origQmc file quotedItem = CIQuote {chatDir = qd, itemId = Just qiId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} - pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live) Nothing Nothing), Just quotedItem) + pure (mcQuote QuotedMsg {msgRef, content = qmc} mc, Just quotedItem) (Just _, Just _) -> throwError SEInvalidQuote + pure (mc' {file = fInv_, ttl = ttl' <$> timed_, live = justTrue live}, quotedItem_) where quoteData :: ChatItem c d -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool) quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwError SEInvalidQuote diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 6f867ab0f1..871c6c512e 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -202,24 +202,22 @@ toggleNtf m ntfOn = withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchAllErrors` eToView prepareGroupMsg :: DB.Connection -> User -> GroupInfo -> Maybe MsgScope -> ShowGroupAsSender -> MsgContent -> Map MemberName MsgMention -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> ExceptT StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)) -prepareGroupMsg db user g@GroupInfo {membership} msgScope showGroupAsSender mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of - (Nothing, Nothing) -> - let mc' = MCSimple $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope (justTrue showGroupAsSender) - in pure (XMsgNew mc', Nothing) - (Nothing, Just _) -> - let mc' = MCForward $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope (justTrue showGroupAsSender) - in pure (XMsgNew mc', Nothing) - (Just quotedItemId, Nothing) -> do - CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, mentions = quoteMentions, file} <- - getGroupCIWithReactions db user g quotedItemId - (origQmc, qd, sent, member_) <- quoteData qci membership - let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = memberId' <$> member_} - qmc = quoteContent mc origQmc file - (qmc', ft', _) = updatedMentionNames qmc formattedText quoteMentions - quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc', formattedText = ft'} - mc' = MCQuote QuotedMsg {msgRef, content = qmc'} (ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope (justTrue showGroupAsSender)) - pure (XMsgNew mc', Just quotedItem) - (Just _, Just _) -> throwError SEInvalidQuote +prepareGroupMsg db user g@GroupInfo {membership} msgScope showGroupAsSender mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = do + (mc', quotedItem_) <- case (quotedItemId_, itemForwarded) of + (Nothing, Nothing) -> pure (mcSimple mc, Nothing) + (Nothing, Just _) -> pure (mcForward mc, Nothing) + (Just quotedItemId, Nothing) -> do + CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, mentions = quoteMentions, file} <- + getGroupCIWithReactions db user g quotedItemId + (origQmc, qd, sent, member_) <- quoteData qci membership + let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = memberId' <$> member_} + qmc = quoteContent mc origQmc file + (qmc', ft', _) = updatedMentionNames qmc formattedText quoteMentions + quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc', formattedText = ft'} + pure (mcQuote QuotedMsg {msgRef, content = qmc'} mc, Just quotedItem) + (Just _, Just _) -> throwError SEInvalidQuote + let mc'' = mc' {mentions = MsgMentions mentions, file = fInv_, ttl = ttl' <$> timed_, live = justTrue live, scope = msgScope, asGroup = justTrue showGroupAsSender} + pure (XMsgNew mc'', quotedItem_) where quoteData :: ChatItem c d -> GroupMember -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTGroup, Bool, Maybe GroupMember) quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwError SEInvalidQuote @@ -1062,7 +1060,7 @@ introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRol let msg = if maxVersion (memberChatVRange m) >= groupKnockingVersion then XGrpLinkAcpt GAPendingReview memberRole memberId - else XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing + else XMsgNew $ mcSimple (MCText pendingReviewMessage) void $ sendDirectMemberMessage mConn msg groupId modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo let rcpModMs = filter shouldIntroduceToMod modMs @@ -1200,7 +1198,7 @@ sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just c | useRelays' gInfo = Nothing | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do let GroupInfo {groupProfile = GroupProfile {description}} = gInfo - fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description + fmap (\descr -> XMsgNew $ mcSimple (MCText descr)) description | otherwise = Nothing itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json] itemForwardEvents cci = case cci of diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 15a6d6c8bd..e4146fd526 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -700,7 +700,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just UserContactRequest {welcomeSharedMsgId = Just smId} -> void $ sendDirectContactMessage user ct $ XMsgUpdate smId mc M.empty Nothing Nothing Nothing Nothing _ -> do - (msg, _) <- sendDirectContactMessage user ct $ XMsgNew $ MCSimple $ extMsgContent mc Nothing + (msg, _) <- sendDirectContactMessage user ct $ XMsgNew $ mcSimple mc ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] @@ -987,7 +987,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = checkSendAsGroup asGroup $ memberCanSend (Just m'') scope $ newGroupContentMessage gInfo' (Just m'') mc msg brokerTs False where - ExtMsgContent {scope, asGroup} = mcExtMsgContent mc + MsgContainer {scope, asGroup} = mc -- file description is always allowed, to allow sending files to support scope XMsgFileDescr sharedMsgId fileDescr -> groupMessageFileDescription gInfo' (Just m'') sharedMsgId fileDescr XMsgUpdate sharedMsgId mContent mentions ttl live msgScope asGroup_ -> @@ -1217,7 +1217,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just UserContactRequest {welcomeSharedMsgId = Just smId} -> void $ sendGroupMessage' user gInfo [m] $ XMsgUpdate smId mc M.empty Nothing Nothing Nothing Nothing _ -> do - msg <- sendGroupMessage' user gInfo [m] $ XMsgNew $ MCSimple $ extMsgContent mc Nothing + msg <- sendGroupMessage' user gInfo [m] $ XMsgNew $ mcSimple mc ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndMsgContent mc) withStore' $ \db -> createGroupSndStatus db (chatItemId' ci) (groupMemberId' m) GSSNew toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo Nothing) ci] @@ -1726,7 +1726,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM () newContentMessage ct mc msg@RcvMessage {sharedMsgId_} msgMeta = do - let ExtMsgContent content _ fInv_ _ _ _ _ = mcExtMsgContent mc + let MsgContainer {content, file = fInv_} = mc -- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete -- case content of -- MCText "hello 111" -> @@ -1737,7 +1737,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = then do void $ newChatItem (ciContentNoParse $ CIRcvChatFeatureRejected CFVoice) Nothing Nothing False else do - let ExtMsgContent _ _ _ itemTTL live_ _ _ = mcExtMsgContent mc + let MsgContainer {ttl = itemTTL, live = live_} = mc timed_ = rcvContactCITimed ct itemTTL live = fromMaybe False live_ file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct @@ -1979,7 +1979,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = rejected gInfo' m' scopeInfo f = newChatItem gInfo' m' scopeInfo (ciContentNoParse $ CIRcvGroupFeatureRejected f) Nothing Nothing False timed_ gInfo' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo' itemTTL live' = fromMaybe False live_ - ExtMsgContent content mentions fInv_ itemTTL live_ msgScope_ asGroup_ = mcExtMsgContent mc + MsgContainer {content, mentions = MsgMentions mentions, file = fInv_, ttl = itemTTL, live = live_, scope = msgScope_, asGroup = asGroup_} = mc sentAsGroup = asGroup_ == Just True ts@(_, ft_) = msgContentTexts content -- m' is Maybe GroupMember @@ -2021,7 +2021,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let fileMember_ = if sentAsGroup then Nothing else m' in processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId gInfo' fileMember_ newChatItem gInfo' m' scopeInfo ciContent ciFile_ timed live = do - let mentions' = if maybe False memberBlocked m' then [] else mentions + let mentions' = if maybe False memberBlocked m' then M.empty else mentions (ci, cInfo) <- saveRcvCI gInfo' m' scopeInfo ciContent ciFile_ timed live mentions' ci' <- maybe (pure ci) (\m -> blockedMemberCI gInfo' m ci) m' let memberId_ = memberId' <$> m' @@ -3290,7 +3290,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XMsgNew mc -> void $ memberCanSend author_ scope $ newGroupContentMessage gInfo author_ mc rcvMsg msgTs True where - ExtMsgContent {scope} = mcExtMsgContent mc + MsgContainer {scope} = mc -- file description is always allowed, to allow sending files to support scope XMsgFileDescr sharedMsgId fileDescr -> void $ groupMessageFileDescription gInfo author_ sharedMsgId fileDescr XMsgUpdate sharedMsgId mContent mentions ttl live msgScope asGroup_ -> diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index e404388d8d..d90429f58e 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -1308,11 +1308,6 @@ data CIForwardedFrom | CIFFGroup {chatName :: Text, msgDir :: MsgDirection, groupId :: Maybe GroupId, chatItemId :: Maybe ChatItemId} deriving (Show) -cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom -cmForwardedFrom = \case - ACME _ (XMsgNew (MCForward _)) -> Just CIFFUnknown - _ -> Nothing - data CIForwardedFromTag = CIFFUnknown_ | CIFFContact_ diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 3485849741..db77a2f7b4 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -477,8 +477,8 @@ deriving instance Show AChatMsgEvent -- actual filtering on forwarding is done in processEvent isForwardedGroupMsg :: ChatMsgEvent e -> Bool isForwardedGroupMsg ev = case ev of - XMsgNew mc -> case mcExtMsgContent mc of - ExtMsgContent {file = Just FileInvitation {fileInline = Just _}} -> False + XMsgNew mc -> case mc of + MsgContainer {file = Just FileInvitation {fileInline = Just _}} -> False _ -> True XMsgFileDescr _ _ -> True XMsgUpdate {} -> True @@ -582,7 +582,7 @@ data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent} cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg cmToQuotedMsg = \case - ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg + ACME _ (XMsgNew MsgContainer {quote = Just quotedMsg}) -> Just quotedMsg _ -> Nothing data MsgContentTag @@ -631,24 +631,51 @@ instance FromField MsgContentTag where fromField = fromTextField_ $ eitherToMayb instance ToField MsgContentTag where toField = toField . safeDecodeUtf8 . strEncode -data MsgContainer - = MCSimple ExtMsgContent - | MCQuote QuotedMsg ExtMsgContent - | MCComment MsgRef ExtMsgContent - | MCForward ExtMsgContent +-- Wire JSON 1:1 with parsed form. The three discriminator fields `quote`, `parent`, +-- and `forward` are independent and may co-occur (e.g. a comment that quotes another +-- comment carries both `parent` and `quote`). `forward` is `Maybe Bool` for backwards +-- compatibility with the previous wire encoding: the serializer omits the field when +-- `Nothing` and the parser treats absent/false as "not a forward". +data MsgContainer = MsgContainer + { content :: MsgContent, + -- the key used in mentions is a locally (per message) unique display name of member. + -- Suffixes _1, _2 should be appended to make names locally unique. + -- It should be done in the UI, as they will be part of the text, and validated in the API. + mentions :: MsgMentions, + file :: Maybe FileInvitation, + ttl :: Maybe Int, + live :: Maybe Bool, + scope :: Maybe MsgScope, + asGroup :: Maybe Bool, + quote :: Maybe QuotedMsg, + parent :: Maybe MsgRef, + forward :: Maybe Bool + } deriving (Eq, Show) -mcExtMsgContent :: MsgContainer -> ExtMsgContent -mcExtMsgContent = \case - MCSimple c -> c - MCQuote _ c -> c - MCComment _ c -> c - MCForward c -> c +mcSimple :: MsgContent -> MsgContainer +mcSimple content = + MsgContainer + { content, + mentions = MsgMentions M.empty, + file = Nothing, + ttl = Nothing, + live = Nothing, + scope = Nothing, + asGroup = Nothing, + quote = Nothing, + parent = Nothing, + forward = Nothing + } -isMCForward :: MsgContainer -> Bool -isMCForward = \case - MCForward _ -> True - _ -> False +mcQuote :: QuotedMsg -> MsgContent -> MsgContainer +mcQuote q c = (mcSimple c) {quote = Just q} + +mcComment :: MsgRef -> MsgContent -> MsgContainer +mcComment p c = (mcSimple c) {parent = Just p} + +mcForward :: MsgContent -> MsgContainer +mcForward c = (mcSimple c) {forward = Just True} data MsgContent = MCText {text :: Text} @@ -722,29 +749,94 @@ msgContentTag = \case MCChat {} -> MCChat_ MCUnknown {tag} -> MCUnknown_ tag -data ExtMsgContent = ExtMsgContent - { content :: MsgContent, - -- the key used in mentions is a locally (per message) unique display name of member. - -- Suffixes _1, _2 should be appended to make names locally unique. - -- It should be done in the UI, as they will be part of the text, and validated in the API. - mentions :: Map MemberName MsgMention, - file :: Maybe FileInvitation, - ttl :: Maybe Int, - live :: Maybe Bool, - scope :: Maybe MsgScope, - asGroup :: Maybe Bool - } +data MsgMention = MsgMention {memberId :: MemberId} deriving (Eq, Show) -data MsgMention = MsgMention {memberId :: MemberId} +newtype MsgMentions = MsgMentions (Map MemberName MsgMention) deriving (Eq, Show) $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink) $(JQ.deriveJSON defaultJSON ''MsgMention) +instance FromJSON MsgMentions where + parseJSON v = MsgMentions <$> parseJSON v + omittedField = Just $ MsgMentions M.empty + +instance ToJSON MsgMentions where + toJSON (MsgMentions m) = toJSON $ toMaybeMap m + toEncoding (MsgMentions m) = toEncoding $ toMaybeMap m + omitField (MsgMentions m) = M.null m + +toMaybeMap :: Map k v -> Maybe (Map k v) +toMaybeMap m = if M.null m then Nothing else Just m +{-# INLINE toMaybeMap #-} + $(JQ.deriveJSON defaultJSON ''QuotedMsg) +instance FromJSON MsgContent where + parseJSON (J.Object v) = + v .: "type" >>= \case + MCText_ -> MCText <$> v .: "text" + MCLink_ -> do + text <- v .: "text" + preview <- v .: "preview" + pure MCLink {text, preview} + MCImage_ -> do + text <- v .: "text" + image <- v .: "image" + pure MCImage {text, image} + MCVideo_ -> do + text <- v .: "text" + image <- v .: "image" + duration <- v .: "duration" + pure MCVideo {text, image, duration} + MCVoice_ -> do + text <- v .: "text" + duration <- v .: "duration" + pure MCVoice {text, duration} + MCFile_ -> MCFile <$> v .: "text" + MCReport_ -> do + text <- v .: "text" + reason <- v .: "reason" + pure MCReport {text, reason} + MCChat_ -> do + text <- v .: "text" + chatLink <- v .: "chatLink" + pure MCChat {text, chatLink} + MCUnknown_ tag -> do + text <- fromMaybe unknownMsgType <$> v .:? "text" + pure MCUnknown {tag, text, json = v} + parseJSON invalid = + JT.prependFailure "bad MsgContent, " (JT.typeMismatch "Object" invalid) + +unknownMsgType :: Text +unknownMsgType = "unknown message type" + +instance ToJSON MsgContent where + toJSON = \case + MCUnknown {json} -> J.Object json + MCText t -> J.object ["type" .= MCText_, "text" .= t] + MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview] + MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image] + MCVideo {text, image, duration} -> J.object ["type" .= MCVideo_, "text" .= text, "image" .= image, "duration" .= duration] + MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration] + MCFile t -> J.object ["type" .= MCFile_, "text" .= t] + MCReport {text, reason} -> J.object ["type" .= MCReport_, "text" .= text, "reason" .= reason] + MCChat {text, chatLink} -> J.object ["type" .= MCChat_, "text" .= text, "chatLink" .= chatLink] + toEncoding = \case + MCUnknown {json} -> JE.value $ J.Object json + MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t + MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview + MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image + MCVideo {text, image, duration} -> J.pairs $ "type" .= MCVideo_ <> "text" .= text <> "image" .= image <> "duration" .= duration + MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration + MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t + MCReport {text, reason} -> J.pairs $ "type" .= MCReport_ <> "text" .= text <> "reason" .= reason + MCChat {text, chatLink} -> J.pairs $ "type" .= MCChat_ <> "text" .= text <> "chatLink" .= chatLink + +$(JQ.deriveJSON defaultJSON ''MsgContainer) + -- this limit reserves space for metadata in forwarded messages -- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, - 16 for block encryption ("rounded" to 15602) maxEncodedMsgLength :: Int @@ -835,109 +927,14 @@ markCompressedBatch :: ByteString -> ByteString markCompressedBatch = B.cons 'X' {-# INLINE markCompressedBatch #-} -parseMsgContainer :: J.Object -> JT.Parser MsgContainer -parseMsgContainer v = - MCQuote <$> v .: "quote" <*> mc - <|> MCComment <$> v .: "parent" <*> mc - <|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc) - -- The support for arbitrary object in "forward" property is added to allow - -- forward compatibility with forwards that include public group links. - <|> (MCForward <$> ((v .: "forward" :: JT.Parser J.Object) *> mc)) - <|> MCSimple <$> mc - where - mc = do - content <- v .: "content" - file <- v .:? "file" - ttl <- v .:? "ttl" - live <- v .:? "live" - mentions <- fromMaybe M.empty <$> (v .:? "mentions") - scope <- v .:? "scope" - asGroup <- v .:? "asGroup" - pure ExtMsgContent {content, mentions, file, ttl, live, scope, asGroup} - -extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent -extMsgContent mc file = ExtMsgContent mc M.empty file Nothing Nothing Nothing Nothing - justTrue :: Bool -> Maybe Bool justTrue True = Just True justTrue False = Nothing -instance FromJSON MsgContent where - parseJSON (J.Object v) = - v .: "type" >>= \case - MCText_ -> MCText <$> v .: "text" - MCLink_ -> do - text <- v .: "text" - preview <- v .: "preview" - pure MCLink {text, preview} - MCImage_ -> do - text <- v .: "text" - image <- v .: "image" - pure MCImage {text, image} - MCVideo_ -> do - text <- v .: "text" - image <- v .: "image" - duration <- v .: "duration" - pure MCVideo {text, image, duration} - MCVoice_ -> do - text <- v .: "text" - duration <- v .: "duration" - pure MCVoice {text, duration} - MCFile_ -> MCFile <$> v .: "text" - MCReport_ -> do - text <- v .: "text" - reason <- v .: "reason" - pure MCReport {text, reason} - MCChat_ -> do - text <- v .: "text" - chatLink <- v .: "chatLink" - pure MCChat {text, chatLink} - MCUnknown_ tag -> do - text <- fromMaybe unknownMsgType <$> v .:? "text" - pure MCUnknown {tag, text, json = v} - parseJSON invalid = - JT.prependFailure "bad MsgContent, " (JT.typeMismatch "Object" invalid) - -unknownMsgType :: Text -unknownMsgType = "unknown message type" - -msgContainerJSON :: MsgContainer -> J.Object -msgContainerJSON = \case - MCQuote qm mc -> o $ ("quote" .= qm) : msgContent mc - MCComment ref mc -> o $ ("parent" .= ref) : msgContent mc - MCForward mc -> o $ ("forward" .= True) : msgContent mc - MCSimple mc -> o $ msgContent mc - where - o = JM.fromList - msgContent ExtMsgContent {content, mentions, file, ttl, live, scope, asGroup} = - ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("mentions" .=? nonEmptyMap mentions) $ ("scope" .=? scope) $ ("asGroup" .=? asGroup) ["content" .= content] - nonEmptyMap :: Map k v -> Maybe (Map k v) nonEmptyMap m = if M.null m then Nothing else Just m {-# INLINE nonEmptyMap #-} -instance ToJSON MsgContent where - toJSON = \case - MCUnknown {json} -> J.Object json - MCText t -> J.object ["type" .= MCText_, "text" .= t] - MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview] - MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image] - MCVideo {text, image, duration} -> J.object ["type" .= MCVideo_, "text" .= text, "image" .= image, "duration" .= duration] - MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration] - MCFile t -> J.object ["type" .= MCFile_, "text" .= t] - MCReport {text, reason} -> J.object ["type" .= MCReport_, "text" .= text, "reason" .= reason] - MCChat {text, chatLink} -> J.object ["type" .= MCChat_, "text" .= text, "chatLink" .= chatLink] - toEncoding = \case - MCUnknown {json} -> JE.value $ J.Object json - MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t - MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview - MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image - MCVideo {text, image, duration} -> J.pairs $ "type" .= MCVideo_ <> "text" .= text <> "image" .= image <> "duration" .= duration - MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration - MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t - MCReport {text, reason} -> J.pairs $ "type" .= MCReport_ <> "text" .= text <> "reason" .= reason - MCChat {text, chatLink} -> J.pairs $ "type" .= MCChat_ <> "text" .= text <> "chatLink" .= chatLink - instance ToField MsgContent where toField = toField . encodeJSON @@ -1254,7 +1251,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do opt key = JT.parseEither (.:? key) params msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json) msg = \case - XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params + XMsgNew_ -> XMsgNew <$> JT.parseEither parseJSON (J.Object params) XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr" XMsgUpdate_ -> do msgId' <- p "msgId" @@ -1340,7 +1337,9 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en o = JM.fromList params :: ChatMsgEvent 'Json -> J.Object params = \case - XMsgNew container -> msgContainerJSON container + XMsgNew mc -> case toJSON mc of + J.Object obj -> obj + _ -> JM.empty XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr] XMsgUpdate {msgId = msgId', content, mentions, ttl, live, scope, asGroup} -> o $ ("asGroup" .=? asGroup) $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("scope" .=? scope) $ ("mentions" .=? nonEmptyMap mentions) ["msgId" .= msgId', "content" .= content] XMsgDel msgId' memberId scope -> o $ ("memberId" .=? memberId) $ ("scope" .=? scope) ["msgId" .= msgId'] diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index a2c91af86b..eb265ffa2d 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -558,7 +558,9 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, msgS quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg pure (ciId, quotedItem, itemForwarded) where - itemForwarded = cmForwardedFrom chatMsgEvent + itemForwarded = case chatMsgEvent of + ACME _ (XMsgNew MsgContainer {forward}) | forward == Just True -> Just CIFFUnknown + _ -> Nothing quotedMsg = cmToQuotedMsg chatMsgEvent quoteRow :: NewQuoteRow quoteRow = case quotedMsg of diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 6d9ee54e6c..3ba789b988 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -113,84 +113,79 @@ decodeChatMessageTest :: Spec decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new simple text" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)) + #==# XMsgNew (mcSimple (MCText "hello")) it "x.msg.new simple text - timed message TTL" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}" - #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") [] Nothing (Just 3600) Nothing Nothing Nothing)) + #==# XMsgNew ((mcSimple (MCText "hello")) {ttl = Just 3600}) it "x.msg.new simple text - live message" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"live\":true}}" - #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") [] Nothing Nothing (Just True) Nothing Nothing)) + #==# XMsgNew ((mcSimple (MCText "hello")) {live = Just True}) it "x.msg.new simple link" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA", content = Nothing}) Nothing)) + #==# XMsgNew (mcSimple (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA", content = Nothing})) it "x.msg.new simple image" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) + #==# XMsgNew (mcSimple (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=")) it "x.msg.new simple image with text" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) + #==# XMsgNew (mcSimple (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=")) it "x.msg.new chat message" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new chat message with chat version range" $ "{\"v\":\"1-17\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) + ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello"))) it "x.msg.new quote" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") - (XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing))) + (XMsgNew (mcQuote quotedMsg (MCText "hello to you too"))) it "x.msg.new quote - timed message TTL" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"ttl\":3600}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") - (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") [] Nothing (Just 3600) Nothing Nothing Nothing))) + (XMsgNew ((mcQuote quotedMsg (MCText "hello to you too")) {ttl = Just 3600})) it "x.msg.new quote - live message" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"live\":true}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") - (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") [] Nothing Nothing (Just True) Nothing Nothing))) + (XMsgNew ((mcQuote quotedMsg (MCText "hello to you too")) {live = 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 (MCText "hello")) 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 Nothing Nothing)) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ (mcForward (MCText "hello")) {ttl = Just 3600}) 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) Nothing Nothing)) + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ (mcForward (MCText "hello")) {live = 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}))) + #==# XMsgNew ((mcSimple (MCText "hello")) {file = Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}}) it "x.msg.new simple file with file" $ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) + #==# XMsgNew ((mcSimple (MCFile "")) {file = Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}}) it "x.msg.new quote with file" $ - "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") ( XMsgNew - ( MCQuote - quotedMsg - ( extMsgContent - (MCText "hello to you too") - (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}) - ) - ) + (mcQuote quotedMsg (MCText "hello to you too")) + {file = Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}} ) it "x.msg.new report" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"reason\":\"spam\",\"type\":\"report\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") - (XMsgNew (MCQuote quotedMsg (extMsgContent (MCReport "" RRSpam) Nothing))) + (XMsgNew (mcQuote quotedMsg (MCReport "" RRSpam))) 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}))) + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"},\"forward\":true}}" + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ (mcForward (MCText "hello")) {file = 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 Nothing Nothing @@ -300,7 +295,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do -- $ "{\"v\":\"1\",\"event\":\"x.grp.msg.forward\",\"params\":{\"msgForward\":{\"memberId\":\"AQIDBA==\",\"msg\":\"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}\",\"msgTs\":\"1970-01-01T00:00:01.000000001Z\"}}}" -- #==# XGrpMsgForward -- (MemberId "\1\2\3\4") - -- (ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))) + -- (ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (mcSimple (MCText "hello")))) -- (systemToUTCTime $ MkSystemTime 1 1) it "x.info.probe" $ "{\"v\":\"1\",\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}"