core: update chat item details api (#2456)

This commit is contained in:
Evgeny Poberezkin 2023-05-18 17:52:58 +02:00 committed by GitHub
parent 3a50da1b53
commit 01b3e98358
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 49 additions and 59 deletions

View File

@ -468,22 +468,10 @@ processChatCommand = \case
APIGetChatItems pagination search -> withUser $ \user -> do APIGetChatItems pagination search -> withUser $ \user -> do
chatItems <- withStore $ \db -> getAllChatItems db user pagination search chatItems <- withStore $ \db -> getAllChatItems db user pagination search
pure $ CRChatItems user chatItems pure $ CRChatItems user chatItems
APIGetChatItemInfo itemId -> withUser $ \user -> do APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
(chatItem@(AChatItem _ _ _ ChatItem {meta}), itemVersions) <- withStore $ \db -> do (chatItem, itemVersions) <- withStore $ \db ->
ci <- getAChatItem db user itemId (,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
versions <- liftIO $ getChatItemVersions db itemId pure $ CRChatItemInfo user chatItem ChatItemInfo {itemVersions}
pure (ci, versions)
let CIMeta {itemTs, createdAt, updatedAt, itemTimed} = meta
ciInfo =
ChatItemInfo
{ chatItemId = itemId,
itemTs,
createdAt,
updatedAt,
deleteAt = itemTimed >>= timedDeleteAt',
itemVersions
}
pure $ CRChatItemInfo user chatItem ciInfo
APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
CTDirect -> do CTDirect -> do
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
@ -1490,7 +1478,9 @@ processChatCommand = \case
chatItems <- withStore $ \db -> getAllChatItems db user (CPLast $ index + 1) Nothing chatItems <- withStore $ \db -> getAllChatItems db user (CPLast $ index + 1) Nothing
pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems) pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems)
ShowChatItem (Just itemId) -> withUser $ \user -> do ShowChatItem (Just itemId) -> withUser $ \user -> do
chatItem <- withStore $ \db -> getAChatItem db user itemId chatItem <- withStore $ \db -> do
chatRef <- getChatRefViaItemId db user itemId
getAChatItem db user chatRef itemId
pure $ CRChatItems user ((: []) chatItem) pure $ CRChatItems user ((: []) chatItem)
ShowChatItem Nothing -> withUser $ \user -> do ShowChatItem Nothing -> withUser $ \user -> do
chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing
@ -1498,7 +1488,7 @@ processChatCommand = \case
ShowChatItemInfo chatName msg -> withUser $ \user -> do ShowChatItemInfo chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName chatRef <- getChatRef user chatName
itemId <- getChatItemIdByText user chatRef msg itemId <- getChatItemIdByText user chatRef msg
processChatCommand $ APIGetChatItemInfo itemId processChatCommand $ APIGetChatItemInfo chatRef itemId
ShowLiveItems on -> withUser $ \_ -> ShowLiveItems on -> withUser $ \_ ->
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_ asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
SendFile chatName f -> withUser $ \user -> do SendFile chatName f -> withUser $ \user -> do
@ -4756,7 +4746,7 @@ chatCommandP =
"/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)), "/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get item info " *> (APIGetChatItemInfo <$> A.decimal), "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
"/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),

View File

@ -214,7 +214,7 @@ data ChatCommand
| APIGetChats {userId :: UserId, pendingConnections :: Bool} | APIGetChats {userId :: UserId, pendingConnections :: Bool}
| APIGetChat ChatRef ChatPagination (Maybe String) | APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems ChatPagination (Maybe String) | APIGetChatItems ChatPagination (Maybe String)
| APIGetChatItemInfo ChatItemId | APIGetChatItemInfo ChatRef ChatItemId
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage} | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode

View File

