mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-12 09:28:09 +00:00
Merge branch 'master' into server-operators
This commit is contained in:
23 files changed
+1136
-402
No files matched your search
@@ -581,7 +581,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)
|
||||
@@ -852,6 +852,8 @@ data ChatPagination
|
||||
= CPLast Int
|
||||
| CPAfter ChatItemId Int
|
||||
| CPBefore ChatItemId Int
|
||||
| CPAround ChatItemId Int
|
||||
| CPInitial Int
|
||||
deriving (Show)
|
||||
|
||||
data PaginationByTime
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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;
|
||||
|]
|
||||
@@ -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,
|
||||
|
||||
+504
-178
@@ -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_ =
|
||||
|
||||
@@ -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.Chat.Migrations.M20241027_server_operators
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
@@ -229,6 +230,7 @@ schemaMigrations =
|
||||
("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),
|
||||
("20241023_chat_item_autoincrement_id", m20241023_chat_item_autoincrement_id, Just down_m20241023_chat_item_autoincrement_id),
|
||||
("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators)
|
||||
]
|
||||
|
||||
|
||||
@@ -94,7 +94,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 operators -> ttyUser u $ viewUserServers userServers operators testView
|
||||
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
|
||||
|
||||
Reference in new issue
Block a user