lovely-projects/simplex-chat
lovely-projects/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-03-14 09:45:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

core: pagination API to load items around defined or the earliest unread item (#5100)

Browse source 
* core: auto increment chat item ids (#5088)

* core: auto increment chat item ids

* file name

* down name

* update schema

* ignore down migration on schema dump test

* fix testDirectMessageDelete test

* fix testNotes test

* core: initial api support for items around a given item (#5092)

* core: initial api support for items around a given item

* implementation and tests for local messages

* pass entities down

* unused

* getAllChatItems implementation and tests

* pagination for getting chat and tests

* remove unused import

* group implementation and tests

* refactor

* order by created at for local and direct chats

* core: initial landing api for chat and gaps  (#5104)

* initial work on initial param for loading chat

* support for initial

* controller parse

* fixed sqls

* refactor names

* fix ChatLandingSection serialized type

* total accuracy on landing section

* descriptive view message

* foldr

* refactor to make landingSection reusable

* refactor: use foldr everywhere

* propagate search

* Revert "propagate search"

This reverts commit 01611fd719.

* throw when search is sent for initial

* gap size wip (needs testing)

* final

* remove order by

* remove index

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* core: fix initial api latest chat items ordering (#5151)

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

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

* final fixes and tests

* clearer tests

* core: remove gaps and make sure page size is always the same (#5163)

* remove gaps

* consistent pagination size

* proper fix and around fix too

* optimize

* refactor

* core: simplify pagination

* core: first unread queries (#5174)

* core: pagination nav info (#5175)

* core: pagination nav info

* wip

* rework

* rework

* group, local

* fix

* rename

* fix tests

* just

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
Diogo 2024-11-14 08:34:25 +00:00 • committed by GitHub
parent 60c37f0d1d
commit 4d82209a3a
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
14 changed files with 665 additions and 204 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
apps/simplex-directory-service/src/Directory/Service.hs
View file

@ -630,7 +630,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
listGroups count pending =
readTVarIO (groupRegs st) >>= \groups -> do
grs <-
if pending
if pending
then filterM (fmap pendingApproval . readTVarIO . groupRegStatus) groups
else pure groups
sendReply $ tshow (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> tshow count else "")
@ -689,7 +689,7 @@ getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId)
where
resp :: ChatResponse -> Maybe Contact
resp = \case
CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) -> Just ct
CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) _ -> Just ct
_ -> Nothing
getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo)

1
simplex-chat.cabal
View file

@ -150,6 +150,7 @@ library
Simplex.Chat.Migrations.M20240920_user_order
Simplex.Chat.Migrations.M20241008_indexes
Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared

14
src/Simplex/Chat.hs
View file

@ -735,14 +735,14 @@ processChatCommand' vr = \case
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
-- TODO optimize queries calculating ChatStats, currently they're disabled
CTDirect -> do
directChat <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
pure $ CRApiChat user (AChat SCTDirect directChat)
(directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
pure $ CRApiChat user (AChat SCTDirect directChat) navInfo
CTGroup -> do
groupChat <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
pure $ CRApiChat user (AChat SCTGroup groupChat)
(groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo
CTLocal -> do
localChat <- withFastStore (\db -> getLocalChat db user cId pagination search)
pure $ CRApiChat user (AChat SCTLocal localChat)
(localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search)
pure $ CRApiChat user (AChat SCTLocal localChat) navInfo
CTContactRequest -> pure $ chatCmdError (Just user) "not implemented"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIGetChatItems pagination search -> withUser $ \user -> do
@ -8301,6 +8301,8 @@ chatCommandP =
(CPLast <$ "count=" <*> A.decimal)
<|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
<|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
<|> (CPAround <$ "around=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
<|> (CPInitial <$ "initial=" <*> A.decimal)
paginationByTimeP =
(PTLast <$ "count=" <*> A.decimal)
<|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal)

4
src/Simplex/Chat/Controller.hs
View file

@ -572,7 +572,7 @@ data ChatResponse
| CRChatSuspended
| CRApiChats {user :: User, chats :: [AChat]}
| CRChats {chats :: [AChat]}
| CRApiChat {user :: User, chat :: AChat}
| CRApiChat {user :: User, chat :: AChat, navInfo :: Maybe NavigationInfo}
| CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
| CRChatItemId User (Maybe ChatItemId)
@ -839,6 +839,8 @@ data ChatPagination
= CPLast Int
| CPAfter ChatItemId Int
| CPBefore ChatItemId Int
| CPAround ChatItemId Int
| CPInitial Int
deriving (Show)
data PaginationByTime

18
src/Simplex/Chat/Messages.hs
View file

@ -227,8 +227,8 @@ data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (Cha
deriving instance Show (CChatItem c)
cchatItemId :: CChatItem c -> ChatItemId
cchatItemId (CChatItem _ ci) = chatItemId' ci
cChatItemId :: CChatItem c -> ChatItemId
cChatItemId (CChatItem _ ci) = chatItemId' ci
chatItemId' :: ChatItem c d -> ChatItemId
chatItemId' ChatItem {meta = CIMeta {itemId}} = itemId
@ -239,6 +239,12 @@ chatItemTs (CChatItem _ ci) = chatItemTs' ci
chatItemTs' :: ChatItem c d -> UTCTime
chatItemTs' ChatItem {meta = CIMeta {itemTs}} = itemTs
ciCreatedAt :: CChatItem c -> UTCTime
ciCreatedAt (CChatItem _ ci) = ciCreatedAt' ci
ciCreatedAt' :: ChatItem c d -> UTCTime
ciCreatedAt' ChatItem {meta = CIMeta {createdAt}} = createdAt
chatItemTimed :: ChatItem c d -> Maybe CITimed
chatItemTimed ChatItem {meta = CIMeta {itemTimed}} = itemTimed
@ -318,6 +324,12 @@ data ChatStats = ChatStats
}
deriving (Show)
data NavigationInfo = NavigationInfo
{ afterUnread :: Int,
afterTotal :: Int
}
deriving (Show)
-- | type to show a mix of messages from multiple chats
data AChatItem = forall c d. (ChatTypeI c, MsgDirectionI d) => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
@ -1408,6 +1420,8 @@ $(JQ.deriveJSON defaultJSON ''ChatItemInfo)
$(JQ.deriveJSON defaultJSON ''ChatStats)
$(JQ.deriveJSON defaultJSON ''NavigationInfo)
instance ChatTypeI c => ToJSON (Chat c) where
toJSON = $(JQ.mkToJSON defaultJSON ''Chat)
toEncoding = $(JQ.mkToEncoding defaultJSON ''Chat)

34
src/Simplex/Chat/Migrations/M20241023_chat_item_autoincrement_id.hs Normal file
View file

@ -0,0 +1,34 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20241023_chat_item_autoincrement_id :: Query
m20241023_chat_item_autoincrement_id =
[sql|
INSERT INTO sqlite_sequence (name, seq)
SELECT 'chat_items', MAX(ROWID) FROM chat_items;
PRAGMA writable_schema=1;
UPDATE sqlite_master SET sql = replace(sql, 'INTEGER PRIMARY KEY', 'INTEGER PRIMARY KEY AUTOINCREMENT')
WHERE name = 'chat_items' AND type = 'table';
PRAGMA writable_schema=0;
|]
down_m20241023_chat_item_autoincrement_id :: Query
down_m20241023_chat_item_autoincrement_id =
[sql|
DELETE FROM sqlite_sequence WHERE name = 'chat_items';
PRAGMA writable_schema=1;
UPDATE sqlite_master
SET sql = replace(sql, 'INTEGER PRIMARY KEY AUTOINCREMENT', 'INTEGER PRIMARY KEY')
WHERE name = 'chat_items' AND type = 'table';
PRAGMA writable_schema=0;
|]

4
src/Simplex/Chat/Migrations/chat_schema.sql
View file

@ -360,7 +360,7 @@ CREATE TABLE pending_group_messages(
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE TABLE chat_items(
chat_item_id INTEGER PRIMARY KEY,
chat_item_id INTEGER PRIMARY KEY AUTOINCREMENT,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
group_id INTEGER REFERENCES groups ON DELETE CASCADE,
@ -399,6 +399,7 @@ CREATE TABLE chat_items(
fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL,
via_proxy INTEGER
);
CREATE TABLE sqlite_sequence(name,seq);
CREATE TABLE chat_item_messages(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
message_id INTEGER NOT NULL UNIQUE REFERENCES messages ON DELETE CASCADE,
@ -429,7 +430,6 @@ CREATE TABLE commands(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE TABLE sqlite_sequence(name,seq);
CREATE TABLE settings(
settings_id INTEGER PRIMARY KEY,
chat_item_ttl INTEGER,

682
src/Simplex/Chat/Store/Messages.hs
View file

@ -3,6 +3,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
@ -947,37 +948,41 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
aChat = AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
in ACPD SCTContactConnection $ ContactConnectionPD updatedAt aChat
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat db vr user contactId pagination search_ = do
let search = fromMaybe "" search_
ct <- getContact db vr user contactId
liftIO $ case pagination of
CPLast count -> getDirectChatLast_ db user ct count search
CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search
CPBefore beforeId count -> getDirectChatBefore_ db user ct beforeId count search
case pagination of
CPLast count -> liftIO $ (,Nothing) <$> getDirectChatLast_ db user ct count search
CPAfter afterId count -> (,Nothing) <$> getDirectChatAfter_ db user ct afterId count search
CPBefore beforeId count -> (,Nothing) <$> getDirectChatBefore_ db user ct beforeId count search
CPAround aroundId count -> getDirectChatAround_ db user ct aroundId count search
CPInitial count -> do
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getDirectChatInitial_ db user ct count
-- the last items in reverse order (the last item in the conversation is the first in the returned list)
getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> String -> IO (Chat 'CTDirect)
getDirectChatLast_ db user@User {userId} ct@Contact {contactId} count search = do
getDirectChatLast_ db user ct count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getDirectChatItemIdsLast_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
pure $ Chat (DirectChat ct) (reverse chatItems) stats
where
getDirectChatItemIdsLast_ :: IO [ChatItemId]
getDirectChatItemIdsLast_ =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, contactId, search, count)
ciIds <- getDirectChatItemIdsLast_ db user ct count search
ts <- getCurrentTime
cis <- mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) (reverse cis) stats
getDirectChatItemIdsLast_ :: DB.Connection -> User -> Contact -> Int -> String -> IO [ChatItemId]
getDirectChatItemIdsLast_ db User {userId} Contact {contactId} count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, contactId, search, count)
safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
safeGetDirectItem db user ct currentTs itemId =
@ -1021,82 +1026,181 @@ getDirectChatItemLast db user@User {userId} contactId = do
(userId, contactId)
getDirectChatItem db user contactId chatItemId
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect)
getDirectChatAfter_ db user@User {userId} ct@Contact {contactId} afterChatItemId count search = do
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db user ct@Contact {contactId} afterId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getDirectChatItemIdsAfter_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
pure $ Chat (DirectChat ct) chatItems stats
afterCI <- getDirectChatItem db user contactId afterId
ciIds <- liftIO $ getDirectCIsAfter_ db user ct afterCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) cis stats
getDirectCIsAfter_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> String -> IO [ChatItemId]
getDirectCIsAfter_ db User {userId} Contact {contactId} afterCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
|]
(userId, contactId, search, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI, count)
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db user ct@Contact {contactId} beforeId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
beforeCI <- getDirectChatItem db user contactId beforeId
ciIds <- liftIO $ getDirectCIsBefore_ db user ct beforeCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) (reverse cis) stats
getDirectCIsBefore_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> String -> IO [ChatItemId]
getDirectCIsBefore_ db User {userId} Contact {contactId} beforeCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, contactId, search, ciCreatedAt beforeCI, ciCreatedAt beforeCI, cChatItemId beforeCI, count)
getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ db user ct aroundId count search = do
stats <- liftIO $ getContactStats_ db user ct
getDirectChatAround' db user ct aroundId count search stats
getDirectChatAround' :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ChatStats -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' db user ct@Contact {contactId} aroundId count search stats = do
aroundCI <- getDirectChatItem db user contactId aroundId
beforeIds <- liftIO $ getDirectCIsBefore_ db user ct aroundCI count search
afterIds <- liftIO $ getDirectCIsAfter_ db user ct aroundCI count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetDirectItem db user ct ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetDirectItem db user ct ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (DirectChat ct) cis stats, Just navInfo)
where
getDirectChatItemIdsAfter_ :: IO [ChatItemId]
getDirectChatItemIdsAfter_ =
map fromOnly
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
cis -> getContactNavInfo_ db user ct (last cis)
getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ db user ct count = do
liftIO (getContactMinUnreadId_ db user ct) >>= \case
Just minUnreadItemId -> do
unreadCount <- liftIO $ getContactUnreadCount_ db user ct
let stats = ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getDirectChatAround' db user ct minUnreadItemId count "" stats
Nothing -> liftIO $ (,Just $ NavigationInfo 0 0) <$> getDirectChatLast_ db user ct count ""
getContactStats_ :: DB.Connection -> User -> Contact -> IO ChatStats
getContactStats_ db user ct = do
minUnreadItemId <- fromMaybe 0 <$> getContactMinUnreadId_ db user ct
unreadCount <- getContactUnreadCount_ db user ct
pure ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getContactMinUnreadId_ :: DB.Connection -> User -> Contact -> IO (Maybe ChatItemId)
getContactMinUnreadId_ db User {userId} Contact {contactId} =
fmap join . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_status = ?
ORDER BY created_at ASC, chat_item_id ASC
LIMIT 1
|]
(userId, contactId, CISRcvNew)
getContactUnreadCount_ :: DB.Connection -> User -> Contact -> IO Int
getContactUnreadCount_ db User {userId} Contact {contactId} =
fromOnly . head
<$> DB.query
db
[sql|
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|]
(userId, contactId, CISRcvNew)
getContactNavInfo_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO NavigationInfo
getContactNavInfo_ db User {userId} Contact {contactId} afterCI = do
afterUnread <- getAfterUnreadCount
afterTotal <- getAfterTotalCount
pure NavigationInfo {afterUnread, afterTotal}
where
getAfterUnreadCount :: IO Int
getAfterUnreadCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT chat_item_id
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
AND chat_item_id > ?
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
WHERE user_id = ? AND contact_id = ? AND item_status = ?
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|]
(userId, contactId, search, afterChatItemId, count)
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect)
getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItemId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getDirectChatItemsIdsBefore_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
pure $ Chat (DirectChat ct) (reverse chatItems) stats
where
getDirectChatItemsIdsBefore_ :: IO [ChatItemId]
getDirectChatItemsIdsBefore_ =
map fromOnly
(userId, contactId, CISRcvNew, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI)
getAfterTotalCount :: IO Int
getAfterTotalCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT chat_item_id
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
AND chat_item_id < ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
WHERE user_id = ? AND contact_id = ?
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|]
(userId, contactId, search, beforeChatItemId, count)
(userId, contactId, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI)
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChat db vr user groupId pagination search_ = do
let search = fromMaybe "" search_
g <- getGroupInfo db vr user groupId
case pagination of
CPLast count -> liftIO $ getGroupChatLast_ db user g count search
CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search
CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search
CPLast count -> liftIO $ (,Nothing) <$> getGroupChatLast_ db user g count search
CPAfter afterId count -> (,Nothing) <$> getGroupChatAfter_ db user g afterId count search
CPBefore beforeId count -> (,Nothing) <$> getGroupChatBefore_ db user g beforeId count search
CPAround aroundId count -> getGroupChatAround_ db user g aroundId count search
CPInitial count -> do
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getGroupChatInitial_ db user g count
getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> IO (Chat 'CTGroup)
getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do
getGroupChatLast_ db user g count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getGroupChatItemIdsLast_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetGroupItem db user g currentTs) chatItemIds
pure $ Chat (GroupChat g) (reverse chatItems) stats
where
getGroupChatItemIdsLast_ :: IO [ChatItemId]
getGroupChatItemIdsLast_ =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
|]
(userId, groupId, search, count)
ciIds <- getGroupChatItemIdsLast_ db user g count search
ts <- getCurrentTime
cis <- mapM (safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g) (reverse cis) stats
getGroupChatItemIdsLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> IO [ChatItemId]
getGroupChatItemIdsLast_ db User {userId} GroupInfo {groupId} count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
|]
(userId, groupId, search, count)
safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
safeGetGroupItem db user g currentTs itemId =
@ -1141,83 +1245,180 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
getGroupChatItem db user groupId chatItemId
getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId count search = do
getGroupChatAfter_ db user g@GroupInfo {groupId} afterId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem)
currentTs <- liftIO getCurrentTime
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
pure $ Chat (GroupChat g) chatItems stats
where
getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId]
getGroupChatItemIdsAfter_ afterChatItemTs =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_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, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
afterCI <- getGroupChatItem db user groupId afterId
ciIds <- liftIO $ getGroupCIsAfter_ db user g afterCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g) cis stats
getGroupCIsAfter_ :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> Int -> String -> IO [ChatItemId]
getGroupCIsAfter_ db User {userId} GroupInfo {groupId} afterCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_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, groupId, search, chatItemTs afterCI, chatItemTs afterCI, cChatItemId afterCI, count)
getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId count search = do
getGroupChatBefore_ db user g@GroupInfo {groupId} beforeId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem)
currentTs <- liftIO getCurrentTime
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
pure $ Chat (GroupChat g) (reverse chatItems) stats
beforeCI <- getGroupChatItem db user groupId beforeId
ciIds <- liftIO $ getGroupCIsBefore_ db user g beforeCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g) (reverse cis) stats
getGroupCIsBefore_ :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> Int -> String -> IO [ChatItemId]
getGroupCIsBefore_ db User {userId} GroupInfo {groupId} beforeCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_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, groupId, search, chatItemTs beforeCI, chatItemTs beforeCI, cChatItemId beforeCI, count)
getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround_ db user g aroundId count search = do
stats <- liftIO $ getGroupStats_ db user g
getGroupChatAround' db user g aroundId count search stats
getGroupChatAround' :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ChatStats -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' db user g@GroupInfo {groupId} aroundId count search stats = do
aroundCI <- getGroupChatItem db user groupId aroundId
beforeIds <- liftIO $ getGroupCIsBefore_ db user g aroundCI count search
afterIds <- liftIO $ getGroupCIsAfter_ db user g aroundCI count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetGroupItem db user g ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetGroupItem db user g ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (GroupChat g) cis stats, Just navInfo)
where
getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId]
getGroupChatItemIdsBefore_ beforeChatItemTs =
map fromOnly
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
cis -> getGroupNavInfo_ db user g (last cis)
getGroupChatInitial_ :: DB.Connection -> User -> GroupInfo -> Int -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatInitial_ db user g count =
liftIO (getGroupMinUnreadId_ db user g) >>= \case
Just minUnreadItemId -> do
unreadCount <- liftIO $ getGroupUnreadCount_ db user g
let stats = ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getGroupChatAround' db user g minUnreadItemId count "" stats
Nothing -> liftIO $ (,Just $ NavigationInfo 0 0) <$> getGroupChatLast_ db user g count ""
getGroupStats_ :: DB.Connection -> User -> GroupInfo -> IO ChatStats
getGroupStats_ db user g = do
minUnreadItemId <- fromMaybe 0 <$> getGroupMinUnreadId_ db user g
unreadCount <- getGroupUnreadCount_ db user g
pure ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getGroupMinUnreadId_ :: DB.Connection -> User -> GroupInfo -> IO (Maybe ChatItemId)
getGroupMinUnreadId_ db User {userId} GroupInfo {groupId} =
fmap join . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_status = ?
ORDER BY item_ts ASC, chat_item_id ASC
LIMIT 1
|]
(userId, groupId, CISRcvNew)
getGroupUnreadCount_ :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupUnreadCount_ db User {userId} GroupInfo {groupId} =
fromOnly . head
<$> DB.query
db
[sql|
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_status = ?
|]
(userId, groupId, CISRcvNew)
getGroupNavInfo_ :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO NavigationInfo
getGroupNavInfo_ db User {userId} GroupInfo {groupId} afterCI = do
afterUnread <- getAfterUnreadCount
afterTotal <- getAfterTotalCount
pure NavigationInfo {afterUnread, afterTotal}
where
getAfterUnreadCount :: IO Int
getAfterUnreadCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT chat_item_id
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND group_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 ?
WHERE user_id = ? AND group_id = ? AND item_status = ?
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
|]
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
(userId, groupId, CISRcvNew, chatItemTs afterCI, chatItemTs afterCI, cChatItemId afterCI)
getAfterTotalCount :: IO Int
getAfterTotalCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND group_id = ?
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
|]
(userId, groupId, chatItemTs afterCI, chatItemTs afterCI, cChatItemId afterCI)
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat db user folderId pagination search_ = do
let search = fromMaybe "" search_
nf <- getNoteFolder db user folderId
liftIO $ case pagination of
CPLast count -> getLocalChatLast_ db user nf count search
CPAfter afterId count -> getLocalChatAfter_ db user nf afterId count search
CPBefore beforeId count -> getLocalChatBefore_ db user nf beforeId count search
case pagination of
CPLast count -> liftIO $ (,Nothing) <$> getLocalChatLast_ db user nf count search
CPAfter afterId count -> (,Nothing) <$> getLocalChatAfter_ db user nf afterId count search
CPBefore beforeId count -> (,Nothing) <$> getLocalChatBefore_ db user nf beforeId count search
CPAround aroundId count -> getLocalChatAround_ db user nf aroundId count search
CPInitial count -> do
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getLocalChatInitial_ db user nf count
getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> IO (Chat 'CTLocal)
getLocalChatLast_ db user@User {userId} nf@NoteFolder {noteFolderId} count search = do
getLocalChatLast_ db user nf count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getLocalChatItemIdsLast_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
pure $ Chat (LocalChat nf) (reverse chatItems) stats
where
getLocalChatItemIdsLast_ :: IO [ChatItemId]
getLocalChatItemIdsLast_ =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, noteFolderId, search, count)
ciIds <- getLocalChatItemIdsLast_ db user nf count search
ts <- getCurrentTime
cis <- mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) (reverse cis) stats
getLocalChatItemIdsLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> IO [ChatItemId]
getLocalChatItemIdsLast_ db User {userId} NoteFolder {noteFolderId} count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, noteFolderId, search, count)
safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
@ -1245,51 +1446,146 @@ safeToLocalItem currentTs itemId = \case
file = Nothing
}
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal)
getLocalChatAfter_ db user@User {userId} nf@NoteFolder {noteFolderId} afterChatItemId count search = do
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} afterId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getLocalChatItemIdsAfter_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
pure $ Chat (LocalChat nf) chatItems stats
where
getLocalChatItemIdsAfter_ :: IO [ChatItemId]
getLocalChatItemIdsAfter_ =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
AND chat_item_id > ?
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
|]
(userId, noteFolderId, search, afterChatItemId, count)
afterCI <- getLocalChatItem db user noteFolderId afterId
ciIds <- liftIO $ getLocalCIsAfter_ db user nf afterCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) cis stats
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal)
getLocalChatBefore_ db user@User {userId} nf@NoteFolder {noteFolderId} beforeChatItemId count search = do
getLocalCIsAfter_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> String -> IO [ChatItemId]
getLocalCIsAfter_ db User {userId} NoteFolder {noteFolderId} afterCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
|]
(userId, noteFolderId, search, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI, count)
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ db user nf@NoteFolder {noteFolderId} beforeId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- getLocalChatItemIdsBefore_
currentTs <- getCurrentTime
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
pure $ Chat (LocalChat nf) (reverse chatItems) stats
beforeCI <- getLocalChatItem db user noteFolderId beforeId
ciIds <- liftIO $ getLocalCIsBefore_ db user nf beforeCI count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) (reverse cis) stats
getLocalCIsBefore_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> String -> IO [ChatItemId]
getLocalCIsBefore_ db User {userId} NoteFolder {noteFolderId} beforeCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, noteFolderId, search, ciCreatedAt beforeCI, ciCreatedAt beforeCI, cChatItemId beforeCI, count)
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ db user nf aroundId count search = do
stats <- liftIO $ getLocalStats_ db user nf
getLocalChatAround' db user nf aroundId count search stats
getLocalChatAround' :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ChatStats -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' db user nf@NoteFolder {noteFolderId} aroundId count search stats = do
aroundCI <- getLocalChatItem db user noteFolderId aroundId
beforeIds <- liftIO $ getLocalCIsBefore_ db user nf aroundCI count search
afterIds <- liftIO $ getLocalCIsAfter_ db user nf aroundCI count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetLocalItem db user nf ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetLocalItem db user nf ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (LocalChat nf) cis stats, Just navInfo)
where
getLocalChatItemIdsBefore_ :: IO [ChatItemId]
getLocalChatItemIdsBefore_ =
map fromOnly
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
cis -> getLocalNavInfo_ db user nf (last cis)
getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ db user nf count = do
liftIO (getLocalMinUnreadId_ db user nf) >>= \case
Just minUnreadItemId -> do
unreadCount <- liftIO $ getLocalUnreadCount_ db user nf
let stats = ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getLocalChatAround' db user nf minUnreadItemId count "" stats
Nothing -> liftIO $ (,Just $ NavigationInfo 0 0) <$> getLocalChatLast_ db user nf count ""
getLocalStats_ :: DB.Connection -> User -> NoteFolder -> IO ChatStats
getLocalStats_ db user nf = do
minUnreadItemId <- fromMaybe 0 <$> getLocalMinUnreadId_ db user nf
unreadCount <- getLocalUnreadCount_ db user nf
pure ChatStats {unreadCount, minUnreadItemId, unreadChat = False}
getLocalMinUnreadId_ :: DB.Connection -> User -> NoteFolder -> IO (Maybe ChatItemId)
getLocalMinUnreadId_ db User {userId} NoteFolder {noteFolderId} =
fmap join . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
ORDER BY created_at ASC, chat_item_id ASC
LIMIT 1
|]
(userId, noteFolderId, CISRcvNew)
getLocalUnreadCount_ :: DB.Connection -> User -> NoteFolder -> IO Int
getLocalUnreadCount_ db User {userId} NoteFolder {noteFolderId} =
fromOnly . head
<$> DB.query
db
[sql|
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
|]
(userId, noteFolderId, CISRcvNew)
getLocalNavInfo_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> IO NavigationInfo
getLocalNavInfo_ db User {userId} NoteFolder {noteFolderId} afterCI = do
afterUnread <- getAfterUnreadCount
afterTotal <- getAfterTotalCount
pure NavigationInfo {afterUnread, afterTotal}
where
getAfterUnreadCount :: IO Int
getAfterUnreadCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT chat_item_id
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
AND chat_item_id < ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|]
(userId, noteFolderId, search, beforeChatItemId, count)
(userId, noteFolderId, CISRcvNew, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI)
getAfterTotalCount :: IO Int
getAfterTotalCount =
fromOnly . head
<$> DB.query
db
[sql|
SELECT COUNT(1)
FROM chat_items
WHERE user_id = ? AND note_folder_id = ?
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|]
(userId, noteFolderId, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI)
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
toChatItemRef = \case
@ -1581,6 +1877,12 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
CPLast count -> liftIO $ getAllChatItemsLast_ count
CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem_ afterId
CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem_ beforeId
CPAround aroundId count -> liftIO . getAllChatItemsAround_ aroundId count . aChatItemTs =<< getAChatItem_ aroundId
CPInitial count -> do
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
liftIO getFirstUnreadItemId_ >>= \case
Just itemId -> liftIO . getAllChatItemsAround_ itemId count . aChatItemTs =<< getAChatItem_ itemId
Nothing -> liftIO $ getAllChatItemsLast_ count
mapM (uncurry (getAChatItem db vr user)) itemRefs
where
search = fromMaybe "" search_
@ -1624,6 +1926,30 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
LIMIT ?
|]
(userId, search, beforeTs, beforeTs, beforeId, count)
getChatItem chatId =
DB.query
db
[sql|
SELECT chat_item_id, contact_id, group_id, note_folder_id
FROM chat_items
WHERE chat_item_id = ?
|]
(Only chatId)
getAllChatItemsAround_ aroundId count aroundTs = do
itemsBefore <- getAllChatItemsBefore_ aroundId count aroundTs
item <- getChatItem aroundId
itemsAfter <- getAllChatItemsAfter_ aroundId count aroundTs
pure $ itemsBefore <> item <> itemsAfter
getFirstUnreadItemId_ =
fmap join . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT MIN(chat_item_id)
FROM chat_items
WHERE user_id = ? AND item_status = ?
|]
(userId, CISRcvNew)
getChatItemIdsByAgentMsgId :: DB.Connection -> Int64 -> AgentMsgId -> IO [ChatItemId]
getChatItemIdsByAgentMsgId db connId msgId =
@ -2631,9 +2957,9 @@ getGroupSndStatusCounts db itemId =
getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
chatItemIds <- getLastItemIds_
ciIds <- getLastItemIds_
-- use getGroupCIWithReactions to read reactions data
reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) chatItemIds
reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) ciIds
where
getLastItemIds_ :: IO [ChatItemId]
getLastItemIds_ =

