mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-28 09:59:44 +00:00
core, ui: make msgVerified optional (#7247)
This commit is contained in:
spaced4ndy
@@ -751,7 +751,7 @@ processChatCommand cxt nm = \case
|
||||
let msgScope = toMsgScope gInfo <$> chatScopeInfo
|
||||
mentions' = M.map (\CIMention {memberId} -> MsgMention {memberId}) ciMentions
|
||||
event = XMsgUpdate itemSharedMId mc mentions' (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive) msgScope (Just showGroupAsSender)
|
||||
reuseSign = case msgVerified of MVSigned _ -> True; _ -> False
|
||||
reuseSign = case msgVerified of Just (MVSigned _) -> True; _ -> False
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo scope recipients reuseSign event
|
||||
ci' <- withFastStore' $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
@@ -848,7 +848,7 @@ processChatCommand cxt nm = \case
|
||||
delEvent msgId =
|
||||
let evt = XMsgDel msgId Nothing (toMsgScope gInfo <$> chatScopeInfo) onlyHistory
|
||||
in (groupMsgSigning (onlyHistory || itemSigned) gInfo evt, evt)
|
||||
itemSigned = case msgVerified of MVSigned _ -> True; _ -> False
|
||||
itemSigned = case msgVerified of Just (MVSigned _) -> True; _ -> False
|
||||
APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
|
||||
(gInfo, items) <- getCommandGroupChatItems user gId itemIds
|
||||
-- TODO [knocking] check scope is Nothing for all items? (prohibit moderation in support chats?)
|
||||
|
||||
@@ -2769,13 +2769,13 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, msgSigned, forwardedByMem
|
||||
_ -> Nothing
|
||||
|
||||
-- TODO [mentions] optimize by avoiding unnecessary parsing
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> MsgVerified -> UTCTime -> ChatItem c d
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> Maybe MsgVerified -> UTCTime -> ChatItem c d
|
||||
mkChatItem cd showGroupAsSender ciId content file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember msgVerified currentTs =
|
||||
let ts@(_, ft_) = ciContentTexts content
|
||||
hasLink_ = ciContentHasLink content ft_
|
||||
in mkChatItem_ cd showGroupAsSender ciId content ts file quotedItem sharedMsgId itemForwarded itemTimed live userMention hasLink_ itemTs forwardedByMember msgVerified currentTs
|
||||
|
||||
mkChatItem_ :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> (Text, Maybe MarkdownList) -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> MsgVerified -> UTCTime -> ChatItem c d
|
||||
mkChatItem_ :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> (Text, Maybe MarkdownList) -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> Maybe MsgVerified -> UTCTime -> ChatItem c d
|
||||
mkChatItem_ cd showGroupAsSender ciId content (itemText, formattedText) file quotedItem sharedMsgId itemForwarded itemTimed live userMention hasLink_ itemTs forwardedByMember msgVerified currentTs =
|
||||
let itemStatus = ciCreateStatus content
|
||||
meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) userMention hasLink_ currentTs itemTs forwardedByMember showGroupAsSender msgVerified currentTs currentTs
|
||||
@@ -3100,9 +3100,9 @@ createLocalChatItems user cd itemsData createdAt = do
|
||||
createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd)
|
||||
createItem db (content, ciFile, itemForwarded, ts@(_, ft_)) = do
|
||||
let hasLink_ = ciContentHasLink content ft_
|
||||
ciId <- createNewChatItem_ db user cd False Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False hasLink_ createdAt Nothing MVUnsigned createdAt
|
||||
ciId <- createNewChatItem_ db user cd False Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False hasLink_ createdAt Nothing Nothing createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
||||
pure $ mkChatItem_ cd False ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False hasLink_ createdAt Nothing MVUnsigned createdAt
|
||||
pure $ mkChatItem_ cd False ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False hasLink_ createdAt Nothing Nothing createdAt
|
||||
|
||||
withUser' :: (User -> CM ChatResponse) -> CM ChatResponse
|
||||
withUser' action =
|
||||
|
||||
@@ -2300,9 +2300,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
where
|
||||
isSender m' = maybe False (\m -> sameMemberId (memberId' m) m') m_
|
||||
-- a verified item requires a verified edit (fail-closed): unsigned is a forgery (bad-signature item); signed-but-no-key is unverifiable (drop with a log)
|
||||
requireVerifiedEdit :: ChatDirection 'CTGroup 'MDRcv -> MsgVerified -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
|
||||
requireVerifiedEdit :: ChatDirection 'CTGroup 'MDRcv -> Maybe MsgVerified -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
|
||||
requireVerifiedEdit cd itemVerified action
|
||||
| itemVerified == MVSigned MSSVerified =
|
||||
| itemVerified == Just (MVSigned MSSVerified) =
|
||||
case msgSigned of
|
||||
Just MSSVerified -> action
|
||||
Just MSSSignedNoKey -> logWarn "x.msg.update: unverified update of a signed item (no key to verify), dropped" $> Nothing
|
||||
@@ -2413,7 +2413,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
-- a verified item requires a verified delete (fail-closed): unsigned is a forgery (bad-signature item); signed-but-no-key is unverifiable (drop with a log)
|
||||
requireVerifiedDelete :: CChatItem 'CTGroup -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
|
||||
requireVerifiedDelete cci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {msgVerified = itemVerified}}) action
|
||||
| itemVerified == MVSigned MSSVerified =
|
||||
| itemVerified == Just (MVSigned MSSVerified) =
|
||||
case msgSigned of
|
||||
Just MSSVerified -> action
|
||||
Just MSSSignedNoKey -> logWarn "x.msg.del: unverified delete of a signed item (no key to verify), dropped" $> Nothing
|
||||
|
||||
@@ -523,7 +523,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
editable :: Bool,
|
||||
forwardedByMember :: Maybe GroupMemberId,
|
||||
showGroupAsSender :: ShowGroupAsSender,
|
||||
msgVerified :: MsgVerified,
|
||||
msgVerified :: Maybe MsgVerified,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime
|
||||
}
|
||||
@@ -531,7 +531,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
|
||||
type ShowGroupAsSender = Bool
|
||||
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe Bool -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> Bool -> Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> Bool -> MsgVerified -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe Bool -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> Bool -> Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> Bool -> Maybe MsgVerified -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus sentViaProxy itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive userMention hasLink_ currentTs itemTs forwardedByMember showGroupAsSender msgVerified createdAt updatedAt =
|
||||
let deletable = deletable' itemContent itemDeleted itemTs nominalDay currentTs
|
||||
editable = deletable && isNothing itemForwarded
|
||||
@@ -567,7 +567,7 @@ dummyMeta itemId ts itemText =
|
||||
editable = False,
|
||||
forwardedByMember = Nothing,
|
||||
showGroupAsSender = False,
|
||||
msgVerified = MVUnsigned,
|
||||
msgVerified = Nothing,
|
||||
createdAt = ts,
|
||||
updatedAt = ts
|
||||
}
|
||||
|
||||
@@ -581,14 +581,14 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, msgS
|
||||
CDChannelRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ ->
|
||||
(Just $ Just userMemberId == memberId, memberId)
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> MsgVerified -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> Maybe MsgVerified -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ hasLink msgVerified itemTs =
|
||||
createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False hasLink itemTs Nothing msgVerified
|
||||
where
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> MsgVerified -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> Maybe MsgVerified -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection showGroupAsSender msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention hasLink itemTs forwardedByMember msgVerified createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
@@ -610,7 +610,7 @@ createNewChatItem_ db User {userId} chatDirection showGroupAsSender msgId_ share
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId, BoolInt) :. (UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, MsgVerified) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId, BoolInt) :. (UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgVerified) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, mcTag_, sharedMsgId, forwardedByMember, BI includeInHistory) :. (createdAt, createdAt, BI <$> justTrue live, BI userMention, BI hasLink, BI itemViewed, BI showGroupAsSender, msgVerified) :. ciTimedRow timed
|
||||
quoteRow' = let (a, b, c, d, e) = quoteRow in (a, b, c, BI <$> d, e)
|
||||
idsRow :: (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId, Maybe NoteFolderId)
|
||||
@@ -1116,7 +1116,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
||||
_ -> Just (CIDeleted @'CTLocal deletedTs)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs Nothing False (fromMaybe MVUnsigned msgSigned) createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs Nothing False msgSigned createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -2323,7 +2323,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
_ -> Just (CIDeleted @'CTDirect deletedTs)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs Nothing False (fromMaybe MVUnsigned msgSigned) createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs Nothing False msgSigned createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -2412,7 +2412,7 @@ toGroupChatItem
|
||||
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs forwardedByMember showGroupAsSender (fromMaybe MVUnsigned msgSigned) createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention hasLink currentTs itemTs forwardedByMember showGroupAsSender msgSigned createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
|
||||
@@ -149,30 +149,24 @@ instance FromField MsgSigStatus where fromField = fromTextField_ textDecode
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "MSS") ''MsgSigStatus)
|
||||
|
||||
data MsgVerified = MVSigned {sigStatus :: MsgSigStatus} | MVSigMissing | MVUnsigned
|
||||
data MsgVerified = MVSigned {sigStatus :: MsgSigStatus} | MVSigMissing
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance TextEncoding MsgVerified where
|
||||
textEncode = \case
|
||||
MVSigned s -> textEncode s
|
||||
MVSigMissing -> "sig_missing"
|
||||
MVUnsigned -> "unsigned"
|
||||
textDecode = \case
|
||||
"sig_missing" -> Just MVSigMissing
|
||||
"unsigned" -> Just MVUnsigned
|
||||
s -> MVSigned <$> textDecode s
|
||||
|
||||
instance ToField MsgVerified where toField = toField . textEncode
|
||||
|
||||
instance FromField MsgVerified where fromField = fromTextField_ textDecode
|
||||
|
||||
$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "MV") ''MsgVerified)
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "MV") ''MsgVerified)
|
||||
|
||||
instance FromJSON MsgVerified where
|
||||
parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "MV") ''MsgVerified)
|
||||
omittedField = Just MVUnsigned
|
||||
|
||||
toMsgVerified :: Bool -> Maybe MsgSigStatus -> MsgVerified
|
||||
toMsgVerified :: Bool -> Maybe MsgSigStatus -> Maybe MsgVerified
|
||||
toMsgVerified signRequired = \case
|
||||
Just s -> MVSigned s
|
||||
Nothing -> if signRequired then MVSigMissing else MVUnsigned
|
||||
Just s -> Just (MVSigned s)
|
||||
Nothing -> if signRequired then Just MVSigMissing else Nothing
|
||||
|
||||
@@ -395,11 +395,11 @@ sigStatusStr = \case
|
||||
Just MSSSignedNoKey -> " (signed, no key to verify)"
|
||||
Nothing -> ""
|
||||
|
||||
msgVerifiedStr :: IsString a => MsgVerified -> a
|
||||
msgVerifiedStr :: IsString a => Maybe MsgVerified -> a
|
||||
msgVerifiedStr = \case
|
||||
MVSigned s -> sigStatusStr (Just s)
|
||||
MVSigMissing -> " (signature missing)"
|
||||
MVUnsigned -> ""
|
||||
Just (MVSigned s) -> sigStatusStr (Just s)
|
||||
Just MVSigMissing -> " (signature missing)"
|
||||
Nothing -> ""
|
||||
|
||||
signedStr :: IsString a => Bool -> a
|
||||
signedStr signed = if signed then " (signed)" else ""
|
||||
|
||||
Reference in New Issue
Block a user