@ -1501,12 +1501,7 @@ jsonCIDeleted = \case
CIModerated m -> JCIDModerated m CIModerated m -> JCIDModerated m
data ChatItemInfo = ChatItemInfo data ChatItemInfo = ChatItemInfo
{ chatItemId :: ChatItemId, { itemVersions :: [ChatItemVersion]
itemTs :: UTCTime,
createdAt :: UTCTime,
updatedAt :: UTCTime,
deleteAt :: Maybe UTCTime,
itemVersions :: [ChatItemVersion]
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
@ -1515,6 +1510,7 @@ instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOpt
data ChatItemVersion = ChatItemVersion data ChatItemVersion = ChatItemVersion
{ chatItemVersionId :: Int64, { chatItemVersionId :: Int64,
msgContent :: MsgContent, msgContent :: MsgContent,
formattedText :: Maybe MarkdownList,
itemVersionTs :: UTCTime, itemVersionTs :: UTCTime,
createdAt :: UTCTime createdAt :: UTCTime
} }

View File

@ -227,6 +227,7 @@ module Simplex.Chat.Store
getGroupChat, getGroupChat,
getAllChatItems, getAllChatItems,
getAChatItem, getAChatItem,
getChatRefViaItemId,
getChatItemVersions, getChatItemVersions,
getDirectCIReactions, getDirectCIReactions,
getDirectReactions, getDirectReactions,
@ -4290,11 +4291,14 @@ getAllChatItems db user@User {userId} pagination search_ = do
itemRefs <- itemRefs <-
rights . map toChatItemRef <$> case pagination of rights . map toChatItemRef <$> case pagination of
CPLast count -> liftIO $ getAllChatItemsLast_ count CPLast count -> liftIO $ getAllChatItemsLast_ count
CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem db user afterId CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem_ afterId
CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem db user beforeId CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem_ beforeId
mapM (uncurry (getAChatItem_ db user) >=> liftIO . getACIReactions db) itemRefs mapM (uncurry (getAChatItem db user) >=> liftIO . getACIReactions db) itemRefs
where where
search = fromMaybe "" search_ search = fromMaybe "" search_
getAChatItem_ itemId = do
chatRef <- getChatRefViaItemId db user itemId
getAChatItem db user chatRef itemId
getAllChatItemsLast_ count = getAllChatItemsLast_ count =
reverse reverse
<$> DB.query <$> DB.query
@ -4771,7 +4775,7 @@ getGroupChatItemIdByText' db User {userId} groupId msg =
getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId db user@User {userId} fileId = do getChatItemByFileId db user@User {userId} fileId = do
(itemId, chatRef) <- (chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $ ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
DB.query DB.query
db db
@ -4783,11 +4787,11 @@ getChatItemByFileId db user@User {userId} fileId = do
LIMIT 1 LIMIT 1
|] |]
(userId, fileId) (userId, fileId)
getAChatItem_ db user itemId chatRef getAChatItem db user chatRef itemId
getChatItemByGroupId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO AChatItem getChatItemByGroupId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId db user@User {userId} groupId = do getChatItemByGroupId db user@User {userId} groupId = do
(itemId, chatRef) <- (chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $ ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
DB.query DB.query
db db
@ -4799,22 +4803,20 @@ getChatItemByGroupId db user@User {userId} groupId = do
LIMIT 1 LIMIT 1
|] |]
(userId, groupId) (userId, groupId)
getAChatItem_ db user itemId chatRef getAChatItem db user chatRef itemId
getAChatItem :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO AChatItem getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getAChatItem db user@User {userId} itemId = do getChatRefViaItemId db User {userId} itemId = do
chatRef <- ExceptT . firstRow' toChatRef (SEChatItemNotFound itemId) $
ExceptT . firstRow' toChatRef (SEChatItemNotFound itemId) $ DB.query db "SELECT contact_id, group_id FROM chat_items WHERE user_id = ? AND chat_item_id = ?" (userId, itemId)
DB.query db "SELECT contact_id, group_id FROM chat_items WHERE user_id = ? AND chat_item_id = ?" (userId, itemId)
getAChatItem_ db user itemId chatRef
where where
toChatRef = \case toChatRef = \case
(Just contactId, Nothing) -> Right $ ChatRef CTDirect contactId (Just contactId, Nothing) -> Right $ ChatRef CTDirect contactId
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId (Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId
(_, _) -> Left $ SEBadChatItem itemId (_, _) -> Left $ SEBadChatItem itemId
getAChatItem_ :: DB.Connection -> User -> ChatItemId -> ChatRef -> ExceptT StoreError IO AChatItem getAChatItem :: DB.Connection -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ db user itemId = \case getAChatItem db user chatRef itemId = case chatRef of
ChatRef CTDirect contactId -> do ChatRef CTDirect contactId -> do
ct <- getContact db user contactId ct <- getContact db user contactId
(CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId (CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId
@ -4839,7 +4841,9 @@ getChatItemVersions db itemId = do
(Only itemId) (Only itemId)
where where
toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion
toChatItemVersion (chatItemVersionId, msgContent, itemVersionTs, createdAt) = ChatItemVersion {chatItemVersionId, msgContent, itemVersionTs, createdAt} toChatItemVersion (chatItemVersionId, msgContent, itemVersionTs, createdAt) =
let formattedText = parseMaybeMarkdownList $ msgContentText msgContent
in ChatItemVersion {chatItemVersionId, msgContent, formattedText, itemVersionTs, createdAt}
getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect) getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect)
getDirectChatReactions_ db ct c@Chat {chatItems} = do getDirectChatReactions_ db ct c@Chat {chatItems} = do
@ -4984,10 +4988,10 @@ updateDirectCIFileStatus db user fileId fileStatus = do
pure $ AChatItem SCTDirect d cInfo $ updateFileStatus ci fileStatus pure $ AChatItem SCTDirect d cInfo $ updateFileStatus ci fileStatus
_ -> pure aci _ -> pure aci
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64) -> Either StoreError (ChatItemId, ChatRef) toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
toChatItemRef = \case toChatItemRef = \case
(itemId, Just contactId, Nothing) -> Right (itemId, ChatRef CTDirect contactId) (itemId, Just contactId, Nothing) -> Right (ChatRef CTDirect contactId, itemId)
(itemId, Nothing, Just groupId) -> Right (itemId, ChatRef CTGroup groupId) (itemId, Nothing, Just groupId) -> Right (ChatRef CTGroup groupId, itemId)
(itemId, _, _) -> Left $ SEBadChatItem itemId (itemId, _, _) -> Left $ SEBadChatItem itemId
updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO () updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()