4
src/Simplex/Chat/Store/Migrations.hs
View file

@ -114,6 +114,7 @@ import Simplex.Chat.Migrations.M20240827_calls_uuid
import Simplex.Chat.Migrations.M20240920_user_order
import Simplex.Chat.Migrations.M20241008_indexes
import Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
import Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -227,7 +228,8 @@ schemaMigrations =
("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid),
("20240920_user_order", m20240920_user_order, Just down_m20240920_user_order),
("20241008_indexes", m20241008_indexes, Just down_m20241008_indexes),
("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id)
("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id),
("20241023_chat_item_autoincrement_id", m20241023_chat_item_autoincrement_id, Just down_m20241023_chat_item_autoincrement_id)
]
-- | The list of migrations in ascending order by date

2
src/Simplex/Chat/View.hs
View file

@ -93,7 +93,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRChatSuspended -> ["chat suspended"]
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [viewJSON chats]
CRChats chats -> viewChats ts tz chats
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
CRApiParsedMarkdown ft -> [viewJSON ft]
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure

58
tests/ChatTests/Direct.hs
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
@ -123,7 +124,7 @@ chatDirectTests = do
it "chat items only expire for users who configured expiration" testEnableCIExpirationOnlyForOneUser
it "disabling chat item expiration doesn't disable it for other users" testDisableCIExpirationOnlyForOneUser
it "both users have configured timed messages with contacts, messages expire, restart" testUsersTimedMessages
it "user profile privacy: hide profiles and notificaitons" testUserPrivacy
it "user profile privacy: hide profiles and notifications" testUserPrivacy
describe "settings" $ do
it "set chat item expiration TTL" testSetChatItemTTL
it "save/get app settings" testAppSettings
@ -210,6 +211,7 @@ testAddContact = versionTestMatrix2 runTestAddContact
-- pagination
alice #$> ("/_get chat @2 after=" <> itemId 1 <> " count=100", chat, [(0, "hello there"), (0, "how are you?")])
alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, features <> [(1, "hello there 🙂")])
alice #$> ("/_get chat @2 around=" <> itemId 2 <> " count=2", chat, [(0, "Audio/video calls: enabled"), (1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")])
-- search
alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")])
-- read messages
@ -360,6 +362,36 @@ 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
bob #$> ("/_get chat @2 initial=2", chat, [(0, "Voice messages: enabled"), (0, "Audio/video calls: enabled"), (0, "1"), (0, "2"), (0, "3")])
-- Read next 2 items
let itemIds = intercalate "," $ map itemId [1 .. 2]
bob #$> ("/_read chat items @2 " <> itemIds, id, "ok")
bob #$> ("/_get chat @2 initial=2", chat, [(0, "1"), (0, "2"), (0, "3"), (0, "4"), (0, "5")])
-- 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 $
@ -791,7 +823,7 @@ testDirectMessageDelete =
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
-- alice: msg id 1
-- alice: msg id 3
bob ##> ("/_update item @2 " <> itemId 2 <> " text hey alice")
bob <# "@alice [edited] > hello 🙂"
bob <## " hey alice"
@ -806,12 +838,12 @@ testDirectMessageDelete =
alice @@@ [("@bob", "hey alice [marked deleted]")]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hey alice [marked deleted]")])
-- alice: deletes msg id 1 that was broadcast deleted by bob
alice #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted")
-- alice: deletes msg id 3 that was broadcast deleted by bob
alice #$> ("/_delete item @2 " <> itemId 3 <> " internal", id, "message deleted")
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
-- alice: msg id 1, bob: msg id 3 (quoting message alice deleted locally)
-- alice: msg id 4, bob: msg id 3 (quoting message alice deleted locally)
bob `send` "> @alice (hello 🙂) do you receive my messages?"
bob <# "@alice > hello 🙂"
bob <## " do you receive my messages?"
@ -819,14 +851,14 @@ testDirectMessageDelete =
alice <## " do you receive my messages?"
alice @@@ [("@bob", "do you receive my messages?")]
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "do you receive my messages?"), Just (1, "hello 🙂"))])
alice #$> ("/_delete item @2 " <> itemId 1 <> " broadcast", id, "cannot delete this item")
alice #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "cannot delete this item")
-- alice: msg id 2, bob: msg id 4
-- alice: msg id 5, bob: msg id 4
bob #> "@alice how are you?"
alice <# "bob> how are you?"
-- alice: deletes msg id 2
alice #$> ("/_delete item @2 " <> itemId 2 <> " internal", id, "message deleted")
-- alice: deletes msg id 5
alice #$> ("/_delete item @2 " <> itemId 5 <> " internal", id, "message deleted")
-- bob: marks deleted msg id 4 (that alice deleted locally)
bob #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "message marked deleted")
@ -2340,6 +2372,14 @@ testUserPrivacy =
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled"
]
alice ##> "/_get items around=11 count=2"
alice
<##? [ "bob> Full deletion: off",
"bob> Message reactions: enabled",
"bob> Voice messages: enabled",
"bob> Audio/video calls: enabled",
"@bob hello"
]
alice ##> "/_get items after=12 count=10"
alice
<##? [ "@bob hello",

