diff --git a/docs/rfcs/2022-05-28-chat-item-integrity.md b/docs/rfcs/2022-05-28-chat-item-integrity.md new file mode 100644 index 0000000000..ad009d1f78 --- /dev/null +++ b/docs/rfcs/2022-05-28-chat-item-integrity.md @@ -0,0 +1,17 @@ +# Chat item integrity + +## Problem + +SMP agent reports skipped, duplicate, incorrect IDs and bad message hashes, and this event is also shown to the terminal users. + +This is not shown to mobile app users at the moment, as there is nothing in the data model to persist this information. + +While message hash violations have never happened so far, skipped messages happen every time we restart the server, until we introduce server redundancy. + +It would be helpful to the users to know when they have skipped messages rather than to check with all their contacts if they do. + +## Solution + +The proposed types/data model differentiates the integrity errors that are related to a particular item (they are saved to item meta-data, and should be shown as item status in the UI) and the errors that indicate skipped messages (these are created as separate chat items, and should be shown in the UI as a separate chat item). + +This [PR #705](https://github.com/simplex-chat/simplex-chat/pull/705) only implements chat item for skipped messages, for the remaining message integrity errors it still uses the event CRMsgIntegrityError that is only displayed in the terminal. diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 377d27552c..e91a4c4180 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1467,7 +1467,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m () newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc ciFile_ <- processFileInvitation fileInvitation_ $ \fi chSize -> withStore $ \st -> createRcvFileTransfer st userId ct fi chSize @@ -1487,7 +1487,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m () messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta updateRcvChatItem `catchError` \e -> case e of (ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do @@ -1508,7 +1508,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m () messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta deleteRcvChatItem `catchError` \e -> case e of (ChatErrorStore (SEChatItemSharedMsgIdNotFound sMsgId)) -> toView $ CRChatItemDeletedNotFound ct sMsgId @@ -1528,7 +1528,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage ciFile_ <- processFileInvitation fileInvitation_ $ \fi chSize -> withStore $ \st -> createRcvGroupFileTransfer st userId m fi chSize ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) ciFile_ - groupMsgToView gInfo ci msgMeta + groupMsgToView gInfo m ci msgMeta let g = groupName' gInfo showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText setActive $ ActiveG g @@ -1560,8 +1560,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage -- TODO remove once XFile is discontinued processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError - -- TODO chunk size has to be sent as part of invitation + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta chSize <- asks $ fileChunkSize . config RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} @@ -1577,14 +1576,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile - groupMsgToView gInfo ci msgMeta + groupMsgToView gInfo m ci msgMeta let g = groupName' gInfo showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file" setActive $ ActiveG g xFileCancel :: Contact -> SharedMsgId -> MsgMeta -> m () - xFileCancel Contact {contactId} sharedMsgId msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + xFileCancel ct@Contact {contactId} sharedMsgId msgMeta = do + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta fileId <- withStore $ \st -> getFileIdBySharedMsgId st userId contactId sharedMsgId ft@RcvFileTransfer {cancelled} <- withStore (\st -> getRcvFileTransfer st user fileId) unless cancelled $ do @@ -1592,8 +1591,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage toView $ CRRcvFileSndCancelled ft xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m () - xFileCancelGroup GroupInfo {groupId} GroupMember {memberId} sharedMsgId msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {memberId} sharedMsgId msgMeta = do + checkIntegrityCreateItem (CDGroupRcv g mem) msgMeta fileId <- withStore $ \st -> getGroupFileIdBySharedMsgId st userId groupId sharedMsgId CChatItem msgDir ChatItem {chatDir} <- withStore $ \st -> getGroupChatItemBySharedMsgId st user groupId sharedMsgId case (msgDir, chatDir) of @@ -1608,8 +1607,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> ConnReqInvitation -> String -> MsgMeta -> m () - xFileAcptInvGroup GroupInfo {groupId} m sharedMsgId fileConnReq fName msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + xFileAcptInvGroup g@GroupInfo {groupId} m sharedMsgId fileConnReq fName msgMeta = do + checkIntegrityCreateItem (CDGroupRcv g m) msgMeta fileId <- withStore $ \st -> getGroupFileIdBySharedMsgId st userId groupId sharedMsgId (FileTransferMeta {fileName, cancelled}, _) <- withStore (\st -> getSndFileTransfer st user fileId) unless cancelled $ @@ -1621,9 +1620,9 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage Left e -> throwError e else messageError "x.file.acpt.inv: fileName is different from expected" - groupMsgToView :: GroupInfo -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m () - groupMsgToView gInfo ci msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + groupMsgToView :: GroupInfo -> GroupMember -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m () + groupMsgToView gInfo m ci msgMeta = do + checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci processGroupInvitation :: Contact -> GroupInvitation -> m () @@ -1634,10 +1633,19 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage toView $ CRReceivedGroupInvitation gInfo ct memRole showToast ("#" <> gName <> " " <> c <> "> ") "invited you to join the group" - checkIntegrity :: MsgMeta -> (MsgErrorType -> m ()) -> m () - checkIntegrity MsgMeta {integrity} action = case integrity of - MsgError e -> action e + checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m () + checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of MsgOk -> pure () + MsgError e -> case e of + MsgSkipped {} -> createIntegrityErrorItem e + _ -> toView $ CRMsgIntegrityError e + where + createIntegrityErrorItem e = do + createdAt <- liftIO getCurrentTime + let content = CIRcvIntegrityError e + ciId <- withStore $ \st -> createNewChatItemNoMsg st user cd content brokerTs createdAt + ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing brokerTs createdAt + toView $ CRNewChatItem $ AChatItem (chatTypeI @c) SMDRcv (toChatInfo cd) ci xInfo :: Contact -> Profile -> m () xInfo c@Contact {profile = p} p' = unless (p == p') $ do @@ -1668,7 +1676,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage -- to party accepting call xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> m () xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey} msg msgMeta = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta dhKeyPair <- if encryptedCall callType then Just <$> liftIO C.generateKeyPair' else pure Nothing ci <- saveCallItem CISCallPending let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair)) @@ -1741,7 +1749,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage msgCurrentCall :: Contact -> CallId -> Text -> RcvMessage -> MsgMeta -> (Call -> m (Maybe Call, Maybe ACIContent)) -> m () msgCurrentCall ct@Contact {contactId = ctId'} callId' eventName RcvMessage {msgId} msgMeta action = do - checkIntegrity msgMeta $ toView . CRMsgIntegrityError + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta calls <- asks currentCalls atomically (TM.lookup ctId' calls) >>= \case Nothing -> messageError $ eventName <> ": no current call" diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index b3bf5c53e9..9abaa4cdda 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -189,7 +189,7 @@ data ChatResponse | CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: AChatItem} | CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId} | CRBroadcastSent MsgContent Int ZonedTime - | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile + | CRMsgIntegrityError {msgError :: MsgErrorType} | CRCmdAccepted {corr :: CorrId} | CRCmdOk | CRChatHelp {helpSection :: HelpSection} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 258873c39c..48c1cb337a 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -33,7 +33,7 @@ import Simplex.Chat.Markdown import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8) -import Simplex.Messaging.Agent.Protocol (AgentErrorType, AgentMsgId, MsgMeta (..)) +import Simplex.Messaging.Agent.Protocol (AgentErrorType, AgentMsgId, MsgErrorType (..), MsgMeta (..)) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, singleFieldJSON, sumTypeJSON) import Simplex.Messaging.Protocol (MsgBody) @@ -171,6 +171,13 @@ toCIDirection = \case CDGroupSnd _ -> CIGroupSnd CDGroupRcv _ m -> CIGroupRcv m +toChatInfo :: ChatDirection c d -> ChatInfo c +toChatInfo = \case + CDDirectSnd c -> DirectChat c + CDDirectRcv c -> DirectChat c + CDGroupSnd g -> GroupChat g + CDGroupRcv g _ -> GroupChat g + data NewChatItem d = NewChatItem { createdByMsgId :: Maybe MessageId, itemSent :: SMsgDirection d, @@ -240,6 +247,7 @@ instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where toJSON = J.genericToJSON J.defaultOptions toEncoding = J.genericToEncoding J.defaultOptions +-- This type is not saved to DB, so all JSON encodings are platform-specific data CIMeta (d :: MsgDirection) = CIMeta { itemId :: ChatItemId, itemTs :: ChatItemTs, @@ -435,7 +443,7 @@ instance StrEncoding ACIStatus where "snd_new" -> pure $ ACIStatus SMDSnd CISSndNew "snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent "snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth - "snd_error" -> ACIStatus SMDSnd <$> (A.space *> strP) + "snd_error" -> ACIStatus SMDSnd . CISSndError <$> (A.space *> strP) "rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew "rcv_read" -> pure $ ACIStatus SMDRcv CISRcvRead _ -> fail "bad status" @@ -487,6 +495,7 @@ ciDeleteModeToText = \case CIDMBroadcast -> "this item is deleted (broadcast)" CIDMInternal -> "this item is deleted (internal)" +-- 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 CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv @@ -494,6 +503,7 @@ data CIContent (d :: MsgDirection) where CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv + CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv deriving instance Show (CIContent d) @@ -505,6 +515,16 @@ ciContentToText = \case CIRcvDeleted cidm -> ciDeleteModeToText cidm CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration + CIRcvIntegrityError err -> msgIntegrityError err + +msgIntegrityError :: MsgErrorType -> Text +msgIntegrityError = \case + MsgSkipped fromId toId + | fromId == toId -> "1 skipped message" + | otherwise -> T.pack (show $ toId - fromId + 1) <> " skipped messages" + MsgBadId msgId -> "unexpected message ID " <> T.pack (show msgId) + MsgBadHash -> "incorrect message hash" + MsgDuplicate -> "duplicate message ID" msgDirToDeletedContent_ :: SMsgDirection d -> CIDeleteMode -> CIContent d msgDirToDeletedContent_ msgDir mode = case msgDir of @@ -539,6 +559,7 @@ data JSONCIContent | JCIRcvDeleted {deleteMode :: CIDeleteMode} | JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds | JCIRcvCall {status :: CICallStatus, duration :: Int} + | JCIRcvIntegrityError {msgError :: MsgErrorType} deriving (Generic) instance FromJSON JSONCIContent where @@ -556,6 +577,7 @@ jsonCIContent = \case CIRcvDeleted cidm -> JCIRcvDeleted cidm CISndCall status duration -> JCISndCall {status, duration} CIRcvCall status duration -> JCIRcvCall {status, duration} + CIRcvIntegrityError err -> JCIRcvIntegrityError err aciContentJSON :: JSONCIContent -> ACIContent aciContentJSON = \case @@ -565,6 +587,7 @@ aciContentJSON = \case JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration + JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err -- platform independent data DBJSONCIContent @@ -574,6 +597,7 @@ data DBJSONCIContent | DBJCIRcvDeleted {deleteMode :: CIDeleteMode} | DBJCISndCall {status :: CICallStatus, duration :: Int} | DBJCIRcvCall {status :: CICallStatus, duration :: Int} + | DBJCIRcvIntegrityError {msgError :: MsgErrorType} deriving (Generic) instance FromJSON DBJSONCIContent where @@ -591,6 +615,7 @@ dbJsonCIContent = \case CIRcvDeleted cidm -> DBJCIRcvDeleted cidm CISndCall status duration -> DBJCISndCall {status, duration} CIRcvCall status duration -> DBJCIRcvCall {status, duration} + CIRcvIntegrityError err -> DBJCIRcvIntegrityError err aciContentDBJSON :: DBJSONCIContent -> ACIContent aciContentDBJSON = \case @@ -600,6 +625,7 @@ aciContentDBJSON = \case DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration + DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err data CICallStatus = CISCallPending diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index f1bd801c71..aadac15c92 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -131,6 +131,7 @@ module Simplex.Chat.Store deletePendingGroupMessage, createNewSndChatItem, createNewRcvChatItem, + createNewChatItemNoMsg, getChatPreviews, getDirectChat, getGroupChat, @@ -2531,6 +2532,14 @@ createNewRcvChatItem st user chatDirection RcvMessage {msgId, chatMsgEvent} shar CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ -> (Just $ Just userMemberId == memberId, memberId) +createNewChatItemNoMsg :: forall c d m. (MsgDirectionI d, MonadUnliftIO m) => SQLiteStore -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> m ChatItemId +createNewChatItemNoMsg st user chatDirection ciContent itemTs createdAt = + liftIO . withTransaction st $ \db -> + createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow itemTs createdAt + where + quoteRow :: NewQuoteRow + quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) + createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> UTCTime -> UTCTime -> IO ChatItemId createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemTs createdAt = do DB.execute diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 4679fca8bb..6f7f31a66c 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -208,6 +208,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvDeleted _ -> [] CIRcvCall {} -> [] + CIRcvIntegrityError err -> viewRcvIntegrityError from err meta where from = ttyFromContact' c where @@ -223,6 +224,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvDeleted _ -> [] CIRcvCall {} -> [] + CIRcvIntegrityError err -> viewRcvIntegrityError from err meta where from = ttyFromGroup' g m where @@ -295,6 +297,9 @@ msgPreview = msgPlain . preview . msgContentText | T.length t <= 120 = t | otherwise = T.take 120 t <> "..." +viewRcvIntegrityError :: StyledString -> MsgErrorType -> CIMeta 'MDRcv -> [StyledString] +viewRcvIntegrityError from msgErr meta = receivedWithTime_ from [] meta $ viewMsgIntegrityError msgErr + viewMsgIntegrityError :: MsgErrorType -> [StyledString] viewMsgIntegrityError err = msgError $ case err of MsgSkipped fromId toId ->