mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 12:19:54 +00:00
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
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
c3c712aa02
commit
89908ef5dc
6 changed files with 89 additions and 24 deletions
17
docs/rfcs/2022-05-28-chat-item-integrity.md
Normal file
17
docs/rfcs/2022-05-28-chat-item-integrity.md
Normal file
|
|
@ -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.
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ->
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue