blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: fix one item missing from latest in initial and wrong check (#5153)

Browse Source 
* core: fix one item missing from latest in initial and wrong check

* final fixes and tests

* clearer tests
This commit is contained in:
Diogo
2024-11-07 12:51:19 +00:00
committed by GitHub
parent 77df3cc208
commit 0d0f0aa434
3 changed files with 88 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Messages.hs
+6 -6
View File
@@ -1001,7 +1001,7 @@ getDirectChatItemGapToLatest_ db User {userId} Contact {contactId} chatItem sear
":itemCreatedAt" := chatItemCreatedAt chatItem,
":chatItemId" := cchatItemId chatItem
]
pure $ maybe 0 (\c -> max 0 (c - 1)) count
pure $ fromMaybe 0 count
safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
safeGetDirectItem db user ct currentTs itemId =
@@ -1118,7 +1118,7 @@ getDirectChatInitial_ db user@User {userId} ct@Contact {contactId} count = do
(chat, gap) <- getDirectChatAround_ db user ct firstUnreadItemId count ""
case gap of
Just size -> do
if size > snd (divideFetchCountAround_ count)
if size > 0
then getLatestItems_ chat size
else pure (chat, Nothing)
Nothing -> pure (chat, Nothing)
@@ -1199,7 +1199,7 @@ getGroupChatItemGapToLatest_ db User {userId} GroupInfo {groupId} chatItem searc
":itemCreatedAt" := chatItemCreatedAt chatItem,
":chatItemId" := cchatItemId chatItem
]
pure $ maybe 0 (\c -> max 0 (c - 1)) count
pure $ fromMaybe 0 count
safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
safeGetGroupItem db user g currentTs itemId =
@@ -1316,7 +1316,7 @@ getGroupChatInitial_ db user@User {userId} g@GroupInfo {groupId} count = do
(chat, gap) <- getGroupChatAround_ db user g firstUnreadItemId count ""
case gap of
Just size -> do
if size > snd (divideFetchCountAround_ count)
if size > 0
then getLatestItems_ chat size
else pure (chat, Nothing)
Nothing -> pure (chat, Nothing)
@@ -1397,7 +1397,7 @@ getLocalChatItemGapToLatest_ db User {userId} NoteFolder {noteFolderId} chatItem
":itemCreatedAt" := chatItemCreatedAt chatItem,
":chatItemId" := cchatItemId chatItem
]
pure $ maybe 0 (\c -> max 0 (c - 1)) count
pure $ fromMaybe 0 count
safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
@@ -1498,7 +1498,7 @@ getLocalChatInitial_ db user@User {userId} nf@NoteFolder {noteFolderId} count =
(chat, gap) <- getLocalChatAround_ db user nf firstUnreadItemId count ""
case gap of
Just size -> do
if size > snd (divideFetchCountAround_ count)
if size > 0
then getLatestItems_ chat size
else pure (chat, Nothing)
Nothing -> pure (chat, Nothing)
tests/ChatTests/Direct.hs
+40
View File
@@ -66,6 +66,7 @@ chatDirectTests = do
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
it "should send multiline message" testMultilineMessage
it "send large message" testLargeMessage
it "initial chat pagination" testChatPaginationInitial
describe "batch send messages" $ do
it "send multiple messages api" testSendMulti
it "send multiple timed messages" testSendMultiTimed
@@ -361,6 +362,45 @@ testMarkReadDirect = testChat2 aliceProfile bobProfile $ \alice bob -> do
let itemIds = intercalate "," $ map show [i - 3 .. i]
bob #$> ("/_read chat items @2 " <> itemIds, id, "ok")
testChatPaginationInitial :: HasCallStack => FilePath -> IO ()
testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
-- Wait, otherwise ids are going to be wrong.
threadDelay 1000000
-- Send messages from alice to bob
forM_ ([1 .. 10] :: [Int]) $ \n -> alice #> ("@bob " <> show n)
-- Bob receives the messages.
forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("alice> " <> show n)
-- All messages are unread for bob, should return area around unread (audio/video calls chat feature + 1,2nd unread message), and last 2 items
bob #$> ("/_get chat @2 initial=3", chat, [(0, "Audio/video calls: enabled"), (0, "1"), (0, "2"), (0, "8"), (0, "9"), (0, "10")])
-- Read next 2 items
let itemIds = intercalate "," $ map itemId [1 .. 2]
bob #$> ("/_read chat items @2 " <> itemIds, id, "ok")
bob #$> ("/_get chat @2 initial=3", chat, [(0, "2"), (0, "3"), (0, "4"), (0, "8"), (0, "9"), (0, "10")])
-- Read items until gap = 0
let itemIds2 = intercalate "," $ map itemId [3 .. 5]
bob #$> ("/_read chat items @2 " <> itemIds2, id, "ok")
bob #$> ("/_get chat @2 initial=3", chat, [(0, "5"), (0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
-- Read items until intersection
bob #$> ("/_read chat items @2 " <> itemId 6, id, "ok")
bob #$> ("/_get chat @2 initial=3", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
-- Read all items
bob #$> ("/_read chat @2", id, "ok")
bob #$> ("/_get chat @2 initial=3", chat, [(0, "8"), (0, "9"), (0, "10")])
bob #$> ("/_get chat @2 initial=5", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
where
opts =
testOpts
{ markRead = False
}
testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
testDuplicateContactsSeparate =
testChat2 aliceProfile bobProfile $
tests/ChatTests/Groups.hs
+42
View File
@@ -36,6 +36,7 @@ chatGroupTests = do
describe "chat groups" $ do
describe "add contacts, create group and send/receive messages" testGroupMatrix
it "mark multiple messages as read" testMarkReadGroup
it "initial chat pagination" testChatPaginationInitial
it "v1: add contacts, create group and send/receive messages" testGroup
it "v1: add contacts, create group and send/receive messages, check messages" testGroupCheckMessages
it "send large message" testGroupLargeMessage
@@ -375,6 +376,47 @@ testMarkReadGroup = testChat2 aliceProfile bobProfile $ \alice bob -> do
let itemIds = intercalate "," $ map show [i - 3 .. i]
bob #$> ("/_read chat items #1 " <> itemIds, id, "ok")
testChatPaginationInitial :: HasCallStack => FilePath -> IO ()
testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do
createGroup2 "team" alice bob
-- Wait, otherwise ids are going to be wrong.
threadDelay 1000000
lastEventId <- (read :: String -> Int) <$> lastItemId bob
let groupItemId n = show $ lastEventId + n
-- Send messages from alice to bob
forM_ ([1 .. 10] :: [Int]) $ \n -> alice #> ("#team " <> show n)
-- Bob receives the messages.
forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("#team alice> " <> show n)
-- All messages are unread for bob, should return area around unread (connected chat event + 1,2nd unread message), and last 2 items
bob #$> ("/_get chat #1 initial=3", chat, [(0, "connected"), (0, "1"), (0, "2"), (0, "8"), (0, "9"), (0, "10")])
-- Read next 2 items
let itemIds = intercalate "," $ map groupItemId [1 .. 2]
bob #$> ("/_read chat items #1 " <> itemIds, id, "ok")
bob #$> ("/_get chat #1 initial=3", chat, [(0, "2"), (0, "3"), (0, "4"), (0, "8"), (0, "9"), (0, "10")])
-- Read items until gap = 0
let itemIds2 = intercalate "," $ map groupItemId [3 .. 5]
bob #$> ("/_read chat items #1 " <> itemIds2, id, "ok")
bob #$> ("/_get chat #1 initial=3", chat, [(0, "5"), (0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
-- Read items until intersection
bob #$> ("/_read chat items #1 " <> groupItemId 6, id, "ok")
bob #$> ("/_get chat #1 initial=3", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
-- Read all items
bob #$> ("/_read chat #1", id, "ok")
bob #$> ("/_get chat #1 initial=3", chat, [(0, "8"), (0, "9"), (0, "10")])
bob #$> ("/_get chat #1 initial=5", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")])
where
opts =
testOpts
{ markRead = False
}
testGroupLargeMessage :: HasCallStack => FilePath -> IO ()
testGroupLargeMessage =
testChat2 aliceProfile bobProfile $