core: chat item on skipped messages (#705)

* core: chat item integrity

* create chat item on skipped messages (but only on content items)

* report skipped messages on all messages, not only content messages

* remove type signature

* remove migration

* update rfc

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.

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
+      checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
-      -- TODO chunk size has to be sent as part of invitation
       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
+    xFileCancel ct@Contact {contactId} sharedMsgId msgMeta = do
-      checkIntegrity msgMeta $ toView . CRMsgIntegrityError
+      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
+    xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {memberId} sharedMsgId msgMeta = do
-      checkIntegrity msgMeta $ toView . CRMsgIntegrityError
+      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
+    xFileAcptInvGroup g@GroupInfo {groupId} m sharedMsgId fileConnReq fName msgMeta = do
-      checkIntegrity msgMeta $ toView . CRMsgIntegrityError
+      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 :: GroupInfo -> GroupMember -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m ()
-    groupMsgToView gInfo ci msgMeta = do
+    groupMsgToView gInfo m ci msgMeta = do
-      checkIntegrity msgMeta $ toView . CRMsgIntegrityError
+      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 ()
+    checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m ()
-    checkIntegrity MsgMeta {integrity} action = case integrity of
+    checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of
-      MsgError e -> action e
       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"

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}

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

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

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 ->