mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
rework (revert from bool to ids)
This commit is contained in:
spaced4ndy
+71
-38
@@ -708,14 +708,14 @@ processChatCommand' vr = \case
|
||||
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
|
||||
APISendMessage (ChatRef cType chatId) live itemTTL cm -> withUser $ \user -> case cType of
|
||||
CTDirect -> withContactLock "sendMessage" chatId $
|
||||
sendContactContentMessage user chatId live itemTTL cm False
|
||||
sendContactContentMessage user chatId live itemTTL cm Nothing
|
||||
CTGroup -> withGroupLock "sendMessage" chatId $
|
||||
sendGroupContentMessage user chatId live itemTTL cm False
|
||||
sendGroupContentMessage user chatId live itemTTL cm Nothing
|
||||
CTLocal -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
APICreateChatItem folderId cm -> withUser $ \user ->
|
||||
createNoteFolderContentItem user folderId cm False
|
||||
createNoteFolderContentItem user folderId cm Nothing
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> case cType of
|
||||
CTDirect -> withContactLock "updateChatItem" chatId $ do
|
||||
ct@Contact {contactId} <- withStore $ \db -> getContact db vr user chatId
|
||||
@@ -860,31 +860,64 @@ processChatCommand' vr = \case
|
||||
throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed")
|
||||
when (add && length rs >= maxMsgReactions) $
|
||||
throwChatError (CECommandError "too many reactions")
|
||||
APIForwardChatItem fromChatRef (ChatRef toCType toChatId) itemId -> withUser $ \user -> case toCType of
|
||||
APIForwardChatItem (ChatRef fromCType fromChatId) (ChatRef toCType toChatId) itemId -> withUser $ \user -> case toCType of
|
||||
CTDirect -> withContactLock "sendMessage" toChatId $ do
|
||||
cm <- prepareForward user
|
||||
sendContactContentMessage user toChatId False Nothing cm True
|
||||
(cm, ciff) <- prepareForward user
|
||||
sendContactContentMessage user toChatId False Nothing cm ciff
|
||||
CTGroup -> withGroupLock "sendMessage" toChatId $ do
|
||||
cm <- prepareForward user
|
||||
sendGroupContentMessage user toChatId False Nothing cm True
|
||||
(cm, ciff) <- prepareForward user
|
||||
sendGroupContentMessage user toChatId False Nothing cm ciff
|
||||
CTLocal -> do
|
||||
cm <- prepareForward user
|
||||
createNoteFolderContentItem user toChatId cm True
|
||||
(cm, ciff) <- prepareForward user
|
||||
createNoteFolderContentItem user toChatId cm ciff
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
where
|
||||
prepareForward :: User -> CM ComposedMessage
|
||||
prepareForward user = do
|
||||
(AChatItem _ _ _ ci) <- withStore $ \db -> getAChatItem db vr user fromChatRef itemId
|
||||
mc <- forwardMC ci
|
||||
file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
|
||||
pure $ ComposedMessage file Nothing mc
|
||||
prepareForward :: User -> CM (ComposedMessage, Maybe CIForwardedFrom)
|
||||
prepareForward user = case fromCType of
|
||||
CTDirect -> do
|
||||
(ct, CChatItem _ ci) <- withStore $ \db -> do
|
||||
ct <- getContact db vr user fromChatId
|
||||
cci <- getDirectChatItem db user fromChatId itemId
|
||||
pure (ct, cci)
|
||||
(mc, mDir) <- forwardMC ci
|
||||
file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
|
||||
let ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) mDir (Just fromChatId) (Just itemId))
|
||||
pure (ComposedMessage file Nothing mc, ciff)
|
||||
where
|
||||
forwardName :: Contact -> ContactName
|
||||
forwardName Contact {profile = LocalProfile {displayName, localAlias}}
|
||||
| localAlias /= "" = localAlias
|
||||
| otherwise = displayName
|
||||
CTGroup -> do
|
||||
(gInfo, CChatItem _ ci) <- withStore $ \db -> do
|
||||
gInfo <- getGroupInfo db vr user fromChatId
|
||||
cci <- getGroupChatItem db user fromChatId itemId
|
||||
pure (gInfo, cci)
|
||||
(mc, mDir) <- forwardMC ci
|
||||
file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
|
||||
let ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) mDir (Just fromChatId) (Just itemId))
|
||||
pure (ComposedMessage file Nothing mc, ciff)
|
||||
where
|
||||
forwardName :: GroupInfo -> ContactName
|
||||
forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName
|
||||
CTLocal -> do
|
||||
(CChatItem _ ci) <- withStore $ \db -> getLocalChatItem db user fromChatId itemId
|
||||
(mc, _) <- forwardMC ci
|
||||
file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
|
||||
let ciff = forwardCIFF ci Nothing
|
||||
pure (ComposedMessage file Nothing mc, ciff)
|
||||
CTContactRequest -> throwChatError $ CECommandError "not supported"
|
||||
CTContactConnection -> throwChatError $ CECommandError "not supported"
|
||||
where
|
||||
forwardMC :: ChatItem c d -> CM MsgContent
|
||||
forwardMC :: ChatItem c d -> CM (MsgContent, MsgDirection)
|
||||
forwardMC ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidForward
|
||||
forwardMC ChatItem {content = CISndMsgContent fmc} = pure fmc
|
||||
forwardMC ChatItem {content = CIRcvMsgContent fmc} = pure fmc
|
||||
forwardMC ChatItem {content = CISndMsgContent fmc} = pure (fmc, MDSnd)
|
||||
forwardMC ChatItem {content = CIRcvMsgContent fmc} = pure (fmc, MDRcv)
|
||||
forwardMC _ = throwChatError CEInvalidForward
|
||||
forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
|
||||
forwardCIFF ChatItem {meta = CIMeta {itemForwarded = Just ciff}} _ = Just ciff
|
||||
forwardCIFF _ ciff = ciff
|
||||
forwardCryptoFile :: ChatItem c d -> CM (Maybe CryptoFile)
|
||||
forwardCryptoFile ChatItem {file = Just CIFile {fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}}}
|
||||
| ciFileLoaded fileStatus =
|
||||
@@ -1600,7 +1633,7 @@ processChatCommand' vr = \case
|
||||
combineResults _ _ (Left e) = Left e
|
||||
createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO ()
|
||||
createCI db user createdAt (ct, sndMsg) =
|
||||
void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing False Nothing False createdAt
|
||||
void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt
|
||||
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
|
||||
@@ -2564,7 +2597,7 @@ processChatCommand' vr = \case
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = newStatus} memRole
|
||||
updateDirectChatItemView user ct itemId aciContent False Nothing
|
||||
_ -> pure () -- prohibited
|
||||
sendContactContentMessage :: User -> ContactId -> Bool -> Maybe Int -> ComposedMessage -> Bool -> CM ChatResponse
|
||||
sendContactContentMessage :: User -> ContactId -> Bool -> Maybe Int -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse
|
||||
sendContactContentMessage user contactId live itemTTL (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do
|
||||
ct@Contact {contactUsed} <- withStore $ \db -> getContact db vr user contactId
|
||||
assertDirectAllowed user MDSnd ct XMsgNew_
|
||||
@@ -2587,9 +2620,9 @@ processChatCommand' vr = \case
|
||||
xftpSndFileTransfer user file fileSize 1 $ CGContact ct
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> CM (MsgContainer, Maybe (CIQuote 'CTDirect))
|
||||
prepareMsg fInv_ timed_ = case (quotedItemId_, itemForwarded) of
|
||||
(Nothing, False) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, True) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Just quotedItemId, False) -> do
|
||||
(Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Just quotedItemId, Nothing) -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getDirectChatItem db user contactId quotedItemId
|
||||
(origQmc, qd, sent) <- quoteData qci
|
||||
@@ -2597,14 +2630,14 @@ processChatCommand' vr = \case
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
(Just _, True) -> throwChatError CEInvalidQuote
|
||||
(Just _, Just _) -> throwChatError CEInvalidQuote
|
||||
where
|
||||
quoteData :: ChatItem c d -> CM (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
|
||||
quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True)
|
||||
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
|
||||
quoteData _ = throwChatError CEInvalidQuote
|
||||
sendGroupContentMessage :: User -> GroupId -> Bool -> Maybe Int -> ComposedMessage -> Bool -> CM ChatResponse
|
||||
sendGroupContentMessage :: User -> GroupId -> Bool -> Maybe Int -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse
|
||||
sendGroupContentMessage user groupId live itemTTL (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do
|
||||
g@(Group gInfo _) <- withStore $ \db -> getGroup db vr user groupId
|
||||
assertUserGroupRole gInfo GRAuthor
|
||||
@@ -2645,7 +2678,7 @@ processChatCommand' vr = \case
|
||||
\db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr
|
||||
saveMemberFD _ = pure ()
|
||||
pure (fInv, ciFile)
|
||||
createNoteFolderContentItem :: User -> NoteFolderId -> ComposedMessage -> Bool -> CM ChatResponse
|
||||
createNoteFolderContentItem :: User -> NoteFolderId -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse
|
||||
createNoteFolderContentItem user folderId (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do
|
||||
forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported"
|
||||
nf <- withStore $ \db -> getNoteFolder db user folderId
|
||||
@@ -2676,11 +2709,11 @@ data ChangedProfileContact = ChangedProfileContact
|
||||
conn :: Connection
|
||||
}
|
||||
|
||||
prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Bool -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
|
||||
(Nothing, False) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, True) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Just quotedItemId, False) -> do
|
||||
(Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Just quotedItemId, Nothing) -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getGroupChatItem db user groupId quotedItemId
|
||||
(origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
|
||||
@@ -2688,7 +2721,7 @@ prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwar
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
(Just _, True) -> throwChatError CEInvalidQuote
|
||||
(Just _, Just _) -> throwChatError CEInvalidQuote
|
||||
where
|
||||
quoteData :: ChatItem c d -> GroupMember -> CM (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
|
||||
@@ -4126,7 +4159,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
|
||||
quotedItemId_ = quoteItemId =<< quotedItem
|
||||
fInv_ = fst <$> fInvDescr_
|
||||
(msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ False fInv_ itemTimed False
|
||||
(msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ Nothing fInv_ itemTimed False
|
||||
let senderVRange = memberChatVRange' sender
|
||||
xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer}
|
||||
fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
|
||||
@@ -6518,9 +6551,9 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me
|
||||
_ -> throwError e
|
||||
|
||||
saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd)
|
||||
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing False Nothing False
|
||||
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False
|
||||
|
||||
saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Bool -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd)
|
||||
saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd)
|
||||
saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemForwarded itemTimed live = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
ciId <- withStore' $ \db -> do
|
||||
@@ -6544,7 +6577,7 @@ saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerT
|
||||
pure r
|
||||
pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live brokerTs forwardedByMember createdAt
|
||||
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Bool -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live itemTs forwardedByMember currentTs =
|
||||
let itemText = ciContentToText content
|
||||
itemStatus = ciCreateStatus content
|
||||
@@ -6809,10 +6842,10 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do
|
||||
createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem]
|
||||
createACIs db itemTs createdAt cd = map $ \content -> do
|
||||
ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt
|
||||
let ci = mkChatItem cd ciId content Nothing Nothing Nothing False Nothing False itemTs Nothing createdAt
|
||||
let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False itemTs Nothing createdAt
|
||||
pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci
|
||||
|
||||
createLocalChatItem :: MsgDirectionI d => User -> ChatDirection 'CTLocal d -> CIContent d -> Bool -> UTCTime -> CM ChatItemId
|
||||
createLocalChatItem :: MsgDirectionI d => User -> ChatDirection 'CTLocal d -> CIContent d -> Maybe CIForwardedFrom -> UTCTime -> CM ChatItemId
|
||||
createLocalChatItem user cd content itemForwarded createdAt = do
|
||||
gVar <- asks random
|
||||
withStore $ \db -> do
|
||||
|
||||
@@ -339,7 +339,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
itemText :: Text,
|
||||
itemStatus :: CIStatus d,
|
||||
itemSharedMsgId :: Maybe SharedMsgId,
|
||||
itemForwarded :: Bool,
|
||||
itemForwarded :: Maybe CIForwardedFrom,
|
||||
itemDeleted :: Maybe (CIDeleted c),
|
||||
itemEdited :: Bool,
|
||||
itemTimed :: Maybe CITimed,
|
||||
@@ -351,7 +351,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||
let editable = case itemContent of
|
||||
CISndMsgContent _ ->
|
||||
@@ -369,7 +369,7 @@ dummyMeta itemId ts itemText =
|
||||
itemText,
|
||||
itemStatus = CISSndNew,
|
||||
itemSharedMsgId = Nothing,
|
||||
itemForwarded = False,
|
||||
itemForwarded = Nothing,
|
||||
itemDeleted = Nothing,
|
||||
itemEdited = False,
|
||||
itemTimed = Nothing,
|
||||
@@ -998,6 +998,37 @@ itemDeletedTs = \case
|
||||
CIBlockedByAdmin ts -> ts
|
||||
CIModerated ts _ -> ts
|
||||
|
||||
data CIForwardedFrom
|
||||
= CIFFUnknown
|
||||
| CIFFContact {chatName :: Text, msgDir :: MsgDirection, contactId :: Maybe ContactId, chatItemId :: Maybe ChatItemId}
|
||||
| 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_
|
||||
| CIFFGroup_
|
||||
|
||||
instance FromField CIForwardedFromTag where fromField = fromTextField_ textDecode
|
||||
|
||||
instance ToField CIForwardedFromTag where toField = toField . textEncode
|
||||
|
||||
instance TextEncoding CIForwardedFromTag where
|
||||
textDecode = \case
|
||||
"unknown" -> Just CIFFUnknown_
|
||||
"contact" -> Just CIFFContact_
|
||||
"group" -> Just CIFFGroup_
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
CIFFUnknown_ -> "unknown"
|
||||
CIFFContact_ -> "contact"
|
||||
CIFFGroup_ -> "group"
|
||||
|
||||
data ChatItemInfo = ChatItemInfo
|
||||
{ itemVersions :: [ChatItemVersion],
|
||||
memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
|
||||
@@ -1060,6 +1091,8 @@ instance ChatTypeI c => ToJSON (CIDeleted c) where
|
||||
toJSON = J.toJSON . jsonCIDeleted
|
||||
toEncoding = J.toEncoding . jsonCIDeleted
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CIFF") ''CIForwardedFrom)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''CITimed)
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress)
|
||||
|
||||
@@ -43,6 +43,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "MD") ''MsgDirection)
|
||||
|
||||
instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP
|
||||
|
||||
instance FromField MsgDirection where fromField = fromIntField_ msgDirectionIntP
|
||||
|
||||
instance ToField MsgDirection where toField = toField . msgDirectionInt
|
||||
|
||||
data SMsgDirection (d :: MsgDirection) where
|
||||
|
||||
@@ -8,16 +8,29 @@ import Database.SQLite.Simple.QQ (sql)
|
||||
m20240402_item_forwarded :: Query
|
||||
m20240402_item_forwarded =
|
||||
[sql|
|
||||
ALTER TABLE chat_items ADD COLUMN item_forwarded INTEGER;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_tag TEXT;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_chat_name TEXT;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_msg_dir INTEGER;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_contact_id INTEGER REFERENCES contacts ON DELETE SET NULL;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_group_id INTEGER REFERENCES groups ON DELETE SET NULL;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL;
|
||||
|
||||
CREATE INDEX idx_chat_items_fwd_from_contact_id ON chat_items(fwd_from_contact_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_group_id ON chat_items(fwd_from_group_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_chat_item_id ON chat_items(fwd_from_chat_item_id);
|
||||
|]
|
||||
|
||||
down_m20240402_item_forwarded :: Query
|
||||
down_m20240402_item_forwarded =
|
||||
[sql|
|
||||
ALTER TABLE chat_items DROP COLUMN item_forwarded;
|
||||
|]
|
||||
DROP INDEX idx_chat_items_fwd_from_contact_id;
|
||||
DROP INDEX idx_chat_items_fwd_from_group_id;
|
||||
DROP INDEX idx_chat_items_fwd_from_chat_item_id;
|
||||
|
||||
-- ALTER TABLE chat_items DROP COLUMN forwarded_from_str;
|
||||
-- ALTER TABLE chat_items DROP COLUMN forwarded_from_contact_id;
|
||||
-- ALTER TABLE chat_items DROP COLUMN forwarded_from_group_id;
|
||||
-- ALTER TABLE chat_items DROP COLUMN forwarded_from_note_folder_id;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_tag;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_chat_name;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_msg_dir;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_contact_id;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_group_id;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_chat_item_id;
|
||||
|]
|
||||
|
||||
@@ -418,11 +418,6 @@ cmToQuotedMsg = \case
|
||||
ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
|
||||
_ -> Nothing
|
||||
|
||||
cmToItemForwarded :: AChatMsgEvent -> Bool
|
||||
cmToItemForwarded = \case
|
||||
ACME _ (XMsgNew (MCForward _)) -> True
|
||||
_ -> False
|
||||
|
||||
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCUnknown_ Text
|
||||
deriving (Eq)
|
||||
|
||||
|
||||
@@ -330,7 +330,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
|
||||
(chatTs, userId, noteFolderId)
|
||||
_ -> pure ()
|
||||
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Bool -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live createdAt Nothing createdAt
|
||||
where
|
||||
@@ -346,13 +346,13 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Bool)
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
pure (ciId, quotedItem, itemForwarded)
|
||||
where
|
||||
itemForwarded = cmToItemForwarded chatMsgEvent
|
||||
itemForwarded = cmForwardedFrom chatMsgEvent
|
||||
quotedMsg = cmToQuotedMsg chatMsgEvent
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = case quotedMsg of
|
||||
@@ -365,12 +365,12 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection ciContent itemTs =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow False Nothing False itemTs Nothing
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False itemTs Nothing
|
||||
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 -> Bool -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
@@ -379,19 +379,21 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
-- user and IDs
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id, item_forwarded,
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id,
|
||||
forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id,
|
||||
-- forwarded from
|
||||
fwd_from_tag, fwd_from_chat_name, fwd_from_msg_dir, fwd_from_contact_id, fwd_from_group_id, fwd_from_chat_item_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow :. forwardedFromRow)
|
||||
ciId <- insertedRowId db
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Bool, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, itemForwarded, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
|
||||
@@ -400,6 +402,16 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing, Nothing)
|
||||
CDLocalRcv NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
CDLocalSnd NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
forwardedFromRow = case itemForwarded of
|
||||
Nothing ->
|
||||
(Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIFFUnknown ->
|
||||
(Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIFFContact {chatName, msgDir, contactId, chatItemId} ->
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatItemId)
|
||||
Just CIFFGroup {chatName, msgDir, groupId, chatItemId} ->
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, Nothing, groupId, chatItemId)
|
||||
|
||||
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
|
||||
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
|
||||
@@ -795,7 +807,7 @@ getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
@@ -827,8 +839,8 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @CTLocal deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
itemForwarded' = fromMaybe False itemForwarded
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -1393,7 +1405,14 @@ type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath,
|
||||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
|
||||
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId, Maybe Bool) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
type ChatItemRow =
|
||||
(Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId)
|
||||
:. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime)
|
||||
:. ChatItemForwardedFromRow
|
||||
:. ChatItemModeRow
|
||||
:. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
@@ -1408,7 +1427,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
@@ -1440,11 +1459,19 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @CTDirect deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
itemForwarded' = fromMaybe False itemForwarded
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toCIForwardedFrom :: ChatItemForwardedFromRow -> Maybe CIForwardedFrom
|
||||
toCIForwardedFrom (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) =
|
||||
case (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) of
|
||||
(Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing) -> Just CIFFUnknown
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatId) -> Just $ CIFFContact chatName msgDir contactId chatId
|
||||
(Just CIFFGroup_, Just chatName, Just msgDir, Nothing, groupId, chatId) -> Just $ CIFFGroup chatName msgDir groupId chatId
|
||||
_ -> Nothing
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
@@ -1457,7 +1484,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
@@ -1494,8 +1521,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs)
|
||||
_ -> Just (maybe (CIDeleted @CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
itemForwarded' = fromMaybe False itemForwarded
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -1730,8 +1757,10 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
|
||||
i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
@@ -1971,8 +2000,10 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
|
||||
i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- CIMeta forwardedByMember
|
||||
@@ -2073,8 +2104,10 @@ getLocalChatItem db User {userId} folderId itemId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id,
|
||||
i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
|
||||
i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol
|
||||
FROM chat_items i
|
||||
|
||||
@@ -555,7 +555,11 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
|
||||
where
|
||||
from = ttyFromContact c
|
||||
where
|
||||
context = maybe (forwarded itemForwarded) (directQuote chatDir) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(directQuote chatDir)
|
||||
quotedItem
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
|
||||
@@ -573,7 +577,11 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
|
||||
where
|
||||
from = ttyFromGroup g m
|
||||
where
|
||||
context = maybe (forwarded itemForwarded) (groupQuote g) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(groupQuote g)
|
||||
quotedItem
|
||||
LocalChat _ -> case chatDir of
|
||||
CILocalSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to context mc
|
||||
@@ -589,7 +597,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
|
||||
where
|
||||
from = "* "
|
||||
where
|
||||
context = forwarded itemForwarded
|
||||
context = maybe [] forwardedFrom itemForwarded
|
||||
ContactRequest {} -> []
|
||||
ContactConnection {} -> []
|
||||
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
|
||||
@@ -681,7 +689,11 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEd
|
||||
where
|
||||
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
|
||||
where
|
||||
context = maybe (forwarded itemForwarded) (directQuote chatDir) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(directQuote chatDir)
|
||||
quotedItem
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc
|
||||
@@ -696,7 +708,11 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEd
|
||||
where
|
||||
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
|
||||
where
|
||||
context = maybe (forwarded itemForwarded) (groupQuote g) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(groupQuote g)
|
||||
quotedItem
|
||||
_ -> []
|
||||
|
||||
hideLive :: CIMeta c d -> [StyledString] -> [StyledString]
|
||||
@@ -778,8 +794,17 @@ directQuote _ CIQuote {content = qmc, chatDir = quoteDir} =
|
||||
groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString]
|
||||
groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir
|
||||
|
||||
forwarded :: Bool -> [StyledString]
|
||||
forwarded itemForwarded = ["-> forwarded" | itemForwarded]
|
||||
forwardedFrom :: CIForwardedFrom -> [StyledString]
|
||||
forwardedFrom = \case
|
||||
CIFFUnknown -> ["-> forwarded"]
|
||||
CIFFContact _ MDSnd _ _ -> ["-> from you"]
|
||||
CIFFContact c MDRcv cId_ _ -> case cId_ of
|
||||
Nothing -> ["-> from " <> ttyContact c]
|
||||
Just cId -> ["-> from " <> ttyContact c <> " (contact id: " <> sShow cId <> ")"]
|
||||
CIFFGroup _ MDSnd _ _ -> ["-> from you"]
|
||||
CIFFGroup c MDRcv gId_ _ -> case gId_ of
|
||||
Nothing -> ["-> from " <> ttyGroup c]
|
||||
Just gId -> ["-> from " <> ttyGroup c <> " (group id: " <> sShow gId <> ")"]
|
||||
|
||||
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
|
||||
sentByMember GroupInfo {membership} = \case
|
||||
|
||||
+25
-33
@@ -42,21 +42,21 @@ testForwardContactToContact =
|
||||
alice <# "bob> hey"
|
||||
|
||||
alice ##> ("/_forward @2 @3 " <> msgId)
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from you"
|
||||
alice <## " hi"
|
||||
cath <# "alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
|
||||
alice `send` "> @bob -> @cath hey"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from bob (contact id: 2)"
|
||||
alice <## " hey"
|
||||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
alice ##> "/tail @cath 2"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from you"
|
||||
alice <## " hi"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from bob (contact id: 2)"
|
||||
alice <## " hey"
|
||||
|
||||
cath ##> "/tail @alice 2"
|
||||
@@ -78,13 +78,13 @@ testForwardContactToGroup =
|
||||
alice <# "bob> hey"
|
||||
|
||||
alice `send` ">> @bob -> #team hi"
|
||||
alice <# "#team -> forwarded"
|
||||
alice <# "#team -> from you"
|
||||
alice <## " hi"
|
||||
cath <# "#team alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
|
||||
alice `send` "> @bob -> #team hey"
|
||||
alice <# "#team -> forwarded"
|
||||
alice <# "#team -> from bob (contact id: 2)"
|
||||
alice <## " hey"
|
||||
cath <# "#team alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
@@ -102,11 +102,11 @@ testForwardContactToNotes =
|
||||
alice <# "bob> hey"
|
||||
|
||||
alice `send` ">> @bob -> * hi"
|
||||
alice <# "* -> forwarded"
|
||||
alice <# "* -> from you"
|
||||
alice <## " hi"
|
||||
|
||||
alice `send` "> @bob -> * hey"
|
||||
alice <# "* -> forwarded"
|
||||
alice <# "* -> from bob (contact id: 2)"
|
||||
alice <## " hey"
|
||||
|
||||
testForwardGroupToContact :: HasCallStack => FilePath -> IO ()
|
||||
@@ -122,13 +122,13 @@ testForwardGroupToContact =
|
||||
alice <# "#team bob> hey"
|
||||
|
||||
alice `send` "> #team -> @cath hi"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from you"
|
||||
alice <## " hi"
|
||||
cath <# "alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
|
||||
alice `send` "> #team -> @cath hey"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <# "@cath -> from #team (group id: 1)"
|
||||
alice <## " hey"
|
||||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
@@ -146,13 +146,13 @@ testForwardGroupToGroup =
|
||||
alice <# "#team bob> hey"
|
||||
|
||||
alice `send` "> #team -> #club hi"
|
||||
alice <# "#club -> forwarded"
|
||||
alice <# "#club -> from you"
|
||||
alice <## " hi"
|
||||
cath <# "#club alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
|
||||
alice `send` "> #team -> #club hey"
|
||||
alice <# "#club -> forwarded"
|
||||
alice <# "#club -> from #team (group id: 1)"
|
||||
alice <## " hey"
|
||||
cath <# "#club alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
@@ -170,11 +170,11 @@ testForwardGroupToNotes =
|
||||
alice <# "#team bob> hey"
|
||||
|
||||
alice `send` "> #team -> * hi"
|
||||
alice <# "* -> forwarded"
|
||||
alice <# "* -> from you"
|
||||
alice <## " hi"
|
||||
|
||||
alice `send` "> #team -> * hey"
|
||||
alice <# "* -> forwarded"
|
||||
alice <# "* -> from #team (group id: 1)"
|
||||
alice <## " hey"
|
||||
|
||||
testForwardNotesToContact :: HasCallStack => FilePath -> IO ()
|
||||
@@ -187,10 +187,8 @@ testForwardNotesToContact =
|
||||
alice /* "hi"
|
||||
|
||||
alice `send` "> * -> @cath hi"
|
||||
alice <# "@cath -> forwarded"
|
||||
alice <## " hi"
|
||||
cath <# "alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
alice <# "@cath hi"
|
||||
cath <# "alice> hi"
|
||||
|
||||
testForwardNotesToGroup :: HasCallStack => FilePath -> IO ()
|
||||
testForwardNotesToGroup =
|
||||
@@ -202,10 +200,8 @@ testForwardNotesToGroup =
|
||||
alice /* "hi"
|
||||
|
||||
alice `send` "> * -> #team hi"
|
||||
alice <# "#team -> forwarded"
|
||||
alice <## " hi"
|
||||
cath <# "#team alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
alice <# "#team hi"
|
||||
cath <# "#team alice> hi"
|
||||
|
||||
testForwardNotesToNotes :: HasCallStack => FilePath -> IO ()
|
||||
testForwardNotesToNotes tmp =
|
||||
@@ -215,13 +211,11 @@ testForwardNotesToNotes tmp =
|
||||
alice /* "hi"
|
||||
|
||||
alice `send` "> * -> * hi"
|
||||
alice <# "* -> forwarded"
|
||||
alice <## " hi"
|
||||
alice <# "* hi"
|
||||
|
||||
alice ##> "/tail * 2"
|
||||
alice <# "* hi"
|
||||
alice <# "* -> forwarded"
|
||||
alice <## " hi"
|
||||
alice <# "* hi"
|
||||
|
||||
testForwardFileNoFilesFolder :: HasCallStack => FilePath -> IO ()
|
||||
testForwardFileNoFilesFolder =
|
||||
@@ -255,7 +249,7 @@ testForwardFileNoFilesFolder =
|
||||
|
||||
-- forward file
|
||||
bob `send` "> @alice -> @cath hi"
|
||||
bob <# "@cath -> forwarded"
|
||||
bob <# "@cath -> from alice (contact id: 2)"
|
||||
bob <## " hi"
|
||||
bob <# "/f @cath ./tests/tmp/test.pdf"
|
||||
bob <## "use /fc 2 to cancel sending"
|
||||
@@ -312,7 +306,7 @@ testForwardFileContactToContact =
|
||||
|
||||
-- forward file
|
||||
bob `send` "> @alice -> @cath hi"
|
||||
bob <# "@cath -> forwarded"
|
||||
bob <# "@cath -> from alice (contact id: 2)"
|
||||
bob <## " hi"
|
||||
bob <# "/f @cath test_1.pdf"
|
||||
bob <## "use /fc 2 to cancel sending"
|
||||
@@ -377,7 +371,7 @@ testForwardFileGroupToNotes =
|
||||
|
||||
-- forward file
|
||||
cath `send` "> #team -> * hi"
|
||||
cath <# "* -> forwarded"
|
||||
cath <# "* -> from #team (group id: 1)"
|
||||
cath <## " hi"
|
||||
cath <# "* file 2 (test_1.pdf)"
|
||||
|
||||
@@ -408,12 +402,10 @@ testForwardFileNotesToGroup =
|
||||
|
||||
-- forward file
|
||||
alice `send` "> * -> #team hi"
|
||||
alice <# "#team -> forwarded"
|
||||
alice <## " hi"
|
||||
alice <# "#team hi"
|
||||
alice <# "/f #team test_1.pdf"
|
||||
alice <## "use /fc 2 to cancel sending"
|
||||
cath <# "#team alice> -> forwarded"
|
||||
cath <## " hi"
|
||||
cath <# "#team alice> hi"
|
||||
cath <# "#team alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
|
||||
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
|
||||
Reference in New Issue
Block a user