View File

@ -424,7 +424,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String) prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString] viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString]
viewChatItemInfo (AChatItem _ msgDir _ _) ChatItemInfo {itemTs, createdAt, deleteAt, itemVersions} tz = viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTimed, createdAt}}) ChatItemInfo {itemVersions} tz =
["sent at: " <> ts itemTs] ["sent at: " <> ts itemTs]
<> receivedAt <> receivedAt
<> toBeDeletedAt <> toBeDeletedAt
@ -434,7 +434,7 @@ viewChatItemInfo (AChatItem _ msgDir _ _) ChatItemInfo {itemTs, createdAt, delet
receivedAt = case msgDir of receivedAt = case msgDir of
SMDRcv -> ["received at: " <> ts createdAt] SMDRcv -> ["received at: " <> ts createdAt]
SMDSnd -> [] SMDSnd -> []
toBeDeletedAt = case deleteAt of toBeDeletedAt = case itemTimed >>= timedDeleteAt' of
Just d -> ["to be deleted at: " <> ts d] Just d -> ["to be deleted at: " <> ts d]
Nothing -> [] Nothing -> []
versions = versions =

View File

@ -283,9 +283,9 @@ testDirectMessageEditHistory =
alice #> "@bob hello!" alice #> "@bob hello!"
bob <# "alice> hello!" bob <# "alice> hello!"
alice ##> ("/_get item info " <> itemId 1) alice ##> ("/_get item info @2 " <> itemId 1)
alice <##. "sent at: " alice <##. "sent at: "
bob ##> ("/_get item info " <> itemId 1) bob ##> ("/_get item info @2 " <> itemId 1)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
@ -293,12 +293,12 @@ testDirectMessageEditHistory =
alice <# "@bob [edited] hey 👋" alice <# "@bob [edited] hey 👋"
bob <# "alice> [edited] hey 👋" bob <# "alice> [edited] hey 👋"
alice ##> ("/_get item info " <> itemId 1) alice ##> ("/_get item info @2 " <> itemId 1)
alice <##. "sent at: " alice <##. "sent at: "
alice <## "message history:" alice <## "message history:"
alice .<## ": hey 👋" alice .<## ": hey 👋"
alice .<## ": hello!" alice .<## ": hello!"
bob ##> ("/_get item info " <> itemId 1) bob ##> ("/_get item info @2 " <> itemId 1)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
bob <## "message history:" bob <## "message history:"
@ -434,12 +434,12 @@ testDirectLiveMessage =
alice <# "@bob [LIVE] hello 2" alice <# "@bob [LIVE] hello 2"
bob <# "alice> [LIVE ended] hello 2" bob <# "alice> [LIVE ended] hello 2"
-- live message has edit history -- live message has edit history
alice ##> ("/_get item info " <> itemId 2) alice ##> ("/_get item info @2 " <> itemId 2)
alice <##. "sent at: " alice <##. "sent at: "
alice <## "message history:" alice <## "message history:"
alice .<## ": hello 2" alice .<## ": hello 2"
alice .<## ":" alice .<## ":"
bob ##> ("/_get item info " <> itemId 2) bob ##> ("/_get item info @2 " <> itemId 2)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
bob <## "message history:" bob <## "message history:"

View File

@ -892,9 +892,9 @@ testGroupMessageEditHistory =
aliceItemId <- lastItemId alice aliceItemId <- lastItemId alice
bobItemId <- lastItemId bob bobItemId <- lastItemId bob
alice ##> ("/_get item info " <> aliceItemId) alice ##> ("/_get item info #1 " <> aliceItemId)
alice <##. "sent at: " alice <##. "sent at: "
bob ##> ("/_get item info " <> bobItemId) bob ##> ("/_get item info #1 " <> bobItemId)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
@ -902,12 +902,12 @@ testGroupMessageEditHistory =
alice <# "#team [edited] hey 👋" alice <# "#team [edited] hey 👋"
bob <# "#team alice> [edited] hey 👋" bob <# "#team alice> [edited] hey 👋"
alice ##> ("/_get item info " <> aliceItemId) alice ##> ("/_get item info #1 " <> aliceItemId)
alice <##. "sent at: " alice <##. "sent at: "
alice <## "message history:" alice <## "message history:"
alice .<## ": hey 👋" alice .<## ": hey 👋"
alice .<## ": hello!" alice .<## ": hello!"
bob ##> ("/_get item info " <> bobItemId) bob ##> ("/_get item info #1 " <> bobItemId)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
bob <## "message history:" bob <## "message history:"
@ -1059,13 +1059,13 @@ testGroupLiveMessage =
bob <# "#team alice> [LIVE ended] hello 2" bob <# "#team alice> [LIVE ended] hello 2"
cath <# "#team alice> [LIVE ended] hello 2" cath <# "#team alice> [LIVE ended] hello 2"
-- live message has edit history -- live message has edit history
alice ##> ("/_get item info " <> msgItemId2) alice ##> ("/_get item info #1 " <> msgItemId2)
alice <##. "sent at: " alice <##. "sent at: "
alice <## "message history:" alice <## "message history:"
alice .<## ": hello 2" alice .<## ": hello 2"
alice .<## ":" alice .<## ":"
bobItemId <- lastItemId bob bobItemId <- lastItemId bob
bob ##> ("/_get item info " <> bobItemId) bob ##> ("/_get item info #1 " <> bobItemId)
bob <##. "sent at: " bob <##. "sent at: "
bob <##. "received at: " bob <##. "received at: "
bob <## "message history:" bob <## "message history:"