34
tests/ChatTests/Groups.hs
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
@ -344,6 +345,7 @@ testGroupShared alice bob cath checkMessages directConnections = do
-- so we take into account group event items as well as sent group invitations in direct chats
alice #$> ("/_get chat #1 after=" <> msgItem1 <> " count=100", chat, [(0, "hi there"), (0, "hey team")])
alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")])
alice #$> ("/_get chat #1 around=" <> msgItem1 <> " count=2", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")])
alice #$> ("/_get chat #1 count=100 search=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, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
@ -374,6 +376,38 @@ 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
bob #$> ("/_get chat #1 initial=2", chat, [(0, "Recent history: on"), (0, "connected"), (0, "1"), (0, "2"), (0, "3")])
-- Read next 2 items
let itemIds = intercalate "," $ map groupItemId [1 .. 2]
bob #$> ("/_read chat items #1 " <> itemIds, id, "ok")
bob #$> ("/_get chat #1 initial=2", chat, [(0, "1"), (0, "2"), (0, "3"), (0, "4"), (0, "5")])
-- 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 $

6
tests/ChatTests/Local.hs
View file

@ -51,7 +51,7 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/chats"
alice /* "ahoy!"
alice ##> "/_update item *1 1 text Greetings."
alice ##> "/_update item *1 2 text Greetings."
alice ##> "/tail *"
alice <# "* Greetings."
@ -102,6 +102,10 @@ testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice #$> ("/_get chat *1 count=100", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 count=1", chat, [(1, "who's there?")])
alice #$> ("/_get chat *1 around=2 count=1", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock")])
alice #$> ("/_get chat *1 around=2 count=3", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 around=3 count=10", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 around=4 count=1", chat, [(1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 after=2 count=10", chat, [(1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 after=2 count=2", chat, [(1, "knock-knock"), (1, "who's there?")])
alice #$> ("/_get chat *1 after=1 count=2", chat, [(1, "memento mori"), (1, "knock-knock")])

4
tests/SchemaDump.hs
View file

@ -102,7 +102,9 @@ skipComparisonForDownMigrations =
-- table and indexes move down to the end of the file
"20231215_recreate_msg_deliveries",
-- on down migration idx_msg_deliveries_agent_ack_cmd_id index moves down to the end of the file
"20240313_drop_agent_ack_cmd_id"
"20240313_drop_agent_ack_cmd_id",
-- on down migration chat_item_autoincrement_id makes sequence table creation move down on the file
"20241023_chat_item_autoincrement_id"
]
getSchema :: FilePath -> FilePath -> IO String