core: get all chat items API (#2333)

* core: get all chat items API

* test
This commit is contained in:
Evgeny Poberezkin 2023-04-27 09:12:34 +02:00 committed by GitHub
parent f82fa42cba
commit 591aa9eaa5
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 64 additions and 17 deletions

View file

@ -453,7 +453,9 @@ processChatCommand = \case
pure $ CRApiChat user (AChat SCTGroup groupChat)
CTContactRequest -> pure $ chatCmdError (Just user) "not implemented"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIGetChatItems _pagination -> pure $ chatCmdError Nothing "not implemented"
APIGetChatItems pagination search -> withUser $ \user -> do
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
pure $ CRChatItems user chatItems
APISendMessage (ChatRef cType chatId) live (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
@ -4565,7 +4567,7 @@ chatCommandP =
"/sql agent " *> (ExecAgentStoreSQL <$> textP),
"/_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 count=" *> (APIGetChatItems <$> A.decimal),
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
"/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> (" 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),

View file

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

View file

@ -299,6 +299,9 @@ aChatItems (AChat ct Chat {chatInfo, chatItems}) = map aChatItem chatItems
aChatItemId :: AChatItem -> Int64
aChatItemId (AChatItem _ _ _ ci) = chatItemId' ci
aChatItemTs :: AChatItem -> UTCTime
aChatItemTs (AChatItem _ _ _ ci) = chatItemTs' ci
updateFileStatus :: forall c d. ChatItem c d -> CIFileStatus d -> ChatItem c d
updateFileStatus ci@ChatItem {file} status = case file of
Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}

View file

@ -4241,18 +4241,17 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems db user pagination search_ = do
let search = fromMaybe "" search_
case pagination of
CPLast count -> getAllChatItemsLast_ db user count search
CPAfter _afterId _count -> throwError $ SEInternalError "not implemented"
CPBefore _beforeId _count -> throwError $ SEInternalError "not implemented"
getAllChatItemsLast_ :: DB.Connection -> User -> Int -> String -> ExceptT StoreError IO [AChatItem]
getAllChatItemsLast_ db user@User {userId} count search = do
getAllChatItems db user@User {userId} pagination search_ = do
itemRefs <-
liftIO $
reverse . rights . map toChatItemRef
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) itemRefs
where
search = fromMaybe "" search_
getAllChatItemsLast_ count =
reverse
<$> DB.query
db
[sql|
@ -4263,7 +4262,31 @@ getAllChatItemsLast_ db user@User {userId} count search = do
LIMIT ?
|]
(userId, search, count)
mapM (uncurry $ getAChatItem_ db user) itemRefs
getAllChatItemsAfter_ afterId count afterTs =
DB.query
db
[sql|
SELECT chat_item_id, contact_id, group_id
FROM chat_items
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
ORDER BY item_ts ASC, chat_item_id ASC
LIMIT ?
|]
(userId, search, afterTs, afterTs, afterId, count)
getAllChatItemsBefore_ beforeId count beforeTs =
reverse
<$> DB.query
db
[sql|
SELECT chat_item_id, contact_id, group_id
FROM chat_items
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
|]
(userId, search, beforeTs, beforeTs, beforeId, count)
getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName db User {userId} gName =

View file

@ -1544,7 +1544,9 @@ testUserPrivacy =
showActiveUser alice "alisa"
-- connect using second user
connectUsers alice bob
threadDelay 1000000
alice #> "@bob hello"
threadDelay 1000000
bob <# "alisa> hello"
bob #> "@alisa hey"
alice <# "bob> hey"
@ -1576,12 +1578,19 @@ testUserPrivacy =
alice <## "alisa (active, hidden, muted)"
-- hidden message is saved
alice ##> "/tail"
alice <##? chatHistory
alice ##> "/_get items count=10"
alice <##? chatHistory
alice ##> "/_get items before=9 count=10"
alice
<##? [ "bob> Disappearing messages: allowed",
"bob> Full deletion: off",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled",
"@bob hello",
"bob> Audio/video calls: enabled"
]
alice ##> "/_get items after=8 count=10"
alice
<##? [ "@bob hello",
"bob> hey",
"bob> hello again",
"bob> this won't show"
@ -1634,6 +1643,16 @@ testUserPrivacy =
alice <## (current <> "user alisa:")
alice <## "messages are shown"
alice <## "profile is visible"
chatHistory =
[ "bob> Disappearing messages: allowed",
"bob> Full deletion: off",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled",
"@bob hello",
"bob> hey",
"bob> hello again",
"bob> this won't show"
]
testSetChatItemTTL :: HasCallStack => FilePath -> IO ()
testSetChatItemTTL =