IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: update chat item details api (#2456)

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Simplex/Chat.hs
View File

@ -468,22 +468,10 @@ processChatCommand = \case
APIGetChatItems pagination search -> withUser $ \user -> do
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
pure $ CRChatItems user chatItems
APIGetChatItemInfo itemId -> withUser $ \user -> do
(chatItem@(AChatItem _ _ _ ChatItem {meta}), itemVersions) <- withStore $ \db -> do
ci <- getAChatItem db user itemId
versions <- liftIO $ getChatItemVersions db itemId
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
APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
(chatItem, itemVersions) <- withStore $ \db ->
(,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
pure $ CRChatItemInfo user chatItem ChatItemInfo {itemVersions}
APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
CTDirect -> do
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
pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems)
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)
ShowChatItem Nothing -> withUser $ \user -> do
chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing
@ -1498,7 +1488,7 @@ processChatCommand = \case
ShowChatItemInfo chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
itemId <- getChatItemIdByText user chatRef msg
processChatCommand $ APIGetChatItemInfo itemId
processChatCommand $ APIGetChatItemInfo chatRef itemId
ShowLiveItems on -> withUser $ \_ ->
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
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 chat " *> (APIGetChat <$> chatRefP <* A.space <*> 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))),
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),

2
src/Simplex/Chat/Controller.hs
View File

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

8
src/Simplex/Chat/Messages.hs
View File

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

42
src/Simplex/Chat/Store.hs
View File

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

4
src/Simplex/Chat/View.hs
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)
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]
<> receivedAt
<> toBeDeletedAt
@ -434,7 +434,7 @@ viewChatItemInfo (AChatItem _ msgDir _ _) ChatItemInfo {itemTs, createdAt, delet
receivedAt = case msgDir of
SMDRcv -> ["received at: " <> ts createdAt]
SMDSnd -> []
toBeDeletedAt = case deleteAt of
toBeDeletedAt = case itemTimed >>= timedDeleteAt' of
Just d -> ["to be deleted at: " <> ts d]
Nothing -> []
versions =

12
tests/ChatTests/Direct.hs
View File

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

12
tests/ChatTests/Groups.hs
View File

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