core: chat search (#914)

This commit is contained in:
JRoberts
2022-08-08 22:48:42 +04:00
committed by GitHub
parent cd28ba62a1
commit 7531791f1b
4 changed files with 69 additions and 59 deletions

View File

@@ -236,9 +236,9 @@ processChatCommand = \case
APIImportArchive cfg -> checkChatStopped $ importArchive cfg >> setStoreChanged $> CRCmdOk
APIDeleteStorage -> checkChatStopped $ deleteStorage >> setStoreChanged $> CRCmdOk
APIGetChats withPCC -> CRApiChats <$> withUser (\user -> withStore' $ \db -> getChatPreviews db user withPCC)
APIGetChat (ChatRef cType cId) pagination -> withUser $ \user -> case cType of
CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\db -> getDirectChat db user cId pagination)
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\db -> getGroupChat db user cId pagination)
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\db -> getDirectChat db user cId pagination search)
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\db -> getGroupChat db user cId pagination search)
CTContactRequest -> pure $ chatCmdError "not implemented"
CTContactConnection -> pure $ chatCmdError "not supported"
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
@@ -812,7 +812,7 @@ processChatCommand = \case
processChatCommand . APISendMessage (ChatRef CTGroup groupId) $ ComposedMessage Nothing (Just quotedItemId) mc
LastMessages (Just chatName) count -> withUser $ \user -> do
chatRef <- getChatRef user chatName
CRLastMessages . aChatItems . chat <$> (processChatCommand . APIGetChat chatRef $ CPLast count)
CRLastMessages . aChatItems . chat <$> processChatCommand (APIGetChat chatRef (CPLast count) Nothing)
LastMessages Nothing count -> withUser $ \user -> withStore $ \db ->
CRLastMessages <$> getAllChatItems db user (CPLast count)
SendFile chatName f -> withUser $ \user -> do
@@ -2459,7 +2459,7 @@ chatCommandP =
"/_db import " *> (APIImportArchive <$> jsonP),
"/_db delete" $> APIDeleteStorage,
"/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP),
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (A.space *> search)),
"/_get items count=" *> (APIGetChatItems <$> A.decimal),
"/_send " *> (APISendMessage <$> chatRefP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> msgContentP),
@@ -2525,7 +2525,7 @@ chatCommandP =
("/contacts" <|> "/cs") $> ListContacts,
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect" <|> "/c") $> AddContact,
(SendMessage <$> chatNameP <* A.space <*> A.takeByteString),
SendMessage <$> chatNameP <* A.space <*> A.takeByteString,
(">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv),
(">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd),
("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> A.takeByteString),
@@ -2588,6 +2588,7 @@ chatCommandP =
n <- (A.space *> A.takeByteString) <|> pure ""
pure $ if B.null n then name else safeDecodeUtf8 n
filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
search = T.unpack . safeDecodeUtf8 <$> A.takeByteString
memberRole =
(" owner" $> GROwner)
<|> (" admin" $> GRAdmin)

View File

@@ -109,7 +109,7 @@ data ChatCommand
| APIImportArchive ArchiveConfig
| APIDeleteStorage
| APIGetChats {pendingConnections :: Bool}
| APIGetChat ChatRef ChatPagination
| APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems Int
| APISendMessage ChatRef ComposedMessage
| APIUpdateChatItem ChatRef ChatItemId MsgContent

View File

@@ -2788,15 +2788,16 @@ toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Mayb
toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, viaUserContactLink, createdAt, updatedAt) =
PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, viaUserContactLink, createdAt, updatedAt}
getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat db user contactId pagination = do
getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat db user contactId pagination search_ = do
let search = fromMaybe "" search_
case pagination of
CPLast count -> getDirectChatLast_ db user contactId count
CPAfter afterId count -> getDirectChatAfter_ db user contactId afterId count
CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count
CPLast count -> getDirectChatLast_ db user contactId count search
CPAfter afterId count -> getDirectChatAfter_ db user contactId afterId count search
CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count search
getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatLast_ db User {userId} contactId count = do
getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatLast_ db User {userId} contactId count search = do
contact <- getContact db userId contactId
stats <- liftIO $ getDirectChatStats_ db userId contactId
chatItems <- ExceptT getDirectChatItemsLast_
@@ -2820,14 +2821,14 @@ getDirectChatLast_ db User {userId} contactId count = do
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1 AND i.item_text LIKE '%' || ? || '%'
ORDER BY i.chat_item_id DESC
LIMIT ?
|]
(userId, contactId, count)
(userId, contactId, search, count)
getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db User {userId} contactId afterChatItemId count search = do
contact <- getContact db userId contactId
stats <- liftIO $ getDirectChatStats_ db userId contactId
chatItems <- ExceptT getDirectChatItemsAfter_
@@ -2851,14 +2852,15 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id > ? AND i.item_deleted != 1
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1 AND i.item_text LIKE '%' || ? || '%'
AND i.chat_item_id > ?
ORDER BY i.chat_item_id ASC
LIMIT ?
|]
(userId, contactId, afterChatItemId, count)
(userId, contactId, search, afterChatItemId, count)
getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do
getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db User {userId} contactId beforeChatItemId count search = do
contact <- getContact db userId contactId
stats <- liftIO $ getDirectChatStats_ db userId contactId
chatItems <- ExceptT getDirectChatItemsBefore_
@@ -2882,11 +2884,12 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id < ? AND i.item_deleted != 1
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1 AND i.item_text LIKE '%' || ? || '%'
AND i.chat_item_id < ?
ORDER BY i.chat_item_id DESC
LIMIT ?
|]
(userId, contactId, beforeChatItemId, count)
(userId, contactId, search, beforeChatItemId, count)
getDirectChatStats_ :: DB.Connection -> UserId -> Int64 -> IO ChatStats
getDirectChatStats_ db userId contactId =
@@ -2940,15 +2943,16 @@ getContact db userId contactId =
|]
(userId, contactId, ConnReady, ConnSndReady)
getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat db user groupId pagination = do
getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat db user groupId pagination search_ = do
let search = fromMaybe "" search_
case pagination of
CPLast count -> getGroupChatLast_ db user groupId count
CPAfter afterId count -> getGroupChatAfter_ db user groupId afterId count
CPBefore beforeId count -> getGroupChatBefore_ db user groupId beforeId count
CPLast count -> getGroupChatLast_ db user groupId count search
CPAfter afterId count -> getGroupChatAfter_ db user groupId afterId count search
CPBefore beforeId count -> getGroupChatBefore_ db user groupId beforeId count search
getGroupChatLast_ :: DB.Connection -> User -> Int64 -> Int -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ db user@User {userId} groupId count = do
getGroupChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ db user@User {userId} groupId count search = do
groupInfo <- getGroupInfo db user groupId
stats <- liftIO $ getGroupChatStats_ db userId groupId
chatItemIds <- liftIO getGroupChatItemIdsLast_
@@ -2963,14 +2967,14 @@ getGroupChatLast_ db user@User {userId} groupId count = do
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_deleted != 1
WHERE user_id = ? AND group_id = ? AND item_deleted != 1 AND item_text LIKE '%' || ? || '%'
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
|]
(userId, groupId, count)
(userId, groupId, search, count)
getGroupChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count = do
getGroupChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count search = do
groupInfo <- getGroupInfo db user groupId
stats <- liftIO $ getGroupChatStats_ db userId groupId
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
@@ -2986,15 +2990,15 @@ getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count = do
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_deleted != 1
WHERE user_id = ? AND group_id = ? AND item_deleted != 1 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, groupId, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
(userId, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
getGroupChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count = do
getGroupChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count search = do
groupInfo <- getGroupInfo db user groupId
stats <- liftIO $ getGroupChatStats_ db userId groupId
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
@@ -3010,12 +3014,12 @@ getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count = do
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_deleted != 1
WHERE user_id = ? AND group_id = ? AND item_deleted != 1 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, groupId, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
getGroupChatStats_ :: DB.Connection -> UserId -> Int64 -> IO ChatStats
getGroupChatStats_ db userId groupId =

View File

@@ -159,11 +159,13 @@ testAddContact = versionTestMatrix2 runTestAddContact
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
chatsEmpty alice bob
alice #> "@bob hello 🙂"
bob <# "alice> hello 🙂"
alice #> "@bob hello there 🙂"
bob <# "alice> hello there 🙂"
chatsOneMessage alice bob
bob #> "@alice hi"
alice <# "bob> hi"
bob #> "@alice hello there"
alice <# "bob> hello there"
bob #> "@alice how are you?"
alice <# "bob> how are you?"
chatsManyMessages alice bob
-- test adding the same contact one more time - local name will be different
alice ##> "/c"
@@ -177,15 +179,15 @@ testAddContact = versionTestMatrix2 runTestAddContact
bob <# "alice_1> hello"
bob #> "@alice_1 hi"
alice <# "bob_1> hi"
alice @@@ [("@bob_1", "hi"), ("@bob", "hi")]
bob @@@ [("@alice_1", "hi"), ("@alice", "hi")]
alice @@@ [("@bob_1", "hi"), ("@bob", "how are you?")]
bob @@@ [("@alice_1", "hi"), ("@alice", "how are you?")]
-- test deleting contact
alice ##> "/d bob_1"
alice <## "bob_1: contact is deleted"
alice ##> "@bob_1 hey"
alice <## "no contact bob_1"
alice @@@ [("@bob", "hi")]
bob @@@ [("@alice_1", "hi"), ("@alice", "hi")]
alice @@@ [("@bob", "how are you?")]
bob @@@ [("@alice_1", "hi"), ("@alice", "how are you?")]
-- test clearing chat
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
alice #$> ("/_get chat @2 count=100", chat, [])
@@ -197,18 +199,20 @@ testAddContact = versionTestMatrix2 runTestAddContact
bob @@@ [("@alice", "")]
bob #$> ("/_get chat @2 count=100", chat, [])
chatsOneMessage alice bob = do
alice @@@ [("@bob", "hello 🙂")]
alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂")])
bob @@@ [("@alice", "hello 🙂")]
bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂")])
alice @@@ [("@bob", "hello there 🙂")]
alice #$> ("/_get chat @2 count=100", chat, [(1, "hello there 🙂")])
bob @@@ [("@alice", "hello there 🙂")]
bob #$> ("/_get chat @2 count=100", chat, [(0, "hello there 🙂")])
chatsManyMessages alice bob = do
alice @@@ [("@bob", "hi")]
alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂"), (0, "hi")])
bob @@@ [("@alice", "hi")]
bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂"), (1, "hi")])
alice @@@ [("@bob", "how are you?")]
alice #$> ("/_get chat @2 count=100", chat, [(1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")])
bob @@@ [("@alice", "how are you?")]
bob #$> ("/_get chat @2 count=100", chat, [(0, "hello there 🙂"), (1, "hello there"), (1, "how are you?")])
-- pagination
alice #$> ("/_get chat @2 after=1 count=100", chat, [(0, "hi")])
alice #$> ("/_get chat @2 before=2 count=100", chat, [(1, "hello 🙂")])
alice #$> ("/_get chat @2 after=1 count=100", chat, [(0, "hello there"), (0, "how are you?")])
alice #$> ("/_get chat @2 before=2 count=100", chat, [(1, "hello there 🙂")])
-- search
alice #$> ("/_get chat @2 count=100 ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")])
-- read messages
alice #$> ("/_read chat @2 from=1 to=100", id, "ok")
bob #$> ("/_read chat @2 from=1 to=100", id, "ok")
@@ -475,6 +479,7 @@ testGroupShared alice bob cath checkMessages = do
-- so we take into account group event items as well as sent group invitations in direct chats
alice #$> ("/_get chat #1 after=5 count=100", chat, [(0, "hi there"), (0, "hey team")])
alice #$> ("/_get chat #1 before=7 count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")])
alice #$> ("/_get chat #1 count=100 team", chat, [(0, "hey team")])
bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
bob